mirror of
https://github.com/PDP-10/its.git
synced 2026-04-06 22:11:57 +00:00
399 lines
12 KiB
Plaintext
399 lines
12 KiB
Plaintext
|
||
<PACKAGE "DEBUGR">
|
||
|
||
<ENTRY DEBUG HELP REPAIR
|
||
INDENT-INC
|
||
INDENT-MOD
|
||
INDENT-DIF
|
||
SELF-FAST
|
||
FORM-FAST
|
||
OUT-FAST
|
||
OUT-UNIQUE>
|
||
|
||
|
||
<DEFINE DEBUG ("OPTIONAL" 'OBJ "EXTRA" (TPL <TUPLE START T>))
|
||
#DECL ((OBJ) <SPECIAL ANY> (TPL) TUPLE)
|
||
<COND (<AND <ASSIGNED? DPROCESS> <TYPE? .DPROCESS PROCESS>>
|
||
<RESUME .TPL .DPROCESS>
|
||
<HANDLER ,CHAR-INT ,CHAR-HANDLER>)
|
||
(ELSE
|
||
<SET DPROCESS <PROCESS ,MAIN-LOOP>>
|
||
<RESUME .TPL .DPROCESS>
|
||
<SETG CHAR-HANDLER <HANDLER ,CHAR-INT ,CHAR-INTERRUPT .DPROCESS>>)>
|
||
<SETG BREAKR-OBL .OBLIST>
|
||
<COND (<ASSIGNED? OBJ>
|
||
<INTERRUPT ,CHAR-INT ,BEGIN-CHAR ,INCHAN>
|
||
<SET OBJ <EVAL .OBJ>>
|
||
<INTERRUPT ,CHAR-INT ,END-CHAR ,INCHAN>
|
||
.OBJ)
|
||
(ELSE "READY")>>
|
||
<PROG () ',MAIN-LOOP ;"For GLUE">
|
||
|
||
<DEFINE HELP ("EXTRA" (C <OPEN "READ" <COND (,ITS "MUDBUG;DEBUGR HELP")
|
||
(ELSE "MDL:DEBUGR.HELP")>>))
|
||
#DECL ((C) <OR FALSE CHANNEL>)
|
||
<COND (.C <FILECOPY .C ,OUTCHAN> ,NULL)>>
|
||
|
||
<DEFINE REPAIR ()
|
||
<COND (<N==? <ME> <MAIN>>
|
||
<INT-LEVEL 0>
|
||
<AND <GASSIGNED? CHAR-HANDLER> <TYPE? ,CHAR-HANDLER HANDLER>
|
||
<OFF ,CHAR-HANDLER>>
|
||
<FREE-RUN <MAIN>>
|
||
<PRINC "
|
||
The broken Debugr has now been repaired and reset.
|
||
You must now re-type: <DEBUG>$ if you want to try
|
||
one-step debugging again. ---- (BKD)" ,OUTCHAN>
|
||
<BREAK-SEQ '<SET DPROCESS <>> <MAIN>>
|
||
<SUICIDE T <MAIN>>)>>
|
||
|
||
\
|
||
|
||
<PROG ()
|
||
<SETG BEGIN-CHAR <ASCII 2>> ;"Cntl B"
|
||
<SETG NEXT-CHAR <ASCII 14>> ;"Cntl N"
|
||
<SETG OVER-CHAR <ASCII 15>> ;"Cntl O"
|
||
<SETG ARG-CHAR <ASCII 1>> ;"Cntl A"
|
||
<SETG RPT-CHAR <ASCII 18>> ;"Cntl R"
|
||
<SETG END-CHAR <ASCII 5>> ;"Cntl E"
|
||
<SETG QUIT-CHAR <ASCII 17>> ;"Cntl Q"
|
||
<SETG POP-CHAR <ASCII 16>> ;"Cntl P"
|
||
<COND (<G? ,MUDDLE 100>
|
||
<ACTIVATE-CHARS <STRING
|
||
<ASCII 7> ; "CNTL G"
|
||
<ASCII <CHTYPE <ANDB <ASCII !\S> *77*> FIX>>
|
||
,BEGIN-CHAR
|
||
,NEXT-CHAR
|
||
,OVER-CHAR
|
||
,ARG-CHAR
|
||
,RPT-CHAR
|
||
,POP-CHAR
|
||
,END-CHAR
|
||
,QUIT-CHAR>>
|
||
;"For 10x/20 make the correct characters do interrupts"
|
||
<SETG ITS <>>)
|
||
(ELSE <SETG ITS T>)>
|
||
<GDECL (BEGIN-CHAR
|
||
NEXT-CHAR
|
||
OVER-CHAR
|
||
ARG-CHAR
|
||
RPT-CHAR
|
||
POP-CHAR
|
||
END-CHAR
|
||
QUIT-CHAR)
|
||
CHARACTER>
|
||
<SETG INDENT-INC 2>
|
||
<SETG INDENT-MOD 10>
|
||
<SETG INDENT-DIF 20>
|
||
<GDECL (INDENT-INC INDENT-MOD INDENT-DIF) FIX>
|
||
<SETG SELF-FAST T>
|
||
<SETG FORM-FAST T>
|
||
<SETG OUT-FAST T>
|
||
<SETG OUT-UNIQUE T>
|
||
<SETG LO LO> ;"Psuedo-LAST-OUT variable for use in OUT-UNIQUE processing">
|
||
|
||
<PROG () ;"DEBUGR condition variables"
|
||
<SETG DSTATE -1> ;"Debuggr's State"
|
||
<SETG RSTATE 1> ;"Reader's State"
|
||
<SETG COUNT 0> ;"Reader's arg counter"
|
||
<GDECL (DSTATE RSTATE COUNT) FIX>>
|
||
|
||
\
|
||
|
||
<DEFINE MAIN-LOOP (DITEM "EXTRA" (INCHAN ,INCHAN) (OUTCHAN ,OUTCHAN))
|
||
#DECL ((DITEM) <SPECIAL <TUPLE ATOM ANY>>
|
||
(INCHAN OUTCHAN) <SPECIAL ANY>)
|
||
<REPEAT ((STATES '([-2 0 <>])) (INFO <>) (I/O-MODE <>) PURPOSE MESSAGE
|
||
(OLEV 0) (LEV 0) (CURLEV 0) (OLDLEV 0) TLF ARG
|
||
RDRVAL)
|
||
#DECL ((LEV) <SPECIAL FIX> (PURPOSE) ATOM (TLF) <SPECIAL <OR FALSE FRAME>>
|
||
(MESSAGE) <SPECIAL ANY> (CURLEV OLDLEV OLEV) FIX
|
||
(RDRVAL) <OR FALSE FIX>
|
||
(STATES) <LIST [REST <VECTOR FIX FIX ANY>]>)
|
||
<SET TLF <>> ;"Top Level Frame"
|
||
<SET PURPOSE <1 .DITEM>> ;"Get indicator of purpose"
|
||
<SET ARG <2 .DITEM>>
|
||
<COND (<AND <==? .PURPOSE EVLIN> <TYPE? .ARG TUPLE> <NOT <EMPTY? .ARG>>>
|
||
<SET ARG <1 .ARG>>)>
|
||
<SET CURLEV <FRAME-COUNT <FRAME <RESUMER>>>>
|
||
<AND ,TRACING? <DTRACE .PURPOSE ,DSTATE .CURLEV .LEV .INFO .ARG>>
|
||
<COND (<==? .PURPOSE START> ;"Request to start up DEBUGGER Process ?"
|
||
<SETG DSTATE 0> <SET MESSAGE <>>)
|
||
(<AND <ASSIGNED? QUICK-RUN!-IEDIT <RESUMER>>
|
||
<LVAL QUICK-RUN!-IEDIT <RESUMER>>>
|
||
<SET LEV .OLEV>
|
||
<SET CURLEV .OLDLEV>
|
||
<SET MESSAGE #DISMISS OK>)
|
||
(<==? .PURPOSE EVLIN> ;"Dispatch on purpose"
|
||
<COND (<AND .MESSAGE <G? .CURLEV .OLDLEV>>
|
||
;"Attempt to 1STEP while in DISMISS evaluation"
|
||
<REPEAT ()
|
||
<AND <G? .OLDLEV <1 <1 .STATES>>> <RETURN>>
|
||
<SET STATES <REST .STATES>>>
|
||
<SET STATES ([.OLDLEV .OLEV .INFO] !.STATES)>
|
||
<SET MESSAGE <>>
|
||
<SETG DSTATE 1>
|
||
<SETG COUNT 0>
|
||
<AGAIN>)
|
||
(<OR <==? ,DSTATE 1> <==? ,DSTATE 2>>
|
||
<COND (<SET I/O-MODE
|
||
<IPRINTER .ARG <- .CURLEV .LEV>>>
|
||
<SET MESSAGE
|
||
<COND (<==? .I/O-MODE T> <>) (ELSE #DISMISS T)>>)
|
||
(<SET RDRVAL <READER .ARG>>
|
||
<SETG DSTATE .RDRVAL>
|
||
<COND (<OR <==? ,DSTATE 3> <==? ,DSTATE 4>>
|
||
<SET INFO .ARG>)>
|
||
<COND (<OR <==? ,DSTATE 2> <==? ,DSTATE 4>>
|
||
<SET MESSAGE #DISMISS T>)
|
||
(ELSE <SET MESSAGE <>>)>)
|
||
(ELSE <AGAIN>)>)
|
||
(<==? ,DSTATE 3>
|
||
<COND (<NOT <SET INFO <MEMQ .ARG .INFO>>>
|
||
<SETG DSTATE 1>
|
||
<AGAIN>)>
|
||
<SET INFO <REST .INFO>>
|
||
<SET I/O-MODE <IPRINTER .ARG <- .CURLEV .LEV>>>
|
||
<SET MESSAGE #DISMISS T>)
|
||
(<==? ,DSTATE 4>
|
||
<COND (<==? .ARG .INFO> ;"Repeating ?"
|
||
<SETG DSTATE 1> <AGAIN>)>
|
||
<SET I/O-MODE <IPRINTER .ARG <- .CURLEV .LEV>>>
|
||
<SET MESSAGE #DISMISS T>)
|
||
(ELSE <ERROR DEBUG ,DSTATE .PURPOSE>)>)
|
||
(<==? .PURPOSE EVLOUT>
|
||
<COND (<OR <==? ,DSTATE 1> <==? ,DSTATE 2>>
|
||
<COND (<OPRINTER .ARG <- .CURLEV .LEV> .I/O-MODE>
|
||
<SETG LO .ARG> ;"Last-out"
|
||
<SETG DSTATE 1>)
|
||
(<NOT <SET RDRVAL <READER .ARG>>> <AGAIN>)
|
||
(<G? .RDRVAL 1>
|
||
<SETG DSTATE 1>)
|
||
(ELSE <SETG DSTATE .RDRVAL>)>)
|
||
(<==? ,DSTATE 3>
|
||
<COND (<L? .CURLEV .OLDLEV> <SETG DSTATE 1> <AGAIN>)>
|
||
<OPRINTER .ARG <- .CURLEV .LEV> .I/O-MODE>
|
||
<SETG LO .ARG>)
|
||
(<==? ,DSTATE 4>
|
||
<COND (<L? .CURLEV .OLDLEV> <SETG DSTATE 1> <AGAIN>)>
|
||
<OPRINTER .ARG <- .CURLEV .LEV> .I/O-MODE>
|
||
<SETG LO .ARG>)
|
||
(<==? ,DSTATE 0> ;"Return from deeper DISMISS level"
|
||
<SET CURLEV <FRAME-COUNT <FRAME <RESUMER>>>>
|
||
<REPEAT ()
|
||
<SET INFO <1 .STATES>>
|
||
<SET STATES <REST .STATES>>
|
||
<COND (<==? .CURLEV <1 .INFO>> <RETURN>)
|
||
(<G? .CURLEV <1 .INFO>>
|
||
<ERROR LEVEL-MISMATCH!-ERRORS DEBUG>)>>
|
||
<SET OLEV <SET LEV <2 .INFO>>>
|
||
<SET INFO <3 .INFO>>
|
||
<SETG DSTATE 1>
|
||
<SETG COUNT 0>
|
||
<SET OLDLEV .CURLEV>
|
||
<SET TLF <>>
|
||
<AGAIN>)
|
||
(<==? ,DSTATE -1> <FREE-RUN <RESUMER>>)
|
||
(ELSE <ERROR DEBUG ,DSTATE .PURPOSE>)>
|
||
<SET I/O-MODE <>>
|
||
<SET MESSAGE <>>)>
|
||
<SET OLEV .LEV>
|
||
<SET OLDLEV .CURLEV>
|
||
<SET DITEM
|
||
<COND (<NOT .TLF> <RESUME .MESSAGE>)
|
||
(<LEGAL? .TLF> <ERRET .MESSAGE .TLF>)
|
||
(ELSE <BREAK-SEQ '<ERRET T> <RESUMER>> <RESUME T>)>>>>
|
||
|
||
<DEFINE OPRINTER (EXPR DEPTH I/O
|
||
"EXTRA" (OUTCHAN .OUTCHAN)
|
||
(INDENT
|
||
<MIN <* ,INDENT-INC <MOD <MAX .DEPTH 1> ,INDENT-MOD>>
|
||
<- <13 .OUTCHAN> ,INDENT-DIF>>))
|
||
#DECL ((INDENT DEPTH) FIX (OUTCHAN) <CHANNEL [12 ANY] FIX>)
|
||
<COND (<AND .I/O <APPLICABLE? .I/O>>
|
||
<APPLY .I/O .EXPR>
|
||
<TERPRI>)
|
||
(<OR <NOT ,OUT-FAST> <NOT ,OUT-UNIQUE> <N==? .EXPR ,LO>>
|
||
<INDENT-TO .INDENT .OUTCHAN> ;"PPRINT's INDENT-TO routine"
|
||
<PRIN1 .DEPTH>
|
||
<PRINC "<= ">
|
||
<&1 .EXPR>
|
||
<TERPRI>)>
|
||
,OUT-FAST>
|
||
|
||
<DEFINE IPRINTER (EXPR DEPTH
|
||
"EXTRA" (OUTCHAN .OUTCHAN)
|
||
(INDENT
|
||
<MIN <* ,INDENT-INC <MOD <MAX .DEPTH 1> ,INDENT-MOD>>
|
||
<- <13 .OUTCHAN> ,INDENT-DIF>>))
|
||
#DECL ((INDENT DEPTH) FIX (OUTCHAN) <CHANNEL [12 ANY] FIX>)
|
||
<SETG LO LO> ;"Clobber last-out, since this is IN"
|
||
<INDENT-TO .INDENT> ;"PPRINT's INDENT-TO routine"
|
||
<PRIN1 .DEPTH>
|
||
<COND (<AND <TYPE? .EXPR FORM> ,FORM-FAST> <FORM-PRINTER .EXPR>)
|
||
(<AND <NOT <TYPE? .EXPR LIST VECTOR UVECTOR FORM>>
|
||
,SELF-FAST>
|
||
<SELF-PRINTER .EXPR>)
|
||
(ELSE <NORMAL-PRINTER .EXPR>)>>
|
||
|
||
<DEFINE FORM-PRINTER (EXPR "EXTRA" (OUTCHAN .OUTCHAN))
|
||
#DECL ((EXPR) FORM (OUTCHAN) CHANNEL)
|
||
<COND (<OR <EMPTY? .EXPR>
|
||
<AND <==? <LENGTH? .EXPR 2> 2>
|
||
<OR <==? <1 .EXPR> LVAL> <==? <1 .EXPR> GVAL>>
|
||
<TYPE? <2 .EXPR> ATOM>> ;".FOO or ,FOO ?"
|
||
<==? <1 .EXPR> QUOTE>>
|
||
<PRINC ": ">
|
||
<&1 .EXPR>
|
||
<PRINC " = ">
|
||
,&1)
|
||
(<==? <1 .EXPR> BREAKR!-IEDIT>
|
||
<PRINC "=> ">
|
||
<&1 .EXPR>
|
||
<TERPRI>
|
||
T)
|
||
(ELSE <NORMAL-PRINTER .EXPR>)>>
|
||
|
||
<DEFINE SELF-PRINTER (EXPR)
|
||
.EXPR ;"NOT USED"
|
||
<PRINC ": ">
|
||
,&1>
|
||
|
||
<DEFINE NORMAL-PRINTER (EXPR "EXTRA" (OUTCHAN .OUTCHAN))
|
||
#DECL ((OUTCHAN) CHANNEL (VALUE) FALSE)
|
||
<PRINC "=> ">
|
||
<&1 .EXPR>
|
||
<TERPRI>
|
||
<>>
|
||
|
||
<DEFINE FRAME-COUNT (FRM)
|
||
#DECL ((FRM) FRAME (VALUE) FIX)
|
||
<REPEAT ((I 0))
|
||
#DECL ((VALUE I) FIX)
|
||
<COND (<==? <FUNCT .FRM> TOPLEVEL> <RETURN .I>)
|
||
(<==? <FUNCT .FRM> EVAL> <SET I <+ .I 1>>)>
|
||
<SET FRM <FRAME .FRM>>>>
|
||
|
||
<DEFINE READER (L-O "ACT" RACT)
|
||
#DECL ((VALUE) <OR FALSE FIX>)
|
||
<COND (<0? <SETG COUNT <MAX 0 <- ,COUNT 1>>>>
|
||
<SETG RSTATE
|
||
<PROG DEBUG-RDR ()
|
||
#DECL ((DEBUG-RDR) <SPECIAL ACTIVATION>)
|
||
<BREAK-SEQ
|
||
<PUT ,BREAK-FORM 2 .L-O>
|
||
<RESUMER>>
|
||
<SET TLF <FRAME <RESUMER>>>
|
||
<RESUME T>
|
||
<SET DITEM <RESUME #DISMISS BREAKR <RESUMER>>>
|
||
<RETURN <> .RACT>>>)
|
||
(ELSE ,RSTATE)>>
|
||
|
||
<PROG ()
|
||
<SETG BREAK-FORM <FORM BREAKR ARG>>
|
||
<GDECL (BREAK-FORM) <FORM ATOM ANY>>
|
||
',BREAKR ;"For GLUE">
|
||
|
||
<DEFINE BREAKR ('L-O
|
||
"AUX" (OUTCHAN ,OUTCHAN) (INCHAN ,INCHAN) (OBLIST ,BREAKR-OBL)
|
||
"ACT" LERR\ !-INTERRUPTS)
|
||
#DECL ((OUTCHAN INCHAN OBLIST) <SPECIAL ANY>
|
||
(LERR\ !-INTERRUPTS) <SPECIAL <OR ACTIVATION FRAME>>)
|
||
<SET LERR\ !-INTERRUPTS
|
||
<FRAME <FRAME .LERR\ !-INTERRUPTS>>>
|
||
<COND (<TYPE? ,BREAKR RSUBR RSUBR-ENTRY>
|
||
<SET LERR\ !-INTERRUPTS <FRAME .LERR\ !-INTERRUPTS>>)>
|
||
<SET LAST-OUT .L-O>
|
||
<REPEAT ((QUICK-RUN!-IEDIT DEBUG) OB)
|
||
#DECL ((QUICK-RUN!-IEDIT) <SPECIAL ANY>)
|
||
<SET OB <READ>>
|
||
<TERPRI>
|
||
<PRIN1 <SET LAST-OUT <EVAL .OB>>>
|
||
<TERPRI>>>
|
||
|
||
<DEFINE CHAR-INTERRUPT (CHAR CHAN "EXTRA" MESS (CNT 0))
|
||
;"Character Interrupt Handler for DEBUG process"
|
||
#DECL ((CHAR) CHARACTER (CHAN) CHANNEL
|
||
(CNT) FIX (MESS) <OR FALSE FIX>)
|
||
<COND (<L? ,DSTATE 0> ;"DEBUGR off ?"
|
||
<ERROR INTERRUPT ,DSTATE CHAR-INTERRUPT>)
|
||
(<==? .CHAR ,BEGIN-CHAR> ;"Begin debugging"
|
||
<1STEP <RESUMER>>
|
||
<SETG DSTATE 1>
|
||
<RESET .CHAN>
|
||
<COND (<AND <ASSIGNED? QUICK-RUN!-IEDIT <RESUMER>>
|
||
<==? T <LVAL QUICK-RUN!-IEDIT <RESUMER>>>>
|
||
<SET LEV
|
||
<FRAME-COUNT <LVAL LERR\ !-INTERRUPTS <RESUMER>>>>
|
||
<BREAK-SEQ '<ERRET T> <RESUMER>>)
|
||
(ELSE <SET LEV <FRAME-COUNT <FRAME <RESUMER>>>>)>
|
||
<DISMISS T>)
|
||
(<==? ,DSTATE 0> ;"Debugger not running ?"
|
||
<COND (<==? .CHAR ,QUIT-CHAR> ;"Quit while not ON ?"
|
||
<OFF ,CHAR-HANDLER>
|
||
<SETG DSTATE -1>
|
||
<RESET .CHAN>
|
||
<DISMISS T>)> ;"Else Ignore")
|
||
(<AND <SET MESS
|
||
<COND (<==? .CHAR ,NEXT-CHAR> 1)
|
||
(<==? .CHAR ,OVER-CHAR> 2)
|
||
(<==? .CHAR ,ARG-CHAR> 3)
|
||
(<==? .CHAR ,RPT-CHAR> 4)
|
||
(<==? .CHAR ,POP-CHAR> 5)
|
||
(<==? .CHAR ,END-CHAR>
|
||
<FREE-RUN <RESUMER>>
|
||
0)
|
||
(<==? .CHAR ,QUIT-CHAR>
|
||
<FREE-RUN <RESUMER>> <OFF ,CHAR-HANDLER>
|
||
-1)>>
|
||
<ASSIGNED? DEBUG-RDR>> ;"Valid activation character ?"
|
||
<CLEAR-LINE .CHAN>
|
||
<DISMISS .MESS .DEBUG-RDR>)
|
||
(<==? .CHAR <ASCII 127>> ;"Delete Character ?"
|
||
<SET CNT </ ,COUNT 10>>)
|
||
(<AND <G=? <ASCII .CHAR> <ASCII !\0>>
|
||
<L=? <ASCII .CHAR> <ASCII !\9>>> ;"Digit Character ?"
|
||
<SET CNT <+ <* 10 ,COUNT> <ASCII .CHAR> -48>>)>
|
||
<SETG COUNT .CNT>>
|
||
|
||
<AND ',CHAR-INTERRUPT ;"For GLUE">
|
||
|
||
<PUT <SETG CHAR-INT
|
||
<GET ,INCHAN INTERRUPT '<ERROR NO-INTERRUPTS!-ERRORS>>>
|
||
4
|
||
100000>
|
||
|
||
<DEFINE CLEAR-LINE (CHAN "EXTRA" (OUTCHAN ,OUTCHAN))
|
||
;"Clear line of activation char etc."
|
||
#DECL ((OUTCHAN CHAN) CHANNEL)
|
||
<RESET .CHAN>
|
||
<COND (,ITS <PRINC "H L">)>
|
||
<PUT .OUTCHAN 14 0>>
|
||
|
||
\
|
||
;"Save on TRACE list, info on last TLNT cycles of the Debugr"
|
||
|
||
<DEFINE DTRACE (PURPOSE DSTATE CURLEV LEV INFO ITEM "EXTRA" V)
|
||
#DECL ((V) <VECTOR [6 ANY]>)
|
||
<PUTREST ,TRACEND <SETG TRACEND ,TRACE>> ;"Move oldest to end"
|
||
<SETG TRACE <REST ,TRACE>>
|
||
<PUTREST ,TRACEND ()>
|
||
<SET V <1 ,TRACEND>> ;"Newest info"
|
||
<PUT .V 1 .PURPOSE>
|
||
<PUT .V 2 .DSTATE>
|
||
<PUT .V 3 .CURLEV>
|
||
<PUT .V 4 .LEV>
|
||
<PUT .V 5 .INFO>
|
||
<PUT .V 6 .ITEM>
|
||
<SETG TCNT <+ ,TCNT 1>>>
|
||
|
||
<PROG ()
|
||
<SETG TLNT 20> <GDECL (TLNT) FIX>
|
||
<SETG TRACE <ILIST ,TLNT '<IVECTOR 6 '0>>>
|
||
<SETG TRACEND <REST ,TRACE <- ,TLNT 1>>>
|
||
<GDECL (TRACE TRACEND) <LIST <VECTOR [6 ANY]>>>
|
||
<SETG TCNT 0> <GDECL (TCNT) FIX>
|
||
<SETG TRACING? T> <GDECL (TRACING?) <OR FALSE ATOM>>>
|
||
|
||
<ENDPACKAGE>
|