55 <SETG THE-UNBOUND <CHTYPE 0 T$UNBOUND>>
57 " This file contains the major general codde generators. These include
58 variable access functions (LVAL, SETG etc.), FSUBRs (COND, AND, REPEAT)
59 and a few assorted others."
61 " Main generator, dispatches to specific code generators. "
63 <DEFINE GEN (NOD "OPT" (WHERE DONT-CARE) "AUX" TEMP)
65 <SET TEMP <GEN-DISPATCH .NOD .WHERE>>
66 <OR <ASSIGNED? NPRUNE> <PUT .NOD ,KIDS ()>>
69 " Generate a sequence of nodes flushing all values except the ladt."
71 <DEFINE SEQ-GEN (L WHERE
72 "OPTIONAL" (INPROG <>) (SINPROG <>) (INCODE-GEN <>)
74 #DECL ((K L) <LIST [REST NODE]> (LAST) NODE)
76 <FUNCTION (N "AUX" (ND <1 .N>) NX W)
77 #DECL ((N) <LIST NODE> (ND) NODE)
78 <COND (<NOT <EMPTY? <REST .N>>>
80 <COND (<AND <==? <NODE-TYPE .NX> ,CALL-CODE>
81 <G=? <LENGTH <SET K <KIDS .NX>>> 2>
82 <==? <NODE-NAME <1 .K>> `ENDIF>>
83 <SET W <GEN .ND .WHERE>>
84 <COND (<AND <NOT .WSET>
87 <N==? .WHERE ,POP-STACK>>
88 <SET WHERE <FIXUP-TEMP .WHERE .W>>
90 <COND (<NOT <EMPTY? <REST .N 2>>>
91 <DEALLOCATE-TEMP .WHERE>)>)
92 (<OR <AND <G=? <LENGTH .ND>
93 <CHTYPE <INDEX ,SIDE-EFFECTS> FIX>>
95 <GETPROP .ND DONT-FLUSH-ME>
98 (<AND <==? <NODE-TYPE .ND> ,CALL-CODE>
99 <G=? <LENGTH <SET K <KIDS .ND>>> 2>
100 <==? <NODE-NAME <1 .K>> `ENDIF>>
102 (ELSE <SET WHERE <GEN .ND .WHERE>>)>>
106 " The main code generation entry (called from CDRIVE). Sets up initial
107 stack model, calls to generate code for the bindings and generates code for
108 the function's body."
110 <DEFINE CODE-GEN (BASEF EXTRA-CODE
111 "AUX" (K <KIDS .BASEF>) CD (NO-KILL ()) (KILL-LIST ())
112 (ATAG <MAKE-TAG "AGAIN">) (RTAG <MAKE-TAG "RETURN">)
113 (CODE-START .EXTRA-CODE) (CODE-PTR .CODE-START)
114 (EVERY-TEMP ()) ARGS-NEXT TMPS TMPS-NEXT (STK 0)
115 (FREE-TEMPS ()) (ALL-TEMPS-LIST ()) TMP-DEST SPECD
116 BNDTMP STKTMP (STK-CHARS7 0) (STK-CHARS8 0))
117 #DECL ((STK-CHARS7 STK-CHARS8 STK) <SPECIAL FIX> (STKTMP) <SPECIAL
119 (BASEF) <SPECIAL NODE>
120 (KILL-LIST NO-KILL CODE-START CODE-PTR TMPS-NEXT ARGS-NEXT
121 EVERY-TEMP ALL-TEMPS-LIST) <SPECIAL LIST> (TMPS) <SPECIAL
123 (K) <LIST [REST NODE]> (ATAG RTAG) ATOM
124 (TMP-DEST) <SPECIAL ATOM> (SPECD) <SPECIAL ANY>
125 (FREE-TEMPS) <SPECIAL <LIST [REST TEMP]>>)
126 <MIM-FCN <NODE-NAME .BASEF>
128 <OR <ACTIVATED .BASEF>
129 <ACTIV? <BINDING-STRUCTURE .BASEF>>
130 <GETPROP <NODE-NAME .BASEF> FRAME>
131 <GETPROP .BASEF UNWIND>>>
133 <SET SPECD <BIND-CODE .BASEF <> <SET BNDTMP <GEN-TEMP <>>>>>
134 <COND (<AGND .BASEF> <IEMIT `LOOP>)>
136 <PUT .BASEF ,DST DONT-CARE>
137 <PUT .BASEF ,CDST DONT-CARE>
138 <PUT .BASEF ,ATAG .ATAG>
139 <PUT .BASEF ,RTAG .RTAG>
140 <COND (<N==? <SET CD <SEQ-GEN .K DONT-CARE <> <> T>> ,NO-DATUM>)
141 (ELSE <SET CD <CDST .BASEF>>)>
142 <COND (<N==? <CDST .BASEF> .CD> <SET CD <MOVE-ARG .CD <CDST .BASEF>>>)>
144 <COND (<ASSIGNED? TMP-DEST> <PUTREST .TMPS-NEXT (= .TMP-DEST)>)>
146 <COND (.SPECD <IEMIT `UNBIND .BNDTMP> <FREE-TEMP .BNDTMP>)>
147 <COND (<N==? .STK-CHARS8 0>
148 <SET STK-CHARS8 <+ .STK-CHARS8 .STK>>
149 <SET STK-CHARS7 <+ .STK-CHARS7 .STK>>
151 <COND (<ASSIGNED? STKTMP>
153 <IEMIT `SUB .STKTMP .STK = .STKTMP (`TYPE FIX)>)
154 (<N==? .STK-CHARS7 0>
155 <IEMIT `IFSYS "TOPS20">
156 <IEMIT `SUB .STKTMP .STK-CHARS7 = .STKTMP>
157 <IEMIT `ENDIF "TOPS20">
158 <IEMIT `IFSYS "UNIX">
159 <IEMIT `SUB .STKTMP .STK-CHARS8 = .STKTMP>
160 <IEMIT `ENDIF "UNIX">)>
163 (<N==? .STK 0> <IEMIT `ADJ <- .STK>>)
164 (<N==? .STK-CHARS8 0>
165 <IEMIT `IFSYS "TOPS20">
166 <IEMIT `ADJ <- .STK-CHARS7>>
167 <IEMIT `ENDIF "TOPS20">
168 <IEMIT `IFSYS "UNIX">
169 <IEMIT `ADJ <- .STK-CHARS8>>
170 <IEMIT `ENDIF "UNIX">)>
172 <TYPIFY-TEMPS .EVERY-TEMP>
173 <IEMIT `END <CHTYPE <NODE-NAME .BASEF> FCN-ATOM>>
176 " Generate code for setting up and binding agruments."
178 <DEFINE BIND-CODE (NOD
179 "OPTIONAL" (FORPROG <>) BNDTMP
180 "AUX" (BST <BINDING-STRUCTURE .NOD>) (NPRUNE T) (LARG <>)
181 (ANY-ARG <>) (ANY-SPEC <>) (OPTS? <>) (OL ()) T-NAME
183 #DECL ((NOD) NODE (BST B) <LIST [REST SYMTAB]> (NPRUNE) <SPECIAL ANY>
184 (INAME) <UVECTOR [REST ATOM]> (BASEF) NODE (TMPS-NEXT OL) LIST
185 (T-NAME) <SPECIAL ANY>)
192 <COND (<OPT? .SYM> <MAKE-TAG "OPT">)
194 <COND (<==? <CODE-SYM .SYM> ,ARGL-TUPLE>
195 <SET TUP? <TOTARGS .NOD>>)>
198 <COND (<NOT <EMPTY? .OL>>
199 <PUTREST <REST .OL <- <LENGTH .OL> 1>> (<MAKE-TAG "OPT">)>
200 <IEMIT `OPT-DISPATCH <REQARGS .NOD> .TUP? !.OL>)>
202 <FUNCTION (SYM "AUX" (NT 0))
203 #DECL ((SYM) SYMTAB (NT) FIX)
206 <GEN-TEMP <> <NAME-SYM .SYM> T <DECL-SYM .SYM>>>
211 <COND (<AND <NOT <SPEC-SYM .SYM>>
212 <N==? <CODE-SYM .SYM> ,ARGL-OPT>
213 <N==? <CODE-SYM .SYM> ,ARGL-QOPT>
214 <OR <==? <SET NT <NODE-TYPE <INIT-SYM .SYM>>>
216 <==? .NT ,LVAL-CODE>>>
217 <GEN <INIT-SYM .SYM> ,POP-STACK>)
218 (ELSE <PUSH ,THE-UNBOUND>)>
219 <COND (<EMPTY? <REST .OL>> <LABEL-TAG <1 .OL>>)>)>>
221 <COND (<==? <NODE-TYPE .NOD> ,FUNCTION-CODE> <MIM-TEMPS-EMIT>)>)>
224 "AUX" (SYM <1 .BS>) TMP (A? <ARG? .SYM>) (O? <OPT? .SYM>))
225 #DECL ((SYM) SYMTAB (TMP) TEMP (BS) <LIST SYMTAB>)
226 <COND (<NOT <USED-AT-ALL .SYM>>
227 <COND (<SPEC-SYM .SYM>
228 <COMPILE-NOTE "Special variable never used: "
232 "Variable never used: " <NAME-SYM .SYM>>)>)>
233 <COND (<AND <NOT .LARG> <NOT .A?> <NOT .O?>>
234 <COND (<AND .ANY-SPEC .ANY-ARG> <GEN-FIX-BIND>)>
236 <COND (<NOT <TYPE? <TEMP-NAME-SYM .SYM> TEMP>>
239 <GEN-TEMP <> <NAME-SYM .SYM> T <DECL-SYM .SYM>>>)>
240 <COND (<AND .O? <NOT .OPTS?>> <SET OPTS? T>)>
241 <COND (<AND <ASSIGNED? BNDTMP>
245 <USE-TEMP .BNDTMP LBIND>
246 <GET-BINDING .BNDTMP>)>
247 <PUT <SET TMP <TEMP-NAME-SYM .SYM>>
249 <COND (<ASS? .SYM> ANY) (ELSE <COMPOSIT-TYPE .SYM>)>>
253 (<CHTYPE <TEMP-NAME .TMP> ATOM>)>>)>
254 <COND (<OR .A? .O?> <SET ANY-ARG T>)>
255 <SET T-NAME <TEMP-NAME .TMP>>
256 <COND (<AND <BIND-GENERATE .SYM .FORPROG>
259 <NOT <SPEC-SYM .SYM>>>
260 <PUTREST .TMPS-NEXT <SET TMPS-NEXT (.T-NAME)>>
261 <USE-TEMP .TMP <ISTYPE? <COMPOSIT-TYPE .SYM>>>
262 <PUT .TMP ,TEMP-REFS 1>)>
263 <COND (<AND <NOT .LARG> <EMPTY? <REST .BS>>>
264 <COND (<AND .ANY-SPEC .ANY-ARG> <GEN-FIX-BIND>)>
267 <COND (<ACTIVATED .NOD> <IEMIT `ACTIVATION>)>
268 <COND (<AND <ASSIGNED? BNDTMP> <NOT .ANY-SPEC> <PUTPROP .NOD UNWIND>>
269 <USE-TEMP .BNDTMP LBIND>
270 <GET-BINDING .BNDTMP>)>
271 <COND (.ANY-SPEC .BNDTMP)>>
273 " Generate \"BIND\" binding code."
275 <DEFINE BIND-B (SYM "AUX" TMP FTMP)
276 #DECL ((STK) FIX (SYM) SYMTAB (BASEF) NODE)
277 <COND (<SPEC-SYM .SYM>
278 <SET FTMP <PREV-FRAME <GEN-TEMP FRAME>>>
279 <SPECIAL-BINDING .SYM T .FTMP>
280 <SET STK <+ .STK ,BINDING-LENGTH>>
283 <PREV-FRAME <TEMP-NAME-SYM .SYM>>
284 <USE-TEMP <TEMP-NAME-SYM .SYM>>)>
287 " Do code generation for normal arguments."
290 #DECL ((SYM) SYMTAB (STK) FIX)
291 <COND (<SPEC-SYM .SYM>
292 <SPECIAL-BINDING .SYM <> <TEMP-NAME-SYM .SYM>>
293 <SET STK <+ .STK ,BINDING-LENGTH>>)>
296 " Initialized optional argument binder."
298 <DEFINE OPT1-B (SYM "AUX" NT)
300 <COND (<OR <SPEC-SYM .SYM>
301 <AND <N==? <SET NT <NODE-TYPE <INIT-SYM .SYM>>> ,QUOTE-CODE>
302 <N==? .NT ,LVAL-CODE>>>
303 <OPTBIND .SYM <INIT-SYM .SYM>>)>>
305 " Uninitialized optional argument binder."
309 <COND (<SPEC-SYM .SYM> <OPTBIND .SYM>)>
312 " Create a binding for either intitialized or unitialized optional."
316 "AUX" (GIVE <MAKE-TAG>) (DEF <MAKE-TAG>) DV TMP
317 (SPEC <SPEC-SYM .SYM>) BLBL)
318 #DECL ((STK) FIX (SYM) SYMTAB (BASEF DVAL) NODE (GIVE DEF) ATOM)
319 <COND (<OR <ASSIGNED? DVAL> .SPEC>
321 <SET TMP <GEN-TEMP FIX>>
322 <IEMIT `SET .TMP 0>)>
323 <TEST-ARG <TEMP-NAME-SYM .SYM> .GIVE>
324 <COND (<ASSIGNED? DVAL>
325 <GEN .DVAL <TEMP-NAME-SYM .SYM>>)>
328 <FREE-TEMP <TEMP-NAME-SYM .SYM> <>>)>
331 <SPECIAL-BINDING .SYM <> <TEMP-NAME-SYM .SYM>>
332 <SET STK <+ .STK ,BINDING-LENGTH>>
333 <IEMIT `VEQUAL? .TMP 0 + <SET BLBL <MAKE-TAG>>>
339 " Do a binding for a named activation."
341 <DEFINE ACT-B (SYM "AUX" TMP FTMP)
342 #DECL ((STK) FIX (SYM) SYMTAB (BASEF) NODE)
343 <COND (<SPEC-SYM .SYM>
344 <SET FTMP <CURRENT-FRAME>>
345 <SPECIAL-BINDING .SYM T .FTMP>
346 <SET STK <+ .STK ,BINDING-LENGTH>>
348 <PUT .BASEF ,ACTIVATED T>)
349 (<OR <ACTIVATED .BASEF> <ACTIV? <BINDING-STRUCTURE .BASEF>>>
350 <PUT .BASEF ,ACTIVATED T>
351 <CURRENT-FRAME <TEMP-NAME-SYM .SYM>>
352 <USE-TEMP <TEMP-NAME-SYM .SYM>>)>
355 " Bind an \"AUX\" variable."
358 "OPT" (FORCE-INIT <>)
359 "AUX" (TMP <TEMP-NAME-SYM .SYM>) TY PT INIT
360 (NOD <INIT-SYM .SYM>))
361 #DECL ((SYM) SYMTAB (NOD) NODE (STK) FIX)
362 <COND (<AND <SET TY <ISTYPE? <COMPOSIT-TYPE .SYM>>>
363 <OR <==? <SET PT <TYPEPRIM .TY>> FIX>
368 <COND (<SPEC-SYM .SYM>
369 <SPECIAL-BINDING .SYM T <SET INIT <GEN .NOD>>>
370 <SET STK <+ .STK ,BINDING-LENGTH>>
372 (<AND <NOT .FORCE-INIT> <==? <NODE-TYPE .NOD> ,QUOTE-CODE>>
375 (<COND (.TY <CHTYPE [<TEMP-NAME .TMP> .TY] ADECL>)
376 (ELSE <TEMP-NAME .TMP>)>
377 <ATOMCHK <NODE-NAME .NOD>>)>)
379 <COND (.TY <SET T-NAME <CHTYPE [<TEMP-NAME .TMP> .TY] ADECL>>)>
380 <GEN .NOD <TEMP-NAME-SYM .SYM>>)>
383 " Do a binding for an uninitialized \"AUX\" "
385 <DEFINE AUX2-B (SYM FP "AUX" TMP)
386 #DECL ((SYM) SYMTAB (STK) FIX)
387 <COND (<SPEC-SYM .SYM>
388 <SPECIAL-BINDING .SYM T>
389 <SET STK <+ .STK ,BINDING-LENGTH>>)
390 (<AND .FP <ASS? .SYM>> <SET-SYM .SYM ,THE-UNBOUND T> T)
393 <SET TMP <PUT <TEMP-NAME-SYM .SYM> ,TEMP-ALLOC <>>>
394 <PUT .TMP ,TEMP-REFS 0>
397 " Do a \"TUPLE\" binding."
399 <DEFINE TUPL-B (SYM "AUX" (TMP1 <TEMP-NAME-SYM .SYM>) TMP2)
400 #DECL ((SYM) SYMTAB (STK) FIX)
401 <GET-ARG-TUPLE .TMP1>
402 <COND (<SPEC-SYM .SYM>
403 <SPECIAL-BINDING .SYM T .TMP1>
404 <SET STK <+ .STK ,BINDING-LENGTH>>)>
407 " Dispatch table for binding generation code."
409 <DEFINE BIND-GENERATE (SYM FORPROG "AUX" (COD <CODE-SYM .SYM>))
410 #DECL ((SYM) SYMTAB (COD) FIX)
413 (,ARGL-ACT <ACT-B .SYM>)
414 (,ARGL-IAUX <AUX1-B .SYM .FORPROG>)
415 (,ARGL-AUX <AUX2-B .SYM .FORPROG>)
416 (,ARGL-TUPLE <TUPL-B .SYM>)
417 (,ARGL-ARGS <NORM-B .SYM>)
418 (,ARGL-QIOPT <OPT1-B .SYM>)
419 (,ARGL-IOPT <OPT1-B .SYM>)
420 (,ARGL-QOPT <OPT2-B .SYM>)
421 (,ARGL-OPT <OPT2-B .SYM>)
422 (,ARGL-CALL <NORM-B .SYM>)
423 (,ARGL-BIND <BIND-B .SYM>)
424 (,ARGL-QUOTE <NORM-B .SYM>)
425 (,ARGL-ARG <NORM-B .SYM>)>>
427 " Appliacation of a form could still be an NTH."
429 <DEFINE FORM-F-GEN (NOD WHERE "AUX" (K <KIDS .NOD>) TY)
431 <COND (<==? <ISTYPE? <SET TY <RESULT-TYPE <1 .K>>>> FIX>
432 <PUT .NOD ,NODE-NAME INTH>
433 <PUT .NOD ,NODE-TYPE <NODE-SUBR .NOD>>
434 <PUT .NOD ,NODE-SUBR ,NTH>
435 <COND (<OR <==? <NODE-TYPE .NOD> ,ALL-REST-CODE>
436 <==? <NODE-TYPE .NOD> ,NTH-CODE>>
437 <SET K (<2 .K> <1 .K>)>)>
440 (.TY <FORM-GEN .NOD .WHERE>)
442 <COMPILE-ERROR "Non-applicabe object type "
446 " Generate a call to EVAL for uncompilable FORM."
448 <DEFINE FORM-GEN (NOD WHERE)
450 <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP>>)>
452 <PUSH <REFERENCE <NODE-NAME .NOD>>>
453 <MSUBR-CALL EVAL 1 .WHERE>
456 " Generate code for LIST/VECTOR etc. evaluation."
458 <GDECL (COPIERS) <UVECTOR [REST ATOM]>>
460 <DEFINE COPY-GEN (NOD WHERE
461 "AUX" (I 0) (ARGS <KIDS .NOD>) SEGTYP (SEGLABEL <MAKE-TAG>)
462 (INAME <NODE-NAME .NOD>) SEGTMP COUNTMP RES X
466 (<AND <TYPE? <SET X <PARENT .NOD>> NODE>
467 <OR <==? <NODE-TYPE .X> ,STACK-CODE>
468 <AND <==? <NODE-TYPE .X> ,CHTYPE-CODE>
469 <TYPE? <SET X <PARENT .X>> NODE>
472 (<==? .INAME TUPLE>)>))
473 #DECL ((GT) <OR FALSE FIX> (NOD) NODE (ARGS) <LIST [REST NODE]> (I) FIX
474 (SEGCALLED SEGLABEL COUNTMP) <SPECIAL ANY> (STK) FIX)
479 <COND (<==? <NODE-TYPE .N> ,SEGMENT-CODE> 0) (ELSE 1)>>
483 #DECL ((N) NODE (STK) FIX)
484 <COND (<EMPTY? .ARGS> <RETURN>)>
486 (<==? <NODE-TYPE <SET N <1 .ARGS>>> ,SEGMENT-CODE>
487 <COND (<NOT <ASSIGNED? SEGTMP>>
488 <SET SEGTMP <GEN-TEMP <>>>
489 <SET COUNTMP <GEN-TEMP FIX>>
490 <SET-TEMP .COUNTMP .I '(`TYPE FIX)>)>
491 <SET RES <GEN <SET N <1 <KIDS .N>>> .SEGTMP>>
492 <SET SEGTYP <STRUCTYP-SEG <RESULT-TYPE .N>>>
493 <COND (<AND <==? <NODE-NAME .NOD> LIST>
494 <EMPTY? <REST .ARGS>>
495 <OR <NOT .SEGTYP> <==? .SEGTYP LIST>>
496 <N==? .RES ,NO-DATUM>>
497 <COND (<==? .WHERE DONT-CARE>
498 <SET WHERE <GEN-TEMP LIST>>)
499 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE LIST>)>
500 <SEGMENT-LIST .SEGTMP
509 (<AND <N==? .RES ,NO-DATUM> <N==? .SEGTYP MULTI>>
510 <SEGMENT-STACK .SEGTMP
513 <ISTYPE? <RESULT-TYPE .N>>
515 <SET SEGLABEL <MAKE-TAG>>)
517 <LABEL-TAG .SEGLABEL>
518 <SET SEGLABEL <MAKE-TAG>>)>)
519 (ELSE <GEN <1 .ARGS> ,POP-STACK>)>
520 <SET ARGS <REST .ARGS>>>
521 <COND (<ASSIGNED? SEGTMP>
523 <COND (<NOT .STACK?> <FREE-TEMP .COUNTMP>)>)>
524 <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP .INAME>>)
525 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE .INAME>)>
526 <COND (<==? .INAME VECTOR>
527 <GEN-VECTOR <COND (<ASSIGNED? SEGTMP> .COUNTMP) (ELSE .I)>
531 <GEN-LIST <COND (<ASSIGNED? SEGTMP> .COUNTMP) (ELSE .I)> .WHERE>)
532 (<==? .INAME UVECTOR>
533 <GEN-UVECTOR <COND (<ASSIGNED? SEGTMP> .COUNTMP) (ELSE .I)>
537 <GEN-TUPLE <COND (<ASSIGNED? SEGTMP> .COUNTMP) (ELSE .I)> .WHERE>)
538 (ELSE <ERROR "NOT READY YET">)>
541 <COND (<ASSIGNED? SEGTMP>
542 <COND (<N==? .INAME UVECTOR>
547 <COND (<G? <TEMP-REFS .COUNTMP> 1>
548 <FREE-TEMP .COUNTMP <>>
549 <SET COUNTMP <GEN-TEMP FIX>>)>>)>
550 <FREE-TEMP .COUNTMP <>>
551 <COND (<ASSIGNED? STKTMP>
552 <IEMIT `SUB .STKTMP .COUNTMP = .STKTMP>)
554 <IEMIT `SUB 0 .COUNTMP = <SET STKTMP <GEN-TEMP FIX>>>)>
555 <SET STK <+ .STK 2>>)
559 <COND (<==? .INAME UVECTOR> .I) (ELSE <* .I 2>)>
563 "Generate code for a call to a SUBR."
565 <DEFINE SUBR-GEN (NOD WHERE "AUX" N ST)
567 <COND (<AND <TYPE? <SET N <PARENT .NOD>> NODE>
568 <==? <NODE-TYPE .N> ,SEGMENT-CODE>
569 <OR <==? <SET ST <STRUCTYP-SEG <RESULT-TYPE .NOD>>> MULTI>
572 <COMP-SUBR-CALL .NOD <KIDS .NOD> .WHERE .COUNTMP .SEGLABEL>)
573 (ELSE <COMP-SUBR-CALL .NOD <KIDS .NOD> .WHERE <> <>>)>>
575 " Compile call to a SUBR that doesn't compile or PUSHJ."
577 <DEFINE COMP-SUBR-CALL (N OBJ W PARENT-COUNT PARENT-LABEL
578 "AUX" (I 0) SEGTMP COUNTMP (SEGLABEL <MAKE-TAG>) RES
579 (SUBR <NODE-NAME .N>) (SEGCALLED <>) X (SLNT 0)
583 <TYPE? <SET X <PARENT .N>> NODE>
584 <OR <==? <NODE-TYPE .X> ,STACK-CODE>
586 <==? <NODE-TYPE .X> ,CHTYPE-CODE>
587 <TYPE? <SET X <PARENT .X>> NODE>
588 <==? <NODE-TYPE .X> ,STACK-CODE>>>>)>))
589 #DECL ((I) FIX (OBJ) <LIST [REST NODE]> (UNK) <OR FALSE ATOM> (N) NODE
590 (SEGCALLED SEGLABEL COUNTMP) <SPECIAL ANY>)
595 <COND (<==? <NODE-TYPE .N> ,SEGMENT-CODE>
599 <COND (<AND <==? .SUBR STRING>
601 <==? <NODE-TYPE .N> ,QUOTE-CODE>>
603 <LENGTH <CHTYPE <NODE-NAME .N>
605 (ELSE <SET SLNT <>>)>
608 <COND (<NOT <MEMQ .SUBR '[LIST VECTOR UVECTOR TUPLE BYTES STRING]>>
609 <COND (.PARENT-COUNT <IEMIT `SFRAME <FORM QUOTE .SUBR>>)
610 (ELSE <START-FRAME .SUBR>)>)>
613 #DECL ((OB) NODE (I STA) FIX)
615 (<==? <NODE-TYPE .OB> ,SEGMENT-CODE>
616 <COND (<NOT <ASSIGNED? SEGTMP>>
617 <SET SEGTMP <GEN-TEMP <>>>
618 <SET COUNTMP <GEN-TEMP <>>>
619 <SET-TEMP .COUNTMP .I '(`TYPE FIX)>)>
620 <SET RES <GEN <SET OB <1 <KIDS .OB>>> .SEGTMP>>
621 <COND (<AND <N==? .RES ,NO-DATUM>
622 <N==? <STRUCTYP-SEG <RESULT-TYPE .OB>> MULTI>>
626 <STRUCTYP <RESULT-TYPE .OB>>
627 <ISTYPE? <RESULT-TYPE .OB>>
629 (.SEGCALLED <LABEL-TAG .SEGLABEL>)>
630 <SET SEGLABEL <MAKE-TAG>>)
631 (ELSE <GEN .OB ,POP-STACK>)>>
633 <COND (<ASSIGNED? SEGTMP>
635 <COND (<NOT .STACK?> <FREE-TEMP .COUNTMP <>>)>)>
636 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <RESULT-TYPE .N>>>)
637 (<TYPE? .W TEMP> <USE-TEMP .W <RESULT-TYPE .N>>)>
640 <COND (<ASSIGNED? COUNTMP> .COUNTMP) (ELSE .I)>
646 <COND (<ASSIGNED? COUNTMP> .COUNTMP) (ELSE .I)>
654 <DEFINE SEGMENT-STACK (SEGTMP COUNTMP SEGTYP SEGTYP2
655 "OPT" (TG1 <MAKE-TAG>)
656 "AUX" (TG2 <MAKE-TAG>) TMP)
659 (<TEMP-NAME .SEGTMP> TYPE VALUE LENGTH)
660 (<TEMP-NAME .COUNTMP> VALUE)>)
663 (<TEMP-NAME .SEGTMP> VALUE)
664 (<TEMP-NAME .COUNTMP> VALUE)>)
667 (<TEMP-NAME .SEGTMP> VALUE LENGTH)
668 (<TEMP-NAME .COUNTMP> VALUE)>)>
671 <COND (.SEGTYP <EMPTY-CHECK .SEGTYP .SEGTMP .SEGTYP2 T .TG1>)
672 (ELSE <IEMIT `EMPTY? .SEGTMP + .TG1>)>
674 <NTH-DO .SEGTYP .SEGTMP ,POP-STACK 1 .SEGTYP2>
675 <REST-DO .SEGTYP .SEGTMP .SEGTMP 1 .SEGTYP2>)
677 <IEMIT `NTH1 .SEGTMP = ,POP-STACK>
678 <IEMIT `REST1 .SEGTMP = .SEGTMP>)>
679 <IEMIT `ADD .COUNTMP 1 = .COUNTMP (`TYPE FIX)>
683 <DEFINE SEGMENT-LIST (SEGTMP COUNTMP LIST? W
684 "OPT" (TGX <MAKE-TAG>) (RES <>)
685 "AUX" (TG1 <MAKE-TAG>) (TG2 <MAKE-TAG>) (TG3 <MAKE-TAG>)
686 (TG4 <MAKE-TAG>) (OTMP <GEN-TEMP>))
688 <IEMIT `TYPE .SEGTMP = .OTMP>
689 <IEMIT `AND .OTMP 7 = .OTMP>
690 <IEMIT `VEQUAL? .OTMP 1 + .TG1>
691 <SEGMENT-STACK .SEGTMP .COUNTMP <> <>>
692 <GEN-LIST .COUNTMP .W>
699 <IEMIT `VEQUAL? .COUNTMP 0 + .TG3>
701 <IEMIT `CONS .OTMP .SEGTMP = .SEGTMP '(`TYPE LIST)>
702 <IEMIT `SUB .COUNTMP 1 = .COUNTMP '(`TYPE FIX)>
706 <MOVE-ARG .SEGTMP .W>
707 <COND (<NOT .LIST?> <LABEL-TAG .TG2>)>
710 <GDECL (SUBRS TEMPLATES) VECTOR>
713 #DECL ((L) <LIST [REST NODE]>)
716 <COND (<==? <NODE-TYPE .N> ,QUOTE-CODE> <>)
717 (<OR <==? <NODE-TYPE .N> ,ISUBR-CODE>
718 <MEMQ ALL <SIDE-EFFECTS .N>:<OR LIST FALSE>>>
722 " Generate code for a COND."
724 <DEFINE COND-GEN (NOD W
725 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
726 "AUX" NW (RW .W) LOCN (COND <MAKE-TAG "COND">) W2 (WSET <>)
727 (KK <CLAUSES .NOD>) (SDIR .DIR))
728 #DECL ((NOD) NODE (COND) ATOM (KK) <LIST [REST NODE]>)
729 <COND (.NOTF <SET DIR <NOT .DIR>>)>
730 <COND (<OR <==? .W ,POP-STACK>
733 <N==? <TEMP-NO-RECYCLE .W> ANY>>>
737 "AUX" (LAST <EMPTY? <REST .BRN>>) (BR <1 .BRN>) NEXT
738 (PRED-TRUE <>) (K <CLAUSES .BR>) (PR <PREDIC .BR>)
739 (NO-SEQ <>) (LEAVE <>) FLG K2 PR2 BR2 PRT2 (BRNCHED <>)
740 (PRT <RESULT-TYPE .PR>) CT)
741 #DECL ((BR2 PR2 PR BR) NODE (BRN) <LIST NODE> (K) <LIST [REST NODE]>)
745 <TYPE-OK? .PRT FALSE>
748 <SET PRT2 <RESULT-TYPE <SET PR2 <PREDIC <SET BR2 <2 .BRN>>>>>>
750 <OR <AND <EMPTY? <SET K2 <CLAUSES .BR2>>> <NOT .PRT2>>
751 <AND <NOT <EMPTY? .K2>>
752 <NOT <RESULT-TYPE <NTH .K2 <LENGTH .K2>>>>>>>
753 <COND-COMPLAIN "Predicate assumed true to avoid type mismatch" .PR>
758 (<OR <SET FLG <OR <NOT <TYPE-OK? .PRT FALSE>> .PRED-TRUE>> .LAST>
760 <COND-COMPLAIN "NON REACHABLE COND CLAUSE(S) " <2 .BRN>>)>
763 <SET LOCN <GEN .PR <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .W)>>>
764 <COND (<AND <NOT .WSET> <N==? .LOCN ,NO-DATUM> <N==? .RW FLUSHED>>
765 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
767 <COND (.DIR <BRANCH-TAG .BRANCH>)>)
774 <COND (<==? .RW FLUSHED> FLUSHED)
775 (<OR .WSET <AND <TYPE? .W TEMP> <0? <TEMP-REFS .W>>>>
778 (ELSE <SET WSET T> <SET W <GEN-TEMP <>>>)>
781 <SET LOCN <GEN .PR <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .W)>>>
782 <COND (<AND <NOT .WSET> <N==? .LOCN ,NO-DATUM> <N==? .RW FLUSHED>>
783 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
787 <COND-COMPLAIN "Predicate assumed FALSE to satisfy type constraint "
790 (<==? <ISTYPE? .PRT> FALSE> <GEN .PR FLUSHED>)
792 <PRED-BRANCH-GEN <COND (<AND .BRANCH .SDIR> .BRANCH) (ELSE .COND)>
800 <FREE-TEMP <PRED-BRANCH-GEN .BRANCH .PR T FLUSHED .NOTF>>)
807 <COND (<OR .WSET <AND <TYPE? .W TEMP> <0? <TEMP-REFS .W>>>>
810 (ELSE <SET WSET T> <SET W <GEN-TEMP <>>>)>
812 <COND (<NOT .LAST> <DEALLOCATE-TEMP .LOCN>)>)>)>)
814 <SET NEXT <MAKE-TAG "PHRASE">>
815 <SET CT <RESULT-TYPE <NTH .K <LENGTH .K>>>>
817 (<OR <AND <N==? <ISTYPE? .PRT> FALSE>
820 "Predicate assumed FALSE to satisfy type constraibnt"
822 <AND <==? <ISTYPE? .PRT> FALSE>
823 <COND-COMPLAIN "COND PREDICATE ALWAYS FALSE" .PR>>>
824 <COND (<AND .BRANCH .LAST <NOT .DIR>>
825 <SET LOCN <GEN .PR .W>>
826 <COND (<AND <NOT .WSET>
827 <N==? .LOCN ,NO-DATUM>
829 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
831 <BRANCH-TAG .BRANCH>)
833 <COND (<AND .LAST <NOT <==? .RW FLUSHED>>>
834 <SET LOCN <GEN .PR .W>>
835 <COND (<AND <NOT .WSET> <N==? .LOCN ,NO-DATUM>>
836 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
838 (ELSE <SET LOCN <GEN .PR FLUSHED>>)>
839 <COND (<N==? .PRT NO-RETURN> <BRANCH-TAG .NEXT>)>)>
841 (<AND <TYPE-OK? FALSE .PRT> <NOT .PRED-TRUE>>
843 (<AND .LAST <NOT .DIR> .BRANCH>
849 <COND (<==? .RW FLUSHED> FLUSHED)
850 (<OR .WSET <AND <TYPE? .W TEMP> <0? <TEMP-REFS .W>>>>
853 (ELSE <SET WSET T> <SET W <GEN-TEMP <>>>)>
855 <DEALLOCATE-TEMP .LOCN>)
857 <FREE-TEMP <PRED-BRANCH-GEN .NEXT .PR <> FLUSHED>>)
858 (<AND .LAST <NOT <==? .RW FLUSHED>>>
864 <COND (<==? .RW FLUSHED> FLUSHED)
865 (<OR .WSET <AND <TYPE? .W TEMP> <0? <TEMP-REFS .W>>>>
868 (ELSE <SET WSET T> <SET W <GEN-TEMP <>>>)>>>
869 <DEALLOCATE-TEMP .LOCN>)
870 (ELSE <PRED-BRANCH-GEN .NEXT .PR <> FLUSHED>)>)
875 <COND-COMPLAIN "NON REACHABLE COND CLAUSE(S)" <2 .BRN>>)>)>
884 <RESULT-TYPE <SET PR <NTH .K <LENGTH .K>>>>
886 <NOT <TYPE-OK? <RESULT-TYPE .PR> '<NOT FALSE>>>>
889 <COND (<==? .RW FLUSHED> <SET LOCN ,NO-DATUM>)
891 <SET LOCN <MOVE-ARG <REFERENCE <NOT .FLG>> .W>>
892 <COND (<AND <NOT .WSET> <N==? .LOCN ,NO-DATUM>>
893 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
898 <COND (<OR <==? .RW FLUSHED>
902 <COND (<AND <NOT .WSET>
904 <N==? .LOCN ,NO-DATUM>>
905 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
907 <COND (<==? .FLG .SDIR> <SET BRNCHED T> <BRANCH-TAG .BRANCH>)>)
911 <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .W)>
915 <COND (<AND <NOT .WSET>
916 <N==? .LOCN ,NO-DATUM>
918 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
923 <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .W)>
927 <COND (<AND <NOT .WSET> <N==? .LOCN ,NO-DATUM> <N==? .RW FLUSHED>>
928 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
930 <COND (<AND <NOT .LAST>
931 <N==? <RESULT-TYPE <NTH .K <LENGTH .K>>> NO-RETURN>>
932 <OR .NO-SEQ <DEALLOCATE-TEMP .LOCN>>
933 <OR .BRNCHED .NO-SEQ <BRANCH-TAG .COND>>)>
935 <COND (<NOT <ASSIGNED? NPRUNE>> <PUT .BR ,CLAUSES ()>)>
936 <AND .LEAVE <MAPLEAVE>>>
938 <COND (<NOT <ASSIGNED? NPRUNE>> <PUT .NOD ,CLAUSES ()>)>
941 <COND (<==? <RESULT-TYPE .NOD> NO-RETURN> ,NO-DATUM)
942 (ELSE <MOVE-ARG .W .RW>)>>
945 <DEFINE FIXUP-TEMP (W LOCN)
946 <COND (<AND <TYPE? .LOCN TEMP> <L=? <TEMP-REFS .LOCN> 1>> .LOCN)
947 (<==? .LOCN .W> .LOCN)
948 (ELSE <MOVE-ARG .LOCN <GEN-TEMP <>>>)>>
950 <DEFINE PSEQ-GEN (L W B D NF "AUX" (WSET <>) WW)
951 #DECL ((L) <LIST [REST NODE]>)
953 <FUNCTION (N "AUX" (ND <1 .N>) NX K)
954 #DECL ((N) <LIST NODE> (ND) NODE)
955 <COND (<NOT <EMPTY? <REST .N>>>
957 <COND (<AND <==? <NODE-TYPE .NX> ,CALL-CODE>
958 <G=? <LENGTH <SET K <KIDS .NX>>> 2>
959 <==? <NODE-NAME <1 .K>> `ENDIF>>
960 <SET WW <GEN .ND .W>>
961 <COND (<AND <NOT .WSET>
964 <N==? .W ,POP-STACK>>
965 <SET W <FIXUP-TEMP .W .WW>>
967 <COND (<NOT <EMPTY? <REST .N 2>>>
968 <DEALLOCATE-TEMP .W>)>)
969 (<OR <AND <G=? <LENGTH .ND> <INDEX ,SIDE-EFFECTS>>
971 <GETPROP .ND DONT-FLUSH-ME>
974 (<AND <==? <NODE-TYPE .ND> ,CALL-CODE>
975 <G=? <LENGTH <SET K <KIDS .ND>>> 2>
976 <==? <NODE-NAME <1 .K>> `ENDIF>>
980 <COND (.B <PRED-BRANCH-GEN .B .ND .D .W .NF>)
981 (ELSE <GEN .ND .W>)>>)>>
985 <DEFINE COND-COMPLAIN (MSG N1) #DECL ((N1) NODE) <COMPILE-NOTE .MSG .N1>>
987 " Generate code for OR use BOOL-GEN to do work."
989 <DEFINE OR-GEN (NOD WHERE "OPTIONAL" (NF <>) (BR <>) (DIR T))
991 <BOOL-GEN .NOD <CLAUSES .NOD> T .WHERE .NF .BR .DIR>>
993 " Generate code for AND use BOOL-GEN to do work."
995 <DEFINE AND-GEN (NOD WHERE "OPTIONAL" (NF <>) (BR <>) (DIR <>))
997 <BOOL-GEN .NOD <CLAUSES .NOD> <> .WHERE .NF .BR .DIR>>
999 <DEFINE BOOL-GEN (NOD PREDS RESULT W NOTF BRANCH DIR
1000 "AUX" (RW .W) (BOOL <MAKE-TAG "BOOL">)
1001 (FLUSH <==? .RW FLUSHED>) (WSET <>)
1002 (FLS <AND <NOT .BRANCH> .FLUSH>) RTF SRES LOCN FIN)
1003 #DECL ((PREDS) <LIST [REST NODE]> (NOTF DIR FLUSH FLS RTF) ANY (BOOL) ATOM
1004 (BRANCH) <OR ATOM FALSE> (NOD) NODE (LOCN) ANY (SRES RESULT) ANY)
1005 <COND (<OR <==? .W ,POP-STACK>
1006 <AND <TYPE? .W TEMP>
1007 <TEMP-NO-RECYCLE .W>
1008 <N==? <TEMP-NO-RECYCLE .W> ANY>>>
1010 <COND (.NOTF <SET RESULT <NOT .RESULT>>)>
1015 <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>>
1016 <COND (.DIR <SET RESULT <NOT .RESULT>>)>
1018 (<EMPTY? .PREDS> <SET LOCN <MOVE-ARG <REFERENCE .RESULT> .W>>)
1022 "AUX" (BR <1 .BRN>) (LAST <EMPTY? <REST .BRN>>)
1023 (RT <RESULT-TYPE .BR>) (RTFL <>) TY)
1024 #DECL ((BRN) <LIST NODE [REST NODE]> (BR) NODE)
1028 <EMPTY? <REST .BRN 2>>
1029 <OR <AND <==? <ISTYPE? <SET TY <RESULT-TYPE <2 .BRN>>>> FALSE>
1032 <AND .SRES <NOT <TYPE-OK? .TY FALSE>>>>
1033 <OR <L? <LENGTH <2 .BRN>> <INDEX ,SIDE-EFFECTS>>
1034 <NOT <SIDE-EFFECTS <2 .BRN>>>>>
1035 <COND (<==? .TY FALSE> <SET RT ATOM>) (ELSE <SET RT FALSE>)>)>
1037 (<AND <TYPE-OK? .RT FALSE>
1038 <NOT <SET RTFL <==? <ISTYPE? .RT> FALSE>>>>
1040 (<OR .BRANCH <AND .FLS <NOT .LAST>>>
1048 <COND (.FLUSH FLUSHED)
1049 (<OR .WSET <AND <TYPE? .W TEMP> <0? <TEMP-REFS .W>>>>
1052 (ELSE <SET WSET T> <SET W <GEN-TEMP <>>>)>
1057 <COND (.FLS .BOOL) (.RESULT .BOOL) (ELSE .BRANCH)>
1060 <COND (<OR .FLUSH <NOT .RTF>> FLUSHED)
1061 (<OR .WSET <AND <TYPE? .W TEMP> <0? <TEMP-REFS .W>>>>
1064 (ELSE <SET WSET T> <SET W <GEN-TEMP <>>>)>
1066 <DEALLOCATE-TEMP .LOCN>)>)
1068 <SET LOCN <GEN .BR .W>>
1069 <COND (<AND <NOT .FLUSH> <N==? .LOCN ,NO-DATUM> <NOT .WSET>>
1070 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
1079 <COND (.FLUSH FLUSHED)
1080 (<OR .WSET <AND <TYPE? .W TEMP> <0? <TEMP-REFS .W>>>>
1083 (ELSE <SET WSET T> <SET W <GEN-TEMP <>>>)>
1085 <DEALLOCATE-TEMP .LOCN>)>)
1086 (<OR <N==? .SRES <COND (.NOTF <SET RTFL <NOT .RTFL>>) (ELSE .RTFL)>>
1089 <COMPILE-NOTE "NON REACHABLE AND/OR CLAUSE" <2 .BRN>>)>
1092 <GEN .BR <COND (<N==? .DIR .RTFL> .W) (ELSE FLUSHED)>>>
1093 <COND (<AND <NOT .FLUSH>
1094 <N==? .LOCN ,NO-DATUM>
1097 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
1099 <COND (<AND <N==? .DIR .RTFL>
1100 <N==? <RESULT-TYPE .BR> NO-RETURN>>
1101 <BRANCH-TAG .BRANCH>)>)
1103 <SET LOCN <GEN .BR .W>>
1104 <COND (<AND <NOT .FLUSH> <N==? .LOCN ,NO-DATUM> <NOT .WSET>>
1105 <SET LOCN <SET W <FIXUP-TEMP .W .LOCN>>>
1110 <COND (<OR <L? <LENGTH .BR> <INDEX ,SIDE-EFFECTS>>
1111 <NOT <SIDE-EFFECTS .BR>>
1113 <COMPILE-NOTE <STRING "PREDICATE ALWAYS "
1114 <COND (.RTFL "FALSE")
1115 (ELSE "TRUE")> " IN AND/OR">
1117 <GEN .BR FLUSHED>)>>
1119 <COND (<NOT <ASSIGNED? NPRUNE>> <PUT .NOD ,CLAUSES ()>)>
1120 <COND (<NOT <AND .BRANCH <NOT .RESULT>>> <LABEL-TAG .BOOL>)>
1122 <COND (<==? <RESULT-TYPE .NOD> NO-RETURN> ,NO-DATUM)
1123 (ELSE <MOVE-ARG .W .RW>)>>
1126 " Generate code for ASSIGNED?"
1128 <DEFINE ASSIGNED?-GEN (N W
1129 "OPTIONAL" (NF <>) (BR <>) (DIR <>) (SETF <>)
1130 "AUX" (A <NODE-NAME .N>) (SDIR .DIR)
1131 (FLS <==? .W FLUSHED>) B2 TMP (GLOBAL T))
1133 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
1134 <COND (.NF <SET DIR <NOT .DIR>>)>
1135 <COND (.SETF <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>>
1137 <SET DIR <COND (<AND .BR <NOT .FLS>> <NOT .DIR>) (ELSE .DIR)>>
1138 <COND (<AND <TYPE? .A SYMTAB> <NOT <SPEC-SYM .A>>>
1140 <COND (<AND .BR .FLS>
1141 <GEN-TYPE? .A UNBOUND .BR <NOT .DIR>>
1144 <GEN-TYPE? .A UNBOUND <SET B2 <MAKE-TAG>> <NOT .DIR>>
1145 <SET W <MOVE-ARG <REFERENCE .SDIR> .W>>
1150 <GEN-TYPE? .A UNBOUND <SET BR <MAKE-TAG>> <NOT .DIR>>
1151 <TRUE-FALSE .N .BR .W>)>)
1153 <COND (<TYPE? .A SYMTAB>
1154 <COND (<N==? <CODE-SYM .A> -1> <SET GLOBAL <>>)>
1155 <SET A <NAME-SYM .A>>)
1156 (ELSE <SET A <GEN <1 <KIDS .N>>>>)>
1157 <COND (<AND .BR .FLS>
1158 <ASS-GEN .A .BR .DIR .GLOBAL>
1162 <ASS-GEN .A <SET B2 <MAKE-TAG>> .DIR .GLOBAL>
1163 <SET W <MOVE-ARG <REFERENCE .SDIR> .W>>
1169 <ASS-GEN .A <SET BR <MAKE-TAG>> .DIR .GLOBAL>
1171 <TRUE-FALSE .N .BR .W>)>)>>
1173 <DEFINE GASSIGNED?-GEN (N W
1174 "OPTIONAL" (NF <>) (BR <>) (DIR <>) (SETF <>)
1175 "AUX" (A <NODE-NAME .N>) (SDIR .DIR)
1176 (NM <NODE-NAME .N>) (FLS <==? .W FLUSHED>) B2
1179 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
1180 <COND (.NF <SET DIR <NOT .DIR>>)>
1181 <COND (.SETF <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .W>>)>
1182 <SET DIR <COND (<AND .BR <NOT .FLS>> <NOT .DIR>) (ELSE .DIR)>>
1183 <SET A <GEN <1 <KIDS .N>>>>
1184 <COND (<AND .BR .FLS> <GEN-GASS .A .BR .DIR .NM> FLUSHED)
1186 <GEN-GASS .A <SET B2 <MAKE-TAG>> .DIR .NM>
1187 <SET W <MOVE-ARG <REFERENCE .SDIR> .W>>
1192 <GEN-GASS .A <SET BR <MAKE-TAG>> .DIR .NM>
1193 <TRUE-FALSE .N .BR .W>)>>
1195 <DEFINE TRUE-FALSE (N B W "OPTIONAL" (THIS T) "AUX" (RW .W) (B2 <MAKE-TAG>))
1196 #DECL ((N) NODE (B2 B) ATOM)
1197 <MOVE-ARG <REFERENCE .THIS> .W>
1200 <MOVE-ARG <REFERENCE <NOT .THIS>> .W>
1202 <DEALLOCATE-TEMP .W>
1205 " Generate code for LVAL."
1207 <DEFINE LVAL-GEN (NOD WHERE
1208 "AUX" (SYM <NODE-NAME .NOD>) TT (ADDR <>) REFS
1210 <COND (<==? <LENGTH <SET TT <TYPE-INFO .NOD>>> 2>
1213 #DECL ((NOD) NODE (SYM) SYMTAB (NO-KILL) LIST (REFS) FIX)
1214 <COND (<==? <RESULT-TYPE .NOD> NO-RETURN>
1215 <COMPILE-ERROR "Variable referenced before initialization: "
1221 (<AND <SPEC-SYM .SYM> <N==? <CODE-SYM .SYM> -1>>
1223 <COND (<TYPE? .WHERE TEMP> .WHERE)
1224 (<==? .WHERE ,POP-STACK> .WHERE)
1225 (ELSE <GEN-TEMP <>>)>>
1226 <COND (<TYPE? .TMP TEMP> <USE-TEMP .TMP <DECL-SYM .SYM>>)>
1227 <GET-VALUE-X <NAME-SYM .SYM> .TMP>
1230 <SET TMP <COND (<TYPE? .WHERE TEMP> .WHERE) (ELSE <GEN-TEMP <>>)>>
1233 <PUSH-CONSTANT <NAME-SYM .SYM>>
1234 <MSUBR-CALL LVAL 1 .TMP>
1237 <SET ADDR <LADDR .SYM>>
1238 <COND (<TYPE? .ADDR TEMP>
1241 <NOT <SPEC-SYM .SYM>>
1245 <AND <==? <1 .LL> .SYM>
1249 (<0? <SET REFS <TEMP-REFS .ADDR>>> <USE-TEMP .ADDR>)
1250 (ELSE <PUT .ADDR ,TEMP-REFS <+ .REFS 1>>)>)>
1255 <DEFINE DELAY-KILL (L1 L2 "AUX" TT TAC SYM)
1256 #DECL ((L1 L2) <LIST [REST !<LIST SYMTAB <OR ATOM FALSE>>]>
1259 <COND (<OR <==? .L1 .L2> <NOT ,DEATH>> <RETURN>)>
1260 <COND (<2 <SET TT <1 .L1>>>
1261 <SET TT <TEMP-NAME-SYM <SET SYM <1 .TT>>>>
1263 <SET L1 <REST .L1>>>>
1265 " Generate LVAL for free variable."
1267 <DEFINE FLVAL-GEN (NOD WHERE "AUX" TMP T1)
1269 <SET TMP <COND (<==? .WHERE DONT-CARE> <GEN-TEMP <>>) (ELSE .WHERE)>>
1270 <COND (<TYPE? .TMP TEMP> <USE-TEMP .TMP>)>
1271 <COND (<TYPE? <SET T1 <NODE-NAME .NOD>> SYMTAB>
1272 <SET T1 <NAME-SYM .T1>>)
1273 (<==? <NODE-TYPE <1 <KIDS .NOD>>> ,QUOTE-CODE>
1274 <SET T1 <NODE-NAME <1 <KIDS .NOD>>>>)
1275 (ELSE <SET T1 <GEN <1 <KIDS .NOD>>>>)>
1276 <GET-VALUE-X .T1 .TMP T>
1278 <MOVE-ARG .TMP .WHERE>>
1280 <DEFINE FSET-GEN (NOD WHERE "AUX" TT (TEM <>) T1)
1281 #DECL ((NOD) NODE (TEM) <OR FALSE NODE>)
1282 <COND (<==? <NODE-SUBR .NOD> ,SET> <SET TEM <2 <KIDS .NOD>>>)>
1283 <COND (<TYPE? <SET TT <NODE-NAME .NOD>> SYMTAB>
1284 <SET TT <NAME-SYM .TT>>)
1285 (<==? <NODE-TYPE <SET T1 <1 <KIDS .NOD>>>> ,QUOTE-CODE>
1286 <SET TT <NODE-NAME .T1>>)
1289 <COND (.TEM <SET TT <INTERF-CHANGE .TT .TEM>>)>)>
1292 <GEN .TEM <COND (<TYPE? .WHERE TEMP> .WHERE)
1293 (ELSE DONT-CARE)>>>)
1295 <SET T1 ,THE-UNBOUND>)>
1296 <SET T1 <SET-VALUE .TT .T1 T>>
1298 <MOVE-ARG <COND (<==? .T1 ,THE-UNBOUND> .TT) (ELSE .T1)> .WHERE>>
1300 " Generate code for an internal SET."
1302 <DEFINE SET-GEN (NOD WHERE "OPT" (NOTF <>) (BRANCH <>) (DIR <>)
1303 "AUX" (SYM <NODE-NAME .NOD>) TY PT TEM (TT <>) REFS
1304 (NM <2 <CHTYPE <NODE-SUBR .NOD> MSUBR>>))
1305 #DECL ((NOD) NODE (SYM) SYMTAB)
1307 (<AND <SPEC-SYM .SYM> <N==? <CODE-SYM .SYM> -1>>
1308 <COND (<==? .NM SET>
1310 <GEN <2 <KIDS .NOD>>
1311 <COND (<TYPE? .WHERE TEMP> .WHERE) (ELSE DONT-CARE)>>>
1312 <SET-VALUE <NAME-SYM .SYM> .TEM>)
1314 <SET-VALUE <NAME-SYM .SYM> ,THE-UNBOUND>
1315 <SET TEM <NAME-SYM .SYM>>)>
1316 <MOVE-ARG .TEM .WHERE>)
1317 (<AND <SPEC-SYM .SYM> <==? .NM UNASSIGN>>
1318 <START-FRAME UNASSIGN>
1319 <PUSH-CONSTANT <NAME-SYM .SYM>>
1320 <COND (<==? .WHERE DONT-CARE>
1321 <SET WHERE <GEN-TEMP <RESULT-TYPE .NOD>>>)
1322 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE <RESULT-TYPE .NOD>>)>
1323 <MSUBR-CALL UNASSIGN 1 .WHERE>
1324 <COND (<==? .WHERE FLUSHED> ,NO-DATUM) (ELSE .WHERE)>)
1327 <PUSH-CONSTANT <NAME-SYM .SYM>>
1328 <GEN <2 <KIDS .NOD>> ,POP-STACK>
1329 <COND (<==? .WHERE DONT-CARE>
1330 <SET WHERE <GEN-TEMP <RESULT-TYPE .NOD>>>)
1331 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE <RESULT-TYPE .NOD>>)>
1332 <MSUBR-CALL SET 2 .WHERE>
1333 <COND (<==? .WHERE FLUSHED> ,NO-DATUM) (ELSE .WHERE)>)
1335 <SET TEM <LADDR .SYM>>
1336 <COND (<AND <NOT <TEMP-ALLOC .TEM>>
1337 <COND (<AND <SET TY <ISTYPE? <DECL-SYM .SYM>>>
1338 <OR <==? <SET PT <TYPEPRIM .TY>> FIX>
1342 <DEALLOCATE-TEMP <USE-TEMP .TEM .TY>>)>
1343 <COND (<==? .NM SET>
1345 <COND (.NOTF <SET DIR <NOT .DIR>>)>
1346 <PRED-BRANCH-GEN .BRANCH <2 <KIDS .NOD>> .DIR .TEM
1349 <SET TEM <GEN <2 <KIDS .NOD>> .TEM>>)>)
1351 <MOVE-ARG ,THE-UNBOUND .TEM>)>
1352 <COND (<TYPE? .TEM TEMP>
1353 <COND (<0? <SET REFS <TEMP-REFS .TEM>>> <SET REFS 1>)>
1354 <PUT .TEM ,TEMP-REFS <+ .REFS 1>>)>
1355 <MOVE-ARG .TEM .WHERE>)>>
1357 <DEFINE ARG? (SYM) #DECL ((SYM) SYMTAB) <1? <NTH ,ARGTBL <CODE-SYM .SYM>>>>
1359 <DEFINE OPT? (SYM) #DECL ((SYM) SYMTAB) <1? <NTH ,OPTBL <CODE-SYM .SYM>>>>
1361 <SETG OPTBL ![0 0 0 0 0 1 1 1 1 0 0 0 0]>
1363 <SETG ARGTBL ![0 0 0 0 1 0 0 0 0 1 0 1 1]>
1365 <GDECL (OPTBL ARGTBL) <UVECTOR [REST FIX]>>
1367 " Compute the address of a local variable using the stack model."
1369 <DEFINE LADDR (S) #DECL ((S) SYMTAB) <TEMP-NAME-SYM .S>>
1371 " Generate obscure stuff."
1373 <DEFINE DEFAULT-GEN (NOD WHERE)
1375 <MOVE-ARG <REFERENCE <NODE-NAME .NOD>> .WHERE>>
1377 " Do GVAL using direct locative reference."
1379 <DEFINE GVAL-GEN (N W "AUX" (RT <RESULT-TYPE .N>) (TYP <ISTYPE? .RT>))
1381 <GEN-GVAL <NODE-NAME <1 <KIDS .N>>>
1382 <COND (<==? .W DONT-CARE>
1383 <SET W <GEN-TEMP .RT>>)
1384 (<TYPE? .W TEMP> <USE-TEMP .W .RT> .W)
1389 " Do SETG using direct locative reference."
1391 <DEFINE SETG-GEN (N W "AUX" TEM)
1393 <SET TEM <GEN <2 <KIDS .N>>>>
1394 <GEN-SETG <NODE-NAME <1 <KIDS .N>>>
1396 <COND (<==? <LENGTH <KIDS .N>> 3>
1397 <GEN <3 <KIDS .N>> DONT-CARE>)
1402 " Generate GVAL calls."
1404 <DEFINE FGVAL-GEN (N W "AUX" TEM)
1406 <GEN-GVAL <SET TEM <GEN <1 <KIDS .N>>>>
1407 <COND (<==? .W DONT-CARE>
1408 <SET W <GEN-TEMP <RESULT-TYPE .N>>>)
1409 (<TYPE? .W TEMP> <USE-TEMP .W <RESULT-TYPE .N>> .W)
1414 " Generate a SETG call."
1416 <DEFINE FSETG-GEN (NOD W "AUX" TEM ATM)
1418 <SET ATM <GEN <1 <KIDS .NOD>>>>
1419 <SET ATM <INTERF-CHANGE .ATM <2 <KIDS .NOD>>>>
1421 <GEN <2 <KIDS .NOD>>
1422 <COND (<TYPE? .W TEMP> .W) (ELSE DONT-CARE)>>>
1425 <COND (<==? <LENGTH <KIDS .NOD>> 3>
1426 <GEN <3 <KIDS .NOD>> DONT-CARE>)
1432 <DEFINE CHTYPE-GEN (NOD WHERE
1433 "AUX" (TYP <ISTYPE? <RESULT-TYPE .NOD>>)
1434 (N <1 <KIDS .NOD>>) N2 TEM TT)
1435 #DECL ((NOD N) NODE)
1437 <TYPE? <PARENT .NOD> NODE>
1438 <MEMQ <NODE-TYPE <PARENT .NOD>> ,CHTYPE-FOR-FREE>
1439 <OR <==? .WHERE ,POP-STACK> <==? .WHERE DONT-CARE>>>
1443 <COND (<AND <G? <LENGTH <KIDS .NOD>> 1>
1444 <N==? <NODE-TYPE <SET N2 <2 <KIDS .NOD>>>>
1446 <SET TEM <INTERF-CHANGE .TEM .N2>>
1447 <SET TT <GEN <1 <KIDS .N2>>>>)>
1448 <COND (<==? .WHERE DONT-CARE>
1449 <COND (<AND <TYPE? .TEM TEMP> <L=? <TEMP-REFS .TEM> 1>>
1450 <DEALLOCATE-TEMP <SET WHERE .TEM>>
1451 <USE-TEMP .TEM .TYP>)
1453 <SET WHERE <GEN-TEMP <COND (.TYP) (ELSE ANY)>>>)>)
1454 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE .TYP>)>
1455 <COND (<AND <ASSIGNED? N2> <N==? <NODE-TYPE .N2> ,QUOTE-CODE>>
1456 <COND (<NOT <TYPE? .TT TEMP>>
1457 <SET TT <MOVE-ARG .TT <GEN-TEMP <>>>>)>
1458 <GEN-CHTYPE .TEM <FORM `TYPE <TEMP-NAME .TT>> .WHERE>
1460 (ELSE <GEN-CHTYPE .TEM .TYP .WHERE>)>
1461 <COND (<N==? .TEM .WHERE> <FREE-TEMP .TEM>)>
1464 <GDECL (CHTYPE-FOR-FREE) <VECTOR [REST FIX]>>
1466 <SETG CHTYPE-FOR-FREE
1482 " Generate do-nothing piece of code."
1484 <DEFINE ID-GEN (N W) #DECL ((N) NODE) <GEN <1 <KIDS .N>> .W>>
1486 " Generate call to READ etc. with eof condition."
1488 <DEFINE READ2-GEN (N W "AUX" (I 0) SPOB BRANCH TMP CF)
1489 #DECL ((N) NODE (I) FIX (SPOB) NODE)
1490 <COND (<AND <TYPE? .W TEMP> <L? <TEMP-REFS .W> 1>> <SET TMP .W>)
1491 (ELSE <SET TMP <GEN-TEMP <>>>)>
1492 <START-FRAME <NODE-NAME .N>>
1495 #DECL ((OB SPOB) NODE (I) FIX)
1496 <COND (<==? <NODE-TYPE .OB> ,EOF-CODE>
1498 <CURRENT-FRAME ,POP-STACK>)
1499 (ELSE <GEN .OB ,POP-STACK>)>
1503 <MSUBR-CALL <NODE-NAME .N> .I .TMP>
1504 <GEN-==? <SET CF <CURRENT-FRAME>> .TMP <> <SET BRANCH <MAKE-TAG>>>
1506 <DEALLOCATE-TEMP .TMP>
1511 <DEFINE GET-GEN (N W) <GETGET .N .W T>>
1513 <DEFINE GET2-GEN (N W) <GETGET .N .W <>>>
1515 <GDECL (GETTERS) UVECTOR>
1517 <DEFINE GETGET (N W REV
1518 "AUX" (K <KIDS .N>) (BR <MAKE-TAG>) TMP (LN <LENGTH .K>) CF)
1519 #DECL ((N) NODE (K) <LIST NODE NODE [REST NODE]> (LN) FIX)
1520 <START-FRAME <NODE-NAME .N>>
1521 <GEN <1 .K> ,POP-STACK>
1522 <GEN <2 .K> ,POP-STACK>
1523 <COND (<==? .LN 3> <CURRENT-FRAME ,POP-STACK>)>
1524 <MSUBR-CALL <NODE-NAME .N>
1526 <COND (<AND <TYPE? .W TEMP>
1527 <OR <L? .LN 3> <L? <TEMP-REFS .W> 1>>>
1528 <USE-TEMP <SET TMP .W>>)
1529 (ELSE <SET TMP <GEN-TEMP>>)>>
1531 <GEN-==? <SET CF <CURRENT-FRAME>> .TMP <> <SET BR <MAKE-TAG>>>
1535 <GEN <3 .K> ,POP-STACK>
1536 <DEALLOCATE-TEMP <MSUBR-CALL EVAL 1 .TMP>>)
1537 (ELSE <DEALLOCATE-TEMP <GEN <3 .K> .TMP>>)>
1541 '<SETG GETTERS [,GET ,GETL ,GETPROP ,GETPL]>
1543 <SETG STACK-INS [`CALL `UBLOCK `LIST `SYSCALL]>
1545 <GDECL (STACK-INS) <VECTOR [REST ATOM]>>
1547 <DEFINE CALL-GEN (NOD WHERE
1548 "OPT" (NOTF <>) (B <>) (D <>)
1549 "AUX" (K <KIDS .NOD>) (INS <NODE-NAME <1 .K>>) L RECSPEC
1550 (ON-STACK <>) COUNTMP SEGTMP I INS1 (REC? <>))
1551 #DECL ((NOD) NODE (K) <LIST NODE [REST NODE]>)
1552 <COND (.NOTF <SET D <NOT .D>>)>
1554 (<MEMQ .INS ,STACK-INS>
1556 <COND (<OR <==? .INS `CALL> <==? .INS `SCALL>>
1557 <COND (<AND <==? <NODE-TYPE <SET INS1 <2 .K>>> ,QUOTE-CODE>
1558 <TYPE? <NODE-NAME .INS1> ATOM>>
1559 <IEMIT <COND (<==? .INS `CALL> `FRAME) (ELSE `SFRAME)>
1562 <CHTYPE <NODE-NAME .INS1> FCN-ATOM>>>>
1563 <SET INS1 <FORM QUOTE .INS1>>)
1565 <IEMIT <COND (<==? .INS `CALL> `FRAME) (ELSE `SFRAME)>>
1566 <SET INS1 <GEN .INS1>>)>
1568 (<==? .INS `SYSCALL> <SET INS1 <GEN <2 .K>>> <SET K <REST .K>>)>)>
1569 <COND (<GETPROP .INS `RECORD-TYPE> <SET REC? T>)>
1574 <COND (<==? <NODE-TYPE .N> ,SEGMENT-CODE> 0) (ELSE 1)>>
1578 <FUNCTION (NL "AUX" (N <1 .NL>) TMP)
1579 #DECL ((N) NODE (NL) <LIST NODE>)
1580 <COND (<==? <NODE-TYPE .N> ,SEGMENT-CODE>
1581 <COND (<NOT <ASSIGNED? SEGTMP>>
1582 <SET SEGTMP <GEN-TEMP <>>>
1583 <SET COUNTMP <GEN-TEMP <>>>
1584 <SET-TEMP .COUNTMP .I '(`TYPE FIX)>)>
1585 <GEN <1 <KIDS .N>> .SEGTMP>
1589 <STRUCTYP <RESULT-TYPE <1 <KIDS .N>>>>
1590 <ISTYPE? <RESULT-TYPE <1 <KIDS .N>>>>>)
1593 <GEN .N <COND (.ON-STACK ,POP-STACK) (ELSE DONT-CARE)>>>
1594 <COND (<NOT .ON-STACK>
1596 <FUNCTION (NN) <SET TMP <INTERF-CHANGE .TMP .NN>>>
1600 <COND (<NOT .ON-STACK> <MAPF <> <FUNCTION (X) <FREE-TEMP .X <>>> .L>)>
1601 <COND (<OR <==? .WHERE FLUSHED> <==? <RESULT-TYPE .NOD> NO-RETURN>>
1603 <COND (<ASSIGNED? INS1>
1606 <COND (<ASSIGNED? COUNTMP> .COUNTMP) (ELSE .I)>>
1610 <COND (<ASSIGNED? COUNTMP> .COUNTMP)
1612 (.B <IEMIT .INS !.L <COND (.D +) (ELSE -)> .B>)
1613 (ELSE <IEMIT .INS !.L>)>
1614 <SET WHERE ,NO-DATUM>)
1616 <COND (<ASSIGNED? COUNTMP>
1617 <FREE-TEMP .COUNTMP <>>
1618 <FREE-TEMP .SEGTMP <>>)>
1619 <COND (<==? .WHERE DONT-CARE>
1620 <SET WHERE <GEN-TEMP <RESULT-TYPE .NOD>>>)
1621 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE <RESULT-TYPE .NOD>>)>
1623 <COND (<ASSIGNED? INS1>
1626 <COND (<ASSIGNED? COUNTMP> .COUNTMP) (ELSE .I)>
1632 <COND (<ASSIGNED? COUNTMP> .COUNTMP) (ELSE .I)>
1636 <TYPE? <SET RECSPEC <NTH .L <LENGTH .L>>> LIST>
1637 <==? <LENGTH .RECSPEC> 2>
1638 <=? <SPNAME <1 .RECSPEC>> "RECORD-TYPE">>
1639 <COND (<==? <LENGTH .L> 1> <SET L ()>)
1640 (ELSE <PUTREST <REST .L <- <LENGTH .L> 2>> ()>)>
1641 <IEMIT .INS !.L = .WHERE .RECSPEC>)
1642 (.B <IEMIT .INS !.L = .WHERE <COND (.D +) (ELSE -)> .B>)
1643 (ELSE <IEMIT .INS !.L = .WHERE>)>)>
1646 <DEFINE CHANNEL-OP-GEN (NOD WHERE
1647 "AUX" (CTY <NODE-SUBR .NOD>) (K <KIDS .NOD>) L I)
1648 #DECL ((NOD) NODE (K) <LIST NODE [REST NODE]> (L) LIST)
1649 <SET I <+ <LENGTH .K> 1>>
1652 <FUNCTION (NL "AUX" (N <1 .NL>) TMP)
1653 #DECL ((N) NODE (NL) <LIST NODE>)
1654 <COND (<==? <NODE-TYPE .N> ,QUOTE-CODE>
1655 <COND (<TYPE? <SET TMP <NODE-NAME .N>> ATOM>
1659 <SET TMP <GEN .N DONT-CARE>>
1661 <FUNCTION (NN) <SET TMP <INTERF-CHANGE .TMP .NN>>>
1665 <MAPF <> <FUNCTION (X) <FREE-TEMP .X <>>> .L>
1666 <COND (<OR <==? .WHERE FLUSHED> <==? <RESULT-TYPE .NOD> NO-RETURN>>
1667 <IEMIT `CHANNEL-OP <FORM QUOTE .CTY> <2 .L> <1 .L> !<REST .L 2>>)
1669 <COND (<==? .WHERE DONT-CARE>
1670 <SET WHERE <GEN-TEMP <RESULT-TYPE .NOD>>>)
1671 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE <RESULT-TYPE .NOD>>)>
1681 <DEFINE SMSUBR-CALL (SUBRC NARGS WHERE "OPT" (STACK? <>) (SLNT <>)
1682 "AUX" (W <COND (<AND <==? .SUBRC STRING>
1685 <NOT <TYPE? .WHERE TEMP>>>
1688 #DECL ((STK STK-CHARS7 STK-CHARS8) FIX)
1689 <COND (<OR <==? .SUBRC VECTOR>
1690 <==? .SUBRC UVECTOR>
1694 <IEMIT <COND (.STACK? `SBLOCK) (ELSE `UBLOCK)>
1695 <FORM `TYPE-CODE .SUBRC>
1701 <COND (<OR <TYPE? .NARGS TEMP>
1704 <SET NARGS <GEN-TEMP FIX>>>>
1705 <COND (<OR <==? .SUBRC VECTOR> <==? .SUBRC TUPLE>>
1706 <IEMIT `DIV .NARGS 2 = .NARGS>)
1708 <IEMIT `ADD .NARGS 3 =.NARGS>
1709 <IEMIT `DIV .NARGS 4 = .NARGS>)
1710 (<==? .SUBRC STRING>
1711 <IEMIT `LENUS .W = .NARGS>
1712 <IEMIT `IFSYS "TOPS20">
1713 <IEMIT `ADD .NARGS 4 = .NARGS>
1714 <IEMIT `DIV .NARGS 5 = .NARGS>
1715 <IEMIT `ENDIF "TOPS20">
1716 <IEMIT `IFSYS "UNIX">
1717 <IEMIT `ADD .NARGS 3 = .NARGS>
1718 <IEMIT `DIV .NARGS 4 = .NARGS>
1719 <IEMIT `ENDIF "UNIX">)>
1720 <FREE-TEMP .NARGS <>>
1721 <COND (<ASSIGNED? STKTMP>
1722 <IEMIT `SUB .STKTMP .NARGS = .STKTMP>)
1724 <IEMIT `SUB 0 .NARGS =
1725 <SET STKTMP <GEN-TEMP FIX>>>)>
1726 <SET STK <+ .STK 2>>)
1727 (<==? .SUBRC STRING>
1729 <+ </ <+ .SLNT 4> 5> .STK-CHARS7>>
1731 <+ </ <+ .SLNT 3> 4> .STK-CHARS8>>
1732 <SET STK <+ .STK 2>>)
1736 <COND (<==? .SUBRC UVECTOR> .NARGS)
1739 (ELSE <* .NARGS 2>)>
1741 <COND (<N==? .W .WHERE> <MOVE-ARG .W .WHERE>)>)
1742 (<==? .SUBRC LIST> <IEMIT `LIST .NARGS = .WHERE '(`TYPE LIST)>)
1743 (ELSE <MSUBR-CALL .SUBRC .NARGS .WHERE>)>>
1745 <DEFINE APPLY-GEN (NOD WHERE
1746 "AUX" (K <KIDS .NOD>) COUNTMP SEGTMP (SEGLABEL <MAKE-TAG>)
1747 (SEGCALLED <>) I MS)
1748 #DECL ((NOD) NODE (K) <LIST NODE [REST NODE]>
1749 (COUNTMP SEGCALLED SEGLABEL) <SPECIAL ANY>)
1751 <SET MS <GEN <1 .K>>>
1756 <COND (<==? <NODE-TYPE .N> ,SEGMENT-CODE> 0) (ELSE 1)>>
1759 <FUNCTION (N "AUX" RES)
1760 #DECL ((N) NODE (NL) <LIST NODE>)
1762 (<==? <NODE-TYPE .N> ,SEGMENT-CODE>
1763 <COND (<NOT <ASSIGNED? SEGTMP>>
1764 <SET SEGTMP <GEN-TEMP <>>>
1765 <SET COUNTMP <GEN-TEMP <>>>
1766 <SET-TEMP .COUNTMP .I '(`TYPE FIX)>)>
1767 <SET RES <GEN <SET N <1 <KIDS .N>>> .SEGTMP>>
1768 <COND (<AND <N==? .RES ,NO-DATUM>
1769 <N==? <STRUCTYP-SEG <RESULT-TYPE .N>> MULTI>>
1773 <STRUCTYP <RESULT-TYPE .N>>
1774 <ISTYPE? <RESULT-TYPE .N>>
1776 (.SEGCALLED <LABEL-TAG .SEGLABEL>)>
1777 <SET SEGLABEL <MAKE-TAG>>)
1778 (ELSE <GEN .N ,POP-STACK>)>>
1780 <COND (<ASSIGNED? COUNTMP> <FREE-TEMP .COUNTMP <>> <FREE-TEMP .SEGTMP <>>)>
1781 <COND (<OR <==? .WHERE FLUSHED> <==? <RESULT-TYPE .NOD> NO-RETURN>>
1782 <IEMIT `ACALL .MS <COND (<ASSIGNED? COUNTMP> .COUNTMP) (ELSE .I)>>
1785 <COND (<==? .WHERE DONT-CARE>
1786 <SET WHERE <GEN-TEMP <RESULT-TYPE .NOD>>>)
1787 (<TYPE? .WHERE TEMP> <USE-TEMP .WHERE <RESULT-TYPE .NOD>>)>
1790 <COND (<ASSIGNED? COUNTMP> .COUNTMP) (ELSE .I)>
1796 <DEFINE UNWIND-GEN (N W
1797 "AUX" (UNBRANCH <MAKE-TAG>) (NOUNWIND <MAKE-TAG>)
1798 (K1 <1 <KIDS .N>>) (K2 <2 <KIDS .N>>) W1 BND LBL)
1799 #DECL ((N K1 K2) NODE (BND) TEMP (STK) FIX)
1801 <IEMIT `LOCATION + .UNBRANCH = <SET LBL <GEN-TEMP>>>
1807 <SET STK <+ .STK ,BINDING-LENGTH>>
1808 <SET W1 <GEN .K1 .W>>
1809 <SET-VALUE UNWIND 0>
1811 <BRANCH-TAG .NOUNWIND>
1812 <LABEL-TAG .UNBRANCH>
1814 <BRANCH-TAG `UNWCONT>
1815 <LABEL-TAG .NOUNWIND>
1818 <DEFINE INTERFERE? (TMP N "AUX" L)
1819 #DECL ((N) NODE (TMP) TEMP (L) <OR FALSE LIST>)
1821 <G=? <LENGTH .N> <INDEX ,SIDE-EFFECTS>>
1822 <SET L <SIDE-EFFECTS .N>>
1824 <FUNCTION (NN "AUX" SYM)
1825 #DECL ((SYM) SYMTAB)
1826 <COND (<AND <TYPE? .NN NODE>
1827 <==? <NODE-TYPE .NN> ,SET-CODE>
1828 <NOT <SPEC-SYM <SET SYM <NODE-NAME .NN>>>>
1829 <N==? <CODE-SYM .SYM> -1>
1830 <==? <TEMP-NAME-SYM .SYM> .TMP>>
1834 <DEFINE INTERF-CHANGE (TMP N)
1836 <COND (<AND <TYPE? .TMP TEMP> <INTERFERE? .TMP .N>>
1837 <MOVE-ARG .TMP <GEN-TEMP <>>>)
1840 <DEFINE ADECL-GEN (NOD WHERE "AUX" (N <1 <KIDS .NOD>>)) <GEN .N .WHERE>>
1842 <DEFINE STACK-GEN (N W) <GEN <1 <KIDS .N>> .W>>
1844 "ILIST, IVECTOR, IUVECTOR AND ISTRING."
1846 <DEFINE ISTRUC-GEN (N W
1847 "AUX" (NAM <NODE-NAME .N>) (K <KIDS .N>)
1848 (NT <NODE-TYPE .N>) (LEN <1 .K>) EL
1849 (TY <RESULT-TYPE .N>) NT-M NT-E EL-TMP EV-TMP STRT
1850 NSTR STR END STR2 OBJ (CALL-EV <>) (GEN-EACH-TIME <>)
1851 X EMP-INS PUT-INS REST-INS (ISTY <ISTYPE? .TY>)
1852 CONS-T1 CONS-T2 CONS-TMP NT-S
1856 <TYPE? <SET X <PARENT .N>> NODE>
1857 <OR <==? <NODE-TYPE .X> ,STACK-CODE>
1858 <AND <==? <NODE-TYPE .X> ,CHTYPE-CODE>
1859 <TYPE? <SET X <PARENT .X>> NODE>
1860 <==? <NODE-TYPE .X> ,STACK-CODE>>>>)>))
1861 #DECL ((N LEN EL) NODE (K) <LIST NODE [OPT NODE]>
1862 (STK STK-CHARS7 STK-CHARS8) FIX (STR) <OR FIX TEMP>)
1863 <COND (<==? .NAM ITUPLE> <SET STACK? T>)>
1864 <COND (<AND <==? <LENGTH .K> 1> <N==? .NAM ILIST>>
1865 <IEMIT <COND (.STACK? `USBLOCK) (ELSE `UUBLOCK)>
1866 <FORM `TYPE-CODE .ISTY>
1867 <SET STR <GEN .LEN DONT-CARE>>
1869 <COND (<TYPE? .W TEMP> <USE-TEMP .W .ISTY> .W)
1871 <SET W <GEN-TEMP <COND (.ISTY) (ANY)>>>)
1874 <COND (<NOT .STACK?> <FREE-TEMP .STR>)>)
1876 <COND (<OR <==? .NAM IVECTOR> <==? .NAM ITUPLE>>
1877 <SET REST-INS `RESTUV>
1878 <SET PUT-INS `PUTUV>
1879 <SET EMP-INS `EMPUV?>)
1880 (<==? .NAM IUVECTOR>
1881 <SET REST-INS `RESTUU>
1882 <SET PUT-INS `PUTUU>
1883 <SET EMP-INS `EMPUU?>)
1885 <SET REST-INS `RESTUS>
1886 <SET PUT-INS `PUTUS>
1887 <SET EMP-INS `EMPUS?>)
1889 <SET REST-INS `RESTUB>
1890 <SET PUT-INS `PUTUB>
1891 <SET EMP-INS `EMPUB?>)
1893 <SET REST-INS `RESTL>
1895 <SET EMP-INS `EMPL?>)>
1896 <COND (<EMPTY? <REST .K>> <SET EL-TMP 0>)
1897 (<OR <AND <==? <SET NT-M <NODE-TYPE .N>> ,ISTRUC2-CODE>
1898 <OR <L? <LENGTH <SET EL <2 .K>>>
1899 <INDEX ,SIDE-EFFECTS>>
1900 <AND <NOT <SIDE-EFFECTS .EL>>
1901 <N==? <SET NT-S <NODE-TYPE .EL>> ,COPY-CODE>
1902 <N==? .NT-S ,CHTYPE-CODE>
1903 ; "TAA 11/5/85--otherwise
1904 <IVECTOR .FOO '<CHTYPE [1 2 3] BAR>>
1905 doesn't generate a new frob each time"
1906 <N==? .NT-S ,ISTRUC-CODE>
1907 <N==? .NT-S ,ISTRUC2-CODE>>>>
1908 <AND <==? .NT-M ,ISTRUC-CODE>
1910 <RESULT-TYPE <SET EL <2 .K>>>
1911 '<OR FORM LIST VECTOR UVECTOR LVAL GVAL>>>>>
1912 <SET EL-TMP <GEN .EL>>)
1913 (<==? .NT-M ,ISTRUC-CODE>
1914 <SET EV-TMP <GEN .EL>>
1916 (ELSE <SET GEN-EACH-TIME T>)>
1917 <SET STR <GEN .LEN>>
1918 <COND (<==? .NAM ILIST>
1920 <COND (<TYPE? .W TEMP> <USE-TEMP <SET OBJ .W> .ISTY>)
1921 (ELSE <SET OBJ <GEN-TEMP>>)> ()>
1922 <COND (<OR <TYPE? .STR FIX>
1923 <G? <TEMP-REFS .STR> 1>>
1924 <IEMIT `SET <SET STR2 <GEN-TEMP FIX>> .STR>
1926 <IEMIT `SET <SET STR2 <GEN-TEMP LIST>> ()>)
1928 <IEMIT <COND (.STACK? `USBLOCK) (ELSE `UUBLOCK)>
1929 <FORM `TYPE-CODE .ISTY>
1932 <COND (<TYPE? .W TEMP> <USE-TEMP <SET OBJ .W> .ISTY>)
1933 (ELSE <SET OBJ <GEN-TEMP>>)>>
1934 <COND (<NOT .STACK?> <FREE-TEMP .STR>)>
1935 <IEMIT `SET <SET STR2 <GEN-TEMP>> .OBJ>)>
1937 (<TEMP-NAME .STR2> VALUE LENGTH)
1938 !<COND (.CALL-EV ((<TEMP-NAME .EV-TMP> TYPE VALUE LENGTH)))
1939 (<AND <NOT .GEN-EACH-TIME> <TYPE? .EL-TMP TEMP>>
1940 ((<TEMP-NAME .EL-TMP> TYPE VALUE LENGTH)))
1942 !<COND (<==? .NAM ILIST> ((<TEMP-NAME .STR> VALUE)))
1944 <LABEL-TAG <SET STRT <MAKE-TAG "ISTR">>>
1945 <COND (<==? .NAM ILIST>
1946 <IEMIT `VEQUAL? .STR 0 + <SET END <MAKE-TAG "ISTRE">>>)
1948 <IEMIT .EMP-INS .STR2 + <SET END <MAKE-TAG "ISTRE">>>)>
1952 <MSUBR-CALL EVAL 1 <SET EL-TMP <GEN-TEMP>>>)
1953 (.GEN-EACH-TIME <SET EL-TMP <GEN .EL>>)>
1954 <COND (<==? .NAM ILIST>
1955 <IEMIT `CONS .EL-TMP () = <SET CONS-TMP <GEN-TEMP LIST>>>
1956 <IEMIT `EMPL? .STR2 + <SET CONS-T1 <MAKE-TAG>>>
1957 <IEMIT `PUTREST .STR2 .CONS-TMP>
1958 <IEMIT `SET .STR2 .CONS-TMP>
1959 <BRANCH-TAG <SET CONS-T2 <MAKE-TAG>>>
1960 <LABEL-TAG .CONS-T1>
1961 <IEMIT `SET .STR2 .CONS-TMP>
1962 <IEMIT `SET .OBJ .CONS-TMP>
1963 <LABEL-TAG .CONS-T2>
1964 <IEMIT `SUB .STR 1 = .STR>)
1966 <IEMIT .PUT-INS .STR2 1 .EL-TMP>
1967 <IEMIT .REST-INS .STR2 1 = .STR2>)>
1968 <COND (<OR .CALL-EV .GEN-EACH-TIME> <FREE-TEMP .EL-TMP>)>
1972 <COND (.CALL-EV <FREE-TEMP .EV-TMP>)
1973 (<NOT .GEN-EACH-TIME> <FREE-TEMP .EL-TMP>)>
1974 <SET W <MOVE-ARG .OBJ .W>>)>
1976 <COND (<TYPE? .STR TEMP>
1977 <COND (<AND <N==? .NAM IUVECTOR> <G? <TEMP-REFS .STR> 1>>
1978 <SET NSTR <GEN-TEMP FIX>>)
1979 (ELSE <SET NSTR .STR>)>
1980 <COND (<OR <==? .NAM IVECTOR> <==? .NAM ITUPLE>>
1981 <IEMIT `LSH .STR 1 = .NSTR>)
1983 <IEMIT `ADD .STR 3 = .NSTR>
1984 <IEMIT `LSH .NSTR -2 = .NSTR>)
1986 <IEMIT `IFSYS "TOPS20">
1987 <IEMIT `ADD .STR 4 = .NSTR>
1988 <IEMIT `DIV .NSTR 5 = .NSTR>
1989 <IEMIT `ENDIF "TOPS20">
1990 <IEMIT `IFSYS "UNIX">
1991 <IEMIT `ADD .STR 3 = .NSTR>
1992 <IEMIT `LSH .NSTR -2 = .NSTR>
1993 <IEMIT `ENDIF "UNIX">)>
1995 <COND (<ASSIGNED? STKTMP>
1996 <IEMIT `SUB .STKTMP .NSTR = .STKTMP>)
1998 <IEMIT `SUB 0 .NSTR = <SET STKTMP <GEN-TEMP FIX>>>)>
1999 <COND (<N==? .STR .NSTR> <FREE-TEMP .NSTR>)>
2000 <SET STK <+ .STK 2>>)
2002 <SET STK-CHARS7 <+ </ <+ .STR 4> 5> .STK-CHARS7>>
2003 <SET STK-CHARS8 <+ </ <+ .STR 3> 4> .STK-CHARS8>>
2004 <SET STK <+ .STK 2>>)
2008 <COND (<==? .NAM IUVECTOR> .STR)
2009 (<==? .NAM IBYTES> </ <+ .STR 3> 4>)
2015 <DEFINE MULTI-SET-GEN (N:NODE W
2016 "AUX" (K:<LIST [REST NODE]> <KIDS .N>) (SEG? <>)
2017 (SIDE-E <>) (MX:FIX 0) (MN:FIX 0)
2018 (VARS:<LIST [REST LIST]> <NODE-NAME .N>) TL:LIST
2019 (VLN:FIX <LENGTH .VARS>) NT:FIX SEGTYP LCL
2020 (LV:<OR ATOM SYMTAB> <1 <NTH .VARS .VLN>>) (I:FIX 0))
2022 <FUNCTION (N:NODE "AUX" RT)
2023 <COND (<OR <==? <SET NT <NODE-TYPE .N>> ,SEG-CODE>
2024 <==? .NT ,SEGMENT-CODE>>
2026 <SET MX <MAX <+ <MAXL <SET RT <RESULT-TYPE <1 <KIDS .N>>>>> .MX>
2028 <SET MN <+ <MINL .RT> .MN>>)
2032 <SET MX <MAX <+ .MX 1> ,MAX-LENGTH>>)>
2033 <COND (<AND <G=? <LENGTH .N> <INDEX ,SIDE-EFFECTS>>
2039 <PROG ((SEGLABEL <MAKE-TAG>) COUNTMP (SEGCALLED <>) SEGTMP)
2040 #DECL ((SEGLABEL COUNTMP SEGCALLED) <SPECIAL ANY>)
2042 <FUNCTION (NN:NODE "AUX" (NT <NODE-TYPE .NN>) RES)
2044 (<OR <==? .NT ,SEG-CODE> <==? .NT ,SEGMENT-CODE>>
2045 <COND (<NOT <ASSIGNED? SEGTMP>>
2046 <SET SEGTMP <GEN-TEMP <>>>
2047 <SET COUNTMP <GEN-TEMP FIX>>
2048 <SET-TEMP .COUNTMP .I '(`TYPE FIX)>)>
2049 <SET RES <GEN <SET NN <1 <KIDS .NN>>> .SEGTMP>>
2050 <SET SEGTYP <STRUCTYP-SEG <RESULT-TYPE .NN>>>
2051 <COND (<AND <N==? .RES ,NO-DATUM> <N==? .SEGTYP MULTI>>
2052 <SEGMENT-STACK .SEGTMP
2055 <ISTYPE? <RESULT-TYPE .NN>>
2057 <SET SEGLABEL <MAKE-TAG>>)
2059 <LABEL-TAG .SEGLABEL>
2060 <SET SEGLABEL <MAKE-TAG>>)>)
2062 <GEN .NN ,POP-STACK>)>>
2064 <COND (<AND .CAREFUL <N==? .MX .MN>>
2065 <IEMIT `VEQUAL? .COUNTMP .VLN - `COMPERR>)>
2066 <REPEAT (TVAR TSYM TMP)
2068 <TYPE? <SET TSYM <1 <SET TVAR <NTH .VARS .VLN>>>>
2070 <NOT <SPEC-SYM .TSYM>>
2071 <N==? <CODE-SYM .TSYM> -1>>
2072 <USE-TEMP <SET TMP <TEMP-NAME-SYM .TSYM>>
2074 <IEMIT `POP = .TMP>)
2076 <IEMIT `POP = <SET TMP <GEN-TEMP <OR <2 .TVAR> T>>>>
2077 <SET-VALUE <COND (<TYPE? .TSYM SYMTAB> <NAME-SYM .TSYM>)
2080 <NOT <AND <TYPE? .TSYM SYMTAB>
2081 <N==? <CODE-SYM .TSYM> -1>>>>
2083 <COND (<==? <SET VLN <- .VLN 1>> 0> <RETURN>)>>>)
2087 <FUNCTION (NN:NODE SYP:<LIST <OR ATOM SYMTAB>>
2088 "AUX" (TY <RESULT-TYPE .NN>) PT
2089 (SY:<OR ATOM SYMTAB> <1 .SYP>))
2090 <COND (<TYPE? .SY SYMTAB>
2091 <SET TY <TYPE-AND <2 .SYP> .TY>>)>
2092 <COND (<AND <SET TY <ISTYPE? .TY>>
2093 <OR <==? <SET PT <TYPEPRIM .TY>> FIX>
2095 (ELSE <SET TY ANY>)>
2096 <GEN .NN <GEN-TEMP .TY>>>
2100 <FUNCTION (SYP:<LIST <OR ATOM SYMTAB>> TMP:TEMP
2101 "AUX" (SY:<OR ATOM SYMTAB> <1 .SYP>) (LCL <>))
2102 <COND (<AND <TYPE? .SY SYMTAB>
2103 <N==? <CODE-SYM .SY> -1>
2105 <NOT <SPEC-SYM .SY>>>
2106 <IEMIT `SET <TEM-NAME-SYM .SY> .TMP>
2109 <COND (<TYPE? .SY SYMTAB> <SET SY <NAME-SYM .SY>>)>
2110 <SET-VALUE .SY .TMP <NOT .LCL>>
2115 <PROG (NL-LATER:LIST SL-LATER:LIST ANY-DONE (MUCH-LATER:LIST ())
2117 <SET NL-LATER <SET SL-LATER ()>>
2121 "AUX" (SYP:<LIST <OR ATOM SYMTAB TEMP>> <1 .SL>) (LCL <>) TY
2122 (N:NODE <1 .NL>) (SY:<OR ATOM SYMTAB TEMP> <1 .SYP>) TMP)
2123 <COND (<OR <TYPE? .SY TEMP>
2124 <AND <NOT <REF? .SY <REST .NL>>>
2125 <NOT <REF? .SY .NL-LATER>>>>
2127 <COND (<OR <AND <TYPE? .SY SYMTAB>
2128 <N==? <CODE-SYM .SY> -1>
2130 <NOT <SPEC-SYM .SY>>
2131 <SET TMP <TEMP-NAME-SYM .SY>>>
2132 <AND <TYPE? .SY TEMP> <SET TMP .SY>>>
2135 <COND (<TYPE? .SY SYMTAB>
2136 <SET SY <NAME-SYM .SY>>)>
2137 <SET-VALUE .SY <GEN .N DONT-CARE> <NOT .LCL>>)>)
2139 <SET SL-LATER (.SYP !.SL-LATER)>
2140 <SET NL-LATER (.N !.NL-LATER)>)>>
2143 <COND (<AND .ANY-DONE <NOT <EMPTY? .SL-LATER>>>
2144 <SET VARS .SL-LATER>
2147 (<NOT <EMPTY? .SL-LATER>>
2149 ((<1 .SL-LATER> <SET TTMP <GEN-TEMP <>>>) !.MUCH-LATER)>
2150 <SET VARS ((.TTMP) !<REST .SL-LATER>)>
2155 "AUX" (SY:<OR ATOM SYMTAB> <1 <1 .L>>) (LCL <>)
2157 <COND (<AND <TYPE? .SY SYMTAB>
2158 <N==? <CODE-SYM .SY> -1>
2160 <NOT <SPEC-SYM .SY>>>
2161 <IEMIT `SET <TEMP-NAME-SYM .SY> .TMP>
2164 <COND (<TYPE? .SY SYMTAB> <SET SY <NAME-SYM .SY>>)>
2165 <SET-VALUE .SY .TMP <NOT .LCL>>
2168 <COND (<N==? .W FLUSHED>
2170 <COND (<AND <TYPE? .LV SYMTAB>
2171 <N==? <CODE-SYM .LV> -1>
2173 <NOT <SPEC-SYM .LV>>>
2174 <TEMP-REFS .LV <+ <TEMP-REFS .LV> 1>>
2177 <COND (<TYPE? .LV SYMTAB> <SET LV <NAME-SYM .LV>>)>
2178 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
2179 <GET-VALUE-X .LV .W <NOT .LCL>>)>)
2182 <DEFINE REF? (SY:<OR ATOM SYMTAB> L:<LIST [REST NODE]>)
2184 <FUNCTION (N:NODE "AUX" (NT:FIX <NODE-TYPE .N>) NN)
2186 <COND (<OR <==? .NT ,LVAL-CODE>
2187 <==? .NT ,ASSIGNED?-CODE>
2188 <==? .NT ,SET-CODE>>
2189 <COND (<==? <NODE-NAME .N> .SY> <MAPLEAVE>)>)
2190 (<OR <==? .NT ,FLVAL-CODE> <==? .NT ,FSET-CODE>>
2191 <COND (<OR <==? <NODE-NAME .N> .SY>
2192 <COND (<==? <NODE-TYPE
2193 <SET NN <1 <KIDS .N>>>>
2195 <==? <NODE-NAME .NN> .SY>)
2197 <OR <TYPE? .SY ATOM>
2198 <==? <CODE-SYM .SY> -1>
2201 (<AND <G? <LENGTH .N> <INDEX ,SIDE-EFFECTS>>
2202 <MEMQ ALL <CHTYPE <SIDE-EFFECTS .N>
2204 <OR <TYPE? .SY ATOM>
2206 <==? <CODE-SYM .SY> -1>>>
2209 <COND (<REF? .SY <KIDS .N>> <MAPLEAVE T>)>
2210 <COND (<==? .NT ,BRANCH-CODE>
2211 <SET NT <NODE-TYPE <SET N <PREDIC .N>>>>
2215 <DEFINE GEN-DISPATCH (N W)
2218 (,FORM-CODE <FORM-GEN .N .W>)
2219 (,PROG-CODE <PROG-REP-GEN .N .W>)
2220 (,SUBR-CODE <SUBR-GEN .N .W>)
2221 (,COND-CODE <COND-GEN .N .W>)
2222 (,LVAL-CODE <LVAL-GEN .N .W>)
2223 (,SET-CODE <SET-GEN .N .W>)
2224 (,OR-CODE <OR-GEN .N .W>)
2225 (,AND-CODE <AND-GEN .N .W>)
2226 (,RETURN-CODE <RETURN-GEN .N .W>)
2227 (,COPY-CODE <COPY-GEN .N .W>)
2228 (,AGAIN-CODE <AGAIN-GEN .N .W>)
2229 (,ARITH-CODE <ARITH-GEN .N .W>)
2230 (,RSUBR-CODE <SUBR-GEN .N .W>)
2231 (,0-TST-CODE <0-TEST .N .W>)
2232 (,NOT-CODE <NOT-GEN .N .W>)
2233 (,1?-CODE <1?-GEN .N .W>)
2234 (,TEST-CODE <TEST-GEN .N .W>)
2235 (,EQ-CODE <==-GEN .N .W>)
2236 (,TY?-CODE <TYPE?-GEN .N .W>)
2237 (,LNTH-CODE <LNTH-GEN .N .W>)
2238 (,MT-CODE <MT-GEN .N .W>)
2239 (,REST-CODE <REST-GEN .N .W>)
2240 (,NTH-CODE <NTH-GEN .N .W>)
2241 (,PUT-CODE <PUT-GEN .N .W>)
2242 (,PUTR-CODE <PUTREST-GEN .N .W>)
2243 (,FLVAL-CODE <FLVAL-GEN .N .W>)
2244 (,FSET-CODE <FSET-GEN .N .W>)
2245 (,FGVAL-CODE <FGVAL-GEN .N .W>)
2246 (,FSETG-CODE <FSETG-GEN .N .W>)
2247 (,MIN-MAX-CODE <MIN-MAX .N .W>)
2248 (,CHTYPE-CODE <CHTYPE-GEN .N .W>)
2249 (,FIX-CODE <FIX-GEN .N .W>)
2250 (,FLOAT-CODE <FLOAT-GEN .N .W>)
2251 (,ABS-CODE <ABS-GEN .N .W>)
2252 (,MOD-CODE <MOD-GEN .N .W>)
2253 (,ID-CODE <ID-GEN .N .W>)
2254 (,ASSIGNED?-CODE <ASSIGNED?-GEN .N .W>)
2255 (,BITL-CODE <BITLOG-GEN .N .W>)
2256 (,ISUBR-CODE <SUBR-GEN .N .W>)
2257 (,EOF-CODE <ID-GEN .N .W>)
2258 (,READ-EOF2-CODE <READ2-GEN .N .W>)
2259 (,READ-EOF-CODE <SUBR-GEN .N .W>)
2260 (,GET2-CODE <GET2-GEN .N .W>)
2261 (,GET-CODE <GET-GEN .N .W>)
2262 (,IPUT-CODE <SUBR-GEN .N .W>)
2263 (,MAP-CODE <MAPFR-GEN .N .W>)
2264 (,MARGS-CODE <MPARGS-GEN .N .W>)
2265 (,MAPLEAVE-CODE <MAPLEAVE-GEN .N .W>)
2266 (,MAPRET-STOP-CODE <MAPRET-STOP-GEN .N .W>)
2267 (,UNWIND-CODE <UNWIND-GEN .N .W>)
2268 (,GVAL-CODE <GVAL-GEN .N .W>)
2269 (,SETG-CODE <SETG-GEN .N .W>)
2270 (,MEMQ-CODE <MEMQ-GEN .N .W>)
2271 (,LENGTH?-CODE <LENGTH?-GEN .N .W>)
2272 (,FORM-F-CODE <FORM-F-GEN .N .W>)
2273 (,ALL-REST-CODE <ALL-REST-GEN .N .W>)
2274 (,COPY-LIST-CODE <LIST-BUILD .N .W>)
2275 (,PUT-SAME-CODE <PUT-GEN .N .W>)
2276 (,BACK-CODE <BACK-GEN .N .W>)
2277 (,TOP-CODE <TOP-GEN .N .W>)
2278 (,ROT-CODE <ROT-GEN .N .W>)
2279 (,LSH-CODE <LSH-GEN .N .W>)
2280 (,BIT-TEST-CODE <BIT-TEST-GEN .N .W>)
2281 (,CALL-CODE <CALL-GEN .N .W>)
2282 (,MONAD-CODE <MONAD?-GEN .N .W>)
2283 (,GASSIGNED?-CODE <GASSIGNED?-GEN .N .W>)
2284 (,APPLY-CODE <APPLY-GEN .N .W>)
2285 (,ADECL-CODE <ADECL-GEN .N .W>)
2286 (,MULTI-RETURN-CODE <MULTI-RETURN-GEN .N .W>)
2287 (,VALID-CODE <VALID-TYPE?-GEN .N .W>)
2288 (,TYPE-C-CODE <TYPE-C-GEN .N .W>)
2289 (,=?-STRING-CODE <=?-STRING-GEN .N .W>)
2290 (,CASE-CODE <CASE-GEN .N .W>)
2291 (,FGETBITS-CODE <FGETBITS-GEN .N .W>)
2292 (,FPUTBITS-CODE <FPUTBITS-GEN .N .W>)
2293 (,ISTRUC-CODE <ISTRUC-GEN .N .W>)
2294 (,ISTRUC2-CODE <ISTRUC-GEN .N .W>)
2295 (,STACK-CODE <STACK-GEN .N .W>)
2296 (,CHANNEL-OP-CODE <CHANNEL-OP-GEN .N .W>)
2297 (,ATOM-PART-CODE <ATOM-PART-GEN .N .W>)
2298 (,OFFSET-PART-CODE <OFFSET-PART-GEN .N .W>)
2299 (,PUT-GET-DECL-CODE <PUT-GET-DECL-GEN .N .W>)
2300 (,SUBSTRUC-CODE <SUBSTRUC-GEN .N .W>)
2301 (,MULTI-SET-CODE <MULTI-SET-GEN .N .W>)
2303 (<DEFAULT-GEN .N .W>)>>