--- /dev/null
+
+<PACKAGE "COMPDEC">
+
+<ENTRY CTLZ-PRINT
+ RSUB-DEC
+ TMPS-NEXT
+ TMP-DEST
+ NO-BQ
+ EXTRA-CODE
+ ALL-TEMPS-LIST
+ MIM-OBL
+ TMP-OBL
+ DEATH
+ HAIRY-ANALYSIS
+ DEBUG-COMPILE
+ CODE-START
+ CODE-PTR
+ FCNS
+ TMPS
+ IDT
+ STYPES
+ PLUSINF
+ MINUSINF
+ IPUT
+ TEMPV
+ DEBUGSW
+ INSTRUCTION
+ INTH
+ FCN
+ SNODES
+ SNODES1
+ PSTACK
+ DUMMY-MAPF
+ INCONSISTENCY
+ SEGS
+ SPEC
+ CODVEC
+ QUOTE-CODE
+ ADECL-CODE
+ CALL-CODE
+ APPLY-CODE
+ RETURN-CODE
+ IPUT-CODE
+ SEG-CODE
+ MULTI-RETURN-CODE
+ PREDV
+ SYM-SLOT
+ STK
+ STKTMP
+ STK-CHARS7
+ STK-CHARS8
+ BINDING-LENGTH
+ PARENT
+ TYPE-INFO
+ PROG-VARS
+ CURRENT-TYPE
+ NODE1
+ PUTR-CODE
+ ISUBR-CODE
+ EOF-CODE
+ IREMAS-CODE
+ GVAL-CODE
+ SPARE4-CODE
+ ADDVAR
+ FSET-CODE
+ OFFPTR
+ PROG-CODE
+ COMP-TYPES
+ NODE-NAME
+ AGND
+ REQARGS
+ DECL-SYM
+ PUT-CODE
+ FLVAL-CODE
+ SETG-CODE
+ BACK-CODE
+ PUT-SAME-CODE
+ RSUBR-DECLS
+ NODEF
+ AND-CODE
+ MT-CODE
+ BITS-CODE
+ FPUTBITS-CODE
+ COPY-LIST-CODE
+ SPARE1-CODE
+ ATAG
+ ASSUM
+ PURE-SYM
+ NUM-SYM
+ KID
+ GNAME-SYM
+ CHTYPE-CODE
+ NODE
+ SYMTAB
+ GDECL-SYM
+ MAP-CODE
+ MARGS-CODE
+ DATVAL
+ NODE-SUBR
+ LIVE-VARS
+ SPEC-SYM
+ AS-NXT-CODE
+ SUBSTRUC-CODE
+ BIT-TEST-CODE
+ SPARE3-CODE
+ NOT-CODE
+ TEST-CODE
+ MIN-MAX-CODE
+ READ-EOF2-CODE
+ KIDS
+ PREDIC
+ NODEPR
+ NODEFM
+ GNEXT-SYM
+ FIX-CODE
+ MFCN-CODE
+ IRSUBR-CODE
+ CASE-CODE
+ SCL
+ NODE-TYPE
+ DEAD-VARS
+ DEATH-LIST
+ COMPOSIT-TYPE
+ PRED
+ COPY-CODE
+ LENGTH?-CODE
+ INIT-DECL-TYPE
+ NODECOND
+ FUNCTION-CODE
+ AGAIN-CODE
+ 0-TST-CODE
+ FGETBITS-CODE
+ MAPRET-STOP-CODE
+ LSH-CODE
+ SYMBOL
+ NODEB
+ SET-CODE
+ ROT-CODE
+ BINDING-STRUCTURE
+ CDST
+ VSPCD
+ NAME-SYM
+ INIT-SYM
+ EQ-CODE
+ ALL-REST-CODE
+ DISPATCH
+ DST
+ RTAG
+ ACCUM-TYPE
+ DATUM
+ ARGNUM-SYM
+ ADDR-SYM
+ USED-AT-ALL
+ ARGNUM
+ FGVAL-CODE
+ ID-CODE
+ FORM-F-CODE
+ INFO-CODE
+ TEMP
+ CLAUSES
+ TRG
+ VARTBL
+ LVARTBL
+ SUBR-CODE
+ LNTH-CODE
+ ASSIGNED?-CODE
+ GET2-CODE
+ AS-IT-IND-VAL-CODE
+ COMMON
+ DATTYP
+ RET-AGAIN-ONLY
+ SEGMENT-CODE
+ FSETG-CODE
+ ISTRUC-CODE
+ MFIRST-CODE
+ CODE-SYM
+ BST
+ RSUBR-CODE
+ 1?-CODE
+ REST-CODE
+ ABS-CODE
+ MPSBR-CODE
+ UNWIND-CODE
+ PRINT-CODE
+ OBLIST?-CODE
+ STACKS
+ ASS?
+ BRANCH-CODE
+ LVAL-CODE
+ OR-CODE
+ ISTRUC2-CODE
+ READ-EOF-CODE
+ MAPLEAVE-CODE
+ MEMQ-CODE
+ RESULT-TYPE
+ SIDE-EFFECTS
+ NEXT-SYM
+ FORM-CODE
+ TY?-CODE
+ FLOAT-CODE
+ GET-CODE
+ SPECS-START
+ RES-TYP
+ BITL-CODE
+ TOP-CODE
+ SPARE2-CODE
+ ACTIVATED
+ TOTARGS
+ VTB
+ RQRG
+ COND-CODE
+ ARITH-CODE
+ NTH-CODE
+ MOD-CODE
+ IND
+ ALL
+ NOTE
+ WARNING
+ PRIM-CODE
+ CAREFUL
+ REASONABLE
+ DONT-CARE
+ FLUSHED
+ NO-RETURN
+ NO-DATUM
+ MESSAGE
+ GROUP-NAME
+ COMMON-TYPE
+ COMMON-SYMTAB
+ COMMON-ITEM
+ COMMON-PRIMTYPE
+ COMMON-DATUM
+ COMMON-SYMT
+ TRANSFORM
+ TRANS
+ N0?
+ POPWR2
+ DEALLOCATE
+ SRC-FLG
+ BIN-FLG
+ GLOSP
+ ANALY-OK
+ VERBOSE
+ COMPILER
+ INDARGL-ACT
+ ARGL-IAUX
+ ARGL-AUX
+ ARGL-TUPLE
+ ARGL-ARGS
+ ARGL-QIOPT
+ ARGL-IOPT
+ ARGL-QOPT
+ ARGL-OPT
+ ARGL-CALL
+ ARGL-BIND
+ ARGL-QUOTE
+ ARGL-ACT
+ ARGL-ARG
+ TAG-COUNT
+ TEMP-NAME-SYM
+ ARG-NAME-SYM
+ ARGS-NEXT
+ SPCS-X
+ POP-STACK
+ TOP-STACK
+ TEMP-NAME
+ TEMP-REFS
+ TEMP-FRAME
+ TEMP-ALLOC
+ TEMP-NO-RECYCLE
+ TEMP-TYPE
+ FREE-TEMPS
+ EVERY-TEMP
+ MIM-SPECIAL
+ MONAD-CODE
+ GASSIGNED?-CODE
+ GLN
+ USAGE-SYM
+ =?-STRING-CODE
+ TYPE-C-CODE
+ ANALYSIS
+ VALID-CODE
+ LIST-TUPLE
+ FCN-ATOM
+ STACK-CODE
+ CHANNEL-OP-CODE
+ RET-OR-AGAIN
+ DONT-FLUSH-ME
+ ATOM-PART-CODE
+ OFFSET-PART-CODE
+ PUT-GET-DECL-CODE
+ THE-BOOL
+ THE-BIT
+ SPECD
+ MULTI-SET-CODE
+ MAX-LENGTH>
+
+<SETG MAX-LENGTH *177777*>
+
+<MANIFEST MAX-LENGTH>
+
+<GDECL (SNODES SNODES1) <UVECTOR [REST FIX]>>
+
+<NEWTYPE STACK WORD>
+
+<BLOCK (<ROOT>)>
+
+<NEWTYPE I$TERMIN WORD>
+<NEWTYPE ADECL VECTOR>
+=
+LBIND
+<NEWTYPE T$UNBOUND WORD>
+
+<ENDBLOCK>
+
+<SETG DEATH <>>
+
+<SETG BQ+1 <+ <ASCII !\`> 1>>
+
+<COND (<OR <NOT <ASSIGNED? READ-TABLE>>
+ <L? <LENGTH .READ-TABLE> ,BQ+1>>
+ <COND (<==? <TYPEPRIM FIX> WORD>
+ <SETG READ-TABLE <SET READ-TABLE <IVECTOR ,BQ+1 0>>>)
+ (ELSE
+ <SETG READ-TABLE <SET READ-TABLE <IVECTOR ,BQ+1 <>>>>)>)>
+
+<SETG MIM-OBL <MOBLIST MIM-OBL>>
+
+<SETG TMP-OBL <MOBLIST TMPS>>
+
+<SETG MIM-OBL-L (,MIM-OBL)>
+
+<DEFINE BQ-RD (X "OPT" Y "AUX" (O .OBLIST) (OBLIST ,MIM-OBL-L))
+ #DECL ((OBLIST) <SPECIAL ANY>)
+ <COND (<NOT <TYPE? <SET X <READ>> ATOM>>
+ <PROG ((OBLIST .O))
+ #DECL ((OBLIST) <SPECIAL ANY>)
+ <ERROR BAD-BACK-Q-USAGE!-ERRORS>>)
+ (ELSE .X)>>
+
+<COND (<AND <==? <TYPEPRIM FIX> WORD> <N==? <NTH .READ-TABLE ,BQ+1> 0>>
+ <PUT .READ-TABLE ,BQ+1 ,BQ-RD>)
+ (<AND <==? <TYPEPRIM FIX> FIX> <NOT <NTH .READ-TABLE ,BQ+1>>>
+ <PUT .READ-TABLE ,BQ+1 [!\` <ASCII !\`> T ,BQ-RD <>]>)>
+
+<SETG POP-STACK `STACK>
+
+<SETG TOP-STACK `STACK>
+
+<NEWTYPE FOOATOM ATOM>
+
+<NEWTYPE FCN-ATOM ATOM>
+
+<SETG OLD-ATOM <PRINTTYPE ATOM>>
+
+<PRINTTYPE ATOM ,PRINT>
+
+<PRINTTYPE FCN-ATOM>
+
+<PRINTTYPE FOOATOM ATOM>
+
+<DEFINE ATOM-PRINT ACT (X) #DECL ((ACT) <SPECIAL ANY>)
+ <COND (<==? <OBLIST? .X> ,MIM-OBL>
+ <COND (<NOT <AND <ASSIGNED? NO-BQ> .NO-BQ>>
+ <PRINC "`">)>
+ <PRINC <SPNAME .X>>)
+ (<==? <OBLIST? .X> ,TMP-OBL> <PRINC <SPNAME .X>>)
+ (ELSE
+ <SET ACT <CHTYPE .ACT FRAME>>
+ <PROG ()
+ <COND (<MEMQ <FUNCT .ACT> '[PRINT PPRINT PRIN1 TOPLEV
+ PRINT-MANY
+ FLATSIZE UNPARSE]>
+ <PRIN1 <CHTYPE .X FOOATOM>>)
+ (<==? <FUNCT .ACT> PRINC>
+ <PRINC <CHTYPE .X FOOATOM>>)
+ (ELSE
+ <SET ACT <FRAME .ACT>>
+ <AGAIN>)>>)>>
+
+<DEFINE FCN-ATOM-PRINT ACT (X) #DECL ((ACT) <SPECIAL ANY>)
+ <COND (<AND <GASSIGNED? CTLZ-PRINT> ,CTLZ-PRINT>
+ <PRINC <ASCII 26>>)>
+ <SET ACT <CHTYPE .ACT FRAME>>
+ <PROG ()
+ <COND (<MEMQ <FUNCT .ACT> '[PRINT PPRINT PRIN1 TOPLEVEL
+ FLATSIZE UNPARSE]>
+ <PRIN1 <CHTYPE .X FOOATOM>>)
+ (<==? <FUNCT .ACT> PRINC>
+ <PRINC <CHTYPE .X FOOATOM>>)
+ (ELSE
+ <SET ACT <FRAME .ACT>>
+ <AGAIN>)>>>
+
+<COND (<==? ,OLD-ATOM ATOM>
+ <PRINTTYPE ATOM ,ATOM-PRINT>
+ <PRINTTYPE FCN-ATOM ,FCN-ATOM-PRINT>)>
+
+<PRINTTYPE STACK <FUNCTION (X) <PRINC "#STACK "> <PRIN1 <CHTYPE .X FIX>>>>
+
+<SETG PLUSINF <CHTYPE <MIN> FIX>>
+
+<SETG MINUSINF <CHTYPE <MAX> FIX>>
+
+"Type specification for NODE."
+
+<NEWTYPE NODE
+ VECTOR
+ '<<PRIMTYPE VECTOR>
+ FIX ;NODE-TYPE
+ ANY ;PARENT
+ ANY ;RESULT-TYPE
+ ANY ;(NODE-NAME PREDIC)
+ <LIST [REST NODE]> ;(KIDS CLAUSES)
+ <OR FALSE ATOM> ;SEGS
+ [OPTIONAL
+ LIST ;(TYPE-INFO LIVE-VARS)
+ ANY ;SIDE-EFFECTS
+ ANY ;(RSUBR-DECLS NODE-SUBR)
+ LIST ;BINDING-STRUCTURE
+ SYMTAB ;SYMTAB
+ <OR FALSE ATOM> ;ACTIVATED
+ ANY ;SPCS-X
+ ANY ;(DST ACCUM-TYPE)
+ ANY ;(CDST DEAD-VARS)
+ ANY ;(ATAG VSPCD)
+ ANY ;(RTAG INIT-DECL-TYPE)
+ LIST ;ASSUM
+ <OR FALSE LIST> ;AGND
+ FIX ;TOTARGS
+ FIX ;REQARGS]>>
+
+"Offsets into pass 1 structure entities and functions to create same."
+
+<SETG NODE-TYPE <OFFSET 1 NODE>>
+
+;"Code specifying the node type."
+
+<SETG PARENT <OFFSET 2 NODE>>
+
+;"Pointer to parent node."
+
+<SETG RESULT-TYPE <OFFSET 3 NODE>>
+
+;"Type expression for result returned by code
+ generated by this node."
+
+<SETG NODE-NAME <OFFSET 4 NODE>>
+
+;"Usually name of SUBR associated with this node."
+
+<SETG KIDS <OFFSET 5 NODE>>
+
+;"List of sub-nodes for this node."
+
+<SETG SEGS <OFFSET 6 NODE>>
+
+;"Predicate: any segments among kids?"
+
+<SETG TYPE-INFO <OFFSET 7 NODE>>
+
+;"Points to transient type info for this node."
+
+<SETG SIDE-EFFECTS <OFFSET 8 NODE>>
+
+;"General info about side effects (format not yet firm.)"
+
+<SETG RSUBR-DECLS <OFFSET 9 NODE>>
+
+;"Function only: final rsubr decls."
+
+<SETG BINDING-STRUCTURE <OFFSET 10 NODE>>
+
+;"Partially compiled arg list."
+
+<SETG SYMTAB <OFFSET 11 NODE>>
+
+;"Pointer to local symbol table."
+
+<SETG ACTIVATED <OFFSET 12 NODE>>
+
+;"Predicate: any named activation?"
+
+<SETG SPCS-X <OFFSET 13 NODE>>
+
+;"Predicate: any specials bound?"
+
+<SETG DST <OFFSET 14 NODE>>
+
+;"Destination spec for value of node."
+
+<SETG CDST <OFFSET 15 NODE>>
+
+;"Current destination used."
+
+<SETG ATAG <OFFSET 16 NODE>>
+
+;"Label for local againing."
+
+<SETG RTAG <OFFSET 17 NODE>>
+
+;"Label for local Returning."
+
+<SETG ASSUM <OFFSET 18 NODE>>
+
+;"Node type assumptions."
+
+<SETG AGND <OFFSET 19 NODE>>
+
+;"Predicate: Again possible?"
+
+<SETG TOTARGS <OFFSET 20 NODE>>
+
+;"Total number of args (including optional)."
+
+<SETG REQARGS <OFFSET 21 NODE>>
+
+;"Required arguemnts."
+
+<SETG CLAUSES <OFFSET <1 ,KIDS> NODE>>
+
+;"For COND clauses."
+
+<SETG NODE-SUBR <OFFSET <1 ,RSUBR-DECLS> NODE>>
+
+;"For many nodes, the SUBR (not its name)."
+
+<SETG PREDIC <OFFSET <1 ,NODE-NAME> NODE>>
+
+;"For cond clause nodes, the predicate."
+
+<SETG ACCUM-TYPE <OFFSET <1 ,DST> NODE>>
+
+;"Accumulated type from all returns etc."
+
+<SETG DEAD-VARS <OFFSET <1 ,CDST> NODE>>
+
+<SETG LIVE-VARS <OFFSET <1 ,TYPE-INFO> NODE>>
+
+<SETG VSPCD <OFFSET <1 ,ATAG> NODE>>
+
+<SETG INIT-DECL-TYPE <OFFSET <1 ,RTAG> NODE>>
+
+" Definitions associated with compiler symbol tables."
+
+"Offsets for variable description blocks"
+
+<NEWTYPE TEMP VECTOR '!<<PRIMTYPE VECTOR> ATOM FIX ANY <OR ATOM FALSE> ANY
+ ANY>>
+
+<NEWTYPE SYMTAB
+ VECTOR
+ '<<PRIMTYPE VECTOR> <PRIMTYPE VECTOR>
+ ATOM
+ <OR FALSE ATOM>
+ FIX
+ <OR ATOM FIX>
+ <OR FALSE ATOM>
+ <OR ATOM SEGMENT FORM>
+ ANY
+ ANY
+ ANY
+ <OR FALSE NODE>
+ <OR FALSE 'T>
+ FIX
+ <OR FALSE 'T>
+ <OR FALSE 'T>
+ LIST
+ ANY
+ ANY
+ ANY>>
+
+<SETG NEXT-SYM <OFFSET 1 SYMTAB>>
+
+;"Pointer to next symbol table entry."
+
+<SETG NAME-SYM <OFFSET 2 SYMTAB>>
+
+;"Name of variable."
+
+<SETG SPEC-SYM <OFFSET 3 SYMTAB>>
+
+;"Predicate: special?"
+
+<SETG CODE-SYM <OFFSET 4 SYMTAB>>
+
+;"Code specifying whether AUX, OPTIONAL etc."
+
+<SETG ARGNUM-SYM <OFFSET 5 SYMTAB>>
+
+;"If an argument, which one."
+
+<SETG PURE-SYM <OFFSET 6 SYMTAB>>
+
+;"Predicate: unchanged in function?"
+
+<SETG DECL-SYM <OFFSET 7 SYMTAB>>
+
+;"Decl for this variable."
+
+<SETG ADDR-SYM <OFFSET 8 SYMTAB>>
+
+;"Where do I live?"
+
+<SETG INIT-SYM <OFFSET 9 SYMTAB>>
+
+;"Predicate: initial value? if so what."
+
+<SETG TEMP-NAME-SYM <OFFSET 10 SYMTAB>>
+
+;"ID of my frame."
+
+<SETG RET-AGAIN-ONLY <OFFSET 11 SYMTAB>>
+
+;"Predicate: used only in AGAIN/RETURN?"
+
+<SETG ASS? <OFFSET 12 SYMTAB>>
+
+;"Predicate: used in ASSIGNED?"
+
+<SETG USAGE-SYM <OFFSET 13 SYMTAB>>
+
+;"Number of uses of this symbol."
+
+'<SETG STORED <OFFSET 14 SYMTAB>>
+
+;"Predicate: stored in slot?"
+
+<SETG USED-AT-ALL <OFFSET 15 SYMTAB>>
+
+;"Predicate: symbolused at all."
+
+<SETG DEATH-LIST <OFFSET 16 SYMTAB>>
+
+;"List of info associated with life time."
+
+<SETG CURRENT-TYPE <OFFSET 17 SYMTAB>>
+
+;"Current decl determined by analysis"
+
+<SETG COMPOSIT-TYPE <OFFSET 18 SYMTAB>>
+
+<SETG ARG-NAME-SYM <OFFSET 19 SYMTAB>>
+
+"How a variable is used in a loop."
+
+;"Type as figured out by all uses of symbol."
+
+<DEFINE NODE1 (TYP PAR RES-TYP NAME KID)
+ <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID <>] NODE>>
+
+"Create a function node with all its hair."
+
+<DEFINE NODEF (TYP PAR RES-TYP NAME KID RSD BST HAT VTB TRG RQRG)
+ <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID <> () <> .RSD .BST .VTB
+ <> <> <> () <> .RES-TYP () <> .TRG .RQRG] NODE>>
+
+"Create a PROG/REPEAT node with nearly as much hair."
+
+<DEFINE NODEPR (TYP PAR RES-TYP NAME KID VL BST HAT VTB)
+ <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID <> () <> .VL .BST .VTB
+ <> <> <> () <> .RES-TYP () <>]
+ NODE>>
+
+"Create a COND node."
+
+<DEFINE NODECOND (TYP PAR RES-TYP NAME CLAU)
+ <CHTYPE [.TYP .PAR .RES-TYP .NAME .CLAU <> () <>] NODE>>
+
+"Create a node for a COND clause."
+
+<DEFINE NODEB (TYP PAR RES-TYP PRED CLAU)
+ <CHTYPE [.TYP .PAR .RES-TYP .PRED .CLAU <> () <>] NODE>>
+
+"Create a node for a SUBR call etc."
+
+<DEFINE NODEFM (TYP PAR RES-TYP NAME KID SUB)
+ <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID <> () <> .SUB] NODE>>
+\f
+
+<DEFINE ADDVAR (NAM SPEC CODE ARGNUM PURE DCL ADDR INIT)
+ <SET VARTBL
+ <CHTYPE [.VARTBL
+ .NAM
+ .SPEC
+ .CODE
+ .ARGNUM
+ .PURE
+ .DCL
+ .ADDR
+ .INIT
+ .NAM
+ <>
+ <>
+ 0
+ T
+ <>
+ ()
+ <>
+ ANY
+ FOO!-IPASS1!-PASS1!-PACKAGE]
+ SYMTAB>>>
+
+"Some specialized decl stuff."
+
+<SETG LVARTBL
+ <PROG ((VARTBL []))
+ #DECL ((VARTBL) <SPECIAL ANY>)
+ <ADDVAR OBLIST T -1 0 T <OR LIST OBLIST> <> <>>
+ <ADDVAR OUTCHAN T -1 0 T CHANNEL <> <>>
+ <ADDVAR INCHAN T -1 0 T CHANNEL <> <>>
+ .VARTBL>>
+
+<COND (<NOT ,MIM>
+ <PUTPROP CHANNEL DECL '<CHANNEL FIX [11 ANY] [5 FIX]>>)>
+
+<COND (,MIM <PUT-DECL STRING '<<PRIMTYPE STRING> [REST CHARACTER]>>)
+ (ELSE <PUTPROP STRING DECL '<<PRIMTYPE STRING> [REST CHARACTER]>>)>
+
+"Codes for the node types in the tree built by pass1 and modified by
+other passes."
+
+"Give symbolic codes arbitrary increasing values."
+
+<PROG ((N 1))
+ <SETG CODVEC
+ <MAPF ,VECTOR
+ <FUNCTION (ATM) <SETG .ATM .N> <SET N <+ .N 1>> .ATM>
+ '[FUNCTION-CODE
+ QUOTE-CODE
+ SEGMENT-CODE
+ FORM-CODE
+ PROG-CODE
+ SUBR-CODE
+ COND-CODE
+ BRANCH-CODE
+ RSUBR-CODE
+ LVAL-CODE
+ SET-CODE
+ OR-CODE
+ AND-CODE
+ RETURN-CODE
+ COPY-CODE
+ GO-CODE
+ AGAIN-CODE
+ ARITH-CODE
+ 0-TST-CODE
+ NOT-CODE
+ 1?-CODE
+ TEST-CODE
+ EQ-CODE
+ TY?-CODE
+ LNTH-CODE
+ MT-CODE
+ NTH-CODE
+ REST-CODE
+ PUT-CODE
+ PUTR-CODE
+ FLVAL-CODE
+ FSET-CODE
+ FGVAL-CODE
+ FSETG-CODE
+ MIN-MAX-CODE
+ STACKFORM-CODE
+ CHTYPE-CODE
+ ABS-CODE
+ FIX-CODE
+ FLOAT-CODE
+ MOD-CODE
+ ID-CODE
+ ASSIGNED?-CODE
+ ISTRUC-CODE
+ ISTRUC2-CODE
+ BITS-CODE
+ BITL-CODE
+ FGETBITS-CODE
+ FPUTBITS-CODE
+ MAP-CODE
+ MFCN-CODE
+ ISUBR-CODE
+ READ-EOF-CODE
+ READ-EOF2-CODE
+ EOF-CODE
+ GET-CODE
+ GET2-CODE
+ IPUT-CODE
+ IREMAS-CODE
+ IRSUBR-CODE
+ MARGS-CODE
+ MPSBR-CODE
+ MAPLEAVE-CODE
+ MAPRET-STOP-CODE
+ UNWIND-CODE
+ GVAL-CODE
+ SETG-CODE
+ SEG-CODE
+ LENGTH?-CODE
+ TAG-CODE
+ MFIRST-CODE
+ PRINT-CODE
+ MEMQ-CODE
+ FORM-F-CODE
+ INFO-CODE
+ OBLIST?-CODE
+ AS-NXT-CODE
+ AS-IT-IND-VAL-CODE
+ ALL-REST-CODE
+ CASE-CODE
+ SUBSTRUC-CODE
+ BACK-CODE
+ TOP-CODE
+ COPY-LIST-CODE
+ PUT-SAME-CODE
+ ROT-CODE
+ LSH-CODE
+ BIT-TEST-CODE
+ ADECL-CODE
+ CALL-CODE
+ MONAD-CODE
+ GASSIGNED?-CODE
+ APPLY-CODE
+ MULTI-RETURN-CODE
+ =?-STRING-CODE
+ TYPE-C-CODE
+ VALID-CODE
+ STACK-CODE
+ CHANNEL-OP-CODE
+ ATOM-PART-CODE
+ OFFSET-PART-CODE
+ PUT-GET-DECL-CODE
+ MULTI-SET-CODE
+ SPARE1-CODE
+ SPARE2-CODE
+ SPARE3-CODE
+ SPARE4-CODE]>>
+ <SETG COMP-TYPES .N>>
+
+<USE "NPRINT">
+
+"Build a dispatch table based on node types."
+
+<DEFINE DISPATCH (DEFAULT "TUPLE" PAIRS
+ "AUX" (TT <IVECTOR ,COMP-TYPES '.DEFAULT>))
+ #DECL ((PAIRS) <<PRIMTYPE VECTOR> [REST <LIST FIX ANY>]>
+ (TT) VECTOR)
+ <REPEAT ((PAIR '(1 1))) #DECL ((PAIR) <LIST FIX ANY>)
+ <COND (<EMPTY? .PAIRS><RETURN .TT>)>
+ <PUT .TT <1 <SET PAIR <1 .PAIRS>>> <2 .PAIR>>
+ <SET PAIRS <REST .PAIRS>>>>
+
+<SETG PREDV <IUVECTOR ,COMP-TYPES 0>>
+
+<GDECL (PREDV) UVECTOR>
+
+<MAPF <>
+ <FUNCTION (N) <PUT ,PREDV .N 1>>
+ [,0-TST-CODE
+ ,1?-CODE
+ ,NOT-CODE
+ ,TEST-CODE
+ ,EQ-CODE
+ ,TY?-CODE
+ ,MT-CODE
+ ,ASSIGNED?-CODE
+ ,MEMQ-CODE
+ ,LENGTH?-CODE
+ ,OBLIST?-CODE
+ ,AS-NXT-CODE
+ ,BIT-TEST-CODE
+ ,GASSIGNED?-CODE
+ ,VALID-CODE
+ ,=?-STRING-CODE]>
+
+
+<MAPF <> <FUNCTION (N) <PUT ,PREDV .N -1>> [,OR-CODE ,AND-CODE ,COND-CODE]>
+
+"Predicate: does this type have special predicate code?"
+
+" Assign codes to differen types of argument in argument list"
+
+<PROG ((N 1))
+ <MAPF <>
+ <FUNCTION (TYP) <SETG .TYP .N> <MANIFEST .TYP> <SET N <+ .N 1>>>
+ '(ARGL-ACT
+ ARGL-IAUX
+ ARGL-AUX
+ ARGL-TUPLE
+ ARGL-ARGS
+ ARGL-QIOPT
+ ARGL-IOPT
+ ARGL-QOPT
+ ARGL-OPT
+ ARGL-CALL
+ ARGL-BIND
+ ARGL-QUOTE
+ ARGL-ARG)>>
+
+<COND (,MIM
+ <PUT-DECL REP-STATE
+ '<LIST [5 <LIST [REST SYMTAB DATUM <OR FALSE ATOM>
+ <OR ATOM FALSE>]>]>>)
+ (ELSE
+ <PUTPROP REP-STATE
+ DECL
+ '<LIST [5 <LIST [REST SYMTAB DATUM <OR FALSE ATOM>
+ <OR ATOM FALSE>]>]>>)>
+
+<COND (,MIM <PUT-DECL SYMBOL '<OR SYMTAB TEMP COMMON>>)
+ (ELSE <PUTPROP SYMBOL DECL '<OR SYMTAB TEMP COMMON>>)>
+
+<SETG DATTYP <OFFSET 1 DATUM>>
+
+<SETG DATVAL <OFFSET 2 DATUM>>
+
+<NEWTYPE DATUM
+ LIST
+ '<<PRIMTYPE LIST> <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>>
+ <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>>>>
+
+<NEWTYPE OFFPTR LIST '<<PRIMTYPE LIST> FIX DATUM ATOM>>
+
+<MANIFEST DATTYP DATVAL>
+
+<MAPF <> ,MANIFEST ,CODVEC>
+
+<MANIFEST USAGE-SYM
+ TOT-MODES
+ RESTS
+ RMODES
+ COMP-TYPES
+ GDECL-SYM
+ GNAME-SYM
+ GNEXT-SYM
+ INIT-SYM
+ ADDR-SYM
+ TOTARGS
+ REQARGS
+ DECL-SYM
+ PURE-SYM
+ ARGNUM-SYM
+ CODE-SYM
+ SPEC-SYM
+ NAME-SYM
+ TEMP-NAME-SYM
+ ARG-NAME-SYM
+ NEXT-SYM
+ PREDIC
+ NODE-SUBR
+ CLAUSES
+ ACTIVATED
+ SYMTAB
+ BINDING-STRUCTURE
+ RSUBR-DECLS
+ SEGS
+ KIDS
+ NODE-NAME
+ RESULT-TYPE
+ PARENT
+ NODE-TYPE
+ SIDE-EFFECTS
+ RET-AGAIN-ONLY
+ ASS?
+ DST
+ CDST
+ ACCUM-TYPE
+ INIT-DECL-TYPE
+ VSPCD
+ AGND
+ ASSUM
+ RTAG
+ ATAG
+ SPCS-X
+ USED-AT-ALL
+ CURRENT-TYPE
+ DEATH-LIST
+ COMPOSIT-TYPE
+ TYPE-INFO
+ LIVE-VARS
+ DEAD-VARS>
+
+<NEWTYPE COMMON
+ VECTOR
+ '<<PRIMTYPE VECTOR> ATOM <OR COMMON SYMTAB> FIX ANY <PRIMTYPE LIST>>>
+
+<SETG COMMON-TYPE <OFFSET 1 COMMON>>
+
+"TYPE OF COMMON (ATOM)"
+
+<SETG COMMON-SYMT <OFFSET 2 COMMON>>
+
+"POINTER TO OR COMMON SYMTAB"
+
+<SETG COMMON-ITEM <OFFSET 3 COMMON>>
+
+"3RD ARGUMENT TO NTH,REST,PUT ETC."
+
+<SETG COMMON-PRIMTYPE <OFFSET 4 COMMON>>
+
+"PRIMTYPE OF OBJECT IN COMMON"
+
+<SETG COMMON-DATUM <OFFSET 5 COMMON>>
+
+"DATUM FOR THIS COMMON"
+
+<MANIFEST COMMON-TYPE COMMON-SYMTAB COMMON-ITEM COMMON-PRIMTYPE COMMON-DATUM>
+
+<NEWTYPE TRANS
+ VECTOR
+ '<<PRIMTYPE VECTOR> NODE <UVECTOR [7 FIX]> <UVECTOR [7 FIX]>>>
+
+<NEWTYPE MIM-SPECIAL ATOM>
+
+<SETG TEMP-NAME <OFFSET 1 TEMP>>
+
+<SETG TEMP-REFS <OFFSET 2 TEMP>>
+
+<SETG TEMP-FRAME <OFFSET 3 TEMP>>
+
+<SETG TEMP-ALLOC <OFFSET 4 TEMP>>
+
+<SETG TEMP-NO-RECYCLE <OFFSET 5 TEMP>>
+
+<SETG TEMP-TYPE <OFFSET 6 TEMP>>
+
+<MANIFEST TEMP-NAME TEMP-REFS TEMP-FRAME TEMP-ALLOC TEMP-NO-RECYCLE
+ TEMP-TYPE>
+
+<COND (<N==? <TYPEPRIM FIX> FIX> <FLOAD "PS:<COMPIL>POPWR2.FBIN">)>
+
+<SETG BINDING-LENGTH 9>
+
+<MANIFEST BINDING-LENGTH>
+
+<ENDPACKAGE>
projects / pdp10-muddle.git / blobdiff