3 <ENTRY GEN CODE-GEN STB SEQ-GEN MERGE-STATES FRMS LVAL-UP GOOD-TUPLE
4 UPDATE-WHERE NSLOTS NTSLOTS STFIXIT STK GET-TMPS PRE
5 STACK:L NO-KILL DELAY-KILL BSTB TOT-SPEC BASEF AC-HACK BINDUP SPECD LADDR
6 ADD:STACK GENERATORS GOODACS FRMID RES-FLS STORE-SET TRUE-FALSE ACFIX
7 SUBR-GEN BIND-CODE SPEC-LIST BTP NPRUNE REG? ARG? ARGS-TO-ACS>
9 <USE "CACS" "CHKDCL" "COMCOD" "COMPDEC" "STRGEN" "MAPGEN" "MMQGEN" "BUILDL" "BITSGEN"
10 "LNQGEN" "ISTRUC" "CARGEN" "NOTGEN" "COMSUB" "BITTST" "CBACK" "ALLR"
11 "CUP" "SUBRTY" "NEWREP" "CPRINT" "INFCMP" "CASE" "SPCGEN">
15 ;"DISABLE FUNNY COND./BOOL FEATURE"
17 " This file contains the major general codde generators. These include
18 variable access functions (LVAL, SETG etc.), FSUBRs (COND, AND, REPEAT)
19 and a few assorted others."
21 " All generators are called with a node and a destination for the
22 result. The destinations are either DATUMs (lists of ACs or types)
23 or the special atoms DONT-CARE or FLUSHED. Generators for
24 SUBRs that can be predicates may have additional arguments when they
25 are being invoked for their branching effect."
27 " The atom STK always points to a list that specifies the model
30 " Main generator, dispatches to specific code generators. "
34 <COND (<AND <SET TEM <LOOKUP "OTBSAV" <GET MUDDLE OBLIST>>>
37 (ELSE <SQUOTA |OTBSAV >)>>>
41 <DEFINE GEN (NOD WHERE "AUX" TEMP)
42 #DECL ((NOD) NODE (WHERE) <OR ATOM DATUM>)
43 <SET TEMP <APPLY <NTH ,GENERATORS <NODE-TYPE .NOD>> .NOD .WHERE>>
44 <OR <ASSIGNED? NPRUNE> <PUT .NOD ,KIDS ()>>
47 " Generate a sequence of nodes flushing all values except the ladt."
49 <DEFINE SEQ-GEN (L WHERE "OPTIONAL" (INPROG <>) (SINPROG <>) (INCODE-GEN <>))
50 #DECL ((L) <LIST [REST NODE]> (WHERE) <OR ATOM DATUM>)
52 <FUNCTION (N "AUX" (ND <1 .N>))
53 #DECL ((N) <LIST NODE> (ND) NODE)
55 <==? <NODE-TYPE .ND> ,QUOTE-CODE>
56 <==? <RESULT-TYPE .ND> ATOM>
57 <OR <NOT <EMPTY? <REST .N>>>
58 <ISTAG? <NODE-NAME .ND>>>>
59 <MESSAGE WARNING " TAG SEEN IN PROG/REPEAT " .ND>
61 <LABEL:TAG <UNIQUE:TAG <NODE-NAME .ND> T>>
62 <COND (<EMPTY? <REST .N>>
65 <COND (<TYPE? .WHERE DATUM> <DATUM !.WHERE>)
70 <COND (<AND .INPROG <TYPE? .WHERE DATUM>>
73 (ELSE <RET-TMP-AC <GEN .ND FLUSHED>>)>>
75 <COND (<AND <NOT .INPROG> <NOT .INCODE-GEN>> <VAR-STORE>)>
78 " The main code generation entry (called from CDRIVE). Sets up initial
79 stack model, calls to generate code for the bindings and generates code for
82 <DEFINE CODE-GEN (BASEF
83 "AUX" (TOT-SPEC 0) (NTSLOTS (<FORM GVAL <TMPLS .BASEF>>))
84 (IDT 0) XX (STB (0)) (STK (0 !.STB)) (PRE <>) (FRMID 1)
85 BTP (FRMS (1 .STK .BASEF 0 .NTSLOTS)) (BSTB .STB)
87 (TMPS <COND (<ACTIVATED .BASEF> (2)) (ELSE (0))>)
88 START:TAG (AC-HACK <ACS .BASEF>) (K <KIDS .BASEF>)
91 <COND (<ACTIVATED .BASEF> <FUNCTION:VALUE>)
92 (ELSE <GOODACS .BASEF <FUNCTION:VALUE>>)>)
93 (ATAG <MAKE:TAG "AGAIN">) (RTAG <MAKE:TAG "EXIT">)
94 (SPEC-LIST ()) (RET <>) (NO-KILL ()) (KILL-LIST ()))
95 #DECL ((TOT-SPEC IDT) <SPECIAL FIX> (BASEF) <SPECIAL NODE>
96 (SPEC-LIST KILL-LIST STK BSTB NTSLOTS) <SPECIAL LIST>
97 (PRE SPECD) <SPECIAL ANY> (FRMID TMPS) <SPECIAL ANY>
98 (START:TAG) <SPECIAL ATOM> (AC-HACK) <SPECIAL <PRIMTYPE LIST>>
99 (FRMS NO-KILL) <SPECIAL LIST> (K) <LIST [REST NODE]> (BTP) LIST
100 (CD) <OR DATUM FALSE>)
101 <BEGIN-FRAME <TMPLS .BASEF>
104 <PUT .BASEF ,STK-B .STB>
105 <BIND-CODE .BASEF .AC-HACK>
108 <SET SPEC-LIST (.BASEF .SPECD <SPECS-START .BASEF>)>
109 <SET STK (0 !<SET BTP .STK!>)>
110 <COND (.AC-HACK <EMIT '<INTGO!-OP!-PACKAGE>>)>
111 <PUT .BASEF ,ATAG .ATAG>
112 <PUT .BASEF ,RTAG .RTAG>
113 <PUT .BASEF ,BTP-B .BTP>
114 <PUT .BASEF ,DST .DEST>
115 <PUT .BASEF ,PRE-ALLOC .PRE>
116 <PUT .BASEF ,SPCS-X .SPECD>
119 <COND (<TYPE? .DEST DATUM> <DATUM !.DEST>)
127 (ELSE <SET CD <CDST .BASEF>>)>
128 <COND (<AND <TYPE? .DEST DATUM>
130 <ISTYPE? <DATTYP .DEST>>
131 <TYPE? <DATTYP .CD> AC>>
132 <RET-TMP-AC <DATTYP .CD> .CD>)>
133 <COND (<AND .RET .AC-HACK>
134 <UNBIND:LOCS .STK .STB <=? .AC-HACK '(FUNNY-STACK)>>)>
137 <AND <TYPE? <DATTYP .DEST> AC>
138 <FIX-ACLINK <DATTYP .DEST> .DEST .CD>>
139 <AND <TYPE? <DATVAL .DEST> AC>
140 <FIX-ACLINK <DATVAL .DEST> .DEST .CD>>)>
146 <COND (<TYPE? .ITEM SYMTAB>
147 <PUT .ITEM ,STORED T>)>>
150 <SET XX <RET-TMP-AC <MOVE:ARG .DEST <FUNCTION:VALUE>>>>
155 " Update ACs with respect to their datums."
157 <DEFINE ACFIX (OLD1 NEW1 "AUX" OLD NEW)
158 #DECL ((OLD NEW) DATUM)
159 <COND (<TYPE? .OLD1 DATUM>
162 <COND (<==? <DATTYP .OLD> ANY-AC>
163 <PUT .OLD ,DATTYP <DATTYP .NEW>>)>
164 <COND (<==? <DATVAL .OLD> ANY-AC>
165 <PUT .OLD ,DATVAL <DATVAL .NEW>>)>)>
168 " Generate code for setting up and binding agruments."
170 <DEFINE BIND-CODE (NOD
172 "AUX" (BST <BINDING-STRUCTURE .NOD>) B (NPRUNE T)
173 (NSLOTS <SSLOTS .NOD>) (TSLOTS <TMPLS .NOD>) (LARG <>)
176 <AND .FLG <MEMBER .FLG '![(STACK) (FUNNY-STACK)!]>>)
178 #DECL ((NOD) NODE (BST B) <LIST [REST SYMTAB]> (NPRUNE) <SPECIAL ANY>
179 (NSLOTS) <SPECIAL FIX> (TSLOTS) ATOM (INAME) <UVECTOR [REST ATOM]>
180 (FRMS) <LIST [5 ANY]> (TOT-SPEC) FIX (BASEF) NODE)
181 <AND <ACTIVATED .NOD> <ACT:INITIAL> <ADD:STACK 2>>
182 <OR .PRE .FLG <PROG ()
183 <SALLOC:SLOTS .TSLOTS>
184 <ADD:STACK .TSLOTS>>>
185 <AND .FLG <SET INAME <NODE-NAME .NOD>>>
187 (<AND .SFLG <L? <TOTARGS .NOD> 0>>
188 <EMIT <INSTRUCTION INTERNAL-ENTRY!-OP!-PACKAGE <1 .INAME> -1>>
189 <EMIT '<`SUBM `M* `(P) >>
192 <PUT .FRMS 2 <SET BSTB <SET STB <SET STK (0 !.STK)>>>>
194 <PUT <1 .BST> ,POTLV <>>
195 <SET BST <REST .BST>>)
198 <OPT-CHECK <REST .BST <REQARGS .NOD>>
199 <- <TOTARGS .NOD> <REQARGS .NOD>>
201 <ADD:STACK <* 2 <TOTARGS .NOD>>>
202 <SET TMPS <STACK:L .STK .STB>>
204 <REPEAT ((I (.TSLOTS 0)) (TG <MAKE:TAG>) (TRG <TOTARGS .NOD>) (OPS 0)
206 #DECL ((TG) ATOM (OPS TRG) FIX (STK OSTK) LIST)
207 <EMIT <INSTRUCTION INTERNAL-ENTRY!-OP!-PACKAGE <1 .INAME> .TRG>>
209 <EMIT '<`SUBM `M* `(P) >>
210 <SALLOC:SLOTS <2 .I>>
213 <REPEAT ((TRG .TRG) (OPS .OPS) SYM T1)
214 #DECL ((TRG OPS) FIX (SYM) SYMTAB (T1) ADDRESS:C)
215 <COND (<EMPTY? .B> <RETURN>) (ELSE <SET SYM <1 .B>>)>
217 <COND (<OR <==? <CODE-SYM .SYM> 7>
218 <==? <CODE-SYM .SYM> 8>
219 <==? <CODE-SYM .SYM> 9>>
220 <TUPCHK <INIT-SYM .SYM> T>)>
228 <COND (<=? .AC-HACK '(FUNNY-STACK)>
237 <* 2 <ARGNUM-SYM .SYM>>
238 !<STACK:L .STK .BSTB>
247 <SET TOT-SPEC <+ .TOT-SPEC 6>>>
248 <SET TRG <- .TRG 1>>)
250 <COND (<L=? <CODE-SYM .SYM> 7>
251 <COND (<SPEC-SYM .SYM> <AUX1-B .SYM>)
252 (ELSE <GEN <INIT-SYM .SYM> <LADDR .SYM T <>>>)>)
254 <COND (<SPEC-SYM .SYM> <AUX2-B .SYM>)
256 <MOVE:ARG <REFERENCE:UNBOUND> <LADDR .SYM T <>>>)>)>
258 <SET OPS <- .OPS 1>>)
260 <AND <OR .GOOD-OPTS <1? <LENGTH .INAME>>>
262 <PUT .SYM ,ARGNUM-SYM <TMPLS .BASEF>>>
264 <PUT .I 2 <+ <CHTYPE <2 .I> FIX> 2>>
267 <COND (<OR .GOOD-OPTS <EMPTY? <SET INAME <REST .INAME>>>>
271 (ELSE <SET STK .OSTK> <BRANCH:TAG .TG>)>>
273 (.FLG <LABEL:TAG <1 .INAME>> <EMIT '<`SUBM `M* `(P) >>)>
274 <REPEAT ((COD 0) SYM)
275 #DECL ((COD) FIX (SYM) SYMTAB)
279 <COND (.SPECD <VAR-STORE> <BIND:END> T) (ELSE T)>>
280 <SALLOC:SLOTS .TSLOTS>
281 <SET TMPS <STACK:L .STK .STB>>
282 <ADD:STACK .TSLOTS>)>
286 <COND (<G? .NSLOTS 0>
287 <SALLOC:SLOTS <- .NSLOTS .TOT-SPEC>>
288 <ADD:STACK <- .NSLOTS .TOT-SPEC>>)>
291 <AND <ACTIVATED .NOD> <ACT:FINAL>>
293 <SET COD <CODE-SYM <SET SYM <1 .BST>>>>
296 <PUT .SYM ,CODE-SYM <SET COD <- .COD>>>
297 <COND (<G? .NSLOTS 0>
298 <SALLOC:SLOTS <- .NSLOTS .TOT-SPEC>>
299 <ADD:STACK <- .NSLOTS .TOT-SPEC>>)>
304 <0? <NTH '![0 0 0 0 1 0 0 0 0 1 0 1 1!] .COD>>
306 <COND (.SPECD <VAR-STORE> <BIND:END> T) (ELSE T)>>
307 <SET TMPS <STACK:L .STK .STB>>
308 <SALLOC:SLOTS .TSLOTS>
309 <ADD:STACK .TSLOTS>)>
310 <APPLY <NTH ,BINDERS .COD> .SYM>
311 <OR .PRE <PUT .SYM ,SPEC-SYM FUDGE>>
312 <SET BST <REST .BST>>>
315 <DEFINE OPT-CHECK (B NUM LBLS "AUX" (N .NUM) (RQ <REQARGS .BASEF>) NOD S)
316 #DECL ((B) <LIST [REST SYMTAB]> (N NUM RQ) FIX (LBLS) <UVECTOR [REST ATOM]>
317 (NOD BASEF) NODE (S) SYMTAB)
325 <COND (<L? <SET N <- .N 1>> 0> <MAPLEAVE>)>
326 <COND (<AND <OR <==? <CODE-SYM .S> 6> <==? <CODE-SYM .S> 7>>
327 <NOT <MEMQ <NODE-TYPE <CHTYPE <INIT-SYM .S> NODE>> ,SNODES>>>
335 <EMIT <INSTRUCTION INTERNAL-ENTRY!-OP!-PACKAGE
336 <NTH .LBLS <+ .NUM 1>>
338 <COND (<OR <==? <CODE-SYM .S> 6> <==? <CODE-SYM .S> 7>>
339 <COND (<==? <NODE-TYPE <SET NOD <INIT-SYM .S>>> ,LVAL-CODE>
341 <ARGNUM-SYM <CHTYPE <NODE-NAME .NOD> SYMTAB>>> 2>>
342 <SET ADDR <ADDRESS:C <- -1 .OFFS> `(TP) >>
343 <SET ADDR <DATUM .ADDR .ADDR>>)
344 (ELSE <SET ADDR <GEN .NOD DONT-CARE>>)>)
345 (ELSE <SET ADDR <REFERENCE:UNBOUND>>)>
346 <STACK:ARGUMENT .ADDR>
347 <COND (<L=? <SET NUM <- .NUM 1>> 0> <RETURN>)>
348 <SET RQ <+ .RQ 1>>>)>>
350 " Generate \"BIND\" binding code."
352 <DEFINE BIND-B (SYM) #DECL ((SYM) SYMTAB) <BINDUP .SYM <MAKE:ENV>>>
354 " Do code generation for normal arguments."
357 #DECL ((SYM) SYMTAB (AC-HACK) <PRIMTYPE LIST>)
359 <BINDUP .SYM <DATUM !<NTH .AC-HACK <ARGNUM-SYM .SYM>>> <>>)
360 (<TYPE? <ADDR-SYM .SYM> DATUM>)
361 (ELSE <BINDUP .SYM <REFERENCE:ARG <ARGNUM-SYM .SYM>>>)>>
363 " Initialized optional argument binder."
367 <TUPCHK <INIT-SYM .SYM>>
368 <OPTBIND .SYM <INIT-SYM .SYM>>>
370 " Uninitialized optional argument binder."
372 <DEFINE OPT2-B (SYM) #DECL ((SYM) SYMTAB) <OPTBIND .SYM>>
374 " Create a binding either by pushing or moving if slots PRE created."
376 <DEFINE BINDUP (SYM SRC "OPTIONAL" (SPCB T))
377 #DECL ((SYM) SYMTAB (SRC) DATUM (TOT-SPEC) FIX)
378 <COND (<SPEC-SYM .SYM>
381 <PUT .SYM ,ADDR-SYM <- <CHTYPE <ADDR-SYM .SYM> FIX> .TOT-SPEC>>
382 <STORE:BIND .SYM .SRC>)
384 <PUSH:BIND <NAME-SYM .SYM> .SRC <DECL-SYM .SYM>>
385 <SET TOT-SPEC <+ .TOT-SPEC 6>>
387 <AND .SPCB <VAR-STORE> <BIND:END>>)>)
388 (ELSE <CLOB:PAIR .SYM .PRE .SRC>)>
391 " Push or store a non special argument."
393 <DEFINE CLOB:PAIR (SYM PRE SRC)
394 #DECL ((SYM) SYMTAB (SRC) DATUM (TOT-SPEC) FIX)
396 <PUT .SYM ,ADDR-SYM <- <CHTYPE <ADDR-SYM .SYM> FIX> .TOT-SPEC>>
397 <STORE:PAIR .SYM .SRC>)
398 (ELSE <PUSH:PAIR .SRC> <ADD:STACK 2>)>>
400 " Create a binding for either intitialized or unitialized optional."
404 "AUX" (GIVE <MAKE:TAG>) (DEF <MAKE:TAG>) DV (LPRE .PRE))
405 #DECL ((SYM) SYMTAB (BASEF DVAL) NODE (GIVE DEF) ATOM (DV) DATUM (TOT-SPEC) FIX)
406 <COND (<SPEC-SYM .SYM>
408 <OR .LPRE <PUSH:ATB <NAME-SYM .SYM>>>)>
409 <TEST:ARG <ARGNUM-SYM .SYM> .DEF>
414 <MOVE:ARG <REFERENCE:ARG <ARGNUM-SYM .SYM>>
418 <REFERENCE:ARG <ARGNUM-SYM .SYM>>
421 <COND (<TYPE? <ARGNUM-SYM .SYM> ATOM>
422 <FORM GVAL <ARGNUM-SYM .SYM>>)
424 (ELSE <PUSH:PAIR <REFERENCE:ARG <ARGNUM-SYM .SYM>>>)>
428 <COND (<ASSIGNED? DVAL>
429 <GEN .DVAL <COND (.LPRE <FUNCTION:VALUE>) (ELSE DONT-CARE)>>)
430 (ELSE <REFERENCE:UNBOUND>)>>
431 <AND <OR <NOT .LPRE> <NOT <SPEC-SYM .SYM>>>
432 <CLOB:PAIR .SYM .LPRE .DV>>
435 <COND (.LPRE <STORE:BIND .SYM .DV>)
437 <PUSH:PAIR <REFERENCE <DECL-SYM .SYM>>>
442 <COND (<AND <NOT .LPRE> <SPEC-SYM .SYM>>
443 <SET TOT-SPEC <+ .TOT-SPEC 6>>)>
446 " Do a binding for a named activation."
450 <AND <ASSIGNED? START:TAG> <BINDUP .SYM <MAKE:ACT>>>>
452 " Bind an \"AUX\" variable."
454 <DEFINE AUX1-B (SYM "AUX" TT TEM TY)
455 #DECL ((SYM) SYMTAB (TT) DATUM (FCN) NODE (TOT-SPEC) FIX)
457 <TUPCHK <INIT-SYM .SYM>>
459 (<AND <NOT .PRE> <SPEC-SYM .SYM>>
460 <PUSH:ATB <NAME-SYM .SYM>>
462 <PUSH:PAIR <SET TT <GEN <INIT-SYM .SYM> DONT-CARE>>>
463 <PUSH:PAIR <REFERENCE <DECL-SYM .SYM>>>
468 <SET TOT-SPEC <+ .TOT-SPEC 6>>
470 (<TYPE? <ADDR-SYM .SYM> TEMPV>
471 <SET TY <CREATE-TMP <SET TEM <ISTYPE-GOOD? <1 <DECL-SYM .SYM>>>>>>
476 <COND (<=? .AC-HACK '(FUNNY-STACK)> <* <TOTARGS .FCN> -2>)
483 <DATUM <COND (<OR <ISTYPE-GOOD? <RESULT-TYPE <INIT-SYM .SYM>>> .TEM>)
486 <SMASH-INACS .SYM .TT>
487 <PUT .SYM ,STORED <>>
488 <PUT <SET TEM <CHTYPE <DATVAL .TT> AC>> ,ACRESIDUE (.SYM !<ACRESIDUE .TEM>)>
489 <COND (<TYPE? <SET TEM <DATTYP .TT>> AC>
490 <PUT .TEM ,ACRESIDUE (.SYM !<ACRESIDUE .TEM>)>)>
492 (ELSE <BINDUP .SYM <GEN <INIT-SYM .SYM> DONT-CARE>>)>>
494 " Do a binding for an uninitialized \"AUX\" "
496 <DEFINE AUX2-B (SYM "AUX" ADR TY)
497 #DECL ((SYM) SYMTAB (FCN) NODE)
499 <TUPCHK <INIT-SYM .SYM>>
500 <COND (<TYPE? <ADDR-SYM .SYM> TEMPV>
501 <SET TY <CREATE-TMP <ISTYPE-GOOD? <1 <DECL-SYM .SYM>>>>>
502 <COND (<ISTYPE-GOOD? <1 <DECL-SYM .SYM>>>
503 <PUT .SYM ,INIT-SYM T>)>
508 <COND (<=? .AC-HACK '(FUNNY-STACK)>
509 <* <TOTARGS .FCN> -2>)
513 (<AND <SET TY <ISTYPE-GOOD? <1 <DECL-SYM .SYM>>>>
515 <NOT <SPEC-SYM .SYM>>>
516 <SET ADR <ADDRESS:PAIR <FORM TYPE-WORD!-OP!-PACKAGE .TY> '[0]>>
517 <PUT .SYM ,INIT-SYM T>
518 <BINDUP .SYM <DATUM .ADR .ADR>>)
519 (ELSE <BINDUP .SYM <REFERENCE:UNBOUND>>)>>
521 <DEFINE TUPCHK (TUP "OPTIONAL" (OPT <>) "AUX" (NS .NSLOTS) (TS .TOT-SPEC))
522 #DECL ((TUP) <OR FALSE NODE> (NS TS) FIX)
524 <COND (<AND <TYPE? .TUP NODE>
525 <OR <==? <NODE-NAME .TUP> ITUPLE>
526 <==? <NODE-NAME .TUP> TUPLE>>>
528 <==? <NODE-TYPE .TUP> ,ISTRUC-CODE>
529 <NOT <GOOD-TUPLE .TUP>>>
531 <SALLOC:SLOTS <- .NS .TS>>
532 <ADD:STACK <- .NS .TS>>)>
533 <EMIT-PRE <SET PRE T>>)>)>>>
535 <DEFINE GOOD-TUPLE (TUP "AUX" (K <KIDS .TUP>) NT (WD 0))
536 #DECL ((NT) FIX (TUP) NODE (K) <LIST [REST NODE]>)
537 <AND <NOT <==? <NODE-TYPE .TUP> ,ISTRUC-CODE>>
538 <COND (<==? <NODE-SUBR .TUP> ,ITUPLE>
539 <AND <==? <NODE-TYPE <1 .K>> ,QUOTE-CODE>
540 <OR <==? <SET NT <NODE-TYPE <2 .K>>> ,QUOTE-CODE>
541 <==? .NT ,FLVAL-CODE>
542 <==? .NT ,FGVAL-CODE>
544 <==? .NT ,LVAL-CODE>>
545 <* <NODE-NAME <1 .K>> 2>>)
549 <COND (<==? <NODE-TYPE .K> ,SEGMENT-CODE>
551 (ELSE <SET WD <+ .WD 2>>)>>
554 " Do a \"TUPLE\" binding."
556 <DEFINE TUPLE1-B (SYM)
558 <EMIT '<`PUSH `P* `A >>
559 <EMIT '<`PUSHJ `P* |MAKTU2 >>
560 <COND (<SPEC-SYM .SYM>
561 <EMIT '<`POP `TP* `B >>
562 <EMIT '<`POP `TP* `A >>
563 <BINDUP .SYM <FUNCTION:VALUE T>>)>>
565 <DEFINE TUPL-B (SYM "AUX" (SK <* 2 <- <ARGNUM-SYM .SYM> 1>>))
566 #DECL ((SYM) SYMTAB (SK) FIX)
567 <EMIT '<`MOVE `B* `AB >>
569 <EMIT <INSTRUCTION `ADD `B* [<FORM .SK (.SK)>]>>>
570 <EMIT '<`HLRZ `A* |OTBSAV `(TB) >>
571 <EMIT '<`HRLI `A* <TYPE-CODE!-OP!-PACKAGE TUPLE>>>
572 <BINDUP .SYM <FUNCTION:VALUE T>>>
574 " Generate the code to actually build a TUPLE."
576 <DEFINE BUILD:TUPLE (NUM "AUX" (STAG <MAKE:TAG>) (ETAG <MAKE:TAG>))
577 #DECL ((NUM) FIX (STAG ETAG) ATOM)
579 <AND <NOT <1? .NUM>> <BUMP:ARGPNTR <- .NUM 1>>>
582 <STACK:ARGUMENT <REFERENCE:ARGPNTR>>
589 " Dispatch table for binding generation code."
592 ![,ACT-B ,AUX1-B ,AUX2-B ,TUPL-B ,NORM-B ,OPT1-B ,OPT1-B ,OPT2-B ,OPT2-B
593 ,NORM-B ,BIND-B ,NORM-B ,NORM-B!]>
595 <DEFINE MENTROPY (N R) T>
597 <COND (<GASSIGNED? NOTIMP>
613 " Appliacation of a form could still be an NTH."
615 <DEFINE FORM-F-GEN (NOD WHERE "AUX" (K <KIDS .NOD>) TY)
617 <COND (<==? <ISTYPE? <SET TY <RESULT-TYPE <1 .K>>>> FIX>
618 <PUT .NOD ,NODE-NAME INTH>
619 <PUT .NOD ,NODE-TYPE <NODE-SUBR .NOD>>
620 <PUT .NOD ,NODE-SUBR ,NTH>
621 <COND (<OR <==? <NODE-TYPE .NOD> ,ALL-REST-CODE>
622 <==? <NODE-TYPE .NOD> ,NTH-CODE>>
623 <SET K (<2 .K> <1 .K>)>)>
626 (.TY <FORM-GEN .NOD .WHERE>)
629 " NON APPLICABLE OBJECT "
633 " Generate a call to EVAL for uncompilable FORM."
635 <DEFINE FORM-GEN (NOD WHERE "AUX" (SSTK .STK) TEM (STK (0 !.STK)))
636 #DECL ((NOD) NODE (WHERE) <OR ATOM DATUM> (TEM) DATUM
637 (STK) <SPECIAL LIST> (SSTK) LIST)
638 <RET-TMP-AC <STACK:ARGUMENT <REFERENCE <NODE-NAME .NOD>>>>
641 <SET TEM <FUNCTION:VALUE T>>
644 <MOVE:ARG .TEM .WHERE>>
646 " Generate code for LIST/VECTOR etc. evaluation."
648 <GDECL (COPIERS) <UVECTOR [REST ATOM]>>
650 <DEFINE COPY-GEN (NOD WHERE
651 "AUX" GT RES (I 0) (ARGS <KIDS .NOD>) (UNK <>)
652 (TYP <ISTYPE? <RESULT-TYPE .NOD>>)
655 '[|IILIST |CIVEC |CIUVEC TUPLE]
656 <LENGTH <CHTYPE <MEMQ .TYP ,COPIERS> UVECTOR>>>))
657 #DECL ((GT) <OR FALSE FIX> (NOD) NODE (WHERE) <OR ATOM DATUM>
658 (ARGS) <LIST [REST NODE]> (I) FIX (VALUE RES) DATUM)
659 <PROG ((STK (0 !.STK)))
660 #DECL ((STK) <SPECIAL LIST>)
663 <AND <EMPTY? .ARGS> <RETURN>>
664 <COND (<==? <NODE-TYPE <1 .ARGS>> ,SEGMENT-CODE>
665 <RET-TMP-AC <GEN <1 <KIDS <1 .ARGS>>> <FUNCTION:VALUE>>>
666 <COND (<AND <==? <NODE-NAME .NOD> LIST>
667 <EMPTY? <REST .ARGS>>>
669 <SEGMENT:LIST .I .UNK>
670 <SET RES <FUNCTION:VALUE T>>
674 <SEGMENT:STACK </ <STACKS .NOD> 2> .UNK>
675 <ADD:STACK <- <STACKS .NOD>>>
679 <RET-TMP-AC <STACK:ARGUMENT <GEN <1 .ARGS> DONT-CARE>>>
682 <SET ARGS <REST .ARGS>>>
684 <SET RES <FUNCTION:VALUE T>>
686 <AND <NOT <==? .INAME TUPLE>>
687 <EMIT <INSTRUCTION `POP
689 <COND (<==? .INAME TUPLE> `D )
692 <EMIT <INSTRUCTION `MOVEI
693 <COND (<==? .INAME TUPLE> `D* ) (ELSE `A* )>
694 <COND (<==? .INAME TUPLE> <+ .I .I>)
696 <COND (<==? .INAME TUPLE>
698 <EMIT <INSTRUCTION `MOVE `D* `(P) >>
699 <EMIT <INSTRUCTION `ASH `D* 1>>)>
700 <EMIT <INSTRUCTION `PUSHJ `P* |MAKTUP >>)
701 (ELSE <EMIT <INSTRUCTION `PUSHJ `P* .INAME>>)>)>>
702 <COND (<==? .INAME TUPLE>
703 <COND (<SET GT <GOOD-TUPLE .NOD>> <ADD:STACK <+ 2 .GT>>)
704 (ELSE <EMIT <INSTRUCTION `AOS `(P) >> <ADD:STACK PSTACK>)>)>
705 <MOVE:ARG .RES .WHERE>>
707 <SETG COPIERS ![TUPLE UVECTOR VECTOR LIST!]>
709 "Generate code for a call to a SUBR."
711 <DEFINE SUBR-GEN (NOD WHERE)
712 #DECL ((WHERE) <OR ATOM DATUM> (NOD) NODE)
713 <COMP:SUBR:CALL <NODE-NAME .NOD>
718 " Compile call to a SUBR that doesn't compile or PUSHJ."
720 <DEFINE COMP:SUBR:CALL (SUBR OBJ STA W
721 "AUX" RES (I 0) (UNK <>) (OS .STK) (STK (0 !.STK)))
722 #DECL ((STA I) FIX (OBJ) <LIST [REST NODE]> (UNK) <OR FALSE ATOM>
723 (STK) <SPECIAL LIST> (OS) LIST (RES) DATUM)
726 #DECL ((OB) NODE (I STA) FIX)
727 <COND (<==? <NODE-TYPE .OB> ,SEGMENT-CODE>
728 <RET-TMP-AC <GEN <1 <KIDS .OB>> <FUNCTION:VALUE>>>
730 <SEGMENT:STACK </ .STA 2> .UNK>
735 <RET-TMP-AC <STACK:ARGUMENT <GEN .OB DONT-CARE>>>
740 <SET RES <FUNCTION:VALUE T>>
741 <COND (.UNK <SEGMENT:FINAL .SUBR>)
742 (ELSE <SUBR:CALL .SUBR .I>)>
747 <GDECL (SUBRS TEMPLATES) UVECTOR>
749 <DEFINE GET-TMPS (SUB "AUX" (LS <MEMQ .SUB ,SUBRS>))
750 #DECL ((VALUE) <LIST ANY ANY> (LS) <OR FALSE UVECTOR>)
751 <COND (.LS <NTH ,TEMPLATES <LENGTH .LS>>)
754 " Generate calls to SUBRs using the internal PUSHJ feature."
756 <DEFINE ISUBR-GEN (NOD WHERE
757 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
758 "AUX" (TMPL <GET-TMPS <NODE-SUBR .NOD>>) W (SDIR .DIR) B2
759 (OS .STK) (STK (0 !.STK)) W2 (TP <4 .TMPL>))
760 #DECL ((NOD) NODE (WHERE W2) <OR ATOM DATUM> (W) DATUM
761 (TMPL) <LIST ANY ANY ANY ANY ANY ANY> (UNK) <OR FALSE ATOM>
762 (STA ARGS) FIX (STK) <SPECIAL LIST> (OS) LIST)
763 <AND .NOTF <SET DIR <NOT .DIR>>>
764 <COND (<==? <NODE-NAME .NOD> INTH> <SET TP (<2 <CHTYPE .TP LIST>>
765 <1 <CHTYPE .TP LIST>>)>)>
766 <COND (<=? .TP STACK> <STACK-ARGS .NOD T>)
767 (<NOT <AC-ARGS .NOD .TP>> <AC-SEG-CALL .TP>)>
769 <EMIT <INSTRUCTION `PUSHJ `P* <6 .TMPL>>>
771 <COND (<AND .BRANCH <5 .TMPL>>
772 <COND (<==? .WHERE FLUSHED>
773 <COND (.DIR <EMIT '<`SKIPA >> <BRANCH:TAG .BRANCH>)
774 (ELSE <BRANCH:TAG .BRANCH>)>)
776 <COND (.DIR <BRANCH:TAG <SET B2 <MAKE:TAG>>>)
778 <NOT <OR <==? .WHERE DONT-CARE>
779 <AND <TYPE? .WHERE DATUM>
782 <OR <==? <DATTYP .W> ANY-AC>
783 <==? <DATTYP .W> ,AC-A>>
784 <OR <==? <DATVAL .W> ANY-AC>
785 <==? <DATVAL .W> ,AC-B>>>>>>
787 <BRANCH:TAG <SET B2 <MAKE:TAG>>>)>
789 <MOVE:ARG <COND (.NOTF <REFERENCE .SDIR>)
790 (ELSE <FUNCTION:VALUE T>)>
793 <COND (<ASSIGNED? B2> <LABEL:TAG .B2>)>
796 <OR <==? .WHERE FLUSHED> <SET DIR <NOT .DIR>>>
797 <D:B:TAG <COND (<==? .WHERE FLUSHED> .BRANCH)
798 (ELSE <SET B2 <MAKE:TAG>>)>
803 <MOVE:ARG <COND (.NOTF <REFERENCE .SDIR>)
804 (ELSE <FUNCTION:VALUE T>)>
806 <COND (<N==? .WHERE FLUSHED>
812 <MOVE:ARG <FUNCTION:VALUE T> .WHERE>)
813 (ELSE <MOVE:ARG <FUNCTION:VALUE T> .WHERE>)>>
815 <DEFINE STACK-ARGS (NOD PASN
816 "AUX" (UNK <>) (ARGS 0) (STA <STACKS .NOD>) N
818 #DECL ((NOD N) NODE (ARGS STA) FIX (K) <LIST [REST NODE]>)
820 <AND <EMPTY? .K> <RETURN>>
821 <COND (<==? <NODE-TYPE <SET N <1 .K>>> ,SEGMENT-CODE>
822 <RET-TMP-AC <GEN <1 <KIDS .N>> <FUNCTION:VALUE>>>
824 <SEGMENT:STACK </ .STA 2> .UNK>
829 <RET-TMP-AC <STACK:ARGUMENT <GEN .N DONT-CARE>>>
831 <SET ARGS <+ .ARGS 1>>)>
834 <COND (.UNK <EMIT '<`POP `P* `A >>)
835 (.PASN <EMIT <INSTRUCTION `MOVEI `A* .ARGS>>)>
836 <COND (<NOT .UNK> .ARGS)>>
838 " Get a bunch of goodies into ACs for a PUSHJ call."
840 <DEFINE AC-ARGS (NOD ACTMP "AUX" WHS)
841 #DECL ((WHS) <LIST [REST DATUM]> (NOD) NODE (ACTMP) LIST)
843 (<SEGS .NOD> <STACK-ARGS .NOD <>>)
847 "AUX" (N <1 .NL>) (W <1 .WL>) (SD <SIDES <REST .NL>>)
848 (RT <ISTYPE-GOOD? <DATTYP .W>>))
849 #DECL ((N) NODE (W) <OR DATUM LIST> (RT) <OR ATOM FALSE>)
852 <COND (<==? <NODE-TYPE .N> ,QUOTE-CODE> DONT-CARE)
854 <DATUM <COND (<ISTYPE-GOOD? <RESULT-TYPE .N>>)
857 (ELSE <DATUM !.W>)>>>
858 <AND .SD <REGSTO <>>>
859 <COND (.RT <DATTYP-FLUSH .W> <PUT .W ,DATTYP .RT>)>
866 #DECL ((W1) DATUM (W2) LIST)
867 <MOVE:ARG .W1 <DATUM !.W2>>>
870 <MAPF <> ,RET-TMP-AC .WHS>
874 #DECL ((L) <LIST [REST NODE]>)
877 <COND (<==? <NODE-TYPE .N> ,QUOTE-CODE> <>)
878 (<OR <==? <NODE-TYPE .N> ,ISUBR-CODE>
879 <MEMQ ALL <SIDE-EFFECTS .N>>>
883 " Generate code for a call to an RSUBR (maybe PUSHJ)."
885 <DEFINE RSUBR-GEN (N W
886 "AUX" (IT <NODE-NAME .N>) ACST RN KNWN (OS .STK)
888 #DECL ((N RN) NODE (W) <OR ATOM DATUM> (STK) <SPECIAL LIST> (OS) LIST)
892 <OR <RESULT-TYPE .ARG>
893 <==? <NODE-TYPE .ARG> ,SEGMENT-CODE>
894 <MESSAGE ERROR "BAD ARG TO " <NODE-NAME .N> .ARG>>>
896 <COND (<AND <TYPE? <NODE-SUBR .N> FUNCTION>
897 <SET ACST <ACS <SET RN <GET .IT .IND>>>>
898 <OR <ASSIGNED? GROUP-NAME> <==? .FCN .RN>>>
899 <COND (<OR <=? .ACST '(STACK)> <=? .ACST '(FUNNY-STACK)>>
900 <SET KNWN <STACK-ARGS .N <>>>
903 <STACK-CALL <REQARGS .RN>
908 <OR <AC-ARGS .N .ACST> <AC-SEG-CALL .ACST>>
911 <EMIT <INSTRUCTION `PUSHJ `P* <1 <CHTYPE <NODE-NAME .RN>
913 <MOVE:ARG <FUNCTION:VALUE T> .W>)
914 (ELSE <SUBR-GEN .N .W>)>>
916 " Generate a call to an internal compiled goodies using a PUSHJ."
918 <DEFINE IRSUBR-GEN (NOD WHERE
919 "AUX" KNWN (N <NODE-SUBR .NOD>) (AN <2 .N>) (OS .STK)
921 #DECL ((NOD) NODE (WHERE) <OR ATOM DATUM> (STK) <SPECIAL LIST> (OS) LIST
922 (N) <IRSUBR ANY <LIST [REST FIX]>> (AN) <LIST [REST FIX]>)
924 <SET KNWN <STACK-ARGS .NOD <>>>
925 <STACK-CALL <MIN !.AN>
930 <MOVE:ARG <FUNCTION:VALUE T> .WHERE>>
932 " Get the arguemnts to a FUNCTION into the ACs."
934 <DEFINE ARGS-TO-ACS (NOD
935 "AUX" (RQRG <REQARGS .NOD>) (INAME <NODE-NAME .NOD>) (N 1)
936 (ACST <ACS .NOD>) TG1 TG2 TG)
937 #DECL ((N RQRG) FIX (INAME) <UVECTOR [REST ATOM]> (ACST) LIST (NOD) NODE)
939 (<MEMBER .ACST '![(STACK) (FUNNY-STACK)!]>
940 <COND (<AND <EMPTY? <REST .INAME>> <NOT <L? .RQRG 0>>>
942 <AND <G? .N .RQRG> <RETURN>>
943 <STACK:ARGUMENT <REFERENCE:ARG .N>>
945 <EMIT <INSTRUCTION `PUSHJ `P* <1 .INAME>>>
946 <EMIT '<`JRST |FINIS >>)
948 <EMIT '<`MOVE `A* `AB >>
950 <EMIT <INSTRUCTION `JUMPGE `AB* <SET TG1 <MAKE:TAG>>>>>
951 <LABEL:TAG <SET TG2 <MAKE:TAG>>>
952 <AND <L? .RQRG 0> <EMIT '<INTGO!-OP>>>
953 <STACK:ARGUMENT <REFERENCE:ARG 1>>
954 <EMIT <INSTRUCTION `ADD `AB* '[<2 (2)>]>>
955 <EMIT <INSTRUCTION `JUMPL `AB* .TG2>>
956 <AND <L=? .RQRG 0> <LABEL:TAG .TG1>>
958 <EMIT '<`ASH `A* -1>>
960 <EMIT <INSTRUCTION `ADDI `A* <SET TG <MAKE:TAG>>>>
961 <EMIT <INSTRUCTION `PUSHJ `P* `@ .RQRG '`(A) >>)
964 <EMIT <INSTRUCTION `PUSHJ `P* <1 .INAME>>>)>
965 <EMIT '<`JRST |FINIS >>
968 <AND <EMPTY? <REST .INAME>> <LABEL:TAG .TG>>
969 <EMIT <INSTRUCTION `SETZ <1 .INAME>>>
970 <AND <EMPTY? <SET INAME <REST .INAME>>>
974 <AND <EMPTY? .ACST> <RETURN>>
975 <RET-TMP-AC <MOVE:ARG <REFERENCE:ARG .N> <DATUM !<1 .ACST>>>>
977 <SET ACST <REST .ACST>>>
978 <EMIT <INSTRUCTION `PUSHJ `P* <1 .INAME>>>
979 <EMIT '<`JRST |FINIS >>)>>
981 " Push the args supplied in ACs onto the stack."
983 <DEFINE ACS-TO-STACK (ACST "AUX" (N 0))
984 #DECL ((N) FIX (ACST) LIST (VALUE) FIX)
988 <STACK:ARGUMENT <DATUM !.W>>
993 <DEFINE AC-SEG-CALL (ACS "AUX" (NARG <LENGTH .ACS>) TT OFFS)
994 #DECL ((OFFS NARG) FIX (ACS) LIST (TT) ADDRESS:C)
996 <EMIT <INSTRUCTION `CAIE `A* .NARG>>
997 <EMIT '<`JRST |COMPER >>)>
998 <SET OFFS <- 1 <SET NARG <* .NARG 2>>>>
1002 <SET TT <ADDRESS:C .OFFS '`(TP) >>
1003 <SET OFFS <+ .OFFS 2>>
1004 <RET-TMP-AC <MOVE:ARG <DATUM .TT .TT> <DATUM !.X>>>>
1006 <EMIT <INSTRUCTION `SUB `TP* [<FORM .NARG (.NARG)>]>>>
1008 " Generate PUSHJ in stack arg case (may go different places)"
1010 <DEFINE STACK-CALL (RQRG TRG INAME KNWN INT)
1011 #DECL ((TRG RQRG) FIX (INAME) <UVECTOR [REST ATOM]> (KNWN) <OR FIX FALSE>
1012 (INT) <OR ATOM FALSE>)
1014 (<L? .TRG 0> ;"TUPLE?"
1015 <COND (.KNWN <EMIT <INSTRUCTION `MOVEI `A* .KNWN>>)>
1020 <FORM MQUOTE!-OP!-PACKAGE
1021 <INTERNAL-RSUBR .INT -1 T>>>)
1022 (ELSE <INSTRUCTION `PUSHJ `P* <1 .INAME>>)>>)
1029 <EMIT <INSTRUCTION `CAIE `A* .RQRG>>
1030 <EMIT '<`JRST |COMPER >>)>
1035 <FORM MQUOTE!-OP!-PACKAGE
1036 <INTERNAL-RSUBR .INT .RQRG T>>>)
1037 (ELSE <INSTRUCTION `PUSHJ `P* <1 .INAME>>)>>)
1040 <EMIT <INSTRUCTION `CAIG `A* .TRG>>
1041 <EMIT <INSTRUCTION `CAIGE `A* .RQRG>>
1042 <EMIT '<`JRST |COMPER >>)>
1047 <PROG ((I <+ <- .TRG .RQRG> 2>))
1054 <FORM MQUOTE!-OP!-PACKAGE
1055 <INTERNAL-RSUBR .INT
1056 <- .TRG <SET I <- .I 1>>>
1058 (ELSE <FORM <NTH .INAME <SET I <- .I 1>>>>)>>>>>
1059 <EMIT <INSTRUCTION `PUSHJ `P* `@ <- .RQRG> `(A) >>)>)
1065 <FORM MQUOTE!-OP!-PACKAGE
1066 <INTERNAL-RSUBR .INT .KNWN T>>>)
1070 <NTH .INAME <- .TRG .KNWN -1>>>)>>)>)>>
1073 " Generate code for a stackform."
1075 <DEFINE STACKFORM-GEN (NOD WHERE
1076 "AUX" (K <KIDS .NOD>) TT T1 T2 TTT (PRE T) (OS .STK)
1080 <==? <NODE-TYPE <SET TT <1 .K>>> ,FGVAL-CODE>
1081 <==? <NODE-TYPE <SET TT <1 <KIDS .TT>>>>
1083 <GASSIGNED? <SET TTT <NODE-NAME .TT>>>
1086 #DECL ((NOD TT) NODE (K) <LIST [REST NODE]> (PRE) <SPECIAL ANY>
1087 (WHERE) <OR ATOM DATUM> (STK) <SPECIAL LIST> (OS) LIST)
1090 <RET-TMP-AC <STACK:ARGUMENT <GEN <1 .K> DONT-CARE>>>)>
1091 <PCOUNTER <COND (.SUBRC 0) (ELSE 1)>>
1093 <LABEL:TAG <SET T1 <MAKE:TAG>>>
1094 <PRED:BRANCH:GEN <SET T2 <MAKE:TAG>> <3 .K> <>>
1095 <RET-TMP-AC <STACK:ARGUMENT <GEN <2 .K> DONT-CARE>>>
1099 <SEGMENT:FINAL <COND (.SUBRC .SUBRC) (ELSE APPLY)>>
1101 <MOVE:ARG <FUNCTION:VALUE T> .WHERE>>
1103 " Generate code for a COND."
1105 <DEFINE COND-GEN (NOD WHERE
1106 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
1107 "AUX" SACS NWHERE (ALLSTATES ()) (SSTATE #SAVED-STATE ())
1108 (RW .WHERE) LOCN (COND <MAKE:TAG "COND">) W2
1109 (KK <CLAUSES .NOD>) (SDIR .DIR) (SACS-OK T)
1111 #DECL ((NOD) NODE (WHERE RW) <OR ATOM DATUM> (COND) ATOM (W2) DATUM
1112 (KK) <LIST [REST NODE]> (ALLSTATES) <LIST [REST SAVED-STATE]>
1113 (SSTATE) SAVED-STATE (LOCN) DATUM)
1114 <AND .NOTF <SET DIR <NOT .DIR>>>
1115 <COND (<AND ,FUDGE .BRANCH> <VAR-STORE>) (ELSE <SET SACS <SAVE:RES>> <REGSTO <>>)>
1116 <PREFER-DATUM .WHERE>
1117 <SET WHERE <GOODACS .NOD .WHERE>>
1118 <COND (<AND <TYPE? .WHERE DATUM>
1120 <OR <==? <ISTYPE? <RESULT-TYPE .NOD>> FALSE>
1121 <==? <ISTYPE? <DATTYP .W2>> FALSE>>>
1122 <SET WHERE <DATUM ANY-AC <DATVAL .W2>>>)>
1125 "AUX" (LAST <EMPTY? <REST .BRN>>) (BR <1 .BRN>) NEXT
1126 (K <CLAUSES .BR>) (PR <PREDIC .BR>) (NO-SEQ <>) (LEAVE <>)
1128 <COND (<TYPE? .WHERE DATUM> <DATUM !.WHERE>)
1129 (ELSE .WHERE)>) FLG (BRNCHED <>))
1130 #DECL ((PR BR) NODE (BRN) <LIST NODE> (K) <LIST [REST NODE]>)
1131 <OR <AND ,FUDGE .BRANCH> <SET SNUMSYM <SAVE-NUM-SYM .SACS>>>
1132 <RESTORE-STATE .SSTATE <AND <ASSIGNED? LOCN> <==? .LOCN ,NO-DATUM>>>
1136 (<OR <SET FLG <NOT <TYPE-OK? <RESULT-TYPE .PR> FALSE>>> .LAST>
1137 <OR .LAST <COND-COMPLAIN "NON REACHABLE COND CLAUSE(S) " <2 .BRN>>>
1138 <COND (<AND .FLG .BRANCH>
1140 <GEN .PR <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .W)>>>
1141 <COND (.DIR <BRANCH:TAG .BRANCH>)>)
1142 (<AND .BRANCH .LAST>
1144 <PRED:BRANCH:GEN .BRANCH
1147 <COND (<==? .RW FLUSHED> FLUSHED)
1152 <GEN .PR <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .W)>>>
1155 <COND (<==? .LOCN ,NO-DATUM>
1156 <SET SACS-OK <SAVE-TYP .PR>>
1157 <OR <AND ,FUDGE .BRANCH> <FIX-NUM-SYM .SNUMSYM .SACS>>)
1158 (<NOT <AND ,FUDGE .BRANCH>><SET ALLSTATES (<SAVE-STATE> !.ALLSTATES)>)>
1160 (<==? <ISTYPE? <RESULT-TYPE .PR>> FALSE> <GEN .PR FLUSHED>)
1162 <PRED:BRANCH:GEN <COND (<AND .BRANCH .SDIR> .BRANCH) (ELSE .COND)>
1169 (<AND .BRANCH .SDIR>
1170 <RET-TMP-AC <PRED:BRANCH:GEN .BRANCH .PR T FLUSHED .NOTF>>)
1177 <COND (<AND <TYPE? .W DATUM> <ISTYPE? <DATTYP .W>>>
1178 <PUT .W ,DATTYP ANY-AC>
1182 <SET SSTATE <SAVE-STATE>>
1183 <OR <==? <RESULT-TYPE .PR> FLUSHED>
1184 <AND ,FUDGE .BRANCH>
1185 <SET ALLSTATES (.SSTATE !.ALLSTATES)>>
1188 <SET NEXT <MAKE:TAG "PHRASE">>
1189 <COND (<==? <ISTYPE? <RESULT-TYPE .PR>> FALSE>
1190 <COND (<AND .BRANCH .LAST <NOT .DIR>>
1191 <SET LOCN <GEN .PR .W>>
1192 <BRANCH:TAG .BRANCH>)
1194 <COND (<AND .LAST <NOT <==? .RW FLUSHED>>>
1195 <SET LOCN <GEN .PR .W>>)
1196 (ELSE <SET LOCN <GEN .PR FLUSHED>>)>
1197 <AND <N==? .LOCN ,NO-DATUM> <BRANCH:TAG .NEXT>>)>
1199 <OR <AND ,FUDGE .BRANCH> <SET ALLSTATES (<SAVE-STATE> !.ALLSTATES)>>
1200 <COND-COMPLAIN "COND PREDICATE ALWAYS FALSE" .PR>)
1201 (<TYPE-OK? FALSE <RESULT-TYPE .PR>>
1202 <COND (<AND .LAST <NOT .DIR> .BRANCH>
1203 <RET-TMP-AC <PRED:BRANCH:GEN .BRANCH .PR <> .W .NOTF>>)
1204 (<AND .LAST .BRANCH>
1205 <RET-TMP-AC <PRED:BRANCH:GEN .NEXT .PR <> FLUSHED>>)
1206 (<AND .LAST <NOT <==? .RW FLUSHED>>>
1207 <RET-TMP-AC <PRED:BRANCH:GEN .NEXT .PR <> .W>>)
1208 (ELSE <PRED:BRANCH:GEN .NEXT .PR <> FLUSHED>)>
1209 <COND (<AND .LAST <N==? <RESULT-TYPE .PR> NO-RETURN>>
1210 <OR <AND ,FUDGE .BRANCH>
1211 <SET ALLSTATES (<SAVE-STATE> !.ALLSTATES)>>)
1212 (<==? <RESULT-TYPE .PR> NO-RETURN>
1213 <SET SACS-OK <SAVE-TYP <NTH .K <LENGTH .K>>>>
1214 <OR <AND ,FUDGE .BRANCH> <FIX-NUM-SYM .SNUMSYM .SACS>>)>)
1219 <COND-COMPLAIN "NON REACHABLE COND CLAUSE(S)"
1221 <SET SSTATE <SAVE-STATE>>
1231 <RESULT-TYPE <SET PR <NTH .K <LENGTH .K>>>> FALSE>>>
1232 <NOT <TYPE-OK? <RESULT-TYPE .PR> '<NOT FALSE>>>>
1234 <SEQ-GEN .K FLUSHED>
1235 <COND (<==? .RW FLUSHED> <SET LOCN ,NO-DATUM>)
1237 <SET LOCN <MOVE:ARG <REFERENCE <NOT .FLG>> .W>>)>)
1240 <COND (<OR <==? .RW FLUSHED>
1244 <AND <==? .FLG .SDIR> <SET BRNCHED T> <BRANCH:TAG .BRANCH>>)
1248 <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .W)>
1252 <AND .LAST .NO-SEQ <NOT .DIR> <BRANCH:TAG .BRANCH>>)
1256 <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .W)>
1261 <COND (<N==? .LOCN ,NO-DATUM>
1262 <OR <AND ,FUDGE .BRANCH> <SET ALLSTATES (<SAVE-STATE> !.ALLSTATES)>>)
1264 <SET SACS-OK <SAVE-TYP <NTH .K <LENGTH .K>>>>
1265 <OR <AND ,FUDGE .BRANCH> <FIX-NUM-SYM .SNUMSYM .SACS>>
1266 <RESTORE-STATE .SSTATE T>)>
1267 <COND (<AND <NOT .LAST> <N==? .LOCN ,NO-DATUM>>
1268 <OR .NO-SEQ <RET-TMP-AC .LOCN>>
1269 <OR .BRNCHED <BRANCH:TAG .COND>>)>
1272 <OR <ASSIGNED? NPRUNE> <PUT .BR ,CLAUSES ()>>
1273 <AND .LEAVE <MAPLEAVE>>>
1275 <OR <ASSIGNED? NPRUNE> <PUT .NOD ,CLAUSES ()>>
1276 <COND (<AND <TYPE? .WHERE DATUM> <N==? <RESULT-TYPE .NOD> NO-RETURN>>
1278 <AND <ISTYPE? <DATTYP .W2>>
1279 <TYPE? <DATTYP .LOCN> AC>
1280 <NOT <==? <DATTYP .W2> <DATTYP .LOCN>>>
1281 <RET-TMP-AC <DATTYP .LOCN> .LOCN>>
1282 <AND <TYPE? <DATTYP .W2> AC> <FIX-ACLINK <DATTYP .W2> .W2 .LOCN>>
1283 <AND <TYPE? <DATVAL .W2> AC> <FIX-ACLINK <DATVAL .W2> .W2 .LOCN>>)>
1286 <COND (<==? <RESULT-TYPE .NOD> NO-RETURN> ,NO-DATUM)
1287 (ELSE <MOVE:ARG .WHERE .RW>)>>
1288 <AND <N==? .NWHERE ,NO-DATUM> <NOT <AND ,FUDGE .BRANCH>> <MERGE-STATES .ALLSTATES>>
1289 <OR .BRANCH <CHECK:VARS .SACS .SACS-OK>>
1292 <DEFINE PSEQ-GEN (L W B D N)
1293 #DECL ((L) <LIST [REST NODE]>)
1295 <COND (<EMPTY? <REST .L>>
1296 <RETURN <COND (.B <PRED:BRANCH:GEN .B <1 .L> .D .W .N>)
1297 (ELSE <GEN <1 .L> .W>)>>)>
1298 <RET-TMP-AC <GEN <1 .L> FLUSHED>>
1301 <DEFINE COND-COMPLAIN (MSG N1) #DECL ((N1) NODE) <MESSAGE NOTE .MSG .N1>>
1303 <DEFINE SAVE-TYP (NOD)
1305 <==? <NODE-TYPE .NOD> ,RETURN-CODE>>
1307 <DEFINE MERGE-STATES (ALLSTATES)
1308 #DECL ((ALLSTATES) LIST)
1310 (<EMPTY? .ALLSTATES>
1312 <FUNCTION (AC "AUX" (NRES <ACRESIDUE .AC>))
1314 <MAPF <> <FUNCTION (X) <SMASH-INACS .X <>>> .NRES>)>
1315 <PUT .AC ,ACRESIDUE <>>>
1317 (ELSE <MAPF <> <FUNCTION (X) <MERGE-STATE .X>> .ALLSTATES>)>>
1319 " Fixup where its going better or something?"
1321 <DEFINE UPDATE-WHERE (NOD WHERE "AUX" TYP)
1322 #DECL ((NOD) NODE (WHERE VALUE) <OR ATOM DATUM>)
1323 <COND (<==? .WHERE FLUSHED> DONT-CARE)
1324 (<SET TYP <ISTYPE? <RESULT-TYPE .NOD>>> <REG? .TYP .WHERE>)
1325 (<==? .WHERE DONT-CARE> <DATUM ANY-AC ANY-AC>)
1328 " Generate code for OR use BOOL-GEN to do work."
1330 <DEFINE OR-GEN (NOD WHERE "OPTIONAL" (NF <>) (BR <>) (DIR T))
1332 <BOOL-GEN .NOD <CLAUSES .NOD> T .WHERE .NF .BR .DIR>>
1334 " Generate code for AND use BOOL-GEN to do work."
1336 <DEFINE AND-GEN (NOD WHERE "OPTIONAL" (NF <>) (BR <>) (DIR <>))
1338 <BOOL-GEN .NOD <CLAUSES .NOD> <> .WHERE .NF .BR .DIR>>
1340 <DEFINE BOOL-GEN (NOD PREDS RESULT WHERE NOTF BRANCH DIR
1341 "AUX" SACS (SSTATE ()) (SS #SAVED-STATE ()) (RW .WHERE)
1342 (BOOL <MAKE:TAG "BOOL">) (FLUSH <==? .RW FLUSHED>)
1343 (FLS <AND <NOT .BRANCH> .FLUSH>) RTF SRES
1344 (LOCN <DATUM ANY ANY>) FIN (SACS-OK T))
1345 #DECL ((PREDS) <LIST [REST NODE]> (SSTATE) <LIST [REST SAVED-STATE]>
1346 (SS) SAVED-STATE (NOTF DIR FLUSH FLS RTF) ANY (BOOL) ATOM
1347 (BRANCH) <OR ATOM FALSE> (WHERE RW) <OR DATUM ATOM> (NOD) NODE
1348 (LOCN) ANY (SRES RESULT) ANY)
1349 <COND (<AND ,FUDGE .BRANCH> <VAR-STORE <>>) (ELSE <SET SACS <SAVE:RES>> <REGSTO <>>)>
1350 <PREFER-DATUM .WHERE>
1351 <AND .NOTF <SET RESULT <NOT .RESULT>>>
1354 <AND <NOT .FLUSH> <==? .SRES .DIR> <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>>
1355 <AND .DIR <SET RESULT <NOT .RESULT>>>
1356 <SET WHERE <GOODACS .NOD .WHERE>>
1358 (<EMPTY? .PREDS> <SET LOCN <MOVE:ARG <REFERENCE .RESULT> .WHERE>>)
1362 "AUX" (BR <1 .BRN>) (LAST <EMPTY? <REST .BRN>>)
1363 (RT <RESULT-TYPE .BR>)
1365 <COND (<AND <TYPE? .WHERE DATUM>
1366 <ISTYPE? <DATTYP .WHERE>>
1368 <GOODACS .BR <DATUM ANY-AC <DATVAL .WHERE>>>)
1369 (<AND <OR <NOT .RTF> .LAST> <TYPE? .WHERE DATUM>>
1371 (<==? .RW FLUSHED> FLUSHED)
1372 (ELSE .WHERE)>) (RTFL <>))
1373 #DECL ((BRN) <LIST NODE> (BR) NODE (W) <OR ATOM DATUM>)
1374 <SET SS <SAVE-STATE>>
1376 (<AND <TYPE-OK? .RT FALSE> <NOT <SET RTFL <==? <ISTYPE? .RT> FALSE>>>>
1378 (<OR .BRANCH <AND .FLS <NOT .LAST>>>
1381 <PRED:BRANCH:GEN .BRANCH
1384 <COND (.FLUSH FLUSHED) (ELSE .W)>
1388 <PRED:BRANCH:GEN <COND (.FLS .BOOL)
1393 <COND (.RTF .W) (ELSE FLUSHED)>
1395 <COND (<AND <NOT <AND ,FUDGE .BRANCH>> <N==? .RT NO-RETURN>>
1396 <SET SSTATE (<SAVE-STATE> !.SSTATE)>)
1397 (<==? .RT NO-RETURN>
1398 <SET SACS-OK <SAVE-TYP .BR>>
1399 <RESTORE-STATE .SS T>)>)
1401 <SET LOCN <GEN .BR .W>>
1402 <COND (<AND <NOT <AND ,FUDGE .BRANCH>> <N==? .RT NO-RETURN>>
1403 <SET SSTATE (<SAVE-STATE> !.SSTATE)>)
1404 (<==? .RT NO-RETURN>
1405 <SET SACS-OK <SAVE-TYP .BR>>
1406 <RESTORE-STATE .SS T>)>
1409 <SET LOCN <PRED:BRANCH:GEN .BOOL .BR .DIR .W .NOTF>>
1410 <COND (<AND <NOT <AND ,FUDGE .BRANCH>> <N==? .RT NO-RETURN>>
1411 <SET SSTATE (<SAVE-STATE> !.SSTATE)>)
1412 (<==? .RT NO-RETURN>
1413 <SET SACS-OK <SAVE-TYP .BR>>
1414 <RESTORE-STATE .SS T>)>
1415 <RET-TMP-AC .LOCN>)>)
1416 (<OR <N==? .SRES <COND (.NOTF <SET RTFL <NOT .RTFL>>) (ELSE .RTFL)>>
1418 <OR .LAST <MESSAGE NOTE "NON REACHABLE AND/OR CLAUSE" <2 .BRN>>>
1421 <GEN .BR <COND (<N==? .DIR .RTFL> .W) (ELSE FLUSHED)>>>
1422 <AND <N==? .DIR .RTFL>
1423 <N==? .LOCN ,NO-DATUM>
1427 <BRANCH:TAG .BRANCH>>)
1428 (ELSE <SET LOCN <GEN .BR .W>>)>
1432 (ELSE <RET-TMP-AC <GEN .BR FLUSHED>>)>
1436 <OR <ASSIGNED? NPRUNE> <PUT .NOD ,CLAUSES ()>>
1437 <COND (<AND <TYPE? .WHERE DATUM> <TYPE? .LOCN DATUM>>
1438 <AND <NOT <==? <DATTYP .WHERE> <DATTYP .LOCN>>>
1439 <ISTYPE? <DATTYP .WHERE>>
1440 <TYPE? <DATTYP .LOCN> AC>
1441 <RET-TMP-AC <DATTYP .LOCN> .LOCN>>
1442 <AND <TYPE? <DATTYP .WHERE> AC>
1443 <FIX-ACLINK <DATTYP .WHERE> .WHERE .LOCN>>
1444 <AND <TYPE? <DATVAL .WHERE> AC>
1445 <FIX-ACLINK <DATVAL .WHERE> .WHERE .LOCN>>)>
1446 <OR <AND .BRANCH <NOT .RESULT>> <LABEL:TAG .BOOL>>
1448 <COND (<==? <RESULT-TYPE .NOD> NO-RETURN> ,NO-DATUM)
1449 (ELSE <OR <AND ,FUDGE .BRANCH>
1450 <MERGE-STATES .SSTATE>> <MOVE:ARG .WHERE .RW>)>>
1451 <OR <AND ,FUDGE .BRANCH> <CHECK:VARS .SACS .SACS-OK>>
1454 " Get the best set of acs around for this guy."
1456 <DEFINE GOODACS (N W1 "AUX" W)
1457 #DECL ((N) NODE (W) DATUM)
1458 <COND (<==? .W1 FLUSHED> DONT-CARE)
1461 <DATUM <COND (<OR <ISTYPE-GOOD? <DATTYP .W>>
1462 <ISTYPE-GOOD? <RESULT-TYPE .N>>>)
1463 (<TYPE? <DATTYP .W> AC> <DATTYP .W>)
1465 <COND (<TYPE? <DATVAL .W> AC> <DATVAL .W>)
1468 <DATUM <COND (<ISTYPE-GOOD? <RESULT-TYPE .N>>) (ELSE ANY-AC)>
1471 " Generate code for ASSIGNED?"
1473 <DEFINE ASSIGNED?-GEN (N W
1474 "OPTIONAL" (NF <>) (BR <>) (DIR <>)
1475 "AUX" (A <LOCAL-ADDR .N <>>) (SDIR .DIR)
1476 (FLS <==? .W FLUSHED>) B2)
1477 #DECL ((A) DATUM (N) NODE)
1478 <AND .NF <SET DIR <NOT .DIR>>>
1480 <COND (<AND .BR <NOT .FLS>> <NOT .DIR>) (ELSE .DIR)>>
1481 <EMIT <INSTRUCTION GETYP!-OP `O* !<ADDR:TYPE .A>>>
1482 <EMIT <INSTRUCTION <COND (.DIR `CAIE ) (ELSE `CAIN )>
1484 '<TYPE-CODE!-OP!-PACKAGE UNBOUND>>>
1486 <COND (<AND .BR .FLS> <BRANCH:TAG .BR> FLUSHED)
1488 <BRANCH:TAG <SET B2 <MAKE:TAG>>>
1489 <SET W <MOVE:ARG <REFERENCE .SDIR> .W>>
1494 <BRANCH:TAG <SET BR <MAKE:TAG>>>
1495 <TRUE-FALSE .N .BR .W>)>>
1497 <DEFINE TRUE-FALSE (N B W "OPTIONAL" (THIS T) "AUX" (RW .W) (B2 <MAKE:TAG>))
1498 #DECL ((N) NODE (B2 B) ATOM (W) <OR DATUM ATOM>)
1499 <SET W <UPDATE-WHERE .N .W>>
1500 <MOVE:ARG <REFERENCE .THIS> .W>
1504 <MOVE:ARG <REFERENCE <NOT .THIS>> .W>
1508 " Generate code for LVAL."
1510 <DEFINE LVAL-GEN (NOD WHERE
1511 "AUX" (SYM <NODE-NAME .NOD>) (TAC <>) (VAC <>) TT ADDR
1513 <COND (<==? <LENGTH <SET TT <TYPE-INFO .NOD>>> 2>
1516 #DECL ((NOD) NODE (SYM) SYMTAB (ADDR) <OR FALSE DATUM>
1517 (TAC VAC) <OR FALSE AC> (NO-KILL) LIST)
1519 <COND (<SET ADDR <INACS .SYM>>
1520 <AND <TYPE? <DATTYP <SET ADDR <DATUM !.ADDR>>> AC>
1521 <PUT <SET TAC <DATTYP .ADDR>>
1523 (.ADDR !<ACLINK .TAC>)>>
1524 <AND <TYPE? <DATVAL .ADDR> AC>
1525 <PUT <SET VAC <DATVAL .ADDR>>
1527 (.ADDR !<ACLINK .VAC>)>>
1528 <SET ADDR <MOVE:ARG .ADDR .WHERE>>)
1530 <SET ADDR <MOVE:ARG <LADDR .SYM <> <>> .WHERE>>
1531 <COND (<AND <TYPE? <SET TT <DATVAL .ADDR>> AC> <SET VAC .TT>>
1532 <AND <TYPE? <SET TT <DATTYP .ADDR>> AC> <SET TAC .TT>>
1533 <COND (<N==? <DATTYP .ADDR> DONT-CARE>
1534 <SMASH-INACS .SYM <DATUM !.ADDR>>
1535 <AND .TAC <PUT .TAC ,ACRESIDUE (.SYM)>>
1536 <AND .VAC <PUT .VAC ,ACRESIDUE (.SYM)>>)>)>)>
1542 <AND <==? <1 .LL> .SYM>
1546 <OR <STORED .SYM> <EMIT <MAKE:TAG <SPNAME <NAME-SYM .SYM>>>>>
1547 <SMASH-INACS .SYM <> <>>
1550 <PUT .TAC ,ACRESIDUE <RES-FLS <ACRESIDUE .TAC> .SYM>>>
1553 <PUT .VAC ,ACRESIDUE <RES-FLS <ACRESIDUE .VAC> .SYM>>>)>
1556 <DEFINE DELAY-KILL (L1 L2 "AUX" TT TAC SYM)
1557 #DECL ((L1 L2) <LIST [REST !<LIST SYMTAB <OR ATOM FALSE>>]> (SYM) SYMTAB)
1559 <COND (<OR <==? .L1 .L2> <NOT ,DEATH>> <RETURN>)>
1560 <COND (<2 <SET TT <1 .L1>>>
1561 <OR <STORED <SET SYM <1 .TT>>>
1562 <EMIT <MAKE:TAG <SPNAME <NAME-SYM .SYM>>>>>
1563 <COND (<SET TT <INACS .SYM>>
1564 <AND <TYPE? <SET TAC <DATTYP .TT>> AC>
1568 <RES-FLS <ACRESIDUE .TAC> .SYM>>>
1569 <AND <TYPE? <SET TAC <DATVAL .TT>> AC>
1573 <RES-FLS <ACRESIDUE .TAC> .SYM>>>
1574 <SMASH-INACS .SYM <>>)>)>
1575 <SET L1 <REST .L1>>>>
1577 <DEFINE RES-FLS (L S)
1578 #DECL ((L) <LIST [REST <OR TEMP SYMTAB COMMON>]> (S) SYMBOL)
1582 <REPEAT ((L1 .L) (LL .L))
1583 #DECL ((LL L1) <LIST [REST <OR TEMP SYMTAB COMMON>]>)
1584 <COND (<==? <1 .LL> .S>
1586 <RETURN <COND (<NOT <EMPTY? <SET L <REST .L>>>> .L)>>)
1587 (ELSE <PUTREST .L <REST .LL>> <RETURN .L1>)>)>
1588 <AND <EMPTY? <SET LL <REST <SET L .LL>>>> <RETURN .L1>>>)>>
1590 " Generate LVAL for free variable."
1592 <DEFINE FLVAL-GEN (NOD WHERE "AUX" T2 T1 TT)
1593 #DECL ((NOD) NODE (TT) SYMTAB (T2) DATUM)
1595 <COND (<TYPE? <SET T1 <NODE-NAME .NOD>> SYMTAB>
1597 <MOVE:ARG <REFERENCE <NAME-SYM .TT>>
1598 <SET T2 <DATUM ATOM <2 ,ALLACS>>>>)
1599 (ELSE <SET T2 <GEN <1 <KIDS .NOD>> <DATUM ATOM <2 ,ALLACS>>>>)>
1602 <MOVE:ARG <FUNCTION:VALUE T> .WHERE>>
1604 <DEFINE FSET-GEN (NOD WHERE "AUX" TT TEM T1 T2)
1605 #DECL ((NOD TEM) NODE (T1) SYMTAB (T2) DATUM)
1607 <COND (<TYPE? <SET TT <NODE-NAME .NOD>> SYMTAB>
1609 <SET T2 <MOVE:ARG <REFERENCE <NAME-SYM .T1>> DONT-CARE>>
1610 <SET TEM <2 <KIDS .NOD>>>)
1612 <SET T2 <GEN <1 <KIDS .NOD>> DONT-CARE>>
1613 <SET TEM <2 <KIDS .NOD>>>)>
1614 <SET TT <GEN .TEM <FUNCTION:VALUE>>>
1615 <SET T2 <MOVE:ARG .T2 <DATUM ATOM <3 ,ALLACS>>>>
1618 <MOVE:ARG .TT .WHERE>>
1620 " Generate code for an internal SET."
1622 <DEFINE SET-GEN (NOD WHERE
1623 "AUX" (SYM <NODE-NAME .NOD>)
1624 (TY <ISTYPE-GOOD? <1 <TYPE-INFO .NOD>>>) TEM
1625 (TYAC ANY-AC) (STORE-SET <>) (VAC ANY-AC) DAT1 (TT <>))
1626 #DECL ((NOD) NODE (ADDR TEM) DATUM (SYM) SYMTAB
1627 (STORE-SET) <SPECIAL ANY>)
1628 <COND (<TYPE? .WHERE DATUM>
1629 <AND <==? <DATVAL .WHERE> DONT-CARE> <PUT .WHERE ,DATVAL ANY-AC>>
1630 <AND <==? <DATTYP .WHERE> DONT-CARE> <PUT .WHERE ,DATTYP ANY-AC>>
1631 <AND <TYPE? <DATTYP .WHERE> AC> <SET TYAC <DATTYP .WHERE>>>
1632 <AND <TYPE? <DATVAL .WHERE> AC> <SET VAC <DATVAL .WHERE>>>)>
1633 <COND (<TYPE? .TYAC AC>
1634 <COND (<MEMQ .SYM <ACRESIDUE .TYAC>>
1638 <OR <==? .S .SYM> <STOREV .SYM>>>
1640 <PUT .TYAC ,ACRESIDUE (.SYM)>)
1641 (ELSE <MUNG-AC .TYAC .WHERE>)>)>
1642 <COND (<TYPE? .VAC AC>
1643 <COND (<MEMQ .SYM <ACRESIDUE .VAC>>
1647 <OR <==? .S .SYM> <STOREV .SYM>>>
1648 <CHTYPE <ACRESIDUE .VAC> LIST>>
1649 <PUT .VAC ,ACRESIDUE (.SYM)>)
1650 (ELSE <MUNG-AC .VAC .WHERE>)>)>
1652 <AND <OR <==? <SPEC-SYM .SYM> FUDGE> <NOT <SPEC-SYM .SYM>>>
1653 <OR <ARG? .SYM> <INIT-SYM .SYM>>
1654 <SET TY <ISTYPE-GOOD? <1 <DECL-SYM .SYM>>>>>>
1655 '<COND (<AND <SET TT <INACS .SYM>>
1659 <MEMQ .SYM <LOOP-VARS <1 <PROG-AC .SYM>>>>
1660 <OR <==? .TY <DATTYP .TT>>
1662 <TYPE? <DATTYP .TT> AC>
1663 <SET TYAC <DATTYP .TT>>>>>
1664 <SET VAC <DATVAL .TT>>)>
1666 <GEN <2 <KIDS .NOD>>
1667 <COND (.TY <DATUM .TY .VAC>)
1668 (ELSE <SET TY <>> <DATUM .TYAC .VAC>)>>>
1669 <REPEAT ((TT .TEM) AC)
1670 #DECL ((TT) <PRIMTYPE LIST> (AC) AC)
1671 <COND (<EMPTY? .TT> <RETURN>)
1673 <OR <MEMQ .TEM <ACLINK <SET AC <1 .TT>>>>
1674 <PUT .AC ,ACLINK (.TEM !<ACLINK .AC>)>>
1675 <OR <MEMQ .SYM <ACRESIDUE .AC>>
1676 <PUT .AC ,ACRESIDUE (.SYM !<ACRESIDUE .AC>)>>)>
1677 <SET TT <REST .TT>>>
1678 <COND (<SET DAT1 <INACS .SYM>>
1679 <COND (<TYPE? <DATTYP .DAT1> AC>
1680 <OR <MEMQ <DATTYP .DAT1> .TEM>
1681 <FLUSH-RESIDUE <DATTYP .DAT1> .SYM>>)>
1682 <COND (<TYPE? <DATVAL .DAT1> AC>
1683 <OR <MEMQ <DATVAL .DAT1> .TEM>
1684 <FLUSH-RESIDUE <DATVAL .DAT1> .SYM>>)>)>
1685 <COND (<TYPE? <DATVAL .TEM> AC> <SMASH-INACS .SYM <DATUM !.TEM>>)>
1686 <PUT .SYM ,STORED .STORE-SET>
1688 <FLUSH-COMMON-SYMT .SYM>
1689 <MOVE:ARG .TEM .WHERE>>
1692 <DEFINE ARG? (SYM) #DECL ((SYM) SYMTAB) <1? <NTH ,ARGTBL <CODE-SYM .SYM>>>>
1694 <SETG ARGTBL ![0 0 0 0 1 0 0 0 0 1 0 1 1!]>
1696 <GDECL (ARGTBL) <UVECTOR [REST FIX]>>
1698 " Update the stack model with a FIX or an ATOM."
1700 <DEFINE ADD:STACK (THING)
1701 #DECL ((STK) <LIST FIX>)
1702 <COND (<TYPE? .THING FIX> <PUT .STK 1 <+ <1 .STK> .THING>>)
1703 (<OR <==? .THING PSLOT> <==? .THING PSTACK>>
1704 <SET STK (0 .THING !.STK)>)
1705 (<TYPE? .THING ATOM>
1706 <SET STK (0 <FORM GVAL .THING> !.STK)>)
1707 (ELSE <MESSAGE INCONSISTENCY "BAD CALL TO ADD:STACK ">)>>
1709 " Return the current distance between two stack places."
1711 <DEFINE STACK:L (FROM TO "AUX" (LN 0) (TF 0) (LF ()))
1712 #DECL ((LN TF) FIX (FROM TO) LIST (VALUE) <OR FALSE LIST>)
1714 <AND <==? <SET T <1 .FROM>> PSTACK> <RETURN <>>>
1715 <COND (<N==? .T PSLOT>
1716 <COND (<NOT <TYPE? .T FIX>> <SET LF (.T !.LF)>)
1717 (ELSE <SET TF .T> <SET LN <+ .LN .TF>>)>)>
1718 <AND <==? .TO .FROM> <RETURN (.LN !.LF)>>
1719 <SET FROM <REST .FROM>>>>
1721 " Compute the address of a local variable using the stack model."
1723 <DEFINE LOCAL-ADDR (NOD STYP "AUX" (S <NODE-NAME .NOD>))
1724 #DECL ((NOD) NODE (S) SYMTAB)
1725 <LADDR .S <> .STYP>>
1727 <DEFINE LADDR (S LOSER STYP
1728 "OPTIONAL" (NOSTORE T)
1729 "AUX" TEM T2 T3 T4 (FRMS .FRMS) (AC-HACK .AC-HACK)
1731 #DECL ((S) SYMTAB (T4) ADDRESS:C (VALUE TEM) DATUM (FRMS NTSLOTS) LIST)
1734 (<SET T2 <INACS .S>>
1735 <COND (<TYPE? <DATTYP <SET T2 <DATUM !.T2>>> AC>
1736 <PUT <DATTYP .T2> ,ACLINK (.T2 !<ACLINK <DATTYP .T2>>)>)>
1737 <COND (<TYPE? <DATVAL .T2> AC>
1738 <PUT <DATVAL .T2> ,ACLINK (.T2 !<ACLINK <DATVAL .T2>>)>)>
1742 <COND (<AND .NOSTORE <TYPE? <NUM-SYM .S> LIST> <1 <NUM-SYM .S>>>
1743 <PUT <NUM-SYM .S> 1 <>>)>
1745 (<AND <TYPE? <ADDR-SYM .S> TEMPV> <==? <1 .FRMS> <FRMNO .S>>>
1747 (<=? .AC-HACK '(STACK)>
1750 !<FIX:ADDR (-1 !<STACK:L .STK <1 <ADDR-SYM .S>>>)
1751 <REST <ADDR-SYM .S>>>
1754 <ADDRESS:C !<REST <ADDR-SYM .S>>
1755 <COND (<=? .AC-HACK '(FUNNY-STACK)> `(FRM) )
1757 <COND (<=? .AC-HACK '(FUNNY-STACK)> 1) (ELSE 0)>>>)>
1759 (<TYPE? <ADDR-SYM .S> DATUM> <DATUM !<ADDR-SYM .S>>)
1760 (<TYPE? <ADDR-SYM .S> FIX TEMPV>
1762 (<AND .AC-HACK <=? .AC-HACK '(STACK)> <==? <1 .FRMS> <FRMNO .S>>>
1765 !<FIX:ADDR (-1 !<STACK:L .STK .BSTB>)
1767 !<COND (<TYPE? <ARGNUM-SYM .S> ATOM>
1768 <MEMBER <FORM GVAL <ARGNUM-SYM .S>> .NTSLOTS>)
1772 (<==? <1 .FRMS> <FRMNO .S>>
1773 <SPEC:REFERENCE:STACK
1776 !<COND (<TYPE? <ARGNUM-SYM .S> FIX>
1777 <COND (<NOT .AC-HACK>
1778 <REST .NTSLOTS <- <LENGTH .NTSLOTS> 1>>)
1780 (<AND .PRE <NOT <SPEC-SYM .S>>> .NTSLOTS)
1781 (ELSE <MEMBER <FORM GVAL <ARGNUM-SYM .S>> .NTSLOTS>)>)>)
1782 (<REPEAT ((FRMS .FRMS) NNTSLTS (LB <>) (OFFS (0 ())) (CURR <>))
1783 #DECL ((FRMS NNTSLTSJ) LIST (OFFS) <LIST [2 <OR FIX LIST>]>)
1785 (<SET CURR <==? <4 .FRMS> FUZZ>>
1789 <- ,OTBSAV <1 .OFFS> 1>
1790 <DATUM <ADDRESS:PAIR |$TTB > .T3>
1792 (<FORM - 0 !<2 .OFFS>>)>>
1798 <- ,OTBSAV <1 .OFFS> 1>
1799 <DATUM <ADDRESS:PAIR |$TTB >
1800 <ADDRESS:PAIR |$TTB `TB >>
1802 (<FORM - 0 !<2 .OFFS>>)>>
1803 <SET OFFS (0 ())>)>)
1804 (ELSE <SET OFFS <STFIXIT .OFFS <4 .FRMS>>>)>
1805 <AND <EMPTY? <SET FRMS <REST .FRMS 5>>>
1806 <MESSAGE INCONSISTANCY "BAD FRAME MODEL ">>
1808 <==? <FRMNO .S> <1 .FRMS>>
1810 (<COND (<TYPE? <ADDR-SYM .S> FIX>
1811 (<+ <ADDR-SYM .S> <- <1 .OFFS>>>))
1813 <FIX:ADDR (<1 .OFFS>)
1814 <REST <CHTYPE <ADDR-SYM .S> LIST>>>)>
1815 (<FORM - 0 !<2 .OFFS>>))>
1816 <SET NNTSLTS <5 .FRMS>>
1823 <DATUM <ADDRESS:PAIR |$TTB > .T3>
1826 !<COND (<TYPE? <ARGNUM-SYM .S> ATOM>
1827 <MEMBER <FORM GVAL <ARGNUM-SYM .S>> .NNTSLTS>)
1828 (ELSE <REST .NNTSLTS <- <LENGTH .NNTSLTS> 1>>)>)>>
1833 !<COND (<TYPE? <ARGNUM-SYM .S> ATOM>
1834 <MEMBER <FORM GVAL <ARGNUM-SYM .S>> .NNTSLTS>)
1835 (<AND <TYPE? <ADDR-SYM .S> FIX>
1836 <G=? <CODE-SYM .S> 6>
1837 <L=? <CODE-SYM .S> 9>
1838 <N=? <ACS <3 .FRMS>> '(STACK)>>
1839 <REST .NNTSLTS <- <LENGTH .NNTSLTS> 1>>)
1841 !<2 .OFFS>)>)>>>>)>)
1842 (ELSE <MESSAGE INCONSISTENCY "BAD VARIABLE ADDRESS ">)>)>>
1843 <COND (<AND <NOT .LOSER>
1845 <OR <ARG? .S> <INIT-SYM .S>>
1846 <SET T2 <ISTYPE-GOOD? <1 <DECL-SYM .S>>>>>
1847 <DATUM .T2 <DATVAL .TEM>>)
1848 (<AND <NOT .LOSER> .STYP <SET T2 <ISTYPE-GOOD? .STYP>>>
1849 <DATUM .T2 <DATVAL .TEM>>)
1852 <DEFINE STFIXIT (OFF FRM "AUX" (NF 0) (NX ()))
1853 #DECL ((NF) FIX (NX) LIST (OFF) <LIST FIX LIST> (FRM) LIST)
1856 <COND (<TYPE? .IT FIX> <SET NF <+ .NF .IT>>)
1857 (ELSE <SET NX (.IT !.NX)>)>>
1859 (<+ <1 .OFF> .NF> (!.NX !<2 .OFF>))>
1861 " Generate obscure stuff."
1863 <DEFINE DEFAULT-GEN (NOD WHERE)
1865 <MOVE:ARG <REFERENCE <NODE-NAME .NOD>> .WHERE>>
1867 " Do GVAL using direct locative reference."
1869 <DEFINE GVAL-GEN (N W
1870 "AUX" (GD <GLOC? <NODE-NAME <1 <KIDS .N>>>>)
1871 (RT <ISTYPE-GOOD? <RESULT-TYPE .N>>))
1873 <SET GD <OFFPTR 0 .GD VECTOR>>
1874 <MOVE:ARG <DATUM <COND (.RT) (ELSE .GD)> .GD> .W>>
1876 " Do SETG using direct locative reference."
1878 <DEFINE SETG-GEN (N W
1879 "AUX" GD DD (NN <2 <KIDS .N>>) (FA <FREE-ACS T>)
1880 (RT <ISTYPE-GOOD? <RESULT-TYPE .N>>)
1884 <COND (<==? .W FLUSHED> DONT-CARE)
1886 <SET DD <GOODACS .N .W>>
1887 <COND (<NOT <TYPE? <DATTYP .DD> AC>>
1888 <PUT .DD ,DATTYP ANY-AC>)>
1890 (<AND .RT <G=? .FA 2>> <GOODACS .N .W>)
1891 (ELSE DONT-CARE)>>))
1892 #DECL ((N NN) NODE (D) DATUM (FA) FIX)
1893 <SET GD <OFFPTR 0 <SET GD <GLOC? <NODE-NAME <1 <KIDS .N>>>>> VECTOR>>
1894 <MOVE:ARG .D <SET GD <DATUM .GD .GD>> T>
1895 <COND (<AND <OR <AND <TYPE? <DATTYP .D> ATOM>
1896 <ISTYPE-GOOD? <DATTYP .D>>>
1897 <TYPE? <DATTYP .D> AC>>
1898 <TYPE? <DATVAL .D> AC>>
1901 (ELSE <RET-TMP-AC .D> <MOVE:ARG .GD .W>)>>
1909 <DEFINE GLOC? (ATM "AUX" GL)
1913 <MOVE:ARG <REFERENCE <RGLOC .ATM T>> <DATUM LOCR ANY-AC>>>
1914 <EMIT <INSTRUCTION `ADD
1915 <ACSYM <CHTYPE <DATVAL .GL> AC>>
1918 <RET-TMP-AC <DATTYP .GL> .GL>
1919 <PUT .GL ,DATTYP VECTOR>
1921 (ELSE <REFERENCE <GLOC .ATM T>>)>>
1925 " Generate GVAL calls."
1927 <DEFINE FGVAL-GEN (NOD WHERE)
1929 <RET-TMP-AC <GEN <1 <KIDS .NOD>> <DATUM ATOM ,AC-B>>>
1932 <MOVE:ARG <FUNCTION:VALUE T> .WHERE>>
1934 " Generate a SETG call."
1936 <DEFINE FSETG-GEN (NOD WHERE "AUX" TT TEM)
1937 #DECL ((NOD) NODE (TT TEM) DATUM)
1938 <SET TT <GEN <1 <KIDS .NOD>> DONT-CARE>>
1939 <SET TEM <GEN <2 <KIDS .NOD>> <FUNCTION:VALUE>>>
1940 <SET TT <MOVE:ARG .TT <DATUM ATOM <3 ,ALLACS>>>>
1941 <PUT <3 ,ALLACS> ,ACPROT T>
1942 <MOVE:ARG .TEM <SET TEM <FUNCTION:VALUE>>>
1943 <PUT <3 ,ALLACS> ,ACPROT <>>
1947 <MOVE:ARG .TEM .WHERE>>
1949 <DEFINE CHTYPE-GEN (NOD WHERE
1950 "AUX" (TYP <ISTYPE? <RESULT-TYPE .NOD>>) (N <1 <KIDS .NOD>>)
1953 <COND (<ISTYPE? <RESULT-TYPE .N>>)
1954 (<MEMQ <NODE-TYPE .N> ,SNODES> DONT-CARE)
1956 #DECL ((NOD N) NODE (TEM) DATUM (WHERE) <OR ATOM DATUM>)
1957 <COND (<TYPE? .WHERE ATOM>
1958 <COND (<ISTYPE-GOOD? .TYP>
1959 <SET TEM <GEN .N DONT-CARE>>
1961 <PUT .TEM ,DATTYP .TYP>)
1963 <SET TEM <GEN .N <DATUM ANY-AC ANY-AC>>>
1964 <MUNG-AC <DATTYP .TEM> .TEM>
1965 <EMIT <INSTRUCTION `HRLI
1966 <ACSYM <CHTYPE <DATTYP .TEM> AC>>
1967 <FORM TYPE-CODE!-OP!-PACKAGE .TYP>>>
1968 <MOVE:ARG .TEM .WHERE>)>)
1969 (<ISTYPE-GOOD? .TYP>
1970 <COND (<AND <==? <LENGTH .WHERE> 2> <TYPE? <DATVAL .WHERE> AC>>
1971 <DATTYP-FLUSH <SET TEM <GEN .N <DATUM .ITYP <DATVAL .WHERE>>>>>
1972 <PUT .TEM ,DATTYP .TYP>
1973 <MOVE:ARG .TEM .WHERE>)
1975 <DATTYP-FLUSH <SET TEM <GEN .N <DATUM .ITYP ANY-AC>>>>
1976 <PUT .TEM ,DATTYP .TYP>
1977 <MOVE:ARG .TEM .WHERE>)>)
1979 <SET TEM <GEN .N <DATUM ANY-AC ANY-AC>>>
1980 <MUNG-AC <DATTYP .TEM> .TEM>
1981 <EMIT <INSTRUCTION `HRLI
1982 <ACSYM <CHTYPE <DATTYP .TEM> AC>>
1983 <FORM TYPE-CODE!-OP!-PACKAGE .TYP>>>
1984 <MOVE:ARG .TEM .WHERE>)>>
1986 " Generate do-nothing piece of code."
1988 <DEFINE ID-GEN (N W) #DECL ((N) NODE) <GEN <1 <KIDS .N>> .W>>
1990 <DEFINE UNWIND-GEN (N W
1991 "AUX" (OSTK .STK) (STK (0 !.STK)) (UNBRANCH <MAKE:TAG>)
1992 (NOUNWIND <MAKE:TAG>) W1)
1993 #DECL ((N) NODE (STK) <SPECIAL LIST> (OSTK) LIST (W1) DATUM)
1995 <EMIT <INSTRUCTION `MOVEI `C* .UNBRANCH>>
1996 <EMIT <INSTRUCTION `SUBI `C* `(M) >>
1997 <EMIT <INSTRUCTION `PUSHJ `P* |IUNWIN >>
1999 <RET-TMP-AC <SET W1 <GEN <1 <KIDS .N>> <GOODACS .N .W>>>>
2002 <EMIT '<`PUSHJ `P* |POPUNW>>
2003 <BRANCH:TAG .NOUNWIND>
2004 <LABEL:TAG .UNBRANCH>
2005 <GEN <2 <KIDS .N>> FLUSHED>
2007 <EMIT '<`JRST |UNWIN2 >>
2008 <LABEL:TAG .NOUNWIND>
2009 <AND <TYPE? <DATTYP .W1> AC> <SGETREG <DATTYP .W1> .W1>>
2010 <AND <TYPE? <DATVAL .W1> AC> <SGETREG <DATVAL .W1> .W1>>
2011 <POP:LOCS .STK .OSTK>
2015 " Generate call to READ etc. with eof condition."
2017 <DEFINE READ2-GEN (N W
2018 "AUX" (OSTK .STK) (STK (0 !.STK)) (I 0) SPOB BRANCH
2019 (PSJ <MEMQ <NODE-NAME .N> '![READCHR NEXTCHR!]>))
2020 #DECL ((N) NODE (STK) <SPECIAL LIST> (OSTK) LIST (I) FIX (SPOB) NODE)
2023 #DECL ((OB SPOB) NODE (I) FIX)
2025 <COND (<==? <NODE-TYPE .OB> ,EOF-CODE> <SET SPOB .OB>)
2026 (ELSE <RET-TMP-AC <GEN .OB <DATUM ,AC-A ,AC-B>>>)>)
2028 <COND (<==? <NODE-TYPE .OB> ,EOF-CODE>
2032 (ELSE <RET-TMP-AC <STACK:ARGUMENT <GEN .OB DONT-CARE>>>)>
2038 <EMIT <INSTRUCTION `PUSHJ
2040 <COND (<==? <NODE-NAME .N> READCHR> |CREADC )
2043 <BRANCH:TAG <SET BRANCH <MAKE:TAG>>>)
2045 <SUBR:CALL <NODE-NAME .N> .I>
2046 <SET BRANCH <TIME:CHECK>>)>
2048 <RET-TMP-AC <GEN .SPOB
2049 <COND (<==? .W FLUSHED> .W) (ELSE <FUNCTION:VALUE>)>>>
2052 <MOVE:ARG <FUNCTION:VALUE T> .W>>
2054 <DEFINE GET-GEN (N W) <GETGET .N .W T>>
2056 <DEFINE GET2-GEN (N W) <GETGET .N .W <>>>
2058 <GDECL (GETTERS) UVECTOR>
2060 <DEFINE GETGET (N W REV
2061 "AUX" (K <KIDS .N>) PITEM PINDIC (BR <MAKE:TAG>)
2062 (INDX <LENGTH <CHTYPE <MEMQ <NODE-SUBR .N> ,GETTERS> UVECTOR>>)
2064 #DECL ((N) NODE (K) <LIST NODE NODE [REST NODE]> (PITEM PINDIC) DATUM
2066 <SET PITEM <GEN <1 .K> <DATUM ,AC-A ,AC-B>>>
2067 <SET PINDIC <GEN <2 .K> <DATUM ,AC-C ,AC-D>>>
2068 <SET PITEM <MOVE:ARG .PITEM <DATUM ,AC-A ,AC-B>>>
2069 <RET-TMP-AC <MOVE:ARG .PINDIC <DATUM ,AC-C ,AC-D>>>
2072 <EMIT <INSTRUCTION `PUSHJ
2074 <NTH '![|CIGETP |CIGTPR |CIGETL |CIGET !] .INDX>>>
2075 <COND (<==? .LN 2> <EMIT '<`JFCL >>)
2080 <RET-TMP-AC <STACK:ARGUMENT <GEN <3 .K> DONT-CARE>>>
2083 (ELSE <RET-TMP-AC <GEN <3 .K> <FUNCTION:VALUE>>>)>
2086 <MOVE:ARG <FUNCTION:VALUE T> .W>>
2089 <DEFINE REG? (TYP TRY
2090 "OPTIONAL" (GETIT <>)
2091 "AUX" (FUNNY <MEMQ <TYPEPRIM .TYP> '![STRING BYTES FRAME TUPLE LOCD!]>)
2094 <COND (<AND <TYPE? .TRY1 DATUM>
2096 <AND <EMPTY? .TRY1> <RETURN <>>>
2097 <AND <TYPE? <DATVAL .TRY1> AC> <RETURN T>>
2098 <SET TRY1 <REST .TRY1 2>>>>
2099 <DATUM <COND (.FUNNY <DATTYP .TRY1>) (ELSE .TYP)>
2102 <COND (.GETIT <ANY2ACS>) (ELSE <DATUM ANY-AC ANY-AC>)>)
2104 <DATUM .TYP <COND (.GETIT <GETREG <>>) (ELSE ANY-AC)>>)>>
2106 <SETG GETTERS ![,GET ,GETL ,GETPROP ,GETPL!]>
2108 <COND (<GASSIGNED? ARITH-GEN>
2110 <DISPATCH ,DEFAULT-GEN
2111 (,FORM-CODE ,FORM-GEN)
2112 (,PROG-CODE ,PROG-REP-GEN)
2113 (,SUBR-CODE ,SUBR-GEN)
2114 (,COND-CODE ,COND-GEN)
2115 (,LVAL-CODE ,LVAL-GEN)
2116 (,SET-CODE ,SET-GEN)
2118 (,AND-CODE ,AND-GEN)
2119 (,RETURN-CODE ,RETURN-GEN)
2120 (,COPY-CODE ,COPY-GEN)
2121 (,AGAIN-CODE ,AGAIN-GEN)
2123 (,ARITH-CODE ,ARITH-GEN)
2124 (,RSUBR-CODE ,RSUBR-GEN)
2125 (,0-TST-CODE ,0-TEST)
2126 (,NOT-CODE ,NOT-GEN)
2128 (,TEST-CODE ,TEST-GEN)
2130 (,TY?-CODE ,TYPE?-GEN)
2131 (,LNTH-CODE ,LNTH-GEN)
2133 (,REST-CODE ,REST-GEN)
2134 (,NTH-CODE ,NTH-GEN)
2135 (,PUT-CODE ,PUT-GEN)
2136 (,PUTR-CODE ,PUTREST-GEN)
2137 (,FLVAL-CODE ,FLVAL-GEN)
2138 (,FSET-CODE ,FSET-GEN)
2139 (,FGVAL-CODE ,FGVAL-GEN)
2140 (,FSETG-CODE ,FSETG-GEN)
2141 (,STACKFORM-CODE ,STACKFORM-GEN)
2142 (,MIN-MAX-CODE ,MIN-MAX)
2143 (,CHTYPE-CODE ,CHTYPE-GEN)
2144 (,FIX-CODE ,FIX-GEN)
2145 (,FLOAT-CODE ,FLOAT-GEN)
2146 (,ABS-CODE ,ABS-GEN)
2147 (,MOD-CODE ,MOD-GEN)
2149 (,ASSIGNED?-CODE ,ASSIGNED?-GEN)
2150 (,ISTRUC-CODE ,ISTRUC-GEN)
2151 (,ISTRUC2-CODE ,ISTRUC-GEN)
2152 (,BITS-CODE ,BITS-GEN)
2153 (,GETBITS-CODE ,GETBITS-GEN)
2154 (,BITL-CODE ,BITLOG-GEN)
2155 (,PUTBITS-CODE ,PUTBITS-GEN)
2156 (,ISUBR-CODE ,ISUBR-GEN)
2158 (,READ-EOF2-CODE ,READ2-GEN)
2159 (,READ-EOF-CODE ,SUBR-GEN)
2160 (,IPUT-CODE ,IPUT-GEN)
2161 (,IREMAS-CODE ,IREMAS-GEN)
2162 (,GET-CODE ,GET-GEN)
2163 (,GET2-CODE ,GET2-GEN)
2164 (,IRSUBR-CODE ,IRSUBR-GEN)
2165 (,MAP-CODE ,MAPFR-GEN)
2166 (,MARGS-CODE ,MPARGS-GEN)
2167 (,MAPLEAVE-CODE ,MAPLEAVE-GEN)
2168 (,MAPRET-STOP-CODE ,MAPRET-STOP-GEN)
2169 (,UNWIND-CODE ,UNWIND-GEN)
2170 (,GVAL-CODE ,GVAL-GEN)
2171 (,SETG-CODE ,SETG-GEN)
2172 (,TAG-CODE ,TAG-GEN)
2173 (,PRINT-CODE ,PRINT-GEN)
2174 (,MEMQ-CODE ,MEMQ-GEN)
2175 (,LENGTH?-CODE ,LENGTH?-GEN)
2176 (,FORM-F-CODE ,FORM-F-GEN)
2177 (,INFO-CODE ,INFO-GEN)
2178 (,OBLIST?-CODE ,OBLIST?-GEN)
2179 (,AS-NXT-CODE ,AS-NXT-GEN)
2180 (,AS-IT-IND-VAL-CODE ,ASSOC-FIELD-GET)
2181 (,ALL-REST-CODE ,ALL-REST-GEN)
2182 (,COPY-LIST-CODE ,LIST-BUILD)
2183 (,PUT-SAME-CODE ,SPEC-PUT-GEN)
2184 (,BACK-CODE ,BACK-GEN)
2185 (,TOP-CODE ,TOP-GEN)
2186 (,SUBSTRUC-CODE ,SUBSTRUC-GEN)
2187 (,ROT-CODE ,ROT-GEN)
2188 (,LSH-CODE ,LSH-GEN)
2189 (,BIT-TEST-CODE ,BIT-TEST-GEN)>>