(FILECREATED "14-AUG-83 13:00:42" <NEWLISP>BREAK.;11 65402
changes to: (FNS BREAK1 BREAKCOM BREAKRESETFN BREAKREAD BREAK3)
previous date: "14-AUG-83 00:46:20" <NEWLISP>BREAK.;10)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT BREAKCOMS)
(RPAQQ BREAKCOMS [(FNS BREAK1 BREAK1A BRKLASTPOS BREAKCOM BREAKCOM1 BREAKRESETFN \BREAKRESETRESTORE
BREAKRETFROM BREAKRETEVAL BREAKEXIT \BREAKSTOP BREAK2 BREAK?= BREAK?=1 BREAK=
STKPOZ STKPOZ1 STKPOZ2 BREAKREAD BAKTRACE BAKTRACE1 BREAK3 BREAK BREAK0
BREAK0A UNBREAK UNBREAK0 REBREAK REBREAK0 TRACE BREAKIN BREAKIN1 UNBREAKIN
SAVED SAVED1 SMARTARGLIST RESTORENAMES VIRGINFN RESTORE PACK-IN- BREAKNARGS)
[INITVARS (SMARTARGARRAY)
(MSARGTABLE)
(MSHASHFILENAME)
(COMPILERMACROPROPS (QUOTE (MACRO]
(VARS (BREAKFN (QUOTE BREAK1))
BREAKI
(NBREAKS 0)
NOBREAKIN
(BREAKDELIMITER (QUOTE "
"))
(BRKFILE T)
(BROKENFNS)
(BRKINFOLST)
BAKTRACELST
(BREAKRESETVALSLST)
(BREAK↑WFLG)
(\USEBREAKRESETFORMS T)
(BREAKINCHAR (CHARACTER 1))
(BREAKHELPFLAG T))
(ADDVARS (LISPXFNS (RETFROM . BREAKRETFROM)
(RETEVAL . BREAKRETEVAL))
(BREAKMACROS (BT (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
0 T))
(BTV (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
1 T))
(BTVPP (PROG ((SYSPRETTYFLG T))
(BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
1 T)))
(BTV* (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
7 T))
(BTV+ (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
5 T))
(BTV! (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
39 T)))
(NOBREAKS GO QUOTE *)
(BREAKCOMSLST BT VALUE ?= @ EVAL OK GO RETURN BTV BTV* BTV! ARGS !EVAL !OK !GO EDIT
UB = -> IN? ↑ %)
(BREAKRESETFORMS (INTERRUPTABLE T)
(SETREADMACROFLG)
(CONTROL)
(ECHOMODE T)))
(P (MOVD? (QUOTE EVAL)
(QUOTE \SAFEEVAL)))
(BLOCKS (PACK-IN-)
(BREAK0 BREAK0 BREAK0A (SPECVARS LINKS)
(LOCALFREEVARS WHEN COMS BRKFN BREAKCOM)
(GLOBALVARS BREAKFN BROKENFNS))
(NIL UNBREAK UNBREAK0 REBREAK REBREAK0 (GLOBALVARS BRKINFOLST BROKENFNS LASTWORD
DWIMFLG USERWORDS))
(NIL SAVED (GLOBALVARS CLISPARRAY DWIMFLG))
(NIL BRKLASTPOS SAVED1 RESTORE BREAK UNBREAKIN (GLOBALVARS UPFINDFLG)
TRACE RESTORENAMES (NOLINKFNS EDITE)
VIRGINFN BREAKNARGS (LINKFNS . T))
(BREAK1BLOCK BREAK1 BREAK1A BREAKCOM BREAKCOM1 BREAKRESETFN BREAKREAD BREAKEXIT
BREAK?= BREAK?=1 BREAK= STKPOZ STKPOZ1 STKPOZ2 BREAK3
(ENTRIES BREAK1 BREAK3 BREAKREAD BREAKRESETFN)
(LOCALFREEVARS BRKCOM BRKLINE BRKEXP BRKVALUE BRKCOMS BRKFN !VALUE
LASTPOS BRKTYPE TYPE-IN BRKBUFS BRKRDBUF LSTPOS BRKFIL
BREAKRESETVALS \BREAKRESETEXPR BRKORIGFLG BRKLISPXHIST
BRKPAT)
(SPECVARS !VALUE LASTPOS BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE NBREAKS
BREAKRESETVALS PLVLFILEFLG BREAKSTATE LISPXID)
(RETFNS BREAK1A)
(GLOBALVARS BREAK↑WFLG BREAKRESETVALSLST BREAKDELIMITER BRKFILE
CLEARSTKLST BREAKCOMSLST BRKFILE BREAKMACROS LISPXCOMS
LISPXHISTORY BREAKRESETFORMS NOSPELLFLG DWIMFLG BREAKI
BREAKHELPFLAG)
(NOLINKFNS . BREAK2))
(BAKTRACEBLOCK BAKTRACE BAKTRACE1 (ENTRIES BAKTRACE BAKTRACE1)
(SPECVARS PLVLFILEFLG)
(GLOBALVARS BREAKDELIMITER BAKTRACELST CLEARSTKLST))
(BREAKIN BREAKIN BREAKIN1 (SPECVARS FN WHERE WHEN BRKCOMS)
(GLOBALVARS BREAKFN NOBREAKIN BROKENFNS UPFINDFLG BREAKINCHAR)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA TRACE REBREAK UNBREAK BREAK BREAK3)
(NLAML BREAKNARGS BREAKIN BREAK1)
(LAMA])
(DEFINEQ
(BREAK1
[NLAMBDA (BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE ERRORN)
(* lmm "13-AUG-83 23:07")
(* BRKTYPE is for USE by DWIM and HELPFIX.)
(DECLARE (SPECVARS BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE ERRORN NBREAKS \USEBREAKRESETFORMS))
(COND
((NULL (\SAFEEVAL BRKWHEN (QUOTE BREAK-EXP)))
(\SAFEEVAL BRKEXP (QUOTE BREAK-EXP)))
[(MINUSP NBREAKS)
(COND
((NULL BRKTYPE) (* for other break types, evaluating the brkexp will just cause another error.
For this case, don't print a msg; it may loop.)
(\SAFEEVAL BRKEXP (QUOTE BREAK-EXP)))
(T (PROG ((NBREAKS 0)
(\USEBREAKRESETFORMS NIL))
(UNBREAK0 BRKFN)
(PRIN1 "Break within a break on " T)
(PRINT BRKFN T)
(PRINT BRKFN T)
(PRIN1 " unbroken." T)
(HELP]
(T (RESETLST (* RESETLST to catch exceptional stuff like undoing BREAKRESETFORMS on ↑D)
(BREAK1A (IMINUS (ADD1 NBREAKS])
(BREAK1A
[LAMBDA (NBREAKS) (* lmm "13-AUG-83 23:57")
(* This is a separate function from BREAK1 so that BREAK1 doesnt have to both an entry and a retfn.
In latter case, there would be a frame for BREAK1, a frame for BREAK1BLOCK, and then another from BREAK1, which
would make the STKNTH in BREAK1a work differently compiled than interpreted.)
(DECLARE (GLOBALVARS BREAKHELPFLAG))
(PROG ((TYPE-IN (NULL BRKCOMS))
(BRKFIL (OR (NULL BRKCOMS)
BRKFILE))
(HELPFLAG BREAKHELPFLAG)
BRKID BRKVALUE !VALUE LASTPOS BRKRDBUF BRKBUFS BREAKRESETVALS \BREAKRESETEXPR BRKORIGFLG
BRKLISPXHIST BRKLINE)
(* HELPFLAG is bound so that calls to ERROR with a NOBREAK of T will not break because the user has set HELPFLAG to
BREAK!)
(* BRKFIL is used for output only when BRKCOMS are not NIL, e.g. for tracing. In this case, by setting BRKFILE to
the name of a file, the user can redirect the output to a file.)
(COND
((AND LISPXHISTORY (NEQ CLEARSTKLST T))
(* How can this work??? LASTPOS isn't set yet --bvm)
(SETQ CLEARSTKLST (CONS LASTPOS CLEARSTKLST))
(* In case user control-D's out of the break, this will RELSTK LASPOS.)
(AND (STACKP BRKTYPE)
(SETQ CLEARSTKLST (CONS BRKTYPE CLEARSTKLST)))
(* occurs on ERRORX breaks. BRKTYPE will be used by the RETFROM that is waiting to be called with the value returned
by BREAK1 as its second argument.)
))
[COND
[(AND (NULL BRKFN)
(NLISTP BRKTYPE))
(* The message (NIL broken) only makes sense for U.D.F. NIL breaks, in which case BRKTYPE is a list.
For all others, the message is just (broken))
(SETQ BRKID (QUOTE (broken]
[(LISTP BRKFN)
(SETQ BRKID (APPEND BRKFN (QUOTE (broken]
(T (SETQ BRKID (LIST BRKFN (QUOTE broken]
(COND
(BRKTYPE (* Not a user BREAK. the buffers will be restored when the BREAK is left.)
(SETQ BRKRDBUF READBUF)
[SETQ BRKBUFS (CLBUFS (EQ BRKTYPE (QUOTE INTERRUPT]
(SETQ READBUF NIL)
(AND (EQ BRKTYPE (QUOTE ERRORX))
(EQ ERRORN 2)
(SETQ LASTPOS (STKNTH -1 LASTPOS)))
(* This to avoid garbage backtraces.)
))
(BREAKRESETFN (QUOTE ENTERING))
(* BREAKRESETFORMS are a list of forms suitable for use in a rsetform which are to be executed, bt their execution
made transparent to the evaluation of the break expression. thus they are restored before doing an EVAL, OK, GO,
RETURN, or REVERT, aand then reexecuted when entering or returning into a break. especially useful for debugging
ppograms that fool around with i/o)
(COND
((EQ (CAR BRKCOMS)
(QUOTE TRACE)) (* handle TRACE specially.)
[COND
((NOT (OPENP BRKFIL (QUOTE OUTPUT)))
(OUTPUT (OUTFILE BRKFIL]
(TERPRI BRKFIL)
(BREAK2) (* Indents appropriate number of spaces.)
(PRIN2 BRKFN BRKFIL T)
(PRINT (QUOTE :)
BRKFIL T)
(SETQ BRKCOMS (CDR BRKCOMS)))
(T (COND
[ERRORN (* print error message)
(COND
((NUMBERP (CAR ERRORN))
(* normal errorn)
(ERRORMESS ERRORN))
(T (* ERRORN is a list of args to ERRORMESS1 as from HELP)
(ERRORMESS1 (CAR ERRORN)
(CADR ERRORN)
(CADDR ERRORN]
((EQ BRKTYPE (QUOTE INTERRUPT))
(* print the interrupted message)
(PRIN1 (SELECTQ (SYSTEMTYPE)
(D (QUOTE "interrupted below "))
(QUOTE "interrupted before "))
T)
(PRINT BRKFN T T)))
(TERPRI BRKFIL)
(BREAK2)
(PRINT BRKID BRKFIL T)))
LP (SETQ BRKLINE NIL)
[COND
[BRKCOMS (COND
((ERSETQ (BREAKCOM (CAR BRKCOMS)))
(SETQ BRKCOMS (CDR BRKCOMS))
(GO LP]
(T (NLSETQ (PROMPTCHAR (QUOTE :)
T LISPXHISTORY))
(COND
((ERSETQ (PROG (BRKLISPXHIST (LISPXID (QUOTE :))
BRKCOM)
(SETQ BRKCOM (LISPXREAD T T))
(BREAKCOM BRKCOM T)))
(GO LP]
ERROR
(SETQ LISPXBUFS (OR (CLBUFS)
LISPXBUFS))
(* For a CONTINUE command WITHIN this BREAK.)
(SETQ READBUF NIL) (* We don't worry about saving READBUF on user induced interruptions, e.g.
control-d control-e since he can always use REDO or RETRY.)
(SETQ BRKCOMS NIL)
(SETQ BRKFIL T)
(BREAKRESETFN (QUOTE REENTERING))
(* E.g. error occurred inside of an EVAL or OK, like from a lower break exited
via ↑.)
(PRIN2 BRKID T T)
(TERPRI T)
(GO LP])
(BRKLASTPOS
[LAMBDA (FLG) (* lmm " 3-JUL-83 23:03")
(* returns initial value of LASTPOS, usually one before the call to break1, except in the cseof an error break or
call to interrupt when rguments ha to be spread via evala. in this case, lastpos is the evala.
however, if FLG is T, value returned by BRKLASTPOS is always the first function before the call to reak1.
used by break package as well as by helpfix and helpfix1)
(PROG (POS POS1)
(SETQ POS (REALSTKNTH -1 (QUOTE BREAK1)
T))
(if (EQ (STKNAME POS)
(QUOTE CLISPBREAK1))
then (REALSTKNTH -1 POS NIL POS)
elseif FLG
then (COND
((EQ (STKNAME (SETQ POS1 (REALSTKNTH -1 POS)))
(QUOTE EVALA))
(REALSTKNTH -1 POS1 NIL POS)))
(* if the first real frame is the one below an evala, we want the one above the
evala.)
(RELSTK POS1))
(RETURN POS])
(BREAKCOM
[LAMBDA (BRKCOM TYPE-IN) (* lmm "14-AUG-83 12:59")
(PROG [BRKZ (BRKFIL (COND
(TYPE-IN T)
(T BRKFILE]
[COND
((AND TYPE-IN (NLISTP BRKCOM))
(SETQ BRKLINE (READLINE T (LIST BRKCOM)
T))
(* this gives the user a chance to delete an atomic comand with a ↑W.)
(SETQ BRKCOM (CAR BRKLINE))
(SETQ BRKLINE (CDR BRKLINE]
TOP [COND
((AND (NULL BRKORIGFLG)
(LITATOM BRKCOM)
(SETQ BRKZ (FASSOC BRKCOM BREAKMACROS)))
(BREAKCOM1 NIL NIL T NIL T)
(* indicates to save the command, without *PRINT* prints, and not to evaluate
it.)
(MAPC (CDR BRKZ)
(FUNCTION BREAKCOM))
(* each command will use the same BRKLISPXHIST.)
)
(T (SELECTQ BRKCOM
[ORIGINAL (PROG ((BRKORIGFLG T))
(MAPC (CDR BRKCOM)
(FUNCTION BREAKCOM]
(RETURN (* User will type in expression to be evaluated and returned as value of BREAK.
otherwise same as GO.)
(BREAKCOM1 (SETQ BRKZ (BREAKREAD (QUOTE LINE)))
NIL NIL (CONS (QUOTE RETURN)
BRKZ))
(BREAKEXIT))
(?= [BREAKCOM1 NIL NIL T (CONS BRKCOM (SETQ BRKZ (BREAKREAD (QUOTE LINE]
(BREAK?= BRKZ))
(@ [BREAKCOM1 NIL NIL T (CONS BRKCOM (SETQ BRKZ (BREAKREAD (QUOTE LINE]
(PRINT (STKNAME (SETQ BRKZ (STKPOZ BRKZ)))
T T))
(REVERT (SETQ BRKZ (BREAKREAD (QUOTE LINE)))
(BREAKCOM1 NIL NIL T (CONS BRKCOM BRKZ)
T)
(COND
(BRKZ (STKPOZ BRKZ)))
(PROG ((FN (STKNAME LASTPOS))
(ARGS (STKARGS LASTPOS))
DEF FORM)
(COND
((NOT (LITATOM FN))
(LISPXPRIN1 "can't revert to open lambda expression
" T)
(ERROR!))
((DUMMYFRAMEP LASTPOS)
(LISPXPRIN1 "can't revert to a DUMMYPFRAMEP
" T T)
(ERROR!)))
(PRINT FN T T)
[COND
([NULL (AND (EXPRP (SETQ DEF (GETD FN)))
(EQ (CAADDR DEF)
(QUOTE BREAK1]
(BREAK0 FN T (QUOTE (UB]
(BREAKRESETFN (QUOTE REVERTING))
(RETAPPLY LASTPOS FN (COND
((EQ (ARGTYPE FN)
3)
(CAR ARGS))
(T ARGS))
T)))
[= (COND
((AND TYPE-IN BRKLINE (NLISTP BRKEXP)
(LISTP BRKTYPE))
(SETQ BRKZ (BREAKREAD))
(BREAKRETFROM (QUOTE BREAK1A)
(SHOWPRINT (BREAKCOM1 (LISPX/ (LIST (QUOTE SETQ)
BRKEXP BRKZ))
NIL NIL (LIST BRKCOM BRKZ))
T T)))
(T (PRINT (QUOTE ?)
T T]
[-> (COND
(DWIMFLG (BREAKCOM1 (LIST (QUOTE HELPFIX1)
(LIST (QUOTE QUOTE)
BRKLINE)
(LIST (QUOTE QUOTE)
LISPXHIST))
NIL NIL (CONS BRKCOM BRKLINE)))
(T (PRINT (QUOTE ?)
T T]
(COND
((AND TYPE-IN BRKLINE (FGETD BRKCOM))
(GO DEFAULT))
(T (SELECTQ BRKCOM
((↑ STOP)
(\BREAKSTOP))
(GO
(* always saves command, evaluates brkexp unless already evaluated, prints value,
and exits)
(BREAKCOM1 BRKEXP NIL BRKVALUE)
(BREAKEXIT))
(OK
(* if not already evaluated, saves command and evaluates brkexp.
does not print value)
(BREAKCOM1 BRKEXP BRKVALUE BRKVALUE)
(BREAKEXIT T))
((EVAL EVALVALUE)
(* Evaluate BRKEXP but do not exit from BREAK.)
(BREAKCOM1 BRKEXP)
(BREAKRESETFN (QUOTE REENTERING))
(SETQ IT (SETQ !VALUE (CAR BRKVALUE)))
[COND
((EQ TYPE-IN T)
(BREAK2)
(PRIN2 BRKFN T T)
(SELECTQ BRKCOM
(EVALVALUE (PRIN1 " = " T)
(SHOWPRINT !VALUE T T))
(PRIN1 (QUOTE " evaluated
")
T]
(* For user's benefit.)
)
(VALUE (COND
((NULL BRKVALUE)
(ERROR (QUOTE "not evaluated yet.")
(QUOTE %)
T)))
(SHOWPRINT (BREAKCOM1 (QUOTE !VALUE))
BRKFIL T)
(SETQ IT !VALUE))
(ARGS
(* The next 11 commands could be on BREAKMACROS but are included here to 'PROTECT' the calls to PRINT, GETD, READ,
etc. contained in them.)
(PRINT (VARIABLES LASTPOS)
T T))
[!EVAL
(* Evaluate as though unbroken and then restore BREAK.)
(* the call to breakcom1 just saves the command, but does not evaluate the
expression)
(BREAKCOM1 NIL NIL T)
(UNBREAK0 BRKFN)
(SETQ BRKZ (FASSOC BRKFN BRKINFOLST))
(BREAKCOM (QUOTE EVAL))
(AND BRKZ (REBREAK0 BRKZ))
(COND
((EQ TYPE-IN T)
(BREAK2)
(PRIN2 BRKFN T T)
(PRIN1 (QUOTE " evaluated
")
T]
(!OK
(* only difference between this and defnit as a macro is that as a macro would get PROPS on the event, so wouldnt
say {FOO evaluated}} etc)
(BREAKCOM1 NIL NIL T)
(BREAKCOM (QUOTE !EVAL))
(BREAKCOM (QUOTE OK)))
(!GO (BREAKCOM1 NIL NIL T)
(BREAKCOM (QUOTE !EVAL))
(BREAKCOM (QUOTE GO)))
(EDIT (PROG (BRKVALUE)
(PRINT (BREAKCOM1 (QUOTE (HELPFIX)))
T T)))
(IN? (PRINT (HELPFIX T)
T T))
[UB (PROG (BRKVALUE)
[SETQ BRKZ
(BREAKCOM1 (LIST (QUOTE UNBREAK0)
(LIST (QUOTE QUOTE)
(COND
((NLISTP BRKFN)
BRKFN)
(T (CAR BRKFN]
(AND TYPE-IN (PRINT BRKZ T T]
(COND
(TYPE-IN (GO DEFAULT))
(T
(* Indicates BRKCOM is from coms, and therefore value shouldn't be printed.)
(PROG ((NBREAKS (MINUS NBREAKS)))
(COND
[BRKLISPXHIST (PROG ((LISPXHIST BRKLISPXHIST))
(\SAFEEVAL BRKCOM
(QUOTE BREAK]
(T (\SAFEEVAL BRKCOM (QUOTE BREAK]
(RETURN)
DEFAULT
(COND
((AND DWIMFLG (LITATOM BRKCOM)
(NOT (FMEMB BRKCOM LISPXCOMS))
[COND
((OR (NULL TYPE-IN)
(NULL BRKLINE))
(NOT (BOUNDP BRKCOM)))
(T (AND (NULL (FGETD BRKCOM))
(NULL (GETLIS BRKCOM (QUOTE (EXPR FILEDEF]
(SETQ BRKZ (FIXSPELL BRKCOM 70 BREAKCOMSLST (NULL TYPE-IN)
T)))
(* Says command would generate an unbound atom error so we first try to correct
spelling using BREAKCOMSLST in addition to SPELLINGS3.)
[SETQ BRKCOM (COND
((NLISTP BRKZ)
BRKZ)
(T (SETQ BRKLINE (LIST (CDR BRKZ)))
(CAR BRKZ]
(GO TOP))
(T (AND (NLISTP BRKCOM)
(LISPXUNREAD BRKLINE))
(PROG ((NBREAKS (MINUS NBREAKS)))
(LISPX BRKCOM (QUOTE :])
(BREAKCOM1
[LAMBDA (BRKX NOSAVEFLG NOEVALFLG BRKZ NOPROPSFLG)
(* lmm "13-AUG-83 23:35")
(DECLARE (SPECVARS TYPE-IN))
(COND
((AND (NULL NOSAVEFLG)
TYPE-IN LISPXHISTORY)
[SETQ BRKLISPXHIST (HISTORYSAVE LISPXHISTORY (QUOTE :)
NIL
[COND
((NULL BRKZ)
(COND
((EQ TYPE-IN T)
(* enables breakcom1 to call itelf recursively to interpret a command, and still
get it saved under original name, e.g. !EVAL -
EVAL)
BRKCOM)
(TYPE-IN
(* dont think i am using this anymore)
(SHOULDNT]
BRKZ
(AND (NULL NOPROPSFLG)
(LIST (QUOTE *PRINT*)
(LIST (QUOTE BREAK3)
(OR BRKFN (QUOTE 'BREAK'))
NBREAKS]
(* BRKLISPXHIST is bound in BREAK1A. Some break commands do not get LISPXHIST rebound, e.g. ↑W commands, and for
some situatons, several break commands use the same lispxhist/brklispxhist, e.g. those arising from macros)
))
[COND
((NULL NOEVALFLG)
[PROG ((HELPCLOCK (CLOCK 2))
(NBREAKS (IMINUS NBREAKS)))
(* note thatHELPFLAG is not ebound here, as it is in LISPX, on the grounds thatif you re doing a RETRY or for some
other eason have set helpflg to BREAK!, it applies while evaluating break expressions, since that is essentially a
continuation.)
(SETQ BRKVALUE (LIST (COND
[BRKLISPXHIST (PROG ((LISPXHIST BRKLISPXHIST))
(AND (EQ BRKX BRKEXP)
(BREAKRESETFN (QUOTE EVALUATING)))
(RETURN (COND
((NULL BRKZ)
(\SAFEEVAL BRKX (QUOTE BREAK-EXP)
))
[(EQ (CAR BRKZ)
(QUOTE RETURN))
(COND
((CDR BRKX)
(APPLY (CAR BRKX)
(CADR BRKX)
(QUOTE :)))
(T (\SAFEEVAL (CAR BRKX)
(QUOTE :]
(T
(* Distinguishes between evaluation of a typed-in expression and an expression
coming from a user function. USED by DWIM.)
(\SAFEEVAL BRKX (QUOTE :]
(T (AND (EQ BRKX BRKEXP)
(BREAKRESETFN (QUOTE EVALUATING)))
(COND
((NULL BRKZ)
(\SAFEEVAL BRKX (QUOTE BREAK-EXP)))
[(EQ (CAR BRKZ)
(QUOTE RETURN))
(COND
((CDR BRKX)
(APPLY (CAR BRKX)
(CADR BRKX)
(QUOTE :)))
(T (\SAFEEVAL (CAR BRKX)
(QUOTE :]
(T
(* Distinguishes between evaluation of a typed-in expression and an expression
coming from a user function. USED by DWIM.)
(\SAFEEVAL BRKX (QUOTE :]
(AND BRKLISPXHIST (FRPLACA (CDDR BRKLISPXHIST)
(CAR BRKVALUE]
(CAR BRKVALUE])
(BREAKRESETFN
[LAMBDA (BREAKSTATE) (* bvm: "30-JUL-83 16:46")
(SELECTQ BREAKSTATE
[(ENTERING REENTERING)
(* ENTERING is first time into break. REENTERING is on rturn from EVAL, or if an
error happens following an OK etc.)
[COND
((AND (NULL BREAKRESETVALS)
\USEBREAKRESETFORMS BREAKRESETFORMS)
[MAPC BREAKRESETFORMS (FUNCTION (LAMBDA (X)
(SETQ BREAKRESETVALS (CONS [COND
((LITATOM X)
(LIST (QUOTE SET)
X
(EVALV X)))
((EQ (CAR X)
(QUOTE SETQ))
(PROG1 (LIST (QUOTE SET)
(CADR X)
(EVALV (CADR X)))
(EVAL X)))
(T (LIST (CAR X)
(EVAL X]
BREAKRESETVALS]
(* Save as a RESETSAVE in case of ↑D. RESETLST is in BREAK1)
(COND
(\BREAKRESETEXPR (RPLACA \BREAKRESETEXPR BREAKRESETVALS))
(T (RESETSAVE NIL (CONS (QUOTE \BREAKRESETRESTORE)
(SETQ \BREAKRESETEXPR (LIST BREAKRESETVALS]
(COND
((OR (EQ BREAKSTATE (QUOTE ENTERING))
(RELSTKP LASTPOS))
(SETQ LASTPOS (BRKLASTPOS]
((NIL LEAVING EVALUATING RESTORE REVERTING)
(* LEAVE means leaving the break and going back up, either via an OK, RETURN, or ↑ EVALUATING means going down, e.g.
an EVAL or OK command. in some situations, might want to do different things.)
[COND
(BREAKRESETVALS [MAPC BREAKRESETVALS (FUNCTION (LAMBDA (X)
(APPLY (CAR X)
(CDR X]
(RPLACA \BREAKRESETEXPR (SETQ BREAKRESETVALS NIL]
(AND (NEQ BREAKSTATE (QUOTE REVERTING))
(BOUNDP (QUOTE LASTPOS))
(RELSTK LASTPOS)))
(SHOULDNT])
(\BREAKRESETRESTORE
[LAMBDA (BREAKRESETVALS)
(DECLARE (SPECVARS BREAKSTATE)) (* bvm: "30-JUL-83 16:43")
(AND BREAKRESETVALS (PROG ((BREAKSTATE (QUOTE LEAVING)))
(MAPC BREAKRESETVALS (FUNCTION (LAMBDA (X)
(APPLY (CAR X)
(CDR X])
(BREAKRETFROM
[LAMBDA (POS VAL FLG) (* wt: " 2-FEB-78 18:31")
(BREAKRESETFN (QUOTE LEAVING))
(RETFROM POS VAL FLG])
(BREAKRETEVAL
[LAMBDA (POS FORM FLG) (* wt: " 2-FEB-78 18:31")
(BREAKRESETFN (QUOTE LEAVING))
(RETEVAL POS FORM FLG])
(BREAKEXIT
[LAMBDA (NOPRINTFLG) (* lmm " 3-JUL-83 23:03")
(RELSTK LASTPOS)
(BREAKRESETFN (QUOTE ENTERING))
[COND
(NOPRINTFLG (* Do not print value.)
(PRINT BRKFN BRKFIL T))
(T
(* In the event that the exit command came from BRKCOMS, e.g. user is tracing, want to keep BREAK= from calling
BREAK2 a second time.)
(BREAK= (OR BRKFN (QUOTE 'BREAK'))
(CAR BRKVALUE]
(BREAKRESETFN (QUOTE LEAVING))
(BKBUFS BRKBUFS) (* BRKBUFS set at beginning of BREAK.)
(AND BRKRDBUF (SETQ READBUF (APPEND READBUF BRKRDBUF)))
(* The AND is not just for efficiency. without it, READBUF would be COPIED in the case of tracing, which makes
debugging history stuff hard.)
(RETFROM (QUOTE BREAK1A)
(CAR BRKVALUE])
(\BREAKSTOP
[LAMBDA NIL (* rrb "12-JUL-83 18:38")
(* gets out of a break context with an ERROR!)
(* this is a separate function so it can be called by
the break window closefn.)
(RELSTK LASTPOS)
(AND (STACKP BRKTYPE)
(RELSTK BRKTYPE)) (* Occurs on ERRORX breaks. See comment in BREAK1.)
(BREAKRESETFN (QUOTE LEAVING))
(RETEVAL (QUOTE BREAK1A)
(QUOTE (ERROR!])
(BREAK2
[LAMBDA (N) (* lmm " 3-JUL-83 23:04")
(SPACES (ITIMES BREAKI (IREMAINDER (SUB1 (OR N (if (MINUSP NBREAKS)
then (IMINUS NBREAKS)
else NBREAKS)))
5))
BRKFIL])
(BREAK?=
[LAMBDA (BRK3X) (* lmm "13-AUG-83 23:35")
(* Handles ?= commands.)
(RESETFORM (PRINTLEVEL 10 10)
(PROG ((PLVLFILEFLG T)
BRK3TEM BRK3Y BRK3Z)
(SETQ BRK3Y (CDDR BRKLISPXHIST))
(SETQ BRK3Z (LISTGET1 BRKLISPXHIST (QUOTE *PRINT*)))
(COND
((NULL BRK3X)
(* E.g. ?= typed, or ?= NIL in BREAKCOMSLST => print all arguments.)
(COND
((ZEROP (SETQ BRK3X (STKNARGS LASTPOS)))
(TERPRI T)
(GO OUT)))
(SETQ BRK3TEM 0)
(GO LP1)))
LP (COND
((NUMBERP (CAR BRK3X))
(BREAK= (BREAK?=1 (CAR BRK3X)
LASTPOS)
(STKARG (CAR BRK3X)
LASTPOS)
BRK3Y BRK3Z))
((LISTP (CAR BRK3X))
(BREAK= (CAR BRK3X)
(STKEVAL LASTPOS (LIST (LIST (QUOTE LAMBDA)
(QUOTE (LISPXHIST))
(LISPX/ (CAR BRK3X)))
(KWOTE BRK3Y))
NIL
(QUOTE :))
BRK3Y BRK3Z)
(* Cannot simply bind LISPXHIST here in BREAK?= as the STKEVAL would cause UNDOSAVE to pick up LISPXHIST as of a
higher point on the stack.)
(* extra argument to STKEVAL is for DWIM.)
)
((EQ (CAR BRK3X)
(QUOTE NIL))
(* This permits user to TRACE and just see the value and no argument printout by performing
(TRACE (FN)) which TRACE converts to (TRACE (FN NIL)) note that (TRACE FN) would give all arguments.)
NIL)
(T (BREAK= (CAR BRK3X)
(EVALV (CAR BRK3X)
LASTPOS)
BRK3Y BRK3Z)))
(COND
((SETQ BRK3X (CDR BRK3X))
(GO LP)))
(GO OUT)
LP1 (COND
((EQ BRK3TEM BRK3X)
(GO OUT)))
(BREAK= (BREAK?=1 (SETQ BRK3TEM (ADD1 BRK3TEM))
LASTPOS)
(STKARG BRK3TEM LASTPOS)
BRK3Y BRK3Z)
(GO LP1)
OUT (COND
((NEQ (POSITION BRKFIL)
0)
(TERPRI BRKFIL)))
(RETURN])
(BREAK?=1
[LAMBDA (N POS) (* lmm " 3-JUL-83 23:04")
(PROG (ARGS TEM)
(RETURN (COND
((AND (SETQ TEM (STKARGNAME N POS))
(LITATOM TEM))
TEM)
(T (AND (FNTYP (SETQ TEM (STKNAME POS)))
(SETQ ARGS (SMARTARGLIST TEM)))
(* e.g., dont want SMARTARGLIST to print NIL not a function, or *PROG*LAM not a
function.)
[COND
((AND ARGS (NLISTP ARGS))
(* for lambda nospreads, the argument name is bound to the number of arguments
passed,)
(SETQ ARGS (AND (NEQ (ARGTYPE (STKNAME POS))
2)
(LIST ARGS]
(PACK (COND
((SETQ TEM (CAR (NTH ARGS N)))
(LIST (QUOTE *)
TEM
(QUOTE *)))
(T (LIST (QUOTE *ARG)
N
(QUOTE *])
(BREAK=
[LAMBDA (X Y BRK3Y BRK3Z) (* lmm " 3-JUL-83 23:04")
(PROG NIL (* Prints name = value; used by ?= commands and TRACE.)
(* BRK3Y and BRK3Z are for use in connection with
history.)
(COND
((NULL TYPE-IN)
(BREAK2)))
(PRIN2 X BRKFIL T)
(COND
(BRK3Z (* Saves expression to left of '=' sign)
(NCONC1 BRK3Z X)))
(PRIN1 (QUOTE " = ")
BRKFIL)
[COND
(BRK3Y (* Saves value to right of '=' sign)
(COND
((NLISTP (CAR BRK3Y)) (* First time through, still has initial value of %.)
(FRPLACA BRK3Y (LIST Y)))
(T (NCONC1 (CAR BRK3Y)
Y]
(SHOWPRIN2 Y BRKFIL)
(PRIN1 BREAKDELIMITER BRKFIL])
(STKPOZ
[LAMBDA (X) (* lmm " 3-JUL-83 23:04")
(PROG (FN (LSTPOS (BRKLASTPOS)))
(* Called from BREAK?= and by @ macro)
(if (AND X (NLISTP X))
then (STKPOZ1 X)
(GO EXIT))
LP (COND
((NULL X)
(GO EXIT)))
[SELECTQ (CAR X)
(← (PRIN1 (QUOTE "not available in spaghetti system")
T)
(ERROR!))
(@ (SETQ LSTPOS LASTPOS)
(SETQ X (CDR X)))
(= [SETQ LSTPOS (STKNTH 0 (EVAL (CADR X]
(SETQ X (CDDR X)))
(COND
((NUMBERP (CAR X))
[SETQ LSTPOS (COND
((MINUSP (CAR X))
(STKNTH (CAR X)
LSTPOS LSTPOS))
(T (STKPOZ2 (CAR X)
LSTPOS]
(SETQ X (CDR X)))
((EQ (CADR X)
(QUOTE /))
(* E.g. FOO / 2 means second occurrence of FOO)
(STKPOZ1 (CAR X)
(IMINUS (CADDR X)))
(SETQ X (CDDDR X)))
(T (SETQ LSTPOS (STKNTH -1 LSTPOS LSTPOS))
(* So FOO FOO will be equivalent to FOO / 2)
(STKPOZ1 (CAR X))
(SETQ X (CDR X]
(GO LP)
EXIT(COND
((NEQ LASTPOS LSTPOS)
(STKNTH 0 LSTPOS LASTPOS)
(* smashes lstpos into the LASTPOS stack pointer, if we just reset lastpos to
lstpos would also have toaadd new lastpos onto clearstklst.)
(RELSTK LSTPOS)))
(RETURN LASTPOS])
(STKPOZ1
[LAMBDA (FN N) (* lmm " 3-JUL-83 23:04")
(PROG (TEM)
(if (SETQ TEM (STKPOS FN N LSTPOS))
then (RELSTK LSTPOS)
(RETURN (SETQ LSTPOS TEM))
elseif [AND DWIMFLG (NEQ NOSPELLFLG T)
(PROG (BRKPAT)
(SETQ BRKPAT (EDITFPAT (CONCAT FN "")))
(RETURN (SETQ TEM (SEARCHPDL [FUNCTION (LAMBDA (FN)
(SKOR0 FN (CADR BRKPAT)
(CADDR BRKPAT)
(CDDDR BRKPAT]
LSTPOS]
then (PRIN1 (QUOTE =)
T)
(PRINT (CAR TEM)
T)
(RELSTK LSTPOS)
(RETURN (SETQ LSTPOS (CDR TEM)))
else (RELSTK LSTPOS)
(ERROR FN (QUOTE "not found")
T])
(STKPOZ2
[LAMBDA (N POS) (* lmm " 3-JUL-83 23:04")
(* Returns the stack position N below POS by starting at current position and backing up the control links until it
reaches a point N frames before POS.)
(PROG (POS1 POS2)
(SETQ POS1 (STKNTH -1))
LP (if (EQP POS1 POS)
then (RELSTK POS1)
(RETURN NIL)
elseif (NOT (ZEROP N))
then (SETQ N (SUB1 N))
(SETQ POS1 (STKNTH -1 POS1 POS1))
(GO LP))
(SETQ POS2 (STKNTH -1))
LP1 (* POS1 stays N ahead of POS2. When POS1 reaches END, POS2 is the desired
position.)
(COND
((NULL POS1)
(RELSTK POS2)
(RETURN NIL))
((EQP POS1 POS)
(RELSTK POS1)
(RETURN POS2)))
(SETQ POS1 (STKNTH -1 POS1 POS1))
(SETQ POS2 (STKNTH -1 POS2 POS2))
(GO LP1])
(BREAKREAD
[LAMBDA (TYPE) (* lmm " 3-JUL-83 23:05")
(* Gets input for next BREAK command -
used by BREAKMACROS.)
(COND
[BRKCOMS (PROG1 (CADR BRKCOMS)
(SETQ BRKCOMS (CDR BRKCOMS]
((EQ TYPE (QUOTE LINE)) (* Macro wants a line for input, e.g. ?=)
BRKLINE)
(T
(* Macro wants a single item, this is different than calling read since READLINE will return NIL if nothing is there
WHILE read will wait.)
(PROG1 (CAR BRKLINE)
(SETQ BRKLINE (CDR BRKLINE])
(BAKTRACE
[LAMBDA (IPOS EPOS SKIPFNS FLAGS FILE)
(* lmm " 3-JUL-83 23:08")
(* FLAGS is a bit mask telling BACKTRACE what is to be printed. 1 is variables, 2 is eval blips, 4 is everything, 8
suppresses function name and "UNTRACE:", and 16 uses access links.)
(RESETFORM (PRINTLEVEL 2 10)
(PROG ((POS (STKNTH 0 IPOS))
(N 0)
FN X Y Z (PLVLFILEFLG T))
(OR FILE (SETQ FILE T))
(AND (NEQ CLEARSTKLST T)
(SETQ CLEARSTKLST (CONS POS CLEARSTKLST)))
(* POS is used as a scratch-position. N is an offset from FROM. whenever baktrace needs to look at a stkname or
stack position, it (re) uses POS and computes (STKNTH N IPOS POS).)
LP (SETQ FN (STKNAME POS))
LP1 (COND
[[AND (SETQ X (FASSOC FN BAKTRACELST))
(COND
((NLISTP (SETQ Z (CADR X)))
(SETQ Y (BAKTRACE1 (CDDR X)
N IPOS POS)))
(T (SOME (CDR X)
(FUNCTION (LAMBDA (X)
(SETQ Z (CAR X))
(SETQ Y (BAKTRACE1 (CDR X)
N IPOS POS]
(SETQ N Y)
(COND
(Z (PRIN2 Z FILE T)
(PRIN1 BREAKDELIMITER FILE]
[(AND SKIPFNS (SOME SKIPFNS (FUNCTION (LAMBDA (SKIPFN)
(APPLY* SKIPFN FN]
(T (COND
((NEQ FLAGS 0)
(BACKTRACE (SETQ POS (STKNTH N IPOS POS))
POS
(LOGOR FLAGS 8)
FILE
(FUNCTION SHOWPRINT))
(* Tells BACKTRACE not to print "UNTRACE:" or the function name.)
(* The SETQ would be unnecessary in spaghetti)
))
(PRIN2 FN FILE T)
(* Prints function name.)
(PRIN1 BREAKDELIMITER FILE)))
(COND
((AND (SETQ POS (STKNTH (SETQ N (SUB1 N))
IPOS POS))
(NOT (EQP POS EPOS)))
(GO LP)))
(RELSTK POS)
(TERPRI FILE)
(RETURN])
(BAKTRACE1
[LAMBDA (LST N IPOS POS) (* lmm " 3-JUL-83 23:05")
(* 'MATCHES' LST against stack starting at POS.
Returns NIL or offset corresponding to last functionthat matches)
(PROG (TEM)
LP (if (NULL LST)
then (RETURN N)
elseif (NULL (SETQ POS (STKNTH (SUB1 N)
IPOS POS)))
then (GO OUT)
elseif (EQ (SETQ TEM (CAR LST))
(STKNAME POS))
then
(* make this check first if user WANTS to put the name of a dummy frame in baktracelst, he can.
e.g. this is necessary in order to have the sequence *PROG*LAM EVALA *ENV* disappear)
(SETQ N (SUB1 N))
elseif (DUMMYFRAMEP POS)
then (SETQ N (SUB1 N))
(GO LP)
elseif (EQ TEM (QUOTE &))
then (SETQ N (SUB1 N))
elseif (NLISTP TEM)
then (GO OUT)
elseif [NULL (SOME TEM (FUNCTION (LAMBDA (X)
(COND
((EQ X (QUOTE -))
(* Optional match)
T)
((SETQ X (BAKTRACE1 X N IPOS POS))
(SETQ N X]
then (GO OUT))
(SETQ LST (CDR LST))
(GO LP)
OUT (RETURN NIL])
(BREAK3
[NLAMBDA Y (* lmm " 3-JUL-83 23:05")
(RESETFORM (PRINTLEVEL 10 10)
(RESETVARS [(BREAKI (COND
((EQ (CAR Y)
T)
BREAKI)
(T 1]
(RETURN (PROG (BRKCOMS (BRKFIL (CAR Y))
(VAL (CADDR (EVQ EVENT)))
(X (CAR (EVQ EVENT)))
(TYPE-IN T)
(BRKFN (CADR Y))
(N (CADDR Y))
(PLVLFILEFLG T))
(SETQ Y (CDDDR Y))
(* Prints various BREAK commands for history list.)
(COND
((EQ VAL (QUOTE %))
(* VAL and X are bound in PRINTHISTORY1)
(BREAK2 N)
(PRIN1 (QUOTE {)
BRKFIL)
(PRIN2 BRKFN BRKFIL T)
(PRIN1 (QUOTE " not finished}
")
BRKFIL))
(T (SELECTQ (CAR X)
((OK !OK)
(BREAK2 N)
(PRINT BRKFN BRKFIL T))
((GO !GO RETURN)
(BREAK2 N)
(BREAK= BRKFN VAL))
((EVAL !EVAL)
(BREAK2 N)
(PRIN2 BRKFN BRKFIL T)
(PRIN1 (QUOTE " evaluated
")
BRKFIL))
[?= (PROG NIL
LP (BREAK2 N)
(BREAK= (CAR Y)
(CAR VAL))
(SETQ Y (CDR Y))
(COND
((SETQ VAL (CDR VAL))
(TAB 5 NIL BRKFIL)
(GO LP]
(PRINT VAL BRKFIL T])
(BREAK
[NLAMBDA X (* lmm " 3-JUL-83 23:05")
(for L on (OR (LISTP X)
(AND X (LIST X)))
join (PROG (TEM)
(RETURN (if (OR (NLISTP (SETQ TEM (CAR L)))
(EQ (CADR TEM)
(QUOTE IN)))
then (BREAK0 TEM T NIL NIL L)
else (BREAK0 (CAR TEM)
(CADR TEM)
(CADDR TEM)
(CADDDR TEM)
L])
(BREAK0
[LAMBDA (FN WHEN COMS BRKFN TAIL)
(* lmm " 3-JUL-83 23:00")
(PROG (X Y VAL)
(AND (NULL BRKFN)
(SETQ BRKFN BREAKFN))
TOP (SETQ VAL FN)
[if (LISTP FN)
then (RETURN (if (NEQ (CADR FN)
(QUOTE IN))
then
(* Used to BREAK on several functions using same breaking condition
(WHEN) and/or same COMS.)
[MAPCONC FN (FUNCTION (LAMBDA (X)
(BREAK0 X WHEN COMS BRKFN]
elseif (NLISTP (SETQ X (CAR FN)))
then [if (NLISTP (SETQ Y (CADDR FN)))
then (BREAK0A X Y)
else
(* Used to BREAK on one function where it appears in several others, e.g.
(PRINT IN (FOO FIE FUM)))
(MAPCONC Y (FUNCTION (LAMBDA (Y)
(BREAK0A X Y]
elseif (NLISTP (SETQ Y (CADDR FN)))
then
(* Used to BREAK on several functions in one, e.g.
((PRIN1 PRIN2 PRINT) IN FOO))
[MAPCONC X (FUNCTION (LAMBDA (X)
(BREAK0A X Y]
else
(* Combination of above two cases.)
(MAPCONC X (FUNCTION (LAMBDA (X)
(MAPCONC Y (FUNCTION (LAMBDA (Y)
(BREAK0A X Y]
[if (NULL (SETQ X (GETD FN)))
then (if (GETPROP FN (QUOTE EXPR))
then (PRIN2 FN T T)
(PRIN1 (QUOTE " unsaved.
")
T)
(UNSAVEDEF FN (QUOTE EXPR))
(GO TOP)
elseif (SETQ X (FNCHECK FN T NIL NIL TAIL))
then (SETQ FN X)
(GO TOP))
[SETQ VAL (CONS FN (QUOTE (not a function]
(GO OUT1)
elseif [AND (EXPRP X)
(AND (EQ (CAADDR X)
BREAKFN)
(NULL (CDDDR X]
then
(* the or is for caaling breakdown on a broken function, or vice versa, i.e. where brkfn does not eq
(CAADDR X) but function is nevertheless borken.)
(/RPLACA (SETQ Y (CADDR X))
BRKFN)
(/RPLACA (SETQ Y (CDDR Y))
WHEN)
(/RPLACD (CDR Y)
(LIST COMS))
(if [SETQ Y (FASSOC (QUOTE BREAK0)
(GETPROP FN (QUOTE BRKINFO]
then
(* This detects the BREAK (FOO) MOVD (FOO FIE) BREAK (FIE) situation, also BREAK (FOO) BREAK
((FOO IN FIE)) in these cases, FIE and FOO-IN-FIE would appear to be broken even WHEN they were not.)
(/RPLACD Y (LIST WHEN COMS))
(/SETATOMVAL (QUOTE BROKENFNS)
(CONS FN (/DREMOVE FN BROKENFNS)))
(* Moves FN to front of BROKENFNS so that UNBREAK of T will UNBREAK it.)
(RETURN (LIST FN))
else (SETQ X (CONS (CAR X)
(CONS (CADR X)
(CDADR (CADDR X]
(SETQ X (SAVED FN (QUOTE BROKEN)
X)) (* Computes appropriate s-expression definition for this function.)
PUTD(/PUTD FN (LIST (CAR X)
(CADR X)
(LIST BRKFN (CONS (QUOTE PROGN)
(CDDR X))
WHEN FN COMS)))
OUT (if (NULL (FMEMB FN BROKENFNS))
then (/SETATOMVAL (QUOTE BROKENFNS)
(CONS FN BROKENFNS)))
(/ADDPROP FN (QUOTE BRKINFO)
(LIST (QUOTE BREAK0)
WHEN COMS))
(* Used for rebreaking. Information saved at time of BREAK instead of retrieved when unbroken because for BREAKIN,
information is not available in a convenient form at time of UNBREAK. i.e. program would have to search through
entire definition looking for calls to BREAK1.)
OUT1(RETURN (LIST VAL])
(BREAK0A
[LAMBDA (X Y) (* lmm " 3-JUL-83 23:05")
(PROG (Z)
(* Note that while information about -IN- breaks is stored on the property list of the atom, e.g. FOO-IN-FIE, and it
is the atom which is added to BROKENFNS, the user should be able to refer to the function using either the atom form
or the list form, whether he is talking to BREAK, UNBREAK, or REBREAK. (Of course, the very first time he breaks the
function, he must refer to in list form, e.g. (FOO IN FIE) or else the alias will not be created.))
(RETURN (if (NLISTP (SETQ Z (CHNGNM Y X)))
then (* X was found in Y)
(BREAK0 Z WHEN COMS BRKFN)
else (LIST Z])
(UNBREAK
[NLAMBDA X (* lmm " 3-JUL-83 23:05")
(if (AND (NULL X)
(OR BROKENFNS BRKINFOLST))
then (SETQ X (REVERSE BROKENFNS))
(* So that most recently broken function will be unbroken last.)
(/SETATOMVAL (QUOTE BROKENFNS)
NIL)
(/SETATOMVAL (QUOTE BRKINFOLST)
NIL))
(MAPCON X (FUNCTION (LAMBDA (L)
(UNBREAK0 (CAR L)
L])
(UNBREAK0
[LAMBDA (FN TAIL) (* lmm " 3-JUL-83 23:05")
(MAPCAR (PACK-IN- FN)
(FUNCTION (LAMBDA (FN)
(PROG [VAL (ALIAS (GETPROP FN (QUOTE ALIAS)))
(BRKINFO (GETPROP FN (QUOTE BRKINFO]
(if (EQ FN T)
then (SETQ FN (CAR BROKENFNS))
elseif [AND DWIMFLG (NULL (FMEMB FN BROKENFNS))
(NULL (OR (GETD FN)
(GETPROP FN (QUOTE EXPR]
then
(* Only spelling correct if FN is not a function. This is because certain functions such as UNSAVEDEF call UNBREAK0
just to make sure function is not broken. Also, user may perform (UNBREAK FOO) just to be sure.
In these cases, don't want to correct spelling.)
(SETQ FN (OR (FIXSPELL FN 70 BROKENFNS NIL TAIL)
(FIXSPELL FN 70 USERWORDS NIL TAIL
(FUNCTION GETD))
FN)))
[COND
((AND TAIL (EQ (CAR (EVALV (QUOTE EDITFX)))
FN))
(* The TAIL check is becauseUNBREAK0 gets called virginfn from inside of editf when it IS ok to unbreak.
only time it isnt is when user calls unbreak himself.)
(PRIN1 FN T)
(PRIN1 (QUOTE " is currently being edited.
")
T)
(/SETATOMVAL (QUOTE BROKENFNS)
(UNION (LIST FN)
BROKENFNS))
(RETURN (CONS FN (QUOTE (not unbroken]
(AND DWIMFLG (SETQ LASTWORD FN))
(/SETATOMVAL (QUOTE BROKENFNS)
(/DREMOVE FN BROKENFNS))
(SETQ VAL (RESTORE FN (QUOTE BROKEN)))
(COND
((GETPROP FN (QUOTE BROKEN-IN))
(UNBREAKIN FN)
(/REMPROP FN (QUOTE BROKEN-IN))
(SETQ VAL FN)))
[COND
(BRKINFO (/SETATOMVAL (QUOTE BRKINFOLST)
(CONS (CONS FN (CONS ALIAS BRKINFO))
BRKINFOLST))
(/REMPROP FN (QUOTE BRKINFO]
(COND
([AND ALIAS (NULL (GETPROP FN (QUOTE ADVISED]
(CHNGNM (CAR ALIAS)
(CDR ALIAS)
T)))
(RETURN VAL])
(REBREAK
[NLAMBDA X (* lmm " 3-JUL-83 23:05")
(PROG (SPLST)
(RETURN
(if (NULL X)
then (* Reverse so that most recently unbroken function will be rebroken last.)
(MAPCONC (REVERSE BRKINFOLST)
(FUNCTION REBREAK0))
elseif (EQ (CAR X)
T)
then (REBREAK0 (CAR BRKINFOLST))
else (SETQ SPLST (MAPCAR BRKINFOLST (FUNCTION CAR)))
(* For spellings correction.)
(MAPCONC X
(FUNCTION (LAMBDA (FN)
(MAPCONC
(PACK-IN- FN)
(FUNCTION (LAMBDA (FN)
(PROG (Y)
[COND
((AND DWIMFLG (NULL (SETQ Y (FASSOC FN BRKINFOLST)))
(NULL (GETD FN)))
(SETQ FN (OR (FIXSPELL FN 75 SPLST)
(FIXSPELL FN 75 USERWORDS NIL NIL
(FUNCTION GETD))
FN]
(RETURN (COND
((OR Y (SETQ Y (FASSOC FN BRKINFOLST)))
(* Information is stored on BRKINFOLST by function name. If user is performing A REBREAK on
(FOO IN FIE) the information will not be found unless it is looked for under FOO-IN-FIE, hence the call to PACK-IN-
which converts list forms of aliases to their atomic form.)
(REBREAK0 Y))
(T (LIST (CONS FN
(QUOTE (- NO BREAK INFORMATION
SAVED])
(REBREAK0
[LAMBDA (INFO) (* lmm " 3-JUL-83 23:05")
(PROG ((FN (CAR INFO))
(ALIAS (CADR INFO)))
(RETURN (MAPCONC (CDDR INFO)
(FUNCTION (LAMBDA (X)
(AND DWIMFLG (SETQ LASTWORD FN))
(if (NEQ (CAR X)
(QUOTE BREAK0))
then (LIST (APPLY (QUOTE BREAKIN)
(CONS FN X)))
else (APPLY (QUOTE BREAK0)
(CONS (COND
(ALIAS
(* Only want to do the CHANGENAME once. Therefore set ALIAS to NIL in case there are other breaks as well, e.g. user
does BREAK ((FOO IN FIE)) and then BREAK (((FOO IN FIE) (NULL Z))))
(PROG1 (LIST (CDR ALIAS)
(QUOTE IN)
(CAR ALIAS))
(SETQ ALIAS NIL)))
(T FN))
(CDR X])
(TRACE
[NLAMBDA X (* lmm " 3-JUL-83 23:05")
(MAPCONC (if (NLISTP X)
then (* Most likely case is NIL, i.e. TRACE LASTWORD.)
(LIST X)
else X)
(FUNCTION (LAMBDA (Z)
(PROG (Y)
[COND
[(OR (NLISTP Z)
(EQ (CADR Z)
(QUOTE IN)))
(SETQ Y (QUOTE (TRACE ?= NIL GO]
(T (SETQ Y (LIST (QUOTE TRACE)
(QUOTE ?=)
(OR (CDR Z)
(QUOTE (NIL)))
(QUOTE GO)))
(SETQ Z (CAR Z]
(RETURN (BREAK0 Z T Y])
(BREAKIN
[NLAMBDA (FN WHERE WHEN BRKCOMS)
(* lmm " 3-JUL-83 23:05")
(RESETVARS ((UPFINDFLG T))
(RETURN (PROG (W BRK X TEM)
(SETQ FN (FNCHECK FN))
(if [NULL (EXPRP (SETQ X (GETD (OR (GETPROP FN (QUOTE BROKEN))
FN]
then (ERROR FN (QUOTE "not an expr.")
T))
[COND
((NULL (FMEMB FN BROKENFNS))
(/SETATOMVAL (QUOTE BROKENFNS)
(CONS FN BROKENFNS]
[COND
[(NULL WHERE)
(* Convenient default case, especially for BREAKIN for NIL, meaning
(BREAKIN LASTWORD))
(PRIN1 (QUOTE (BEFORE))
T)
(SETQ WHERE (LIST (QUOTE BEFORE)
(QUOTE TTY:]
((LISTP (CAR WHERE))
(SETQ W (CDR WHERE))
(SETQ WHERE (CAR WHERE]
LOOP[COND
[(FMEMB (CAR WHERE)
(QUOTE (AFTER AROUND BEFORE]
(T (RETURN (LIST (CAR WHERE)
(QUOTE ?]
(SETQ BRK (LIST (OR WHEN T)
[BREAKIN1 (CONS FN (CONS (L-CASE (CAR WHERE))
(CDR WHERE]
BRKCOMS))
[SETQ BRK (COND
[(EQ (CAR WHERE)
(QUOTE AROUND))
(LIST (QUOTE MBD)
(CONS BREAKFN (CONS EDITEMBEDTOKEN BRK]
(T (LIST (CAR WHERE)
(CONS BREAKFN (CONS NIL BRK]
(COND
((NEQ (CADR WHERE)
(QUOTE TTY:))
(* Don't print 'SEARCHING...' for (before/after/around tty))
(PRIN1 (QUOTE searching...)
T)))
(OR [NLSETQ (EDITE X
(LIST (CONS (QUOTE LC)
(APPEND (CDR WHERE)
NOBREAKIN))
BRK
(QUOTE (E (PROGN (/PUT FN (QUOTE BROKEN-IN)
T)
(/ADDPROP FN (QUOTE BRKINFO)
(LIST WHERE WHEN
BRKCOMS)))
T]
(PRINT (QUOTE (not found))
T T))
(AND (NEQ (POSITION T)
0)
(TERPRI T))
(COND
(W (SETQ WHERE (CAR W))
(SETQ W (CDR W))
(GO LOOP)))
(RETURN FN])
(BREAKIN1
[LAMBDA (X) (* lmm " 3-JUL-83 23:05")
(MAPCAR X (FUNCTION (LAMBDA (X)
(if (LISTP X)
then (BREAKIN1 X)
else (PACK* X BREAKINCHAR])
(UNBREAKIN
[LAMBDA (FN) (* lmm " 3-JUL-83 23:05")
(* Just does the editing. Property values not affected.)
(RESETVARS ((UPFINDFLG T))
(RETURN
(PROG ((DEF (CGETD FN)))
(if (EXPRP DEF)
then
[EDITE
DEF
(QUOTE
((BIND (LPQ (I F BREAKFN T)
(COMS (COND
((EQ [SETQ #1 (CAR (NLSETQ (## 4 2]
(CONSTANT (PACK* (QUOTE around)
BREAKINCHAR)))
(QUOTE (XTR 2)))
([OR (EQ #1 (CONSTANT (PACK* (QUOTE before)
BREAKINCHAR)))
(EQ #1 (CONSTANT (PACK* (QUOTE after)
BREAKINCHAR]
(QUOTE (ORR (BK UP (2))
DELETE)))
(T (QUOTE ((ORR (NX)
(!NX]
(* The first clause is so that whenever possible, breaks are removed by patching around. If just a delete were done,
the interpreter would skip the next form since cdr of the current list of forms would be patched.
The only time this fails is when a breakis inserted as the first elemen of a list, e.g. as a cond prediate.)
)
(RETURN FN])
(SAVED
[LAMBDA (FN WHERE DF GS) (* lmm " 3-JUL-83 23:05")
(PROG (ARGS TYP TEM)
(if (NULL GS)
then (* We are going to clobber FN, so save its definition.)
(/PUTD [SETQ GS (PACK (LIST FN (GENSYM (QUOTE B]
DF))
[COND
((EXPRP DF) (* DF is already an EXPR, so no more need be done.)
(COND
((AND (NOT (FNTYP DF))
DWIMFLG) (* car of functon might be misspelled, or more importantly, this might be a
function which is defined via a dwimuserfn.)
(DWIMIFY FN)))
[COND
[(SETQ TEM (GETHASH DF CLISPARRAY))
(SETQ DF (LIST (CAR TEM)
(CADR TEM)
(CONS (QUOTE APPLY*)
(CONS (KWOTE DF)
(CADR TEM]
((NOT (FNTYP DF))
(* Something else in function cell.)
(ERROR FN (QUOTE "not a function"]
(COND
(WHERE (/PUT FN WHERE GS)))
(RETURN DF))
(DF (SETQ TYP (FNTYP DF))
(SETQ ARGS (SMARTARGLIST FN))
(SETQ DF (SAVED1 TYP GS ARGS]
(COND
(WHERE (/PUT FN WHERE GS)))
(RETURN (AND DF (LIST (SELECTQ TYP
((CEXPR SUBR CEXPR* SUBR* SEXPR SEXPR*)
(QUOTE LAMBDA))
(QUOTE NLAMBDA))
ARGS DF])
(SAVED1
[LAMBDA (TYP FN ARGS) (* lmm " 3-JUL-83 23:05")
(* I have inserted the swapped function types, but it was a long search for the problem because the HELP was an
ERROR! for reasons I have not yet encountered. I changed it, change it back if you know why it was ERROR! before.
JWG 5/74)
(* Constructs body of definition.)
(SELECTQ TYP
((EXPR CEXPR SUBR SEXPR)
(CONS FN ARGS))
[(FEXPR CFEXPR FSUBR SFEXPR)
(* BLKAPPLY is same as APPLY but user might have a BREAK on APPLY, i.e. this is in lieu of a BRKAPPLY The internal
is for DWIM, i.e. so FINDFN will look through this functon.)
(LIST (QUOTE BLKAPPLY)
(LIST (QUOTE QUOTE)
FN)
(CONS (QUOTE LIST)
ARGS)
(QUOTE (QUOTE INTERNAL]
[(EXPR* CEXPR* SUBR* SEXPR*)
(LIST (QUOTE BLKAPPLY)
(LIST (QUOTE QUOTE)
FN)
(LIST (QUOTE BREAKNARGS)
ARGS)
(QUOTE (QUOTE INTERNAL]
[(FEXPR* CFEXPR* FSUBR* SFEXPR*)
(LIST (QUOTE BLKAPPLY)
(LIST (QUOTE QUOTE)
FN)
(if (NLISTP ARGS)
then ARGS
else (* e.g. SETQ is an FSUBR* but smartarglist treatts it as though it were a
spread.)
(CONS (QUOTE LIST)
ARGS))
(QUOTE (QUOTE INTERNAL]
(HELP])
(SMARTARGLIST
[LAMBDA (FN EXPLAINFLG TAIL) (* lmm " 3-JUL-83 23:06")
(PROG (TEM DEF)
(if (NOT (LITATOM FN))
then (RETURN (ARGLIST FN)))
RETRY
[COND
([SETQ TEM (GETLIS FN (QUOTE (ARGNAMES]
(* gives user an override. also provides a way of ensuring that argument names stay around even if helpsys data base
goes away. for example, if user wanted to advise a system subr and was worried.)
(RETURN (COND
((OR (NLISTP (SETQ TEM (CADR TEM)))
(CAR TEM))
(* ARGNAMES is used for two purposes, one to provide an overrirde, the other to ave a lookup.
therefore for nospread functions, we must store both the arglist to be used for explaining, and the one to be used
for breaking and advising. this situation is indicated by having the value of ARGNAMES be a dotted pair of the two
arglists. (note thatthe first one will always be a list, hence this nlistp check to distinguish the two cases.))
TEM)
(EXPLAINFLG (CADR TEM))
(T (CDDR TEM]
[COND
([SETQ DEF (OR (GETD FN)
(CADR (GETLIS FN (QUOTE (EXPR CODE]
[COND
([AND (OR (EXPRP DEF)
(CCODEP DEF))
(OR (NOT EXPLAINFLG)
(NOT (FMEMB (ARGTYPE DEF)
(QUOTE (2 3]
(* Can use ARGLIST if function is defined. Want to try harder for subrs in interlisp-10, maybe.
Want to try harder if "EXPLAINING" rather than advising)
(RETURN (ARGLIST DEF]
(COND
((AND (GETD (QUOTE HELPSYS))
[NLSETQ (SETQ TEM (HELPSYS FN (QUOTE ARGS]
TEM)
(COND
((NULL (CAR TEM))
(* helpsys stores arglists of NIL as (NIL))
(SETQ TEM NIL)))
[COND
((NEQ (NARGS DEF)
(LENGTH TEM))
(* DIFERENT NUMBER THAN IN MANUAL)
(SETQ TEM (ARGLIST DEF]
[/PUT FN (QUOTE ARGNAMES)
(COND
((SUBRP DEF)
(* vanilla subr)
TEM)
(T (CONS NIL (CONS TEM (ARGLIST DEF]
(RETURN TEM]
(RETURN (COND
[(AND EXPLAINFLG (SETQ TEM (GETMACROPROP FN COMPILERMACROPROPS)))
(SELECTQ (CAR TEM)
([LAMBDA NLAMBDA OPENLAMBDA]
(CADR TEM))
(= (SMARTARGLIST (CDR TEM)
EXPLAINFLG))
(NIL NIL)
(COND
((LISTP (CAR TEM))
(RETURN (COND
[(CDR (LAST (CAR TEM)))
(APPEND (CAR TEM)
(LIST (QUOTE ...)
(CDR (LAST (CAR TEM]
(T (CAR TEM]
((AND SMARTARGARRAY (SETQ TEM (SGETHASH FN SMARTARGARRAY)))
[PROG [(L (QUOTE (X Y Z P D Q]
(FRPTQ (IDIFFERENCE (NARGS FN)
(LENGTH TEM))
(NCONC1 TEM (pop L]
TEM)
([AND MSHASHFILENAME (SETQ TEM (GETTABLE FN (CADR MSARGTABLE]
(AND (NEQ TEM T)
TEM))
((AND (SETQ TEM (FNCHECK FN T NIL T TAIL))
(NEQ TEM FN))
(SETQ FN TEM)
(GO RETRY))
(T (ARGLIST FN])
(RESTORENAMES
[LAMBDA (FN) (* lmm " 3-JUL-83 23:06")
(PROG1 [MAPCAR (GETPROP FN (QUOTE NAMESCHANGED))
(FUNCTION (LAMBDA (XXX MACROX MACROY FN)
(PROG (Z (DEF (GETD (OR (GETP FN (QUOTE ADVISED))
(GETP FN (QUOTE BROKEN))
FN)))
(NEW (PACK* XXX (QUOTE -IN-)
FN)))
(/PUTD NEW)
(if (FMEMB NEW BROKENFNS)
then (/SETATOMVAL (QUOTE BROKENFNS)
(REMOVE NEW BROKENFNS)))
[COND
([SETQ Z (REMOVE XXX (GETPROP FN (QUOTE NAMESCHANGED]
(/PUTPROP FN (QUOTE NAMESCHANGED)
Z))
(T (/REMPROP FN (QUOTE NAMESCHANGED]
(/REMPROP NEW (QUOTE ALIAS))
[COND
[(NULL DEF)
(RETURN (CONS DEF (QUOTE (not defined]
([NULL (RESETVARS ((NOLINKMESS T))
(RETURN (CHANGENAME1 DEF NEW XXX FN]
(RETURN (CONS NEW (APPEND (QUOTE (not found in))
(LIST FN]
(RETURN XXX]
(/REMPROP FN (QUOTE NAMESCHANGED])
(VIRGINFN
[LAMBDA (FN FLG) (* lmm " 3-JUL-83 23:06")
(PROG [D (X1 (GETPROP FN (QUOTE BROKEN)))
(X2 (GETPROP FN (QUOTE ADVISED)))
(X3 (GETPROP FN (QUOTE NAMESCHANGED)))
(X4 (GETPROP FN (QUOTE BROKEN-IN)))
(X5 (GETPROP FN (QUOTE EXPR]
(if FLG
then (COND
((OR X1 X4)
(PRIN2 FN T T)
(PRIN1 (QUOTE " unbroken.
")
T)
(UNBREAK0 FN)))
[COND
(X2 (PRIN2 FN T T)
(PRIN1 (QUOTE " unadvised.
")
T)
(APPLY (QUOTE UNADVISE)
(LIST FN]
(COND
(X3 (PRIN2 FN T T)
(PRIN1 (QUOTE " names restored.
")
T)
(RESTORENAMES FN)))
(COND
((AND [NULL (EXPRP (SETQ D (GETD FN]
X5)
(SETQ D X5)))
(RETURN D))
(SETQ D (GETD (OR (AND X2 (GETPROP FN (QUOTE ADVISED)))
X1 FN)))
[COND
((OR (NLISTP D)
(NLISTP (CDR D)))
(RETURN (OR X5 D]
(COND
(X4 (SETQ D (UNBREAKIN (COPY D)))
(SETQ FLG T)))
[COND
(X3 [COND
((NULL FLG)
(SETQ D (COPY D]
(MAPC X3 (FUNCTION (LAMBDA (X)
(SETQ D (/DSUBST X (PACK (LIST X (QUOTE -IN-)
FN))
D]
(RETURN D])
(RESTORE
[LAMBDA (FN X) (* lmm " 3-JUL-83 23:06")
(PROG (Y)
(RETURN (if (SETQ Y (GETPROP FN X))
then (/PUTD FN (GETD Y))
(AND (NULL (RELSTK (STKPOS FN)))
(/PUTD Y))
(/REMPROP FN X)
FN
else (LIST FN (QUOTE NOT)
X])
(PACK-IN-
[LAMBDA (X) (* lmm "22-JUL-83 13:53")
(* Allows user to refer to alias-functions using either atomic or list form by always converting to atomic form.
called by REBREAK, UNBREAK0, READVISE0, UNADVISE, and ADVISEDUMP. returns a list of functions.)
(COND
((NLISTP X)
(LIST X))
(T (PROG ((TEM1 (CAR X))
(TEM2 (CADDR X)))
(RETURN (COND
((NEQ (CADR X)
(QUOTE IN))
(ERROR (QUOTE "not of form (fn1 IN fn2)")
X T))
[(LISTP TEM1)
(MAPCONC TEM1 (FUNCTION (LAMBDA (Y)
(PACK-IN- (LIST Y (QUOTE IN)
TEM2]
[(LISTP TEM2)
(MAPCONC TEM2 (FUNCTION (LAMBDA (Y)
(PACK-IN- (LIST TEM1 (QUOTE IN)
Y]
(T (LIST (PACK (LIST TEM1 (QUOTE -IN-)
TEM2])
(BREAKNARGS
[NLAMBDA (BRKX) (* lmm " 3-JUL-83 23:06")
(* Makes a list of the arguments to a nospread EVAL type function.)
(PROG (BRKY (BRKN (EVAL BRKX)))
LP (if (NOT (IGREATERP BRKN 0))
then (RETURN BRKY))
(SETQ BRKY (CONS (APPLY (QUOTE ARG)
(LIST BRKX BRKN))
BRKY))
(SETQ BRKN (SUB1 BRKN))
(GO LP])
)
(RPAQ? SMARTARGARRAY )
(RPAQ? MSARGTABLE )
(RPAQ? MSHASHFILENAME )
(RPAQ? COMPILERMACROPROPS (QUOTE (MACRO)))
(RPAQQ BREAKFN BREAK1)
(RPAQQ BREAKI 3)
(RPAQQ NBREAKS 0)
(RPAQQ NOBREAKIN ([COMS (COND ([SOME (CDR L)
(FUNCTION (LAMBDA (X)
(MEMB (CAR X)
NOBREAKS]
(ERROR!))
((CAR (NLSETQ (SELECTQ (## 1 !0 BK)
([LAMBDA NLAMBDA]
T)
NIL)))
(ERROR!))
(T (SELECTQ (## !0 1)
(COND 1)
(SELECTQ (AND (NEQ (##)
(## !0 2))
(NEQ (##)
(## !0 -1))
1))
NIL]
(IF (NEQ (CAR WHERE)
(QUOTE AROUND))
(MARK (>*)
(IF (AND (NEQ (##)
(## ←))
(LISTP (##)))
((E (PROGN (PRIN1 (QUOTE "break inserted ")
T)
(PRIN1 (CAR WHERE)
T)
(SPACES 1 T)
(## P))
T))
NIL))
NIL)))
(RPAQQ BREAKDELIMITER "
")
(RPAQQ BRKFILE T)
(RPAQQ BROKENFNS NIL)
(RPAQQ BRKINFOLST NIL)
(RPAQQ BAKTRACELST ((APPLY (**BREAK** LISPX ERRORSET BREAK1A ERRORSET BREAK1)
(**TOP** LISPX ERRORSET EVALQT T)
(**EDITOR** LISPX ERRORSET ERRORSET ERRORSET EDITL1 EDITL0 ERRORSET
((ERRORSET ERRORSET ERRORSET EDITL1 EDITL0 ERRORSET)
-)
EDITL ERRORSET ERRORSET EDITE ((EDITF)
(EDITV)
(EDITP)
-))
(**USEREXEC** LISPX ERRORSET ERRORSET USEREXEC))
(EVAL (**BREAK** LISPX ERRORSET BREAK1A ERRORSET BREAK1)
(**TOP** LISPX ERRORSET EVALQT T)
(**EDITOR** ((MAPCAR APPLY)
(ERRORSET LISPX))
ERRORSET ERRORSET ERRORSET EDITL1 EDITL0 ERRORSET
((ERRORSET ERRORSET ERRORSET EDITL1 EDITL0 ERRORSET)
-)
EDITL ERRORSET ERRORSET EDITE ((EDITF)
(EDITV)
(EDITP)
-))
(**USEREXEC** ERRORSET LISPX ERRORSET ERRORSET USEREXEC))
(PROGN **BREAK** EVAL ((ERRORSET BREAK1A ERRORSET BREAK1)
(BREAK1)))
(BLKAPPLY **BREAK** PROGN EVAL ERRORSET BREAK1A ERRORSET BREAK1)
(*PROG*LAM (NIL EVALA *ENV*)
(NIL CLISPBREAK1))))
(RPAQQ BREAKRESETVALSLST NIL)
(RPAQQ BREAK↑WFLG NIL)
(RPAQQ \USEBREAKRESETFORMS T)
(RPAQ BREAKINCHAR (CHARACTER 1))
(RPAQQ BREAKHELPFLAG T)
(ADDTOVAR LISPXFNS (RETFROM . BREAKRETFROM)
(RETEVAL . BREAKRETEVAL))
(ADDTOVAR BREAKMACROS (BT (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
0 T))
(BTV (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
1 T))
(BTVPP (PROG ((SYSPRETTYFLG T))
(BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
1 T)))
(BTV* (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
7 T))
(BTV+ (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
5 T))
(BTV! (BAKTRACE LASTPOS NIL (BREAKREAD (QUOTE LINE))
39 T)))
(ADDTOVAR NOBREAKS GO QUOTE *)
(ADDTOVAR BREAKCOMSLST BT VALUE ?= @ EVAL OK GO RETURN BTV BTV* BTV! ARGS !EVAL !OK !GO EDIT UB = ->
IN? ↑ %)
(ADDTOVAR BREAKRESETFORMS (INTERRUPTABLE T)
(SETREADMACROFLG)
(CONTROL)
(ECHOMODE T))
(MOVD? (QUOTE EVAL)
(QUOTE \SAFEEVAL))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: PACK-IN-)
(BLOCK: BREAK0 BREAK0 BREAK0A (SPECVARS LINKS)
(LOCALFREEVARS WHEN COMS BRKFN BREAKCOM)
(GLOBALVARS BREAKFN BROKENFNS))
(BLOCK: NIL UNBREAK UNBREAK0 REBREAK REBREAK0 (GLOBALVARS BRKINFOLST BROKENFNS LASTWORD DWIMFLG
USERWORDS))
(BLOCK: NIL SAVED (GLOBALVARS CLISPARRAY DWIMFLG))
(BLOCK: NIL BRKLASTPOS SAVED1 RESTORE BREAK UNBREAKIN (GLOBALVARS UPFINDFLG)
TRACE RESTORENAMES (NOLINKFNS EDITE)
VIRGINFN BREAKNARGS (LINKFNS . T))
(BLOCK: BREAK1BLOCK BREAK1 BREAK1A BREAKCOM BREAKCOM1 BREAKRESETFN BREAKREAD BREAKEXIT BREAK?=
BREAK?=1 BREAK= STKPOZ STKPOZ1 STKPOZ2 BREAK3 (ENTRIES BREAK1 BREAK3 BREAKREAD BREAKRESETFN)
(LOCALFREEVARS BRKCOM BRKLINE BRKEXP BRKVALUE BRKCOMS BRKFN !VALUE LASTPOS BRKTYPE TYPE-IN
BRKBUFS BRKRDBUF LSTPOS BRKFIL BREAKRESETVALS \BREAKRESETEXPR BRKORIGFLG
BRKLISPXHIST BRKPAT)
(SPECVARS !VALUE LASTPOS BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE NBREAKS BREAKRESETVALS
PLVLFILEFLG BREAKSTATE LISPXID)
(RETFNS BREAK1A)
(GLOBALVARS BREAK↑WFLG BREAKRESETVALSLST BREAKDELIMITER BRKFILE CLEARSTKLST BREAKCOMSLST
BRKFILE BREAKMACROS LISPXCOMS LISPXHISTORY BREAKRESETFORMS NOSPELLFLG DWIMFLG
BREAKI BREAKHELPFLAG)
(NOLINKFNS . BREAK2))
(BLOCK: BAKTRACEBLOCK BAKTRACE BAKTRACE1 (ENTRIES BAKTRACE BAKTRACE1)
(SPECVARS PLVLFILEFLG)
(GLOBALVARS BREAKDELIMITER BAKTRACELST CLEARSTKLST))
(BLOCK: BREAKIN BREAKIN BREAKIN1 (SPECVARS FN WHERE WHEN BRKCOMS)
(GLOBALVARS BREAKFN NOBREAKIN BROKENFNS UPFINDFLG BREAKINCHAR))
]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA TRACE REBREAK UNBREAK BREAK BREAK3)
(ADDTOVAR NLAML BREAKNARGS BREAKIN BREAK1)
(ADDTOVAR LAMA )
)
(PUTPROPS BREAK COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP ((18012) (3800 NIL (BREAK1 3810 . 4878) (BREAK1A 4880 . 9871) (BRKLASTPOS 9873 . 10888) (
BREAKCOM 10890 . 18011)))))
STOP
1 18502 . 21517) (BREAKRESETFN 21521 . 23330) (\BREAKRESETRESTORE
23334 . 23640) (BREAKRETFROM 23644 . 23795) (BREAKRETEVAL 23799 . 23951) (BREAKEXIT 23955 . 24922) (
\BREAKSTOP 24926 . 25565) (BREAK2 25569 . 25826) (BREAK?= 25830 . 27922) (BREAK?=1 27926 . 28821) (
BREAK= 28825 . 29853) (STKPOZ 29857 . 31411) (STKPOZ1 31415 . 32136) (STKPOZ2 32140 . 33099) (
BREAKREAD 33103 . 33711) (BAKTRACE 33715 . 35746) (BAKTRACE1 35750 . 37045) (BREAK3 37049 . 38519) (
BREAK 38523 . 38949) (BREAK0 38953 . 42713) (BREAK0A 42717 . 43479) (UNBREAK 43483 . 43940) (UNBREAK0
43944 . 45933) (REBREAK 45937 . 47369) (REBREAK0 47373 . 48192) (TRACE 48196 . 48776) (BREAKIN 48780 .
50910) (BREAKIN1 50914 . 51121) (UNBREAKIN 51125 . 52333) (SAVED 52337 . 53645) (SAVED1 53649 . 55092
) (SMARTARGLIST 55096 . 58208) (RESTORENAMES 58212 . 59242) (VIRGINFN 59246 . 60525) (RESTORE 60529 .
60852) (PACK-IN- 60856 . 61689) (BREAKNARGS 61693 . 62136)))))
STOP