(FILECREATED " 8-Aug-86 13:53:41" {ERIS}<LISPCORE>LIBRARY>CMLDEBUG.;6 12343 changes to: (VARS CMLDEBUGCOMS) (FNS COMMONLISP-BREAKLOOP) (COMMANDS OK STOP ↑ ~) previous date: " 7-Aug-86 18:44:57" {ERIS}<LISPCORE>LIBRARY>CMLDEBUG.;5) (* Copyright (c) 1986 by Xerox Corporation. All rights reserved.) (PRETTYCOMPRINT CMLDEBUGCOMS) (RPAQQ CMLDEBUGCOMS ((* * "CMLDebug - a CommonLisp debugger") (FILES CMLEXEC) (P (MOVD (QUOTE BREAKLOOP) (QUOTE INTERLISP-BREAKLOOP))) (FNS BREAKLOOP2 COMMONLISP-BREAKLOOP FIND-COMMONLISP-ENV) (P (MOVD (QUOTE BREAKLOOP) (QUOTE \SAVED.BREAKLOOP))) (FUNCTIONS DEBUG-ON DEBUG-OFF) (COMMANDS ?= @ BT BT! BTV BTV! CL:EVAL DBT DBT! OK PR RETURN REVERT STOP UB ↑ ~) (VARS BREAK-COMMANDS) (PROP FILE-TYPE CMLDEBUG))) (* * "CMLDebug - a CommonLisp debugger") (FILESLOAD CMLEXEC) (MOVD (QUOTE BREAKLOOP) (QUOTE INTERLISP-BREAKLOOP)) (DEFINEQ (BREAKLOOP2 [LAMBDA (NBREAKS) (* hdj "31-Jul-86 18:00") (DECLARE (SPECIAL *CURRENT-EXECUTIVE-TYPE*)) (if (AND (BOUNDP (QUOTE *CURRENT-EXECUTIVE-TYPE*)) (EQ *CURRENT-EXECUTIVE-TYPE* (QUOTE COMMON-LISP))) then (COMMONLISP-BREAKLOOP NBREAKS) else (INTERLISP-BREAKLOOP NBREAKS]) (COMMONLISP-BREAKLOOP [LAMBDA (NBREAKS) (* hdj " 7-Aug-86 18:41") (PROG ((TYPE-IN (NULL BRKCOMS)) (HELPFLAG BREAKHELPFLAG) BRKID BRKVALUES LASTPOS BRKRDBUF BRKBUFS BREAKRESETVALS \BREAKRESETEXPR BRKORIGFLG BRKLISPXHIST BRKLINE !VALUES \USEBREAKRESETFORMS) (DECLARE (SPECIAL TYPE-IN BRKFIL HELPFLAG BRKID BRKVALUES LASTPOS BRKRDBUF BRKBUFS BREAKRESETVALS \BREAKRESETEXPR \USEBREAKRESETFORMS BRKORIGFLG BRKLISPXHIST BRKLINE !VALUES)) (* ;; "") (* ;; " HELPFLAG is bound so that calls to ERROR with a NOBREAK of T will not break because the user has set HELPFLAG to BREAK!") (* ;; "") (SETQ \USEBREAKRESETFORMS T) (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 (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] (if (EQ BRKTYPE (QUOTE INTERRUPT)) then (FORMAT *TERMINAL-IO* "~%%Interrupted below ~S~2%%" BRKFN) else (if (AND (NULL BRKFN) (NLISTP BRKTYPE)) then (* ;; "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 %"Breakpoint%"") (FORMAT *TERMINAL-IO* "~%%Breakpoint~2%%") else (FORMAT *TERMINAL-IO* "~%%Breakpoint at ~S~2%%" BRKFN))) (CMLEXEC :PROMPT ": " :COMMANDS BREAK-COMMANDS :ENVIRONMENT (FIND-COMMONLISP-ENV LASTPOS) :FUNCTION (FUNCTION (LAMBDA (INPUT ENV) (LET ((NBREAKS (- NBREAKS))) (EVAL-INPUT INPUT ENV]) (FIND-COMMONLISP-ENV [LAMBDA (STACKPOS) (* hdj "31-Jul-86 19:06") (DECLARE (SPECVARS LASTPOS)) (LET [(POS (STKPOS (QUOTE CL:EVAL) NIL (OR STACKPOS LASTPOS] (AND POS (STKARG 2 POS]) ) (MOVD (QUOTE BREAKLOOP) (QUOTE \SAVED.BREAKLOOP)) (DEFUN DEBUG-ON NIL (/MOVD (QUOTE BREAKLOOP2) (QUOTE BREAKLOOP))) (DEFUN DEBUG-OFF NIL (/MOVD (QUOTE \SAVED.BREAKLOOP) (QUOTE BREAKLOOP))) (DEFCOMMAND (?= :BREAK) (&REST PLACE) (STKPOZ PLACE) (PRINT-ARGLIST (SMARTARGLIST (STKNAME LASTPOS) T) (STKARGS LASTPOS) T 0) (VALUES)) (DEFCOMMAND (@ :BREAK) (&REST PLACE) (LET ((NAME (STKNAME (STKPOZ PLACE)))) (PRINTOUT T "@ = " NAME T)) (VALUES)) (DEFCOMMAND (BT :BREAK) (&OPTIONAL FOO) (BAKTRACE LASTPOS NIL (QUOTE (DUMMYFRAMEP)) 0 T) (VALUES)) (DEFCOMMAND (BT! :BREAK) (&OPTIONAL FOO) (BAKTRACE LASTPOS NIL NIL 0 T) (VALUES)) (DEFCOMMAND (BTV :BREAK) NIL (BAKTRACE LASTPOS NIL NIL 1 T) (VALUES)) (DEFCOMMAND (BTV! :BREAK) NIL (BAKTRACE LASTPOS NIL NIL 39 T) (VALUES)) (DEFCOMMAND (CL:EVAL :BREAK) (&ENVIRONMENT ENV) (UNWIND-PROTECT (PROGN (BREAKRESETFN (QUOTE EVALUATING )) (SETQ !VALUES (CL:EVAL BRKEXP ENV))) (BREAKRESETFN (QUOTE REENTERING)))) (DEFCOMMAND (DBT :BREAK) NIL (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM) (QUOTE BREAKPOS)) NIL (QUOTE (DUMMYFRAMEP))) (VALUES)) (DEFCOMMAND (DBT! :BREAK) NIL (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM) (QUOTE BREAKPOS)) NIL NIL) (VALUES)) (DEFCOMMAND (OK :BREAK :QUIET) (&ENVIRONMENT ENV) (DECLARE (SPECIAL NBREAKS BRKEXP !VALUES)) (BREAKRESETFN (QUOTE LEAVING)) (LET ((NBREAKS (- NBREAKS))) (SETQ !VALUES (MULTIPLE-VALUE-LIST (CL:EVAL BRKEXP ENV)))) (RETAPPLY (QUOTE BREAK1A) (FUNCTION VALUES-LIST) (LIST !VALUES))) (DEFCOMMAND (PR :BREAK) NIL (PROCEED-FROM-BREAK)) (DEFCOMMAND (RETURN :BREAK) (&OPTIONAL (EXPRESSION NIL) &ENVIRONMENT ENV) (DECLARE (SPECIAL NBREAKS)) (BREAKRESETFN (QUOTE LEAVING)) (LET ((VALUES (MULTIPLE-VALUE-LIST (CL:EVAL EXPRESSION ENV)))) (RETAPPLY (QUOTE BREAK1A) (FUNCTION VALUES-LIST) (LIST VALUES)))) (DEFCOMMAND (REVERT :BREAK) (&REST PLACE) (LET ((PLACE-SPEC (OR PLACE (QUOTE (@))))) (STKPOZ PLACE-SPEC) (RESETFORM (PRINTLEVEL (QUOTE (2 . 3))) (PRINT (STKNAME LASTPOS) T T)) (BREAKRESETFN (QUOTE REVERTING)) (BREAKREVERT LASTPOS))) (DEFCOMMAND (STOP :BREAK :QUIET) NIL (RELSTK LASTPOS) (AND (STACKP BRKTYPE) (RELSTK BRKTYPE)) (BREAKRESETFN (QUOTE LEAVING)) (RETEVAL (QUOTE BREAK1A) (QUOTE (ERROR!)))) (DEFCOMMAND (UB :BREAK) (&OPTIONAL (FN BRKFN)) (DECLARE (SPECIAL BRKFN)) (APPLY (FUNCTION UNBREAK) FN)) (DEFCOMMAND (↑ :BREAK :QUIET) NIL (RELSTK LASTPOS) (AND (STACKP BRKTYPE) (RELSTK BRKTYPE)) (BREAKRESETFN (QUOTE LEAVING)) (RETEVAL (QUOTE BREAK1A) (QUOTE (ERROR!)))) (DEFCOMMAND (~ :BREAK :QUIET) NIL (RELSTK LASTPOS) (AND (STACKP BRKTYPE) (RELSTK BRKTYPE)) (BREAKRESETFN (QUOTE LEAVING)) (RETEVAL (QUOTE BREAK1A) (QUOTE (ERROR!)))) (RPAQQ BREAK-COMMANDS ((↑ break-↑ :QUIET NIL) (↑ break-↑ :EVAL NIL) (OK break-OK :QUIET NIL) (~ break-~ :QUIET NIL) (↑ break-↑ :QUIET NIL) (STOP break-STOP :QUIET NIL) (@ break-@ :EVAL NIL) (@ break-@ :EVAL NIL) (?= break-?= :EVAL NIL) (?= break-?= :EVAL NIL) (?= break-?= :EVAL NIL) (?= break-?= :EVAL NIL) (@ break-@ :EVAL NIL) (BT break-BT :EVAL NIL) (BT! break-BT! :EVAL NIL) (BTV break-BTV :EVAL NIL) (BTV! break-BTV! :EVAL NIL) (CL:EVAL break-CL:EVAL :EVAL NIL) (DBT break-DBT :EVAL NIL) (DBT! break-DBT! :EVAL NIL) (OK break-OK :EVAL NIL) (PR break-PR :EVAL NIL) (RETURN break-RETURN :EVAL NIL) (REVERT break-REVERT :EVAL NIL) (STOP break-STOP :EVAL NIL) (UB break-UB :EVAL NIL) (↑ break-↑ :EVAL NIL) (~ break-~ :EVAL NIL))) (PUTPROPS CMLDEBUG FILE-TYPE COMPILE-FILE) (PUTPROPS CMLDEBUG COPYRIGHT ("Xerox Corporation" 1986)) (DECLARE: DONTCOPY (FILEMAP (NIL (1037 5054 (BREAKLOOP2 1047 . 1435) (COMMONLISP-BREAKLOOP 1437 . 4751) ( FIND-COMMONLISP-ENV 4753 . 5052))))) STOP