12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485 |
- <DEFINE PRINT-FREE ("OPTIONAL" FOO)
- <COND (<NOT <ASSIGNED? FOO>>
- <SET FOO
- <CHTYPE <1 <GET-LOC <+ ,IDCHAIN <* 1024 <ALLOCPAGE ,TVASS>>>
- ,AUV1>>
- FIX>>)
- (<SET FOO <CHTYPE <ORB *400000000000* .FOO> FIX>>)>
- <REPEAT ()
- <AND <G=? .FOO 0> <RETURN>>
- <SET FOO <CHTYPE <ANDB .FOO #WORD *000000777777*> FIX>>
- <COND (<SET M <MEMQ <- .FOO ,SCORE> ,LOSSTABLE>>
- <ERROR SCORE-MUNGED .FOO <1 <BACK .M 2>>>)
- (<SET M <MEMQ <- .FOO ,QASKED> ,LOSSTABLE>>
- <ERROR QASKED-MUNGED .FOO <1 <BACK .M 2>>>)
- (<==? .FOO 3> <ERROR LUSERS-MUNGED>)>
- <SET Q <DATA-FIND ,TVASS .FOO>>
- <PRIN1 .FOO>
- <INDENT-TO 6>
- <SET FOO <CHTYPE <3 .Q> FIX>>
- <CRLF>>>
- <DEFINE PRINT-UBLOCK (OFFSET)
- <SET L <DATA-AREAD ,TVASS 3 <ARESET ,TVSPACE>>>
- <REPEAT ((LL .L))
- <AND <TYPE? <1 .LL> FIX> <RETURN>>
- <PRINC <1 .LL>>
- <PRINC " -- ">
- <PRINT <DATA-AREAD ,TVASS <+ <3 .LL> .OFFSET> <ARESET ,TVSPACE1>>>
- <CRLF>
- <SET LL <REST .LL 4>>>>
-
- <DEFINE PRINT-Q ()
- <REPEAT ((FOO <CHTYPE <DATA-READW ,LOWQUES ,TVASS> FIX>))
- <AND <0? .FOO>
- <RETURN>>
- <SET Q <DATA-AREAD ,TVASS .FOO <ARESET ,TVSPACE>>>
- <PRIN1 <NTH .Q ,QQNUM>>
- <INDENT-TO 10>
- <PRIN1 .FOO>
- <INDENT-TO 16>
- <PRINC <NTH .Q ,QAUTH>>
- <INDENT-TO 23>
- <PRIN1 <NTH .Q ,QCAT>>
- <SET FOO <CHTYPE <DATA-READW .FOO ,TVASS> FIX>>
- <CRLF>>>
-
- <DEFINE PRINT-A (WHR)
- <REPEAT ((FOO <CHTYPE <DATA-READW .WHR ,TVASS> FIX>))
- <AND <0? .FOO>
- <RETURN>>
- <SET Q <DATA-AREAD ,TVASS .FOO <ARESET ,TVSPACE>>>
- <PRIN1 .FOO>
- <INDENT-TO 6>
- <PRIN1 <NTH .Q ,AQUES>>
- <SET FOO <CHTYPE <DATA-READW .FOO ,TVASS> FIX>>
- <CRLF>>>
- <DEFINE PRINT-CHAIN (WHR)
- <REPEAT ((FOO <CHTYPE <DATA-READW .WHR ,TVASS> FIX>))
- <AND <0? .FOO>
- <RETURN>>
- <SET Q <DATA-AREAD ,TVASS .FOO <ARESET ,TVSPACE>>>
- <PRIN1 .FOO>
- <INDENT-TO 6>
- <PRIN1 .Q>
- <SET FOO <CHTYPE <DATA-READW .FOO ,TVASS> FIX>>
- <CRLF>>>
- ; "LENGTH OF CHAIN POINTER IN AN ASYLUM"
- <DEFINE CHAIN-LENGTH (WD "AUX" (CNT 0))
- #DECL ((WD) <PRIMTYPE WORD> (CNT) FIX)
- <REPEAT ((WD <CHTYPE .WD FIX>))
- <COND (<0? <SET WD <CHTYPE <DATA-READW .WD ,TVASS> FIX>>>
- <RETURN .CNT>)
- (<SET CNT <+ .CNT 1>> <CRLF> <PRIN1 .WD>)>>>
- <DEFINE DR (FX)
- #DECL ((FX) FIX)
- <DATA-AREAD .FX ,TVASS <ARESET ,TVSPACE>>>
|