mirror of
https://github.com/PDP-10/its.git
synced 2026-03-07 11:39:43 +00:00
294 lines
7.3 KiB
Plaintext
294 lines
7.3 KiB
Plaintext
|
|
<PACKAGE "TRACE">
|
|
|
|
<ENTRY TRACE
|
|
UNTRACE
|
|
TFUNCTION
|
|
TRSUBR
|
|
TRSUBR-ENTRY
|
|
TSUBR
|
|
TRACELIST>
|
|
|
|
<ENTRY INDENT
|
|
INDENT-MOD
|
|
IN-BREAK
|
|
IN-PRINT
|
|
OUT-BREAK
|
|
OUT-PRINT
|
|
VERBOSE
|
|
TSTRUC>
|
|
|
|
<ENTRY TRACE-ARGS TRACE-VAL>
|
|
|
|
<NEWTYPE TFUNCTION LIST>
|
|
|
|
<NEWTYPE TRSUBR VECTOR>
|
|
|
|
<NEWTYPE TRSUBR-ENTRY VECTOR>
|
|
|
|
<NEWTYPE TSUBR WORD>
|
|
|
|
<NEWTYPE TSTRUC VECTOR '<<PRIMTYPE VECTOR> [7 ANY]>>
|
|
|
|
<PUT APPTRACE
|
|
DECL
|
|
'<OR TFUNCTION TRSUBR TRSUBR-ENTRY TSUBR>>
|
|
|
|
<SETG IN-BREAK 1>
|
|
|
|
<SETG IN-PRINT 2>
|
|
|
|
<SETG OUT-PRINT 3>
|
|
|
|
<SETG OUT-BREAK 4>
|
|
|
|
<SETG VERBOSE 5>
|
|
|
|
<SETG NAME 6>
|
|
|
|
<SETG RVAL 7>
|
|
|
|
<MANIFEST IN-BREAK
|
|
IN-PRINT
|
|
OUT-PRINT
|
|
OUT-BREAK
|
|
VERBOSE
|
|
NAME
|
|
RVAL>
|
|
|
|
<DEFINE TRACE ("OPTIONAL" (FROBS <>)
|
|
"TUPLE" DEFS
|
|
"AUX" (IN-BREAK <>) (IN-PRINT T) (OUT-PRINT T) (OUT-BREAK <>)
|
|
(VERBOSE <>))
|
|
#DECL ((FROBS) <OR FALSE ATOM <LIST [REST ATOM]>>
|
|
(DEFS) <TUPLE [REST <OR ATOM LIST>]>
|
|
(IN-PRINT OUT-PRINT OUT-BREAK VERBOSE) ANY)
|
|
<COND (<NOT .FROBS> <FLOAD "MUDBUG;TRACE ORDER"> T)
|
|
(T
|
|
<MAPF <>
|
|
<FUNCTION (X "AUX" Y Z)
|
|
#DECL ((X) <OR ATOM LIST> (Y) ATOM
|
|
(Z) STRING)
|
|
<COND (<TYPE? .X ATOM>
|
|
<SET Z <SPNAME .X>>
|
|
<COND (<=? .Z "IN-BREAK"> <SET IN-BREAK T>)
|
|
(<=? .Z "OUT-BREAK"> <SET OUT-BREAK T>)
|
|
(<=? .Z "VERBOSE"> <SET VERBOSE T>)>)
|
|
(<REPEAT
|
|
((ZORK <COND (<TYPE? <NTH .X <LENGTH .X>> FORM>
|
|
<ENTRY-HACK <NTH .X <LENGTH .X>>>)
|
|
(<NTH .X <LENGTH .X>>)>))
|
|
<SET Y <1 .X>>
|
|
<SET Z <SPNAME .Y>>
|
|
<COND (<=? .Z "IN-BREAK">
|
|
<SET IN-BREAK .ZORK>)
|
|
(<=? .Z "OUT-BREAK">
|
|
<SET OUT-BREAK .ZORK>)
|
|
(<=? .Z "IN-PRINT">
|
|
<SET IN-PRINT .ZORK>)
|
|
(<=? .Z "OUT-PRINT">
|
|
<SET OUT-PRINT .ZORK>)
|
|
(<=? .Z "VERBOSE">
|
|
<SET VERBOSE .ZORK>)>
|
|
<OR <TYPE? <1 <SET X <REST .X>>> ATOM>
|
|
<RETURN>>>)>>
|
|
.DEFS>
|
|
<COND (<TYPE? .FROBS ATOM>
|
|
<TRACE-IT .FROBS
|
|
.IN-BREAK
|
|
.IN-PRINT
|
|
.OUT-PRINT
|
|
.OUT-BREAK
|
|
.VERBOSE>)
|
|
(T
|
|
<MAPF <>
|
|
<FUNCTION (X)
|
|
#DECL ((X) ATOM)
|
|
<TRACE-IT .X
|
|
.IN-BREAK
|
|
.IN-PRINT
|
|
.OUT-PRINT
|
|
.OUT-BREAK
|
|
.VERBOSE>>
|
|
.FROBS>
|
|
.FROBS)>)>>
|
|
|
|
<DEFINE ENTRY-HACK (AFORM) #DECL ((AFORM) FORM)
|
|
<MAPR <>
|
|
<FUNCTION (X "AUX" (Y <1 .X>)) #DECL ((X) <PRIMTYPE LIST>)
|
|
<COND (<TYPE? .Y ATOM>
|
|
<COND (<=? <SPNAME .Y> "TRACE-ARGS">
|
|
<PUT .X 1 TRACE-ARGS>)
|
|
(<=? <SPNAME .Y> "TRACE-VAL">
|
|
<PUT .X 1 TRACE-VAL>)>)
|
|
(<TYPE? .Y FORM>
|
|
<ENTRY-HACK .Y>)>>
|
|
.AFORM>
|
|
.AFORM>
|
|
|
|
<OR <GASSIGNED? TRACELIST> <SETG TRACELIST ()>>
|
|
|
|
<GDECL (TRACELIST) <LIST [REST ATOM]>>
|
|
|
|
<DEFINE TRACE-IT (FROB IN-BREAK IN-PRINT OUT-PRINT OUT-BREAK VERBOSE
|
|
"AUX" VAL RVAL TS)
|
|
#DECL ((FROB) ATOM (IN-BREAK IN-PRINT OUT-PRINT OUT-BREAK VERBOSE) ANY
|
|
(VAL) <OR FUNCTION RSUBR-ENTRY RSUBR SUBR APPTRACE>
|
|
(TS) <OR FALSE TSTRUC> (RVAL) APPTRACE)
|
|
<COND (<GASSIGNED? .FROB>
|
|
<SET VAL ,.FROB>
|
|
<COND (<AND
|
|
<TYPE? .VAL TFUNCTION TRSUBR TRSUBR-ENTRY TSUBR>
|
|
<SET TS <GETPROP .VAL TRACE>>>
|
|
<SET RVAL .VAL>
|
|
<SET VAL <RVAL .TS>>)
|
|
(T
|
|
<SETG
|
|
.FROB
|
|
<SET
|
|
RVAL
|
|
<COND (<TYPE? .VAL FUNCTION>
|
|
<CHTYPE .VAL TFUNCTION>)
|
|
(<TYPE? .VAL RSUBR>
|
|
<CHTYPE .VAL TRSUBR>)
|
|
(<TYPE? .VAL RSUBR-ENTRY>
|
|
<CHTYPE .VAL TRSUBR-ENTRY>)
|
|
(T
|
|
<CHTYPE .VAL TSUBR>)>>>
|
|
<SETG TRACELIST (.FROB !,TRACELIST)>
|
|
<PUTPROP .RVAL TRACE <SET TS <CHTYPE <IVECTOR 7 <>> TSTRUC>>>)>
|
|
<PUT .TS ,IN-BREAK .IN-BREAK>
|
|
<PUT .TS ,IN-PRINT .IN-PRINT>
|
|
<PUT .TS ,OUT-PRINT .OUT-PRINT>
|
|
<PUT .TS ,OUT-BREAK .OUT-BREAK>
|
|
<PUT .TS ,VERBOSE .VERBOSE>
|
|
<PUT .TS ,NAME .FROB>
|
|
<PUT .TS ,RVAL .VAL>
|
|
.FROB)>>
|
|
|
|
<DEFINE UNTRACE ("OPTIONAL" (X ,TRACELIST))
|
|
#DECL ((X) <OR ATOM <LIST [REST ATOM]>>)
|
|
<COND (<==? .X ,TRACELIST>
|
|
<MAPF <>
|
|
<FUNCTION (FROB "AUX" TEMP)
|
|
#DECL ((FROB) ATOM (TEMP) <OR FALSE TSTRUC>)
|
|
<AND <SET TEMP <GET ,.FROB TRACE>>
|
|
<SETG .FROB <RVAL .TEMP>>>>
|
|
.X>
|
|
<SETG TRACELIST ()>
|
|
.X)
|
|
(<TYPE? .X LIST>
|
|
<MAPF <>
|
|
<FUNCTION (X) #DECL ((X) ATOM) <UNTRACE-IT .X>>
|
|
.X>)
|
|
(T <UNTRACE-IT .X>)>
|
|
.X>
|
|
|
|
<DEFINE UNTRACE-IT (X "AUX" (LST ,TRACELIST) (ZORK ,.X) TEMP)
|
|
#DECL ((X) ATOM (LST) <LIST [REST ATOM]> (ZORK) APPTRACE
|
|
(TEMP) <OR FALSE TSTRUC>)
|
|
<COND (<==? <1 .LST> .X>
|
|
<SETG TRACELIST <REST .LST>>
|
|
<AND <SET TEMP <GET .ZORK TRACE>>
|
|
<SETG .X <RVAL .TEMP>>>)
|
|
(<REPEAT ((NL <REST .LST>) (OL .LST))
|
|
#DECL ((OL NL) LIST)
|
|
<COND (<EMPTY? .NL> <RETURN>)
|
|
(<==? <1 .NL> .X>
|
|
<AND <SET TEMP <GET .ZORK TRACE>>
|
|
<SETG .X <RVAL .TEMP>>>
|
|
<PUTREST .OL <REST .NL>>
|
|
<RETURN>)
|
|
(<SET OL .NL> <SET NL <REST .NL>>)>>)>>
|
|
|
|
<DEFINE TSTRUC-PRINT (X "AUX" (OUTCHAN .OUTCHAN))
|
|
#DECL ((X) TSTRUC (OUTCHAN) ANY)
|
|
<PRIN1 <NAME .X>>
|
|
<CRLF>
|
|
<PRINC "IN-BREAK: ">
|
|
<PRIN1 <IN-BREAK .X>>
|
|
<CRLF>
|
|
<PRINC "IN-PRINT: ">
|
|
<PRIN1 <IN-PRINT .X>>
|
|
<CRLF>
|
|
<PRINC "OUT-PRINT: ">
|
|
<PRIN1 <OUT-PRINT .X>>
|
|
<CRLF>
|
|
<PRINC "OUT-BREAK: ">
|
|
<PRIN1 <OUT-BREAK .X>>
|
|
<CRLF>
|
|
<PRINC "VERBOSE: ">
|
|
<PRIN1 <VERBOSE .X>>
|
|
<CRLF>>
|
|
|
|
<PRINTTYPE TSTRUC ,TSTRUC-PRINT>
|
|
|
|
<PRINTTYPE TRSUBR-ENTRY RSUBR-ENTRY>
|
|
|
|
<PRINTTYPE TRSUBR RSUBR>
|
|
|
|
<SETG INDENT-MOD 10>
|
|
|
|
<GDECL (INDENT INDENT-MOD) FIX>
|
|
|
|
<DEFINE TRACER (X "TUPLE" TRACE-ARGS "AUX" FROB
|
|
(INDENT <AND <ASSIGNED? INDENT> .INDENT <+ .INDENT 1>>)
|
|
RINDENT NAME TRACE-VAL STRUC
|
|
(OUTCHAN ,OUTCHAN))
|
|
#DECL ((X) APPTRACE (TRACE-ARGS) <SPECIAL TUPLE> (FROB) ANY (RINDENT) FIX
|
|
(NAME) ATOM (TRACE-VAL) <SPECIAL ANY> (STRUC) TSTRUC
|
|
(OUTCHAN) <SPECIAL CHANNEL> (INDENT) <SPECIAL <OR FIX FALSE>>)
|
|
<COND (<NOT .INDENT>)
|
|
(<GASSIGNED? INDENT-MOD>
|
|
<SET RINDENT <+ 4 <MOD .INDENT ,INDENT-MOD>>>)
|
|
(T
|
|
<SET RINDENT <+ 4 .INDENT>>)>
|
|
<SET STRUC <GET .X TRACE>>
|
|
<SET NAME <NAME .STRUC>>
|
|
<COND (<AND <SET FROB <IN-PRINT .STRUC>>
|
|
<OR <TYPE? .FROB ATOM> <EVAL .FROB>>>
|
|
<COND (<AND .INDENT <G? .INDENT 0>>
|
|
<PRIN1 .INDENT>
|
|
<INDENT-TO .RINDENT>)>
|
|
<PRINC "Entering ">
|
|
<PRIN1 .NAME>
|
|
<PRINC " with ">
|
|
<&1 .TRACE-ARGS>
|
|
<CRLF>)>
|
|
<COND (<AND <SET FROB <VERBOSE .STRUC>>
|
|
<OR <TYPE? .FROB ATOM> <EVAL .FROB>>>
|
|
<MAPF <> ,& .TRACE-ARGS>)>
|
|
<COND (<AND <SET FROB <IN-BREAK .STRUC>>
|
|
<OR <TYPE? .FROB ATOM> <EVAL .FROB>>>
|
|
<TBREAK .NAME>)>
|
|
<SET TRACE-VAL <APPLY <RVAL .STRUC> !.TRACE-ARGS>>
|
|
<COND (<AND <SET FROB <OUT-PRINT .STRUC>>
|
|
<OR <TYPE? .FROB ATOM> <EVAL .FROB>>>
|
|
<COND (<AND .INDENT <G? .INDENT 0>>
|
|
<PRIN1 .INDENT>
|
|
<INDENT-TO .RINDENT>)>
|
|
<PRINC "Leaving ">
|
|
<PRIN1 .NAME>
|
|
<PRINC " with ">
|
|
<&1 .TRACE-VAL>
|
|
<CRLF>)>
|
|
<COND (<AND <SET FROB <OUT-BREAK .STRUC>>
|
|
<OR <TYPE? .FROB ATOM> <EVAL .FROB>>>
|
|
<TBREAK .NAME>)>
|
|
.TRACE-VAL>
|
|
|
|
<DEFINE TBREAK (NM "AUX" (QUICK-RUN!-IEDIT T))
|
|
#DECL ((QUICK-RUN!-IEDIT) <SPECIAL ATOM>)
|
|
<PRINC "**BREAK**">
|
|
<LISTEN>>
|
|
|
|
<APPLYTYPE TRSUBR ,TRACER>
|
|
|
|
<APPLYTYPE TRSUBR-ENTRY ,TRACER>
|
|
|
|
<APPLYTYPE TSUBR ,TRACER>
|
|
|
|
<APPLYTYPE TFUNCTION ,TRACER>
|
|
|
|
<ENDPACKAGE>
|