mirror of
https://github.com/PDP-10/its.git
synced 2026-01-13 15:27:28 +00:00
97 lines
3.1 KiB
Plaintext
97 lines
3.1 KiB
Plaintext
'<PCODE "3PPRINT">
|
|
|
|
<BLOAT 7100 100 5 20>
|
|
|
|
<PACKAGE "PP">
|
|
|
|
<RENTRY PPRINT EPRINT EPRIN1 COLPP FRAMES FRATM FRLVAL FRM PPRINF INDENT-TO
|
|
FORMS NULL LINPOS LINLNT PAGPOS PAGLNT QUICKPRINT LOOKAHEAD VERTICAL DENSE
|
|
LEFT-MARGIN>
|
|
|
|
<BLOCK (<ROOT>)>
|
|
|
|
FIXUP!-RSUBRS
|
|
|
|
<ENDBLOCK>
|
|
|
|
<COND (<NOT <GASSIGNED? NULL>> <SETG NULL <INSERT <ATOM <ASCII 127>> <ROOT>>>)>
|
|
<SETG QUICKPRINT <SET QUICKPRINT T>>
|
|
|
|
<SETG LOOKAHEAD <SET LOOKAHEAD T>>
|
|
|
|
<SETG VERTICAL <SET VERTICAL <>>>
|
|
|
|
<SETG DENSE <SET DENSE <>>>
|
|
|
|
<SETG LEFT-MARGIN <SET LEFT-MARGIN 0>>
|
|
|
|
<SETG PPRINT %<RSUBR!- '[ %<PCODE!- "3PPRINT" 0> PPRINT #DECL ("VALUE" ANY ANY
|
|
"OPTIONAL" CHANNEL) OUTCHAN (CHANNEL) DEFINE SETG DEFMAC QUOTE SET FUNCTION #
|
|
FALSE ("NAKED ATOM?") MARG (FIX) LEFT-MARGIN %<RGLOC NULL T> %<RGLOC OUTCHAN T>
|
|
QUICKPRINT (ANY) REDEFINE T KEEP-FIXUPS %<RGLOC MUDDLE T> "READ" "_PPRIN" "TPL:"
|
|
"PRINT" "PPRNF" "MUD" "_PPRNF" ">" "PRINTO" COMMENT %<RGLOC CR:FF:CR T> %<RGLOC
|
|
CR:SP:CR T> ":<" "." TO "DONE" NO-DUMP "FUNCT---ARGS" TOPLEVEL %<RGLOC FUNF T>
|
|
EVAL "FRAME---FUNCTION" "FRAMES FROM " "Atom is not bound anywhere."
|
|
"Bound further down to: " "Toplevel binding: " "Frame----Value"
|
|
"----bound, but not assigned a value----
|
|
" BAD-CHANNEL!-ERRORS PPRINT %<RGLOC QUICKPRINT T> VERTICAL %<RGLOC VERTICAL T>
|
|
LOOKAHEAD %<RGLOC LOOKAHEAD T> DENSE %<RGLOC DENSE T> FITS? PROG REPEAT LVAL
|
|
GVAL "![" WORD "!]" " (" CHANNEL " [" STORE CANT-PPRINT!-ERRORS DONE " ;"
|
|
RSUBR-ENTRY RSUBR "TTY" FIXUP!-RSUBRS CAN-NOT-BE-DUMPED!-ERRORS DECL L (LIST)
|
|
STACKFORM MAPF MAPR (0) LIST %<RGLOC TABS T> %<RGLOC SPACES T>]>>
|
|
<AND <ASSIGNED? GLUE> .GLUE <PUT ,PPRINT PGLUE ![1073741823 -1 -1 -1 -1 0!]>>
|
|
|
|
|
|
<SETG EPRINT %<RSUBR-ENTRY '[PPRINT EPRINT #DECL ("VALUE" ANY ANY "OPTIONAL" FIX
|
|
)] 208>>
|
|
|
|
<SETG EPRIN1 %<RSUBR-ENTRY '[PPRINT EPRIN1 #DECL ("VALUE" ANY ANY "OPTIONAL" FIX
|
|
)] 282>>
|
|
|
|
<SETG PPRINF %<RSUBR-ENTRY '[PPRINT PPRINF #DECL ("VALUE" <OR FALSE STRING> <OR
|
|
ATOM LIST STRING> "OPTIONAL" STRING FIX <OR FALSE ATOM> FIX)] 346>>
|
|
|
|
<SETG CR:SP:CR ![7022316820!]>
|
|
|
|
<SETG CR:FF:CR ![7021661460!]>
|
|
|
|
<GDECL (CR:SP:CR CR:FF:CR) UVECTOR>
|
|
|
|
<SETG COLPP %<RSUBR-ENTRY '[PPRINT COLPP #DECL ("VALUE" ANY ANY "OPTIONAL"
|
|
CHANNEL FIX FIX)] 830>>
|
|
|
|
<SETG FRAMES %<RSUBR-ENTRY '[PPRINT FRAMES #DECL ("VALUE" <OR ATOM STRING>
|
|
"OPTIONAL" FIX FIX)] 928>>
|
|
|
|
<SETG FRATM %<RSUBR-ENTRY '[PPRINT FRATM #DECL ("VALUE" <OR ATOM STRING>
|
|
"OPTIONAL" FIX FIX)] 1079>>
|
|
|
|
<SETG FRM %<RSUBR-ENTRY '[PPRINT FRM #DECL ("VALUE" FRAME FIX)] 1255>>
|
|
|
|
<SETG FRLVAL %<RSUBR-ENTRY '[PPRINT FRLVAL #DECL ("VALUE" STRING ATOM "OPTIONAL"
|
|
FIX FIX)] 1302>>
|
|
|
|
<SETG FORMS %<RSUBR-ENTRY '[PPRINT FORMS #DECL ("VALUE" ANY ANY "OPTIONAL" <
|
|
CHANNEL [12 ANY] [4 FIX]> FIX ANY)] 1560>>
|
|
|
|
<SETG LINPOS 14>
|
|
|
|
<SETG LINLNT 13>
|
|
|
|
<SETG PAGPOS 16>
|
|
|
|
<SETG PAGLNT 15>
|
|
|
|
<MANIFEST LINPOS LINLNT PAGPOS PAGLNT>
|
|
|
|
<SETG TABS <PROG ((I -1)) <IVECTOR 15 '<ISTRING <SET I <+ .I 1>> !\ >>>>
|
|
|
|
<SETG SPACES <PROG ((I -1)) <IVECTOR 8 '<ISTRING <SET I <+ .I 1>> !\ >>>>
|
|
|
|
<GDECL (TABS SPACES) <VECTOR [REST STRING]>>
|
|
|
|
<SETG INDENT-TO %<RSUBR-ENTRY '[PPRINT INDENT-TO #DECL ("VALUE" <OR FALSE STRING
|
|
> FIX "OPTIONAL" <CHANNEL [12 ANY] [4 FIX]>)] 5103>>
|
|
|
|
<ENDPACKAGE>
|