4 <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>
6 <SETG MAX-LENGTH 65535>
10 <GDECL (SNODES SNODES1) <UVECTOR [REST FIX]>>
16 <NEWTYPE I$TERMIN WORD>
18 <NEWTYPE ADECL VECTOR>
24 <NEWTYPE T$UNBOUND WORD>
30 <SETG BQ+1 <+ <ASCII !\`> 1>>
32 <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 <>>>>)>)>
34 <SETG MIM-OBL <MOBLIST MIM-OBL>>
36 <SETG TMP-OBL <MOBLIST TMPS>>
38 <SETG MIM-OBL-L (,MIM-OBL)>
41 <GFCN
\1aBQ-RD ("VALUE" ANY ANY "OPTIONAL" ANY) X6 Y7>
42 <OPT-DISPATCH 1 %<> OPT4 OPT5>
46 <TEMP O8:LIST TEMP3:LBIND TEMP12 TEMP17:LBIND>
48 <GEN-LVAL 'OBLIST = O8>
49 <GETS 'BIND = TEMP3 (TYPE LBIND)>
50 <GVAL 'MIM-OBL-L = TEMP12>
51 <BBIND 'OBLIST 'ANY 'FIX TEMP12>
54 <CALL '
\1aREAD 0 = X6>
55 <TYPE? X6 <TYPE-CODE ATOM> + PHRASE14 (DEAD-JUMP O8) (DEAD-FALL X6)>
56 <GETS 'BIND = TEMP17 (TYPE LBIND)>
57 <BBIND 'OBLIST 'ANY 'FIX O8>
60 <PUSH 'BAD-BACK-Q-USAGE!-ERRORS>
61 <CALL '
\1aERROR 1 = TEMP12>
77 <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 <>]>)>
79 <SETG POP-STACK `STACK>
81 <SETG TOP-STACK `STACK>
83 <NEWTYPE FOOATOM ATOM>
85 <NEWTYPE FCN-ATOM ATOM>
87 <SETG OLD-ATOM <PRINTTYPE ATOM>>
89 <PRINTTYPE ATOM ,PRINT>
93 <PRINTTYPE FOOATOM ATOM>
96 <FCN
\1aATOM-PRINT ("VALUE" ANY ANY) X4>
97 <TEMP TEMP3:LBIND TEMP6 TEMP9 TEMP47>
99 <GETS 'BIND = TEMP3 (TYPE LBIND)>
100 <CFRAME = TEMP6 (TYPE FRAME)>
101 <BBIND 'ACT 'ANY 'FIX TEMP6>
104 <NTHR X4 4 = TEMP6 (RECORD-TYPE ATOM)>
105 <GVAL 'MIM-OBL = TEMP9>
106 <EQUAL? TEMP6 TEMP9 - PHRASE8>
108 <GEN-ASSIGNED? 'NO-BQ - BOOL12>
109 <GEN-LVAL 'NO-BQ = TEMP6>
110 <TYPE? TEMP6 <TYPE-CODE FALSE> - PEEP68>
115 <GEN-LVAL 'OUTCHAN = STACK>
119 <NTHR X4 4 = TEMP6 (RECORD-TYPE ATOM)>
120 <GVAL 'TMP-OBL = TEMP9>
121 <EQUAL? TEMP6 TEMP9 - PHRASE24>
125 <NTHR X4 3 = STACK (RECORD-TYPE ATOM)>
128 <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
129 <NTHR TEMP6 1 = TEMP6 (RECORD-TYPE LBIND)>
130 <CHTYPE TEMP6 <TYPE-CODE FRAME> = TEMP6>
131 <NTHR 'ACT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
132 <PUTR TEMP9 1 TEMP6 (RECORD-TYPE LBIND)>
138 <NTHR 'ACT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
139 <NTHR TEMP9 1 = STACK (RECORD-TYPE LBIND)>
141 <CALL '
\1aFUNCT 1 = TEMP9>
142 <SET TEMP6 [PRINT PPRINT PRIN1 TOPLEV PRINT-MANY FLATSIZE UNPARSE] (TYPE VECTOR)>
143 <LOOP (TEMP9 VALUE) (TEMP6 LENGTH VALUE)>
145 <NTHUV TEMP6 1 = TEMP47>
146 <VEQUAL? TEMP47 TEMP9 + TAG40 (DEAD-JUMP TEMP9 TEMP6)>
148 <RESTUV TEMP6 1 = TEMP6 (TYPE VECTOR)>
149 <EMPUV? TEMP6 - TAG41 (DEAD-FALL TEMP9 TEMP6)>
153 <CHTYPE X4 <TYPE-CODE FOOATOM> = STACK>
154 <GEN-LVAL 'OUTCHAN = STACK>
155 <CALL '
\1aPRIN1 2 = TEMP6 (DEAD-FALL X4)>
159 <NTHR 'ACT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
160 <NTHR TEMP9 1 = STACK (RECORD-TYPE LBIND)>
162 <CALL '
\1aFUNCT 1 = TEMP9>
163 <VEQUAL? TEMP9 'PRINC - PHRASE51>
166 <CHTYPE X4 <TYPE-CODE FOOATOM> = STACK>
168 <GEN-LVAL 'OUTCHAN = STACK>
169 <CALL '
\1aPRINC 2 = TEMP6 (DEAD-FALL X4)>
173 <NTHR 'ACT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
174 <NTHR TEMP47 1 = STACK (RECORD-TYPE LBIND)>
176 <CALL '
\1aFRAME 1 = TEMP47>
177 <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
178 <PUTR TEMP6 1 TEMP47 (RECORD-TYPE LBIND)>
190 <FCN
\1aFCN-ATOM-PRINT ("VALUE" ANY ANY) X4>
191 <TEMP TEMP3:LBIND TEMP6 TEMP18 TEMP31>
193 <GETS 'BIND = TEMP3 (TYPE LBIND)>
194 <CFRAME = TEMP6 (TYPE FRAME)>
195 <BBIND 'ACT 'ANY 'FIX TEMP6>
198 <NTHR 'CTLZ-PRINT 1 = TEMP6 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE8) (DEAD-JUMP TEMP6)>
199 <TYPE? TEMP6 <TYPE-CODE FALSE> + PHRASE8 (DEAD-JUMP TEMP6)>
200 <NTHR TEMP6 1 = TEMP6 (RECORD-TYPE GBIND)>
201 <TYPE? TEMP6 <TYPE-CODE UNBOUND> + PHRASE8>
203 <GVAL 'CTLZ-PRINT = TEMP6>
204 <TYPE? TEMP6 <TYPE-CODE FALSE> + PHRASE8>
208 <GEN-LVAL 'OUTCHAN = STACK>
211 <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
212 <NTHR TEMP6 1 = TEMP6 (RECORD-TYPE LBIND)>
213 <CHTYPE TEMP6 <TYPE-CODE FRAME> = TEMP6>
214 <NTHR 'ACT 2 = TEMP18 (RECORD-TYPE ATOM) (TYPE LBIND)>
215 <PUTR TEMP18 1 TEMP6 (RECORD-TYPE LBIND)>
221 <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
222 <NTHR TEMP6 1 = STACK (RECORD-TYPE LBIND)>
224 <CALL '
\1aFUNCT 1 = TEMP6>
225 <SET TEMP18 [PRINT PPRINT PRIN1 TOPLEVEL FLATSIZE UNPARSE] (TYPE VECTOR)>
226 <LOOP (TEMP6 VALUE) (TEMP18 LENGTH VALUE)>
228 <NTHUV TEMP18 1 = TEMP31>
229 <VEQUAL? TEMP31 TEMP6 + TAG23 (DEAD-JUMP TEMP18 TEMP6)>
231 <RESTUV TEMP18 1 = TEMP18 (TYPE VECTOR)>
232 <EMPUV? TEMP18 - TAG24 (DEAD-FALL TEMP18 TEMP6)>
236 <CHTYPE X4 <TYPE-CODE FOOATOM> = STACK>
237 <GEN-LVAL 'OUTCHAN = STACK>
238 <CALL '
\1aPRIN1 2 = TEMP6 (DEAD-FALL X4)>
242 <NTHR 'ACT 2 = TEMP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
243 <NTHR TEMP6 1 = STACK (RECORD-TYPE LBIND)>
245 <CALL '
\1aFUNCT 1 = TEMP6>
246 <VEQUAL? TEMP6 'PRINC - PHRASE35>
249 <CHTYPE X4 <TYPE-CODE FOOATOM> = STACK>
250 <GEN-LVAL 'OUTCHAN = STACK>
251 <CALL '
\1aPRINC 2 = TEMP6 (DEAD-FALL X4)>
255 <NTHR 'ACT 2 = TEMP31 (RECORD-TYPE ATOM) (TYPE LBIND)>
256 <NTHR TEMP31 1 = STACK (RECORD-TYPE LBIND)>
258 <CALL '
\1aFRAME 1 = TEMP31>
259 <NTHR 'ACT 2 = TEMP18 (RECORD-TYPE ATOM) (TYPE LBIND)>
260 <PUTR TEMP18 1 TEMP31 (RECORD-TYPE LBIND)>
269 <END
\1aFCN-ATOM-PRINT>
271 <COND (<==? ,OLD-ATOM ATOM> <PRINTTYPE ATOM ,ATOM-PRINT> <PRINTTYPE FCN-ATOM ,FCN-ATOM-PRINT>)>
273 <PRINTTYPE STACK <FUNCTION (X) <PRINC "#STACK "> <PRIN1 <CHTYPE .X FIX>>>>
275 <SETG PLUSINF <CHTYPE <MIN> FIX>>
277 <SETG MINUSINF <CHTYPE <MAX> FIX>>
279 "Type specification for NODE."
281 <NEWTYPE NODE VECTOR '<<PRIMTYPE VECTOR> FIX ANY ANY ANY <LIST [REST NODE]> <OR FALSE ATOM> [OPTIONAL LIST ANY ANY LIST SYMTAB <OR FALSE ATOM> ANY ANY ANY ANY ANY LIST <OR FALSE LIST> FIX FIX]>>
283 "Offsets into pass 1 structure entities and functions to create same."
285 <SETG NODE-TYPE <OFFSET 1 NODE>>
287 <SETG PARENT <OFFSET 2 NODE>>
289 <SETG RESULT-TYPE <OFFSET 3 NODE>>
291 <SETG NODE-NAME <OFFSET 4 NODE>>
293 <SETG KIDS <OFFSET 5 NODE>>
295 <SETG SEGS <OFFSET 6 NODE>>
297 <SETG TYPE-INFO <OFFSET 7 NODE>>
299 <SETG SIDE-EFFECTS <OFFSET 8 NODE>>
301 <SETG RSUBR-DECLS <OFFSET 9 NODE>>
303 <SETG BINDING-STRUCTURE <OFFSET 10 NODE>>
305 <SETG SYMTAB <OFFSET 11 NODE>>
307 <SETG ACTIVATED <OFFSET 12 NODE>>
309 <SETG SPCS-X <OFFSET 13 NODE>>
311 <SETG DST <OFFSET 14 NODE>>
313 <SETG CDST <OFFSET 15 NODE>>
315 <SETG ATAG <OFFSET 16 NODE>>
317 <SETG RTAG <OFFSET 17 NODE>>
319 <SETG ASSUM <OFFSET 18 NODE>>
321 <SETG AGND <OFFSET 19 NODE>>
323 <SETG TOTARGS <OFFSET 20 NODE>>
325 <SETG REQARGS <OFFSET 21 NODE>>
327 <SETG CLAUSES <OFFSET <1 ,KIDS> NODE>>
329 <SETG NODE-SUBR <OFFSET <1 ,RSUBR-DECLS> NODE>>
331 <SETG PREDIC <OFFSET <1 ,NODE-NAME> NODE>>
333 <SETG ACCUM-TYPE <OFFSET <1 ,DST> NODE>>
335 <SETG DEAD-VARS <OFFSET <1 ,CDST> NODE>>
337 <SETG LIVE-VARS <OFFSET <1 ,TYPE-INFO> NODE>>
339 <SETG VSPCD <OFFSET <1 ,ATAG> NODE>>
341 <SETG INIT-DECL-TYPE <OFFSET <1 ,RTAG> NODE>>
343 " Definitions associated with compiler symbol tables."
345 "Offsets for variable description blocks"
347 <NEWTYPE TEMP VECTOR '!<<PRIMTYPE VECTOR> ATOM FIX ANY <OR ATOM FALSE> ANY ANY>>
349 <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>>
351 <SETG NEXT-SYM <OFFSET 1 SYMTAB>>
353 <SETG NAME-SYM <OFFSET 2 SYMTAB>>
355 <SETG SPEC-SYM <OFFSET 3 SYMTAB>>
357 <SETG CODE-SYM <OFFSET 4 SYMTAB>>
359 <SETG ARGNUM-SYM <OFFSET 5 SYMTAB>>
361 <SETG PURE-SYM <OFFSET 6 SYMTAB>>
363 <SETG DECL-SYM <OFFSET 7 SYMTAB>>
365 <SETG ADDR-SYM <OFFSET 8 SYMTAB>>
367 <SETG INIT-SYM <OFFSET 9 SYMTAB>>
369 <SETG TEMP-NAME-SYM <OFFSET 10 SYMTAB>>
371 <SETG RET-AGAIN-ONLY <OFFSET 11 SYMTAB>>
373 <SETG ASS? <OFFSET 12 SYMTAB>>
375 <SETG USAGE-SYM <OFFSET 13 SYMTAB>>
377 '<SETG STORED <OFFSET 14 SYMTAB>>
379 <SETG USED-AT-ALL <OFFSET 15 SYMTAB>>
381 <SETG DEATH-LIST <OFFSET 16 SYMTAB>>
383 <SETG CURRENT-TYPE <OFFSET 17 SYMTAB>>
385 <SETG COMPOSIT-TYPE <OFFSET 18 SYMTAB>>
387 <SETG ARG-NAME-SYM <OFFSET 19 SYMTAB>>
389 "How a variable is used in a loop."
392 <GFCN
\1aNODE1 ("VALUE" NODE ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 KID8>
406 <UBLOCK <TYPE-CODE VECTOR> 6 = TEMP10>
407 <CHTYPE TEMP10 <TYPE-CODE NODE> = TEMP10>
412 "Create a function node with all its hair."
415 <GFCN
\1aNODEF ("VALUE" NODE ANY ANY ANY ANY ANY ANY ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 KID8 RSD9 BST10 HAT11 VTB12 TRG13 RQRG14>
449 <UBLOCK <TYPE-CODE VECTOR> 21 = TEMP16>
450 <CHTYPE TEMP16 <TYPE-CODE NODE> = TEMP16>
455 "Create a PROG/REPEAT node with nearly as much hair."
458 <GFCN
\1aNODEPR ("VALUE" NODE ANY ANY ANY ANY ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 KID8 VL9 BST10 HAT11 VTB12>
488 <UBLOCK <TYPE-CODE VECTOR> 19 = TEMP14>
489 <CHTYPE TEMP14 <TYPE-CODE NODE> = TEMP14>
494 "Create a COND node."
497 <GFCN
\1aNODECOND ("VALUE" NODE ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 CLAU8>
513 <UBLOCK <TYPE-CODE VECTOR> 8 = TEMP10>
514 <CHTYPE TEMP10 <TYPE-CODE NODE> = TEMP10>
519 "Create a node for a COND clause."
522 <GFCN
\1aNODEB ("VALUE" NODE ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 PRED7 CLAU8>
538 <UBLOCK <TYPE-CODE VECTOR> 8 = TEMP10>
539 <CHTYPE TEMP10 <TYPE-CODE NODE> = TEMP10>
544 "Create a node for a SUBR call etc."
547 <GFCN
\1aNODEFM ("VALUE" NODE ANY ANY ANY ANY ANY ANY) TYP4 PAR5 RES-TYP6 NAME7 KID8 SUB9>
565 <UBLOCK <TYPE-CODE VECTOR> 9 = TEMP11>
566 <CHTYPE TEMP11 <TYPE-CODE NODE> = TEMP11>
572 <GFCN
\1aADDVAR ("VALUE" SYMTAB ANY ANY ANY ANY ANY ANY ANY ANY) NAM4 SPEC5 CODE6 ARGNUM7 PURE8 DCL9 ADDR10 INIT11>
575 <GEN-LVAL 'VARTBL = STACK>
601 <PUSH 'FOO!-IPASS1!-PASS1!-PACKAGE>
602 <UBLOCK <TYPE-CODE VECTOR> 19 = TEMP13>
603 <CHTYPE TEMP13 <TYPE-CODE SYMTAB> = TEMP13>
604 <GEN-SET 'VARTBL TEMP13>
609 "Some specialized decl stuff."
611 <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>>
613 <COND (<NOT ,MIM> <PUTPROP CHANNEL DECL '<CHANNEL FIX [11 ANY] [5 FIX]>>)>
615 <COND (,MIM <PUT-DECL STRING '<<PRIMTYPE STRING> [REST CHARACTER]>>) (ELSE <PUTPROP STRING DECL '<<PRIMTYPE STRING> [REST CHARACTER]>>)>
617 "Codes for the node types in the tree built by pass1 and modified by
620 "Give symbolic codes arbitrary increasing values."
622 <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>>
626 "Build a dispatch table based on node types."
629 <GFCN
\1aDISPATCH ("VALUE" VECTOR ANY "TUPLE" <<PRIMTYPE VECTOR> [REST <LIST FIX ANY>]>) DEFAULT4>
630 <MAKTUP PAIRS5 TEMP7 TT6:VECTOR TEMP16:FIX = PAIRS5>
632 <UUBLOCK <TYPE-CODE VECTOR> 108 = TT6>
634 <LOOP (TEMP7 VALUE LENGTH) (DEFAULT4 TYPE VALUE LENGTH)>
636 <EMPUV? TEMP7 + ISTRE9 (DEAD-JUMP DEFAULT4 TEMP7)>
637 <PUTUV TEMP7 1 DEFAULT4>
638 <RESTUV TEMP7 1 = TEMP7>
644 <EMPUV? PAIRS5 - PHRASE15 (DEAD-FALL PAIRS5)>
648 <NTHUV PAIRS5 1 = TEMP7 (TYPE LIST)>
649 <NTHL TEMP7 1 = TEMP16 (TYPE FIX)>
650 <RESTL TEMP7 1 = TEMP7 (TYPE LIST)>
651 <NTHL TEMP7 1 = TEMP7>
652 <PUTUV TT6 TEMP16 TEMP7>
654 <RESTUV PAIRS5 1 = PAIRS5 (TYPE VECTOR)>
655 <CHTYPE PAIRS5 <TYPE-CODE VECTOR> = PAIRS5>
659 <SETG PREDV <IUVECTOR ,COMP-TYPES 0>>
661 <GDECL (PREDV) UVECTOR>
663 <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]>
665 <MAPF <> <FUNCTION (N) <PUT ,PREDV .N -1>> [,OR-CODE ,AND-CODE ,COND-CODE]>
667 "Predicate: does this type have special predicate code?"
669 " Assign codes to differen types of argument in argument list"
671 <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)>>
673 <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>]>]>>)>
675 <COND (,MIM <PUT-DECL SYMBOL '<OR SYMTAB TEMP COMMON>>) (ELSE <PUTPROP SYMBOL DECL '<OR SYMTAB TEMP COMMON>>)>
677 <SETG DATTYP <OFFSET 1 DATUM>>
679 <SETG DATVAL <OFFSET 2 DATUM>>
681 <NEWTYPE DATUM LIST '<<PRIMTYPE LIST> <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>> <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>>>>
683 <NEWTYPE OFFPTR LIST '<<PRIMTYPE LIST> FIX DATUM ATOM>>
685 <MANIFEST DATTYP DATVAL>
687 <MAPF <> ,MANIFEST ,CODVEC>
689 <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>
691 <NEWTYPE COMMON VECTOR '<<PRIMTYPE VECTOR> ATOM <OR COMMON SYMTAB> FIX ANY <PRIMTYPE LIST>>>
693 <SETG COMMON-TYPE <OFFSET 1 COMMON>>
695 "TYPE OF COMMON (ATOM)"
697 <SETG COMMON-SYMT <OFFSET 2 COMMON>>
699 "POINTER TO OR COMMON SYMTAB"
701 <SETG COMMON-ITEM <OFFSET 3 COMMON>>
703 "3RD ARGUMENT TO NTH,REST,PUT ETC."
705 <SETG COMMON-PRIMTYPE <OFFSET 4 COMMON>>
707 "PRIMTYPE OF OBJECT IN COMMON"
709 <SETG COMMON-DATUM <OFFSET 5 COMMON>>
711 "DATUM FOR THIS COMMON"
713 <MANIFEST COMMON-TYPE COMMON-SYMTAB COMMON-ITEM COMMON-PRIMTYPE COMMON-DATUM>
715 <NEWTYPE TRANS VECTOR '<<PRIMTYPE VECTOR> NODE <UVECTOR [7 FIX]> <UVECTOR [7 FIX]>>>
717 <NEWTYPE MIM-SPECIAL ATOM>
719 <SETG TEMP-NAME <OFFSET 1 TEMP>>
721 <SETG TEMP-REFS <OFFSET 2 TEMP>>
723 <SETG TEMP-FRAME <OFFSET 3 TEMP>>
725 <SETG TEMP-ALLOC <OFFSET 4 TEMP>>
727 <SETG TEMP-NO-RECYCLE <OFFSET 5 TEMP>>
729 <SETG TEMP-TYPE <OFFSET 6 TEMP>>
731 <MANIFEST TEMP-NAME TEMP-REFS TEMP-FRAME TEMP-ALLOC TEMP-NO-RECYCLE TEMP-TYPE>
733 <COND (<N==? <TYPEPRIM FIX> FIX> <FLOAD "PS:<COMPIL>POPWR2.FBIN">)>
735 <SETG BINDING-LENGTH 9>
737 <MANIFEST BINDING-LENGTH>