github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

Add NOERROR extra parameter to STKARGNAME, and set it in DEBUGGER (#471)

Browse Source
This commit is contained in:
Larry Masinter 2021-09-12 11:47:14 -07:00 committed by GitHub
parent d04f734295
commit 0236971881
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 86 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
sources/ASTACK
View File

@ -1,13 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-May-91 14:25:00" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;4| 43099
(FILECREATED "11-Sep-2021 12:54:19" {DSK}<home>larry>medley>sources>ASTACK.;2 43098
changes to%: (FNS \STKARG)
changes to%: (FNS STKARGNAME)
previous date%: "20-Feb-91 13:47:06" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;3|)
previous date%: "23-May-91 14:25:00" {DSK}<home>larry>medley>sources>ASTACK.;1)
(* ; "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1982-1987, 1990-1991 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT ASTACKCOMS)
@ -501,7 +501,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
(T (LISPERROR "ILLEGAL STACK ARG" N])
(STKARGNAME
[LAMBDA (N POS) (* ; "Edited 18-Feb-91 16:55 by jds")
[LAMBDA (N POS NOERROR) (* ; "Edited 11-Sep-2021 12:51 by larry")
(* ;; "Given an interpreted frame and an argument number, return the name of that argument (actually, just the n-th NameTable entry)")
@ -552,6 +552,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
WORDSPERCELL]
(RETURN)))
(MAKE-NTENTRY PVARCODE (SUB1 NTENTRY)))
(NOERROR (RETURN))
(T (LISPERROR "ILLEGAL STACK ARG" N]
(RETURN (for NT1 from (fetch (FNHEADER OVERHEADWORDS) of T)
by (CONSTANT (WORDSPERNAMEENTRY)) as NT2
@ -789,13 +790,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
)
(PUTPROPS ASTACK COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1519 4724 (ARG 1529 . 1688) (SETARG 1690 . 1874) (\ARG 1876 . 2111) (\ARGPTR 2113 .
4455) (\SETARG 4457 . 4722)) (4725 8940 (\RETURN 4735 . 5093) (\STACKARGPTR 5095 . 8938)) (8985 12362
(STKNTH 8995 . 9893) (STKNTHNAME 9895 . 10782) (STKNAME 10784 . 10929) (SETSTKNAME 10931 . 12360)) (
12363 16138 (STKPOS 12373 . 13294) (STKSCAN 13296 . 13942) (RETFROM 13944 . 14298) (RETTO 14300 .
14575) (RESUME 14577 . 15950) (\RESUME 15952 . 16136)) (16139 42186 (STKARG 16149 . 16484) (\STKARG
16486 . 21189) (SETSTKARG 21191 . 25374) (STKARGNAME 25376 . 29599) (\SPREADFRAMEP 29601 . 30142) (
SETSTKARGNAME 30144 . 33435) (STKNARGS 33437 . 35846) (FRAMESCAN 35848 . 36298) (\INTERPFRAMENT 36300
. 36700) (\FRAMESCAN 36702 . 39755) (\VAROFFSET 39757 . 42184)) (42228 42781 (\RECLAIMSTACKP 42238 .
42779)))))
(FILEMAP (NIL (1470 4675 (ARG 1480 . 1639) (SETARG 1641 . 1825) (\ARG 1827 . 2062) (\ARGPTR 2064 .
4406) (\SETARG 4408 . 4673)) (4676 8891 (\RETURN 4686 . 5044) (\STACKARGPTR 5046 . 8889)) (8936 12313
(STKNTH 8946 . 9844) (STKNTHNAME 9846 . 10733) (STKNAME 10735 . 10880) (SETSTKNAME 10882 . 12311)) (
12314 16089 (STKPOS 12324 . 13245) (STKSCAN 13247 . 13893) (RETFROM 13895 . 14249) (RETTO 14251 .
14526) (RESUME 14528 . 15901) (\RESUME 15903 . 16087)) (16090 42185 (STKARG 16100 . 16435) (\STKARG
16437 . 21140) (SETSTKARG 21142 . 25325) (STKARGNAME 25327 . 29598) (\SPREADFRAMEP 29600 . 30141) (
SETSTKARGNAME 30143 . 33434) (STKNARGS 33436 . 35845) (FRAMESCAN 35847 . 36297) (\INTERPFRAMENT 36299
. 36699) (\FRAMESCAN 36701 . 39754) (\VAROFFSET 39756 . 42183)) (42227 42780 (\RECLAIMSTACKP 42237 .
42778)))))
STOP

BIN
sources/ASTACK.LCOM
View File

Binary file not shown.

108
sources/DEBUGGER
View File

@ -1,14 +1,14 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES
"DBG")))
(IL:FILECREATED "16-Aug-91 17:38:56" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;3| 84381
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES "DBG")) READTABLE
"XCL" BASE 10)
(IL:FILECREATED "11-Sep-2021 12:57:01" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;2| 84311
IL:|changes| IL:|to:| (IL:FUNCTIONS DEBUGGER-EVAL)
IL:|changes| IL:|to:| (IL:FUNCTIONS STACK-FRAME-PROPERTIES)
IL:|previous| IL:|date:| "16-May-90 15:26:02" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;2|
IL:|previous| IL:|date:| "16-Aug-91 17:38:56" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;1|
)
; Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
; Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
(IL:PRETTYCOMPRINT IL:DEBUGGERCOMS)
@ -520,14 +520,13 @@
(DEFVAR IL:LASTPOS)
(XCL:DEFCOMMAND ("@" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
(XCL:DEFCOMMAND ("@" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
"Set debugger stack pointer to location specified by PLACE (or default)"
(FORMAT T "@ = ~S~%" (IL:STKNAME (FIND-DEBUGGER-STACK-FRAME IL:PLACE IL:ENV)))
(VALUES))
(XCL:DEFCOMMAND ("REVERT" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV) (DECLARE (SPECIAL
IL:BRKVALUES)
)
(XCL:DEFCOMMAND ("REVERT" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
(DECLARE (SPECIAL IL:BRKVALUES))
"Unwind to specified frame (or LASTPOS) and enter breakpoint"
(IL:* IL:|;;| "Find the stack frame that the user asked to unwind to , if any:")
@ -561,7 +560,8 @@
(IL:RELSTK IL:POS))))))))
(THROW 'DEBUGGER-EXIT NIL)))
(XCL:DEFCOMMAND ("?=" :DEBUGGER) NIL "Show arguments"
(XCL:DEFCOMMAND ("?=" :DEBUGGER) ()
"Show arguments"
(MULTIPLE-VALUE-BIND (IL:NAME IL:DEFN)
(FIND-ORIGINAL-NAME-AND-DEFINITION IL:LASTPOS)
(MULTIPLE-VALUE-BIND (IL:LAMBDA-CAR IL:ARGLIST)
@ -589,7 +589,7 @@
0 T))))))
(VALUES))
(XCL:DEFCOMMAND ("EVAL" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?))
(XCL:DEFCOMMAND ("EVAL" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?))
(DECLARE (SPECIAL IL:BRKENV IL:BRKVALUES))
"Evaluate expression in debugged context"
(XCL:CONDITION-CASE (IF IL:EXPRESSION-PROVIDED?
@ -600,14 +600,15 @@
(SI::DEBUGGER-EVAL-ABORTED (IL:C)
(VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))
(XCL:DEFCOMMAND ("VALUE" :DEBUGGER :QUIET) NIL
(XCL:DEFCOMMAND ("VALUE" :DEBUGGER :QUIET) ()
"Show value from previous evaluation of debug expression"
(IF IL:BRKVALUES
(VALUES-LIST (CDR IL:BRKVALUES))
(PROGN (FORMAT T "Not yet evaluated~&")
(VALUES))))
(XCL:DEFCOMMAND ("UB" :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN)) "Unbreak function with breakpoint"
(XCL:DEFCOMMAND ("UB" :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN))
"Unbreak function with breakpoint"
(DECLARE (SPECIAL IL:BRKFN))
(IL:EVAL (LIST 'XCL:UNBREAK IL:FN)))
@ -882,26 +883,32 @@
(return nil))))
)
(XCL:DEFCOMMAND ("BT" :DEBUGGER) NIL "Print backtrace of external frames"
(XCL:DEFCOMMAND ("BT" :DEBUGGER) ()
"Print backtrace of external frames"
(PRINT-BACKTRACE :FROM IL:LASTPOS :TEST 'XCL::INTERESTING-FRAME-P)
(VALUES))
(XCL:DEFCOMMAND ("BT!" :DEBUGGER) NIL "Print backtrace of all frames"
(XCL:DEFCOMMAND ("BT!" :DEBUGGER) ()
"Print backtrace of all frames"
(PRINT-BACKTRACE :FROM IL:LASTPOS :TEST NIL)
(VALUES))
(XCL:DEFCOMMAND ("BTV" :DEBUGGER) NIL "Print backtrace of frames and special bindings"
(XCL:DEFCOMMAND ("BTV" :DEBUGGER) ()
"Print backtrace of frames and special bindings"
(PRINT-BACKTRACE :FROM IL:LASTPOS :PRINT-VARIABLES T)
(VALUES))
(XCL:DEFCOMMAND ("BTV!" :DEBUGGER) NIL "Print backtrace of all frame information"
(XCL:DEFCOMMAND ("BTV!" :DEBUGGER) ()
"Print backtrace of all frame information"
(PRINT-BACKTRACE :FROM IL:LASTPOS :PRINT-VARIABLES T :PRINT-JUNK T)
(VALUES))
(XCL:DEFCOMMAND ("DBT" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU NIL T)
(XCL:DEFCOMMAND ("DBT" :DEBUGGER) ()
(ATTACH-BACKTRACE-MENU NIL T)
(VALUES))
(XCL:DEFCOMMAND ("DBT!" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU)
(XCL:DEFCOMMAND ("DBT!" :DEBUGGER) ()
(ATTACH-BACKTRACE-MENU)
(VALUES))
(DEFUN ATTACH-BACKTRACE-MENU (&OPTIONAL IL:TTYWINDOW IL:SKIP)
@ -1209,7 +1216,7 @@
0
IL:AS I IL:|from| (1+ NUM-ARGS) IL:|to| TOTAL-SLOTS
IL:|when| (AND (IL:NEQ NOVALUE (IL:STKARG I POS NOVALUE))
(OR (SETF ARGNAME (IL:STKARGNAME I POS))
(OR (SETF ARGNAME (IL:STKARGNAME I POS T))
(AND LOTS? (SETQ ARGNAME (FORMAT NIL "local ~D" PVAR))
))) IL:|collect| (LIST ARGNAME I))))
(AND SLOTS (CONS '("locals")
@ -1345,16 +1352,19 @@
(T 0)))
OUTPUT))
(XCL:DEFCOMMAND ("STOP" :DEBUGGER :QUIET) NIL "Exit this debugger level"
(XCL:DEFCOMMAND ("STOP" :DEBUGGER :QUIET) ()
"Exit this debugger level"
(IL:SETQ IL:BRKVALUES '(IL:ERROR!))
(THROW 'DEBUGGER-EXIT NIL))
(XCL:DEFCOMMAND ("^" :DEBUGGER :QUIET) NIL "Abort out of debugger"
(XCL:DEFCOMMAND ("^" :DEBUGGER :QUIET) ()
"Abort out of debugger"
(IL:SETQ IL:BRKVALUES '(IL:ERROR!))
(THROW 'DEBUGGER-EXIT NIL))
(XCL:DEFCOMMAND ("RETURN" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
&ENVIRONMENT IL:ENV) "Return value from debugger"
(XCL:DEFCOMMAND ("RETURN" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
&ENVIRONMENT IL:ENV)
"Return value from debugger"
(XCL:CONDITION-CASE (PROGN (IL:SETQ IL:BRKVALUES (LIST 'RETURN (MULTIPLE-VALUE-LIST (
 DEBUGGER-EVAL
IL:EXPRESSION
@ -1364,20 +1374,23 @@
(SI::DEBUGGER-EVAL-ABORTED (IL:C)
(VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))
(XCL:DEFCOMMAND ("PR" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
(ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
(VALUES))
(XCL:DEFCOMMAND ("PR!" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
(ESCAPE-FROM-DEBUGGER NIL IL:NAME-OR-NUMBER)
(VALUES))
(XCL:DEFCOMMAND ("PROCEED" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
(XCL:DEFCOMMAND ("PR" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
"Select and invoke a proceed case."
(ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
(VALUES))
(XCL:DEFCOMMAND ("OK" :DEBUGGER :QUIET) NIL (DECLARE (SPECIAL IL:BRKENV))
(XCL:DEFCOMMAND ("PR!" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
"Select and invoke a proceed case."
(ESCAPE-FROM-DEBUGGER NIL IL:NAME-OR-NUMBER)
(VALUES))
(XCL:DEFCOMMAND ("PROCEED" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
"Select and invoke a proceed case."
(ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
(VALUES))
(XCL:DEFCOMMAND ("OK" :DEBUGGER :QUIET) ()
(DECLARE (SPECIAL IL:BRKENV))
"Exit/proceed from debugger"
(XCL:CONDITION-CASE (PROGN (WHEN (TYPEP IL:BRKCOND 'SI::BREAKPOINT)
@ -1530,6 +1543,27 @@
)
(IL:PUTPROPS XCL:DEBUGGER IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (18680 18967 (IL:WBREAK 18693 . 18965)) (42297 47159 (IL:BAKTRACE 42310 . 45094) (
IL:BAKTRACE1 45096 . 47157)) (81689 83655 (IL:FIND-STACK-FRAME 81702 . 83653)))))
(IL:FILEMAP (NIL (4639 6450 (XCL:ENTER-DEBUGGER-P 4639 . 6450)) (6452 13574 (XCL:DEBUGGER 6452 . 13574
)) (13576 13890 (EMERGENCY-PANIC-LOOP 13576 . 13890)) (13892 15347 (IL:FIND-DEBUGGER-ENTRY-FRAME 13892
. 15347)) (15349 16038 (PRINT-ENTRY-MESSAGE 15349 . 16038)) (16040 16341 (SIMPLE-REPORT-CONDITION
16040 . 16341)) (16343 18083 (XCL::INTERESTING-FRAME-P 16343 . 18083)) (18668 18955 (IL:WBREAK 18681
. 18953)) (19068 20177 (REUSE-CURRENT-WINDOW 19068 . 20177)) (20179 21483 (CREATE-DEBUGGER-WINDOW
20179 . 21483)) (21485 22437 (SET-UP-DEBUGGER-WINDOW 21485 . 22437)) (22439 23454 (
CLOSE-DEBUGGER-WINDOW 22439 . 23454)) (23456 23942 (RELEASE-DEBUGGER-WINDOW 23456 . 23942)) (23944
24881 (NEAR-BY-REGION 23944 . 24881)) (24883 25993 (DEBUGGER-BUTTON-EVENT 24883 . 25993)) (25995 26932
(DEBUGGER-MENU-HELP 25995 . 26932)) (31872 33690 (DEBUGGER-EVAL 31872 . 33690)) (33692 38041 (
FIND-DEBUGGER-STACK-FRAME 33692 . 38041)) (38043 38782 (FIND-NAMED-STACK-POSITION 38043 . 38782)) (
38784 39416 (FIND-ORIGINAL-NAME-AND-DEFINITION 38784 . 39416)) (39418 39552 (STKPTR-CCODE 39418 .
39552)) (42143 47005 (IL:BAKTRACE 42156 . 44940) (IL:BAKTRACE1 44942 . 47003)) (47841 54770 (
ATTACH-BACKTRACE-MENU 47841 . 54770)) (54772 57983 (REGION-NEXT-TO 54772 . 57983)) (57985 59428 (
BACKTRACE-MENU-BUTTONEVENTFN 57985 . 59428)) (59430 63704 (BACKTRACE-ITEM-SELECTED 59430 . 63704)) (
63706 67543 (STACK-FRAME-PROPERTIES 63706 . 67543)) (67545 68555 (STACK-FRAME-FETCHFN 67545 . 68555))
(68557 69744 (STACK-FRAME-STOREFN 68557 . 69744)) (69746 70321 (STACK-FRAME-VALUE-COMMAND 69746 .
70321)) (70323 70733 (STACK-FRAME-PROPERTY 70323 . 70733)) (70735 72720 (MAKE-FRAME-INSPECT-WINDOW
70735 . 72720)) (72722 72919 (%RELEASE-STACK-DATUM 72722 . 72919)) (72921 73627 (PRINT-BACKTRACE 72921
. 73627)) (76856 76950 (EXIT-DEBUGGER 76856 . 76950)) (76952 77271 (INVOKE-ESCAPE-FROM-MENU 76952 .
77271)) (77273 78696 (ESCAPE-FROM-DEBUGGER 77273 . 78696)) (78698 79076 (MENU-FROM-ESCAPE-LIST 78698
. 79076)) (79078 80237 (KEYLIST-FROM-ESCAPE-LIST 79078 . 80237)) (80239 81247 (COLLECT-ACTIVE-ESCAPES
80239 . 81247)) (81249 81618 (IL:FIND-LEXICAL-ENVIRONMENT 81249 . 81618)) (81619 83585 (
IL:FIND-STACK-FRAME 81632 . 83583)))))
IL:STOP

BIN
sources/DEBUGGER.DFASL
View File

Binary file not shown.