(FILECREATED "31-Jul-85 02:03:25" {ERIS}<LISPCORE>SOURCES>BREAK.;23 72913
changes to: (FNS BREAK0)
previous date: "24-Jul-85 15:17:57" {ERIS}<LISPCORE>SOURCES>BREAK.;22)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved. The following
program was created in 1982 but has not been published within the meaning of the copyright law, is
furnished under license, and may not be used, copied and/or disclosed except in accordance with the
terms of said license.)
(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 BREAKINCOMMENT
UNBREAKIN SAVED BREAKREVERT SAVED1 SMARTARGLIST RESTORENAMES VIRGINFN RESTORE
PACK-IN- BREAKNARGS)
[INITVARS (SMARTARGARRAY)
(MSARGTABLE)
(MSHASHFILENAME)
(COMPILERMACROPROPS (QUOTE (MACRO]
(VARS BREAKAROUND BREAKBEFORE BREAKAFTER)
(VARS (BREAKFN (QUOTE BREAK1))
BREAKI
(NBREAKS 0)
NOBREAKIN
(BREAKDELIMITER (QUOTE "
"))
(BRKFILE T)
(BROKENFNS)
(BRKINFOLST)
BAKTRACELST
(\USEBREAKRESETFORMS T)
(BREAKHELPFLAG T))
(INITVARS (BREAKTTBL (GETTERMTABLE)))
(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)
(SETTERMTABLE BREAKTTBL)))
(P (MOVD? (QUOTE EVAL)
(QUOTE \SAFEEVAL))
(MOVD? (QUOTE APPLY)
(QUOTE \SAFEAPPLY))
(MOVD? (QUOTE APPLY*)
(QUOTE \SAFEAPPLY*)))
(BLOCKS (PACK-IN-)
(BREAK0 BREAK0 BREAK0A (SPECVARS LINKS)
(LOCALFREEVARS WHEN COMS BRKFN BREAKCOM)
(GLOBALVARS BREAKFN BROKENFNS BREAKAROUND BREAKBEFORE BREAKAFTER))
(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 BREAK1A)
(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 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))
(NIL BREAKIN (SPECVARS FN WHERE WHEN BRKCOMS)
(GLOBALVARS BREAKFN NOBREAKIN BROKENFNS UPFINDFLG)))
(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 "24-Aug-84 15:38")
(* BRKTYPE is for use by DWIM and HELPFIX.
-
also is REVERT when called from REVERT code)
(DECLARE (SPECVARS BRKEXP BRKWHEN BRKFN BRKCOMS BRKTYPE ERRORN NBREAKS \USEBREAKRESETFORMS))
(COND
((NULL (\SAFEEVAL BRKWHEN (QUOTE BREAK-EXP)))
(\SAFEEVAL BRKEXP (QUOTE BREAK-EXP)))
[(MINUSP NBREAKS)
(SELECTQ BRKTYPE
(NIL (* 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)))
[INTERRUPT
(* this handles the case of ↑b while running in ttywait in a break. Not very elegant but then the whole mechanism to
prevent infinite breaks could use redoing.)
(RESETLST (* RESETLST to catch exceptional stuff like undoing
BREAKRESETFORMS on ↑D)
(BREAK1A (ADD1 NBREAKS]
(PROG ((NBREAKS 0)
(\USEBREAKRESETFORMS NIL))
(UNBREAK0 BRKFN)
(PRIN1 "Break within a break on " 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 " 5-SEP-84 12:55")
(* 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 (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]
(BREAKRESETFN (QUOTE ENTERING))
(SELECTQ BRKTYPE
(REVERT (AND (LISTP (STKNAME LASTPOS))
(LITATOM BRKFN)
(SETSTKNAME LASTPOS BRKFN)))
(NIL)
(PROGN (* 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.)
))
(COND
((AND LISPXHISTORY (NEQ CLEARSTKLST T)) (* moved to after LASTPOS is set up)
(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.)
))
(* 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
((AND (NUMBERP (CAR ERRORN))
(NEQ (CADDR ERRORN)
(QUOTE help!))) (* 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 "24-Aug-84 15:45")
(* 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 (REALSTKNTH -1 (QUOTE BREAK1)
T)))
(SELECTQ (STKNAME POS)
((EVALA CLISPBREAK1)
(SETQ POS (REALSTKNTH -1 POS NIL POS)))
(if FLG
then (SELECTQ (STKNTHNAME -1 POS)
(EVALA (SETQ POS (REALSTKNTH -1 POS NIL POS)))
NIL)))
(RETURN POS])
(BREAKCOM
(LAMBDA (BRKCOM TYPE-IN) (* kbr: "24-Jul-85 15:00")
(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 (BREAKREAD (QUOTE LINE))
(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)))
(RESETFORM (PRINTLEVEL (QUOTE (2 . 3)))
(PRINT (STKNAME LASTPOS)
T T))
(BREAKRESETFN (QUOTE REVERTING))
(BREAKREVERT LASTPOS))
(= (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) (* rrb "29-Aug-84 19:39")
(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)
(\SAFEAPPLY (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)
(\SAFEAPPLY (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) (* rrb "29-Aug-84 19:40")
(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)
(\SAFEAPPLY (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)) (* rrb "29-Aug-84 19:40")
(AND BREAKRESETVALS (PROG ((BREAKSTATE (QUOTE LEAVING)))
(MAPC BREAKRESETVALS (FUNCTION (LAMBDA (X)
(\SAFEAPPLY (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 " 1-JUL-84 22:01")
(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]
(COND
((SETQ TEM (CAR (NTH ARGS N)))
(PACK* (QUOTE *)
TEM
(QUOTE *)))
(T (PACK* (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 "10-Sep-84 18:34")
(PROG (FN (LSTPOS (BRKLASTPOS T))
SAWNAME) (* 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)
(@ (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 (if SAWNAME
then (SETQ LSTPOS (STKNTH -1 LSTPOS LSTPOS))
(* So FOO FOO will be equivalent to FOO / 2)
else (SETQ SAWNAME T))
(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) (* rrb "29-Aug-84 19:38")
(* 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)
(\SAFEAPPLY* 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 (COND
((NULL LST)
(RETURN N))
((NULL (SETQ POS (STKNTH (SUB1 N)
IPOS POS)))
(GO OUT))
((EQ (SETQ TEM (CAR LST))
(STKNAME POS))
(* 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)))
((DUMMYFRAMEP POS)
(SETQ N (SUB1 N))
(GO LP))
((EQ TEM (QUOTE &))
(SETQ N (SUB1 N)))
((NLISTP TEM)
(GO OUT))
([NULL (SOME TEM (FUNCTION (LAMBDA (X)
(COND
((EQ X (QUOTE -)) (* Optional match)
T)
((SETQ X (BAKTRACE1 X N IPOS POS))
(SETQ N X]
(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 "14-Aug-84 18:54")
(for L on (NLAMBDA.ARGS 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 "31-Jul-85 02: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]
(COND
((NULL (SETQ X (GETD FN)))
(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))
[[AND (EXPRP X)
(AND (EQ (CAADDR X)
BREAKFN)
(NULL (CDDDR X]
(* 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]
((UNSAFE.TO.MODIFY FN "break")
(SETQ VAL (LIST FN (QUOTE not)
(QUOTE broken)))
(GO OUT1)))
(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 "14-Aug-84 19:14")
(if (AND (NULL (SETQ X (NLAMBDA.ARGS 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 "14-Aug-84 19:14")
(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 (SETQ X (NLAMBDA.ARGS 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 "27-Aug-84 18:43")
(MAPCONC (NLAMBDA.ARGS (OR X (AND DWIMFLG LASTWORD)))
(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 " 1-JUL-84 23:25")
(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)
(BREAKINCOMMENT FN 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])
(BREAKINCOMMENT
[LAMBDA (FN WHERE) (* lmm "11-Jul-84 18:16")
(CONS (if (LISTP FN)
then (CAR FN)
else FN)
(CONS (SELECTQ (CAR WHERE)
(AROUND BREAKAROUND)
(BEFORE BREAKBEFORE)
(AFTER BREAKAFTER)
(SHOULDNT))
(CDR WHERE])
(UNBREAKIN
[LAMBDA (FN) (* lmm " 1-JUL-84 22:07")
(* 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]
BREAKAROUND)
(QUOTE (XTR 2)))
((OR (EQ #1 BREAKBEFORE)
(EQ #1 BREAKAFTER))
(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) (* rrb "29-Aug-84 19:39")
(PROG (ARGS TYP TEM)
(COND
((NULL GS) (* We are going to clobber FN, so save its definition.)
(/PUTD [SETQ GS (PACK* 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 \SAFEAPPLY*)
(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])
(BREAKREVERT
(LAMBDA (POS) (* lmm " 5-SEP-84 12:59")
(PROG (ARGNAMES (FN (STKNAME POS))
DEF)
LP (SELECTQ (STKNAME POS)
((EVAL \EVAL \EVALFORM \SAFEEVAL) (* these can just be redone)
(RETURN (ENVEVAL (BQUOTE (BREAK1 , (STKARG 1 POS)
T , FN))
POS POS T T)))
(PROG (* PROG is special in Interlisp-D)
(SELECTQ (SYSTEMTYPE)
(D (SETQ POS (STKNTH -1 POS POS))
(GO LP))
NIL))
NIL)
(COND
((AND (SETQ DEF (COND
((LITATOM FN)
(GETD FN))
(T (* POS could be a lambda expression call)
FN)))
(SELECTQ (ARGTYPE FN)
((0 1)
(SETQ ARGNAMES (SMARTARGLIST FN))
(AND (EQLENGTH ARGNAMES (STKNARGS POS))
(for I from 1 as X in ARGNAMES always (EQ X (STKARGNAME I POS)))))
(3 (EQ (SETQ ARGNAMES (SMARTARGLIST FN))
(STKARGNAME 1 POS)))
NIL)) (* can evaluate in place, since all SMARTARGLIST is
bound at POS)
(RETURN (ENVEVAL (COND
((FMEMB (CAR (LISTP DEF))
(QUOTE (LAMBDA NLAMBDA)))
(* FN is either a lambda expression or has a lambda
definition)
(BQUOTE (BREAK1 (PROGN ., (CDDR DEF))
T , FN)))
(T (BQUOTE (BREAK1 , (SELECTQ (ARGTYPE FN)
((0 NIL)
(CONS FN ARGNAMES))
(1 (BQUOTE (\SAFEAPPLY (QUOTE , FN)
(LIST .,
ARGNAMES)
(QUOTE INTERNAL)
)))
(2 (BQUOTE (\SAFEAPPLY (QUOTE , FN)
(BREAKNARGS
, ARGNAMES)
(QUOTE INTERNAL)
)))
(3 (BQUOTE (\SAFEAPPLY (QUOTE , FN)
, ARGNAMES
(QUOTE INTERNAL)
)))
(SHOULDNT))
T , FN))))
POS POS T T)))) (* either SMARTARGLIST doesn't match what is bound, or
fn is not defined, etc.)
(SETQ ARGNAMES (SMARTARGLIST FN)) (* cons together what BREAK would put on the function
if you did a BREAK of it)
(RETURN
(ENVAPPLY (LIST (SELECTQ (ARGTYPE FN)
((1 3)
(QUOTE NLAMBDA))
(QUOTE LAMBDA))
ARGNAMES
(BQUOTE (BREAK1 ,
(SELECTQ
(ARGTYPE FN)
(0 (CONS FN ARGNAMES))
(1 (BQUOTE (\SAFEAPPLY (QUOTE , FN)
(LIST ., ARGNAMES)
(QUOTE INTERNAL))))
(2 (BQUOTE (\SAFEAPPLY (QUOTE , FN)
(BREAKNARGS , ARGNAMES)
(QUOTE INTERNAL))))
(3 (BQUOTE (\SAFEAPPLY (QUOTE , FN)
,
(COND
((NLISTP ARGNAMES)
ARGNAMES)
(T
(* e.g. SETQ is an FSUBR* but smartarglist treatts it
as though it were a spread.)
(CONS (QUOTE LIST)
ARGNAMES)))
(QUOTE INTERNAL))))
(SHOULDNT))
T , FN NIL REVERT)))
(STKARGS POS)
(SETQ POS (STKNTH -1 POS POS))
POS T T)))))
(SAVED1
[LAMBDA (TYP FN ARGS) (* rrb "29-Aug-84 19:41")
(* Constructs body of definition.)
(SELECTQ TYP
((EXPR CEXPR SUBR SEXPR)
(CONS FN ARGS))
[(FEXPR CFEXPR FSUBR SFEXPR)
(* \SAFEAPPLY 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 \SAFEAPPLY)
(LIST (QUOTE QUOTE)
FN)
(CONS (QUOTE LIST)
ARGS)
(QUOTE (QUOTE INTERNAL]
[(EXPR* CEXPR* SUBR* SEXPR*)
(LIST (QUOTE \SAFEAPPLY)
(LIST (QUOTE QUOTE)
FN)
(LIST (QUOTE BREAKNARGS)
ARGS)
(QUOTE (QUOTE INTERNAL]
[(FEXPR* CFEXPR* FSUBR* SFEXPR*)
(LIST (QUOTE \SAFEAPPLY)
(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 " 1-JUL-84 22:42")
(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* 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 " 1-JUL-84 22:42")
(* 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* TEM1 (QUOTE -IN-)
TEM2])
(BREAKNARGS
[NLAMBDA (BRKX) (* rrb "29-Aug-84 19:42")
(* Makes a list of the arguments to a nospread EVAL type
function.)
(PROG (BRKY (BRKN (EVAL BRKX)))
LP (COND
((NOT (IGREATERP BRKN 0))
(RETURN BRKY)))
(SETQ BRKY (CONS (\SAFEAPPLY (QUOTE ARG)
(LIST BRKX BRKN))
BRKY))
(SETQ BRKN (SUB1 BRKN))
(GO LP])
)
(RPAQ? SMARTARGARRAY )
(RPAQ? MSARGTABLE )
(RPAQ? MSHASHFILENAME )
(RPAQ? COMPILERMACROPROPS (QUOTE (MACRO)))
(RPAQQ BREAKAROUND broken-around)
(RPAQQ BREAKBEFORE broken-before)
(RPAQQ BREAKAFTER broken-after)
(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 \USEBREAKRESETFORMS T)
(RPAQQ BREAKHELPFLAG T)
(RPAQ? BREAKTTBL (GETTERMTABLE))
(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)
(SETTERMTABLE BREAKTTBL))
(MOVD? (QUOTE EVAL)
(QUOTE \SAFEEVAL))
(MOVD? (QUOTE APPLY)
(QUOTE \SAFEAPPLY))
(MOVD? (QUOTE APPLY*)
(QUOTE \SAFEAPPLY*))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: PACK-IN-)
(BLOCK: BREAK0 BREAK0 BREAK0A (SPECVARS LINKS)
(LOCALFREEVARS WHEN COMS BRKFN BREAKCOM)
(GLOBALVARS BREAKFN BROKENFNS BREAKAROUND BREAKBEFORE BREAKAFTER))
(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
BREAK1A)
(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 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: NIL BREAKIN (SPECVARS FN WHERE WHEN BRKCOMS)
(GLOBALVARS BREAKFN NOBREAKIN BROKENFNS UPFINDFLG))
]
(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" T 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4152 67737 (BREAK1 4162 . 5815) (BREAK1A 5817 . 11603) (BRKLASTPOS 11605 . 12447) (
BREAKCOM 12449 . 19889) (BREAKCOM1 19891 . 22883) (BREAKRESETFN 22885 . 24951) (\BREAKRESETRESTORE
24953 . 25255) (BREAKRETFROM 25257 . 25430) (BREAKRETEVAL 25432 . 25606) (BREAKEXIT 25608 . 26548) (
\BREAKSTOP 26550 . 27174) (BREAK2 27176 . 27452) (BREAK?= 27454 . 29557) (BREAK?=1 29559 . 30440) (
BREAK= 30442 . 31441) (STKPOZ 31443 . 32999) (STKPOZ1 33001 . 33725) (STKPOZ2 33727 . 34711) (
BREAKREAD 34713 . 35432) (BAKTRACE 35434 . 37448) (BAKTRACE1 37450 . 38629) (BREAK3 38631 . 40247) (
BREAK 40249 . 40688) (BREAK0 40690 . 44953) (BREAK0A 44955 . 45754) (UNBREAK 45756 . 46248) (UNBREAK0
46250 . 48195) (REBREAK 48197 . 49680) (REBREAK0 49682 . 50502) (TRACE 50504 . 51001) (BREAKIN 51003
. 52955) (BREAKINCOMMENT 52957 . 53272) (UNBREAKIN 53274 . 54366) (SAVED 54368 . 55747) (BREAKREVERT
55749 . 59530) (SAVED1 59532 . 60757) (SMARTARGLIST 60759 . 63780) (RESTORENAMES 63782 . 64810) (
VIRGINFN 64812 . 66062) (RESTORE 66064 . 66402) (PACK-IN- 66404 . 67226) (BREAKNARGS 67228 . 67735))))
)
STOP