4 <ENTRY MAKE-TAG FIND-FRAME SPEC-GEN-TEMP PREV-FRAME GEN-VAL-==? GEN-==? GET-BINDING BRANCH-TAG RET-TMP-AC MIM-FCN MIM-RETURN REFERENCE GEN-TYPE? GEN-VT GEN-TC GEN-CHTYPE GEN-GVAL GEN-SETG MIM-TEMPS-HOLD MIM-TEMPS-EMIT EMIT IEMIT INSTRUCTION LABEL-TAG PUSH POP PUSH-CONSTANT GEN-FIX-BIND SPECIAL-BINDING FINISH-BINDING SET-TEMP SET-SYM CURRENT-FRAME GET-ARG-TUPLE ARG-TO-TEMP TEST-ARG MSUBR-CALL SEG-SUBR-CALL START-FRAME GEN-LIST GEN-VECTOR GEN-UVECTOR GEN-TUPLE MOVE-ARG GEN-CHTYPE D-B-TAG GEN-TEMP NTH-LIST NTH-UVECTOR NTH-VECTOR NTH-STRING NTH-RECORD NTH-BYTES REST-LIST REST-UVECTOR REST-VECTOR REST-STRING REST-BYTES REST-RECORD EMPTY-LIST EMPTY-UVECTOR EMPTY-VECTOR EMPTY-STRING EMPTY-BYTES EMPTY-RECORD PUT-LIST PUT-UVECTOR PUT-VECTOR PUT-STRING PUT-BYTES PUT-RECORD LENGTH-LIST LENGTH-UVECTOR LENGTH-VECTOR LENGTH-STRING LENGTH-BYTES LENGTH-RECORD PROTECT USE-TEMP FREE-TEMP DEALLOCATE-TEMP GEN-SHIFT GEN-ARG-NUM SET-VALUE GET-VALUE-X ATOMCHK ISPEC-BIND GEN-GASS ASS-GEN M$$VALU TYPIFY-TEMPS SPEC-IEMIT>
6 <USE "CHKDCL" "COMPDEC" "ADVMESS">
8 <SETG RAT (`RECORD-TYPE ATOM)>
10 <SETG RBN (`RECORD-TYPE LBIND)>
12 <SETG RGBN (`RECORD-TYPE GBIND)>
14 <SETG QQ-BIND <FORM QUOTE BIND>>
22 <SETG QQ-M$$BINDID <FORM QUOTE M$$BINDID>>
26 <GDECL (MIMOPS) VECTOR>
46 <MANIFEST M$$FRM-MSUB M$$FRM-ARGN M$$FRM-ID M$$FRM-PREV M$$FRM-BIND M$$FRM-ARGS M$$FRM-ACTN M$$FRM-PC M$$FRM-TP>
60 <MANIFEST M$$LVAL M$$GVAL M$$PNAM M$$OBLS M$$TYPE M$$ATML>
76 <MANIFEST M$$VALU M$$ATOM M$$DECL M$$PBND M$$PATM M$$UBID M$$BNDL>
78 <SETG MIMOPS [("PUSH" ANY) ("POP" ANY) ("SET" ANY) ("SETS" ANY) ("GETS" ANY) ("ADJ" ANY) ("FRAME" ANY) ("VFRAME" ANY) ("CFRAME" ANY) ("ARGS" TUPLE) ("TUPLE" TUPLE) ("RFRAME" NO-RETURN) ("CALL" ANY) ("ACTIVATION" ANY) ("AGAIN" NO-RETURN) ("RET" NO-RETURN) ("RTUPLE" NO-RETURN) ("JUMP" NO-RETURN) ("HALT" ANY) ("OBJECT" ANY) ("TYPE" FIX) ("TYPE?" ANY) ("CHTYPE" ANY) ("NEWTYPE" FIX) ("VALUE" FIX) ("LIST" LIST) ("UBLOCK" ANY) ("RECORD" ANY) ("NTHL" ANY) ("NTHR" ANY T) ("NTHU" ANY) ("LENL" FIX) ("LENR" FIX T) ("LENU" FIX) ("EMPL?" ANY) ("EMPR?" ANY T) ("EMPU?" ANY) ("PUTL" LIST) ("PUTU" ANY) ("PUTR" ANY T) ("RESTL" LIST) ("RESTU" ANY) ("BACKU" ANY) ("TOPU" ANY) ("CONS" LIST) ("PUTREST" LIST) ("BIND" ANY) ("SETG" ANY) ("GVAL" ANY) ("OPEN" ANY) ("CLOSE" ANY) ("READ" ANY) ("PRINT" ANY) ("SAVE" ANY) ("RESTORE" ANY) ("ADD" FIX) ("ADDF" FLOAT) ("SUB" FIX) ("SUBF" FLOAT) ("MUL" FIX) ("MULF" FLOAT) ("DIV" FIX) ("DIVF" FLOAT) ("RANDOM" FIX) ("FIX" FIX) ("FLOAT" FLOAT) ("GRTR?" ANY) ("LESS?" ANY) ("AND" FIX) ("OR" FIX) ("XOR" FIX) ("EQV" FIX) ("LSH" FIX) ("ROT" FIX) ("EQUAL?" ANY) ("VEQUAL?" ANY) ("RESET" ANY) ("ATIC" FIX) ("MARKL?" ANY) ("MARKU?" ANY) ("MARKR?" ANY) ("MARKL" ANY) ("MARKU" ANY) ("MARKR" ANY) ("MARKUV?" ANY) ("MARKUV" ANY) ("MARKUU" ANY) ("MARKUU?" ANY) ("MARKUS" ANY) ("MARKUS?" ANY) ("MARKUB" ANY) ("MARKUB?" ANY) ("SWEEP" ANY) ("RETRY" NO-RETURN) ("LOOP" ANY) ("IRECORD" ANY) ("TEMPLATE-TABLE" ANY) ("CONTENTS" ANY) ("NEXTS" FIX) ("SWNEXT" ANY) ("RELL" ANY) ("RELU" ANY) ("RELR" ANY) ("INTGO" ANY) ("PFRAME" ANY) ("NTH1" ANY) ("REST1" ANY) ("EMPTY?" ANY) ("MONAD?" ANY) ("QUIT" ANY) ("SYSCALL" ANY) ("LEGAL?" ANY) ("SETZONE" ANY) ("BLT" ANY T) ("ALLOCR" ANY T) ("ALLOCUU" ANY) ("ALLOCUV" ANY) ("ALLOCL" ANY) ("ALLOCUS" ANY) ("ALLOCUB" ANY) ("PUTS" ANY) ("SYSOP" ANY) ("MPAGES" FIX) ("ACALL" ANY) ("LOCK" ANY) ("RNTIME" FLOAT) ("TYPEW" ANY) ("TYPEWC" ANY) ("SAVTTY" ANY) ("FATAL" ANY) ("GETTTY" ANY) ("FGETBITS" ANY) ("FPUTBITS" ANY) ("PIPE" ANY) ("IFSYS" ANY) ("ENDIF" ANY) ("CGC-UVECTOR" ANY) ("CGC-VECTOR" ANY) ("CGC-STRING" ANY) ("CGC-BYTES" ANY) ("CGC-LIST" ANY) ("CGC-RECORD" ANY T) ("MOVSTK" ANY) ("GETSTK" ANY) ("ON-STACK?" FIX) ("USBLOCK" ANY) ("SBLOCK" ANY) ("UUBLOCK" ANY) ("BBIND" ANY) ("GEN-LVAL" ANY) ("GEN-SET" ANY) ("STRING-EQUAL?" ANY) ("MOVE-STRING" ANY) ("MOVE-WORDS" ANY) ("STRCOMP" ANY) ("SETSIZ" ANY) ("BIGSTACK" ANY)]>
80 <MAPF <> <FUNCTION (L "AUX" (S <1 .L>) (TYP <2 .L>) A) #DECL ((L) <LIST STRING ANY>) <COND (<NOT <SET A <LOOKUP .S ,MIM-OBL>>> <SET A <INSERT .S ,MIM-OBL>>)> <COND (<N==? .TYP ANY> <PUTPROP .A TYPE .TYP>)> <COND (<G? <LENGTH .L> 2> <PUTPROP .A `RECORD-TYPE T>)>> ,MIMOPS>
82 "Generate function starting pseudo-op"
85 <GFCN
\1aMIM-FCN ("VALUE" LIST ANY ANY "OPTIONAL" ANY) NAME6 DCL7 NEED-FR8>
86 <OPT-DISPATCH 2 %<> OPT4 OPT5>
94 <TYPE? NEED-FR8 <TYPE-CODE FALSE> + PHRASE13>
96 <SET TEMP14 '`FCN (TYPE ATOM)>
99 <SET TEMP14 '`GFCN (TYPE ATOM)>
103 <CHTYPE NAME6 <TYPE-CODE FCN-ATOM> = STACK>
105 <CHTYPE DCL7 <TYPE-CODE LIST> = STACK>
107 <CALL '
\1aFORM 3 = TEMP14>
110 <RESTL TEMP14 1 = TEMP14 (TYPE LIST)>
111 <RESTL TEMP14 1 = TEMP14 (TYPE LIST)>
112 <CHTYPE TEMP14 <TYPE-CODE LIST> = TEMP14>
113 <GEN-SET 'ARGS-NEXT TEMP14>
117 "Generate temp pseudo-op and return pointer to list so that others can
118 be dynamically added"
121 <GFCN
\1aMIM-TEMPS-HOLD ("VALUE" LIST)>
126 <CALL '
\1aFORM 1 = TEMP5>
127 <GEN-SET 'TMPS TEMP5>
129 <GEN-LVAL 'TMPS = TEMP5>
130 <CHTYPE TEMP5 <TYPE-CODE LIST> = TEMP5>
131 <GEN-SET 'TMPS-NEXT TEMP5>
133 <GEN-LVAL 'TMPS-NEXT = TEMP5>
136 <END
\1aMIM-TEMPS-HOLD>
138 <GFCN
\1aMIM-TEMPS-EMIT ("VALUE" ATOM)>
142 <GEN-LVAL 'TMPS = STACK>
146 <CALL '
\1aIEMIT 1 = TEMP5>
149 <END
\1aMIM-TEMPS-EMIT>
150 "Here to change any TEMPS to ADECLs if possible"
153 <GFCN
\1aTYPIFY-TEMPS ("VALUE" <OR ATOM FALSE> <LIST [REST TEMP]>) L4>
154 <TEMP TEMP14 TEMP11:LIST TMP16:TEMP TYP17>
156 <SET TEMP14 %<> (TYPE FALSE)>
157 <SET TEMP11 L4 (TYPE LIST)>
162 <EMPL? TEMP11 + MAPAP9>
163 <NTHL TEMP11 1 = TMP16>
164 <NTHUV TMP16 6 = TYP17>
166 <TYPE? TEMP14 <TYPE-CODE FALSE> + PHRASE19>
170 <CALL '
\1aISTYPE? 1 = TYP17>
172 <TYPE? TEMP14 <TYPE-CODE FALSE> + PHRASE19>
173 <VEQUAL? TYP17 'NO-RETURN - TAG22>
174 <SET TEMP14 %<> (TYPE FALSE)>
177 <VEQUAL? TYP17 'ANY - TAG23>
178 <SET TEMP14 %<> (TYPE FALSE)>
183 <NTHUV TMP16 3 = TEMP14>
185 <RESTL TEMP14 1 = TEMP14 (TYPE LIST)>
186 <CHTYPE TEMP14 <TYPE-CODE LIST> = STACK>
190 <CALL '
\1aMUNG-TMP 3 = TEMP14>
192 <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
197 <END
\1aTYPIFY-TEMPS>
199 <GFCN
\1aMUNG-TMP ("VALUE" <OR ATOM FALSE> TEMP LIST ANY) TMP4 TL5 TYP6>
200 <TEMP NM7:ATOM TEMP17 TEMP14:LIST LL19:LIST>
202 <NTHUV TMP4 1 = NM7 (TYPE ATOM)>
204 <SET TEMP17 %<> (TYPE FALSE)>
205 <SET TEMP14 TL5 (TYPE LIST)>
210 <EMPL? TEMP14 + MAPAP12>
212 <NTHL LL19 1 = TEMP17>
213 <EQUAL? TEMP17 NM7 + TAG23>
215 <SET TEMP17 %<> (TYPE FALSE)>
222 <UBLOCK <TYPE-CODE VECTOR> 2 = TEMP17>
223 <CHTYPE TEMP17 <TYPE-CODE ADECL> = TEMP17>
228 <RESTL TEMP14 1 = TEMP14 (TYPE LIST)>
234 "Here to create a temporary"
237 <GFCN
\1aGEN-TEMP ("VALUE" TEMP "OPTIONAL" ANY ANY ANY ANY) ALLOCATE9 NM10 ARG-TEMP11 NO-RECYC12>
238 <OPT-DISPATCH 0 %<> OPT4 OPT5 OPT6 OPT7 OPT8>
248 <TEMP TEMP16 TN14:LIST FT15:LIST TMP13:TEMP OF57:LIST>
250 <GEN-LVAL 'TMPS-NEXT = TN14>
251 <GEN-LVAL 'FREE-TEMPS = FT15>
252 <EMPL? FT15 + BOOL24 (TYPE LIST)>
253 <TYPE? ARG-TEMP11 <TYPE-CODE FALSE> + PHRASE23>
258 <CALL '
\1aMAKE-TAG 1 = NM10>
259 <TYPE? ALLOCATE9 <TYPE-CODE FALSE> + PHRASE27>
260 <CHTYPE NM10 <TYPE-CODE ATOM> = TEMP16>
261 <CONS TEMP16 () = TEMP16>
262 <GEN-SET 'TMPS-NEXT TEMP16>
263 <PUTREST TN14 TEMP16>
268 <TYPE? ALLOCATE9 <TYPE-CODE FALSE> - BOOL34>
269 <TYPE? NO-RECYC12 <TYPE-CODE FALSE> + PHRASE33>
270 <TYPE? ARG-TEMP11 <TYPE-CODE FALSE> + PHRASE33>
272 <SET TEMP16 1 (TYPE FIX)>
275 <SET TEMP16 0 (TYPE FIX)>
279 <GEN-LVAL 'TMPS = STACK>
280 <TYPE? ALLOCATE9 <TYPE-CODE FALSE> - BOOL41>
281 <TYPE? ARG-TEMP11 <TYPE-CODE FALSE> + PHRASE40>
284 <SET TEMP16 'T (TYPE ATOM)>
287 <SET TEMP16 %<> (TYPE FALSE)>
293 <TYPE? ALLOCATE9 <TYPE-CODE FALSE> + PHRASE45>
297 <CALL '
\1aISTYPE? 1 = TEMP16>
300 <SET TEMP16 'NO-RETURN (TYPE ATOM)>
304 <UBLOCK <TYPE-CODE VECTOR> 6 = TEMP16>
305 <CHTYPE TEMP16 <TYPE-CODE TEMP> = TMP13>
307 <GEN-LVAL 'EVERY-TEMP = TEMP16>
308 <CONS TMP13 TEMP16 = TEMP16>
309 <GEN-SET 'EVERY-TEMP TEMP16>
314 <TYPE? ALLOCATE9 <TYPE-CODE FALSE> + PHRASE52>
315 <EQUAL? ALLOCATE9 'ANY + PHRASE52>
321 <EMPL? TN14 + PHRASE52 (TYPE LIST)>
322 <NTHL TN14 1 = TMP13 (TYPE TEMP)>
323 <NTHUV TMP13 6 = TEMP16>
324 <EQUAL? TEMP16 'NO-RETURN + BOOL63>
326 <NTHUV TMP13 6 = TEMP16>
327 <TYPE? TEMP16 <TYPE-CODE FALSE> + PHRASE62>
330 <FRAME '
\1aTYPE-MERGE>
331 <NTHUV TMP13 6 = STACK>
333 <CALL '
\1aTYPE-MERGE 2 = STACK>
334 <CALL '
\1aISTYPE? 1 = TEMP16>
335 <TYPE? TEMP16 <TYPE-CODE FALSE> + PHRASE62>
338 <VEQUAL? OF57 TN14 - PHRASE69>
339 <RESTL TN14 1 = TEMP16 (TYPE LIST)>
341 <GEN-SET 'FREE-TEMPS TEMP16>
345 <RESTL TN14 1 = TEMP16 (TYPE LIST)>
347 <PUTREST OF57 TEMP16>
353 <RESTL OF57 1 = TN14 (TYPE LIST)>
360 <CALL '
\1aUSE-TEMP 2>
364 <NTHL FT15 1 = TMP13 (TYPE TEMP)>
365 <RESTL FT15 1 = TEMP16 (TYPE LIST)>
367 <GEN-SET 'FREE-TEMPS TEMP16>
369 <TYPE? ALLOCATE9 <TYPE-CODE FALSE> + PHRASE78>
374 <CALL '
\1aUSE-TEMP 2>
380 <GFCN
\1aSPEC-GEN-TEMP ("VALUE" TEMP ANY "OPTIONAL" ANY ANY) TTMPS7 ALLOCATE8 NM9>
381 <OPT-DISPATCH 1 %<> OPT4 OPT5 OPT6>
387 <TEMP TEMP3:LBIND TEMP15 L11 TEMP34 TMP10:TEMP>
389 <GETS 'BIND = TEMP3 (TYPE LBIND)>
390 <GEN-LVAL 'TMPS-NEXT = TEMP15>
391 <BBIND 'TMPS-NEXT 'LIST 'FIX TEMP15>
393 <GEN-LVAL 'FREE-TEMPS = TEMP15>
394 <BBIND 'FREE-TEMPS 'LIST 'FIX TEMP15>
396 <GEN-LVAL 'TMPS = TEMP15>
397 <BBIND 'TMPS 'FORM 'FIX TEMP15>
399 <NTHR 'TMPS 2 = TEMP15 (RECORD-TYPE ATOM) (TYPE LBIND)>
400 <NTHR TEMP15 1 = TEMP15 (RECORD-TYPE LBIND)>
401 <EQUAL? TEMP15 TTMPS7 + PHRASE23>
403 <FRAME '
\1aFIND-FRAME>
404 <NTHR 'TMPS 2 = TEMP15 (RECORD-TYPE ATOM) (TYPE LBIND)>
405 <PUTR TEMP15 1 TTMPS7 (RECORD-TYPE LBIND)>
410 <CALL '
\1aFIND-FRAME 2 = L11>
411 <EMPTY? L11 - PHRASE30>
412 <FRAME '
\1aCOMPILE-LOSSAGE>
413 <PUSH "Bad frame model">
414 <CALL '
\1aCOMPILE-LOSSAGE 1>
416 <RESTL L11 1 = TEMP15 (TYPE LIST)>
417 <NTHL TEMP15 1 = TEMP15 (TYPE LIST)>
418 <NTHR 'TMPS-NEXT 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
419 <PUTR TEMP34 1 TEMP15 (RECORD-TYPE LBIND)>
421 <RESTL L11 1 = TEMP15 (TYPE LIST)>
422 <RESTL TEMP15 1 = TEMP15 (TYPE LIST)>
423 <NTHL TEMP15 1 = TEMP15 (TYPE LIST)>
424 <NTHR 'FREE-TEMPS 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
425 <PUTR TEMP34 1 TEMP15 (RECORD-TYPE LBIND)>
432 <CALL '
\1aGEN-TEMP 2 = TMP10>
433 <NTHR 'TMPS-NEXT 2 = TEMP15 (RECORD-TYPE ATOM) (TYPE LBIND)>
434 <NTHR TEMP15 1 = TEMP15 (RECORD-TYPE LBIND)>
435 <RESTL L11 1 = TEMP34 (TYPE LIST)>
436 <PUTL TEMP34 1 TEMP15>
438 <NTHR 'FREE-TEMPS 2 = TEMP15 (RECORD-TYPE ATOM) (TYPE LBIND)>
439 <NTHR TEMP15 1 = TEMP15 (RECORD-TYPE LBIND)>
440 <RESTL L11 1 = TEMP34 (TYPE LIST)>
442 <RESTL TEMP34 1 = TEMP34 (TYPE LIST)>
443 <PUTL TEMP34 1 TEMP15>
452 <CALL '
\1aGEN-TEMP 2 = TMP10>
459 <END
\1aSPEC-GEN-TEMP>
461 <GFCN
\1aFIND-FRAME ("VALUE" <OR LIST TEMP> ANY "OPTIONAL" ANY) TMPS6 LOC7>
462 <OPT-DISPATCH 1 %<> OPT4 OPT5>
468 <GEN-LVAL 'ALL-TEMPS-LIST = L8>
472 <EMPL? L8 - PHRASE20 (TYPE LIST)>
473 <TYPE? LOC7 <TYPE-CODE FALSE> + PHRASE19>
476 <FRAME '
\1aCOMPILE-LOSSAGE>
477 <PUSH "Bad frame model">
478 <CALL '
\1aCOMPILE-LOSSAGE 1>
480 <NTHL L8 1 = TEMP9 (TYPE LIST)>
481 <NTHL TEMP9 1 = TEMP9 (TYPE FORM)>
482 <EQUAL? TEMP9 TMPS6 + PHRASE23>
484 <RESTL L8 1 = L8 (TYPE LIST)>
487 <TYPE? LOC7 <TYPE-CODE FALSE> + PHRASE27>
489 <NTHL L8 1 = TEMP9 (TYPE LIST)>
494 <NTHL L8 1 = TEMP9 (TYPE LIST)>
496 <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
497 <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
498 <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
499 <NTHL TEMP9 1 = TEMP9 (TYPE TEMP)>
504 <GFCN
\1aUSE-TEMP ("VALUE" TEMP TEMP "OPTIONAL" ANY ANY) TMP7 TY8 INIT9>
505 <OPT-DISPATCH 1 %<> OPT4 OPT5 OPT6>
511 <TEMP NM10 TEMP15 TEMP18 L11>
513 <NTHUV TMP7 1 = NM10 (TYPE ATOM)>
514 <NTHUV TMP7 4 = TEMP15>
515 <TYPE? TEMP15 <TYPE-CODE FALSE> - PHRASE14>
517 <NTHUV TMP7 3 = TEMP15>
518 <GEN-LVAL 'TMPS = TEMP18>
519 <EQUAL? TEMP15 TEMP18 - PHRASE17>
521 <GEN-LVAL 'TMPS-NEXT = TEMP18>
522 <CONS NM10 () = TEMP15>
524 <GEN-SET 'TMPS-NEXT TEMP15>
525 <PUTREST TEMP18 TEMP15>
529 <FRAME '
\1aFIND-FRAME>
530 <NTHUV TMP7 3 = STACK>
532 <CALL '
\1aFIND-FRAME 2 = L11>
533 <EMPTY? L11 - PHRASE28>
534 <FRAME '
\1aCOMPILE-LOSSAGE>
535 <PUSH "Bad frame model">
536 <CALL '
\1aCOMPILE-LOSSAGE 1>
538 <RESTL L11 1 = TEMP18 (TYPE LIST)>
539 <NTHL TEMP18 1 = TEMP18>
540 <CONS NM10 () = TEMP15>
542 <RESTL L11 1 = NM10 (TYPE LIST)>
545 <RESTL L11 1 = NM10 (TYPE LIST)>
547 <NTHL NM10 1 = NM10 (TYPE LIST)>
548 <PUTREST TEMP18 NM10>
553 <TYPE? TY8 <TYPE-CODE FALSE> + PHRASE32>
554 <NTHUV TMP7 6 = TEMP18>
555 <TYPE? TEMP18 <TYPE-CODE FALSE> + PHRASE32>
558 <FRAME '
\1aTYPE-MERGE>
559 <NTHUV TMP7 6 = STACK>
562 <CALL '
\1aTYPE-MERGE 2 = STACK>
563 <CALL '
\1aISTYPE? 1 = TEMP18>
564 <PUTUV TMP7 6 TEMP18>
568 <TYPE? TY8 <TYPE-CODE FALSE> - PHRASE36>
572 <NTHUV TMP7 2 = TEMP18 (TYPE FIX)>
573 <ADD TEMP18 1 = TEMP18 (TYPE FIX)>
574 <PUTUV TMP7 2 TEMP18 (TYPE FIX)>
580 <GFCN
\1aFREE-TEMP ("VALUE" ANY ANY "OPTIONAL" ANY) TMP6 KILL7>
581 <OPT-DISPATCH 1 %<> OPT4 OPT5>
585 <TEMP REFS8 TEMP26 L9 TEMP45>
587 <TYPE? TMP6 <TYPE-CODE TEMP> - PHRASE54>
588 <NTHUV TMP6 2 = REFS8 (TYPE FIX)>
589 <SUB REFS8 1 = REFS8 (TYPE FIX)>
590 <LESS? REFS8 0 - TAG13>
591 <SET REFS8 0 (TYPE FIX)>
593 <PUTUV TMP6 2 REFS8 (TYPE FIX)>
594 <VEQUAL? REFS8 0 - PHRASE54 (TYPE FIX)>
596 <NTHUV TMP6 5 = REFS8>
597 <TYPE? REFS8 <TYPE-CODE FALSE> - PHRASE39>
599 <GEN-LVAL 'TMPS = REFS8>
600 <NTHUV TMP6 3 = TEMP26>
601 <EQUAL? REFS8 TEMP26 - PHRASE22>
603 <GEN-LVAL 'FREE-TEMPS = TEMP26>
604 <EMPL? TEMP26 + TAG27>
605 <LOOP (TMP6 VALUE) (TEMP26 VALUE)>
607 <NTHL TEMP26 1 = REFS8>
608 <TYPE? REFS8 <TYPE-CODE TEMP> - TAG29>
609 <VEQUAL? REFS8 TMP6 + PHRASE22>
612 <RESTL TEMP26 1 = TEMP26 (TYPE LIST)>
613 <EMPL? TEMP26 - TAG28>
615 <GEN-LVAL 'FREE-TEMPS = TEMP26>
616 <CONS TMP6 TEMP26 = TEMP26>
617 <GEN-SET 'FREE-TEMPS TEMP26>
621 <FRAME '
\1aFIND-FRAME>
622 <NTHUV TMP6 3 = STACK>
624 <CALL '
\1aFIND-FRAME 2 = L9>
625 <EMPL? L9 + PHRASE39 (TYPE LIST)>
626 <RESTL L9 1 = TEMP26 (TYPE LIST)>
627 <RESTL TEMP26 1 = TEMP26 (TYPE LIST)>
628 <NTHL TEMP26 1 = TEMP26>
629 <EMPTY? TEMP26 + TAG41>
630 <LOOP (TMP6 VALUE) (TEMP26 LENGTH VALUE TYPE)>
632 <NTH1 TEMP26 = REFS8>
633 <TYPE? REFS8 <TYPE-CODE TEMP> - TAG43>
634 <VEQUAL? REFS8 TMP6 + PHRASE39>
637 <REST1 TEMP26 = TEMP26>
638 <EMPTY? TEMP26 - TAG42>
641 <SET REFS8 1 (TYPE FIX)>
642 <RESTL L9 1 = TEMP45 (TYPE LIST)>
643 <RESTL TEMP45 1 = TEMP45 (TYPE LIST)>
644 <NTHL TEMP45 1 = TEMP26>
646 <TYPE TEMP26 = TEMP45>
647 <AND TEMP45 7 = TEMP45>
648 <VEQUAL? TEMP45 1 + TAG46>
650 <LOOP (TEMP26 TYPE VALUE LENGTH) (REFS8 VALUE)>
653 <EMPTY? TEMP26 + TAG51>
654 <NTH1 TEMP26 = STACK>
655 <REST1 TEMP26 = TEMP26>
656 <ADD REFS8 1 = REFS8 (TYPE FIX)>
659 <LIST REFS8 = TEMP45 (TYPE LIST)>
665 <VEQUAL? REFS8 0 + TAG48>
667 <CONS TEMP45 TEMP26 = TEMP26 (TYPE LIST)>
669 <SUB REFS8 1 = REFS8 (TYPE FIX)>
675 <RESTL L9 1 = TEMP26 (TYPE LIST)>
677 <RESTL TEMP26 1 = TEMP26 (TYPE LIST)>
678 <PUTL TEMP26 1 TEMP45>
681 <TYPE? KILL7 <TYPE-CODE FALSE> + PHRASE54>
685 <NTHUV TMP6 1 = STACK (TYPE ATOM)>
692 <GFCN
\1aDEALLOCATE-TEMP ("VALUE" ANY ANY) TMP4>
695 <TYPE? TMP4 <TYPE-CODE TEMP> - PHRASE7>
696 <NTHUV TMP4 2 = REFS5 (TYPE FIX)>
697 <SUB REFS5 1 = REFS5 (TYPE FIX)>
698 <LESS? REFS5 0 - TAG9>
699 <SET REFS5 0 (TYPE FIX)>
701 <PUTUV TMP4 2 REFS5 (TYPE FIX)>
706 <END
\1aDEALLOCATE-TEMP>
707 "Generate a unique atom for label, temp name, var name etc."
710 <GFCN
\1aMAKE-TAG ("VALUE" ANY "OPTIONAL" <OR ATOM STRING>) S6>
711 <OPT-DISPATCH 0 %<> OPT4 OPT5>
715 <TEMP TEMP13 TC8:STRING>
717 <TYPE? S6 <TYPE-CODE ATOM> - PHRASE10>
718 <NTHR S6 3 = S6 (RECORD-TYPE ATOM)>
722 <GEN-LVAL 'TAG-COUNT = STACK>
724 <CALL '
\1a+ 2 = TEMP13>
725 <GEN-SET 'TAG-COUNT TEMP13>
728 <CALL '
\1aUNPARSE 1 = TC8>
729 <LENUS S6 = TEMP13 (TYPE FIX)>
730 <NTHUS S6 TEMP13 = TEMP13 (TYPE CHARACTER)>
731 <SUB TEMP13 48 = TEMP13 (TYPE FIX)>
732 <LESS? TEMP13 0 + PHRASE20 (TYPE FIX)>
733 <GRTR? TEMP13 9 + PHRASE20 (TYPE FIX)>
740 <UBLOCK <TYPE-CODE STRING> 3 = S6 (TYPE STRING)>
747 <UBLOCK <TYPE-CODE STRING> 2 = S6 (TYPE STRING)>
751 <GVAL 'TMP-OBL = STACK>
752 <CALL '
\1aLOOKUP 2 = TEMP13>
753 <TYPE? TEMP13 <TYPE-CODE FALSE> - BOOL28>
757 <GVAL 'TMP-OBL = STACK>
758 <CALL '
\1aINSERT 2 = TEMP13>
763 "Add an instruction to the output code"
766 <GFCN
\1aEMIT ("VALUE" <LIST ANY> ANY) THING4>
769 <GEN-LVAL 'CODE-PTR = TEMP5>
770 <GEN-LVAL 'CODE-PTR = TEMP9>
771 <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
772 <CONS THING4 TEMP9 = TEMP9>
774 <GEN-SET 'CODE-PTR TEMP9>
775 <PUTREST TEMP5 TEMP9>
780 <SETG INSTRUCTION ,FORM>
783 <GFCN
\1aIEMIT ("VALUE" ATOM "TUPLE" ANY)>
786 <FRAME '
\1aREAL-IEMIT>
790 <CALL '
\1aREAL-IEMIT 2 = X4>
795 <GFCN
\1aSPEC-IEMIT ("VALUE" ATOM "TUPLE" ANY)>
798 <FRAME '
\1aREAL-IEMIT>
802 <CALL '
\1aREAL-IEMIT 2 = X4>
807 <GFCN
\1aREAL-IEMIT ("VALUE" ATOM ANY <TUPLE ANY>) SKIP-DEAD4 X5>
808 <TEMP (DEAD-TEMPS6:LIST ()) INS7 (PAST=8 %<>) (DO-LATER-SETRL10 %<>) (FREED-TEMPS11:LIST ()) TEMP17 XP29:VECTOR Y30 TEMP36 TEMP41 FOR-SETRL9>
811 <RESTUV X5 1 = TEMP17 (TYPE VECTOR)>
812 <CHTYPE TEMP17 <TYPE-CODE VECTOR> = TEMP17>
813 <EMPUV? TEMP17 + MAPAP22 (TYPE VECTOR)>
815 <RESTUV X5 1 = TEMP17 (TYPE VECTOR)>
816 <CHTYPE TEMP17 <TYPE-CODE VECTOR> = TEMP17>
817 <EMPUV? TEMP17 + PHRASE80>
821 <EMPUV? TEMP17 + MAPAP22>
824 <EQUAL? Y30 '= - PHRASE33>
825 <SET PAST=8 'T (TYPE ATOM)>
827 <TYPE? Y30 <TYPE-CODE MIM-SPECIAL> - PHRASE35>
828 <CHTYPE Y30 <TYPE-CODE ATOM> = TEMP36>
830 <PUTUV XP29 1 TEMP36>
834 <TYPE? Y30 <TYPE-CODE TEMP> - PHRASE37>
835 <NTHUV Y30 3 = TEMP36>
836 <GEN-LVAL 'TMPS = TEMP41>
837 <EQUAL? TEMP36 TEMP41 + PHRASE39>
839 <EQUAL? INS7 '`SETRL - BOOL44>
840 <RESTUV X5 2 = TEMP41 (TYPE VECTOR)>
841 <CHTYPE TEMP41 <TYPE-CODE VECTOR> = TEMP41>
842 <VEQUAL? TEMP41 XP29 + PHRASE39>
845 <EQUAL? INS7 '`SET - PHRASE46>
846 <RESTUV X5 1 = TEMP41 (TYPE VECTOR)>
847 <CHTYPE TEMP41 <TYPE-CODE VECTOR> = TEMP41>
848 <VEQUAL? TEMP41 XP29 - PHRASE48>
852 <FRAME '
\1aFIND-FRAME>
853 <NTHUV Y30 3 = STACK>
854 <CALL '
\1aFIND-FRAME 1 = STACK>
855 <NTHUV Y30 1 = STACK (TYPE ATOM)>
857 <NTHUV XP29 2 = STACK>
859 <SET TEMP36 4 (TYPE FIX)>
860 <RESTUV X5 3 = TEMP41 (TYPE VECTOR)>
862 <CHTYPE TEMP41 <TYPE-CODE VECTOR> = TEMP41>
863 <LOOP (TEMP41 VALUE LENGTH) (TEMP36 VALUE)>
866 <EMPUV? TEMP41 + TAG49>
867 <NTHUV TEMP41 1 = STACK>
868 <RESTUV TEMP41 1 = TEMP41 (TYPE VECTOR)>
869 <ADD TEMP36 1 = TEMP36 (TYPE FIX)>
872 <CALL '
\1aIEMIT TEMP36>
879 <FRAME '
\1aFIND-FRAME>
880 <NTHUV Y30 3 = STACK>
881 <CALL '
\1aFIND-FRAME 1 = STACK>
882 <NTHUV Y30 1 = STACK (TYPE ATOM)>
884 <SET TEMP41 4 (TYPE FIX)>
885 <RESTUV X5 3 = TEMP36 (TYPE VECTOR)>
887 <CHTYPE TEMP36 <TYPE-CODE VECTOR> = TEMP36>
888 <LOOP (TEMP36 VALUE LENGTH) (TEMP41 VALUE)>
891 <EMPUV? TEMP36 + TAG54>
892 <NTHUV TEMP36 1 = STACK>
893 <RESTUV TEMP36 1 = TEMP36 (TYPE VECTOR)>
894 <ADD TEMP41 1 = TEMP41 (TYPE FIX)>
897 <CALL '
\1aIEMIT TEMP41>
901 <VEQUAL? PAST=8 0 - PHRASE58>
902 <FRAME '
\1aLOOP-FRAME>
904 <CALL '
\1aLOOP-FRAME 1 = TEMP36>
905 <CONS TEMP36 () = TEMP41>
906 <PUTREST TEMP41 FREED-TEMPS11>
908 <SET FREED-TEMPS11 TEMP41>
910 <NTHUV TEMP36 1 = TEMP41 (TYPE ATOM)>
911 <CONS TEMP41 DEAD-TEMPS6 = DEAD-TEMPS6>
916 <CALL '
\1aGEN-TEMP 0 = DO-LATER-SETRL10>
917 <SET TEMP36 DO-LATER-SETRL10>
923 <NTHUV TEMP36 1 = TEMP41 (TYPE ATOM)>
925 <PUTUV XP29 1 TEMP41>
927 <NTHUV Y30 2 = TEMP41 (TYPE FIX)>
928 <VEQUAL? TEMP41 0 - PHRASE67 (TYPE FIX)>
930 <NTHUV Y30 1 = TEMP41 (TYPE ATOM)>
932 <CONS TEMP41 DEAD-TEMPS6 = DEAD-TEMPS6>
936 <TYPE? Y30 <TYPE-CODE ATOM> - PHRASE67>
937 <VEQUAL? Y30 '= + PHRASE67>
938 <VEQUAL? Y30 '+ + PHRASE67>
939 <VEQUAL? Y30 '- + PHRASE67>
940 <VEQUAL? Y30 '`COMPERR + PHRASE67>
941 <VEQUAL? Y30 '`UNWCONT + PHRASE67>
942 <GVAL 'POP-STACK = TEMP41>
943 <EQUAL? TEMP41 Y30 + PHRASE67>
945 <NTHR Y30 4 = TEMP41 (RECORD-TYPE ATOM)>
946 <GVAL 'TMP-OBL = TEMP36>
947 <EQUAL? TEMP41 TEMP36 + PHRASE67>
953 <CALL '
\1aFORM 2 = TEMP36>
954 <PUTUV XP29 1 TEMP36>
957 <RESTUV TEMP17 1 = TEMP17 (TYPE VECTOR)>
960 <FRAME '
\1aINSTRUCTION>
963 <SET INS7 1 (TYPE FIX)>
964 <RESTUV X5 1 = TEMP17 (TYPE VECTOR)>
966 <CHTYPE TEMP17 <TYPE-CODE VECTOR> = TEMP17>
967 <LOOP (TEMP17 VALUE LENGTH) (INS7 VALUE)>
970 <EMPUV? TEMP17 + TAG70>
971 <NTHUV TEMP17 1 = STACK>
972 <RESTUV TEMP17 1 = TEMP17 (TYPE VECTOR)>
973 <ADD INS7 1 = INS7 (TYPE FIX)>
976 <CALL '
\1aINSTRUCTION INS7 = INS7>
977 <TYPE? SKIP-DEAD4 <TYPE-CODE FALSE> + PHRASE74>
979 <GEN-LVAL 'CODE-PTR = PAST=8>
980 <NTHL PAST=8 1 = Y30>
981 <TYPE? Y30 <TYPE-CODE FORM> - PHRASE74>
982 <EMPL? Y30 + PHRASE74 (TYPE FORM)>
983 <NTHL Y30 1 = TEMP17>
984 <EQUAL? TEMP17 '`DEAD - PHRASE74>
986 <PUTL PAST=8 1 INS7 (TYPE FORM)>
995 <TYPE? DO-LATER-SETRL10 <TYPE-CODE FALSE> + PHRASE80>
998 <FRAME '
\1aFIND-FRAME>
999 <NTHUV FOR-SETRL9 3 = STACK>
1000 <CALL '
\1aFIND-FRAME 1 = STACK>
1001 <NTHUV FOR-SETRL9 1 = STACK (TYPE ATOM)>
1003 <PUSH DO-LATER-SETRL10>
1004 <DEAD DO-LATER-SETRL10>
1007 <SET TEMP17 FREED-TEMPS11 (TYPE LIST)>
1008 <DEAD FREED-TEMPS11>
1012 <EMPL? TEMP17 + MAPAP87>
1013 <NTHL TEMP17 1 = INS7>
1014 <FRAME '
\1aFREE-TEMP>
1018 <CALL '
\1aFREE-TEMP 2>
1019 <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
1022 <EMPL? DEAD-TEMPS6 + PHRASE93 (TYPE LIST)>
1024 <CONS '`DEAD DEAD-TEMPS6 = DEAD-TEMPS6>
1025 <CHTYPE DEAD-TEMPS6 <TYPE-CODE FORM> = STACK>
1032 <GFCN
\1aLOOP-FRAME ("VALUE" STRUCTURED ANY "OPTIONAL" ANY ANY) TMP7 LTMP8 TNAME9>
1033 <OPT-DISPATCH 1 %<> OPT4 OPT5 OPT6>
1039 <TEMP TEMP16 XTMP10 TEMP3:LBIND TEMP25>
1041 <TYPE? TNAME9 <TYPE-CODE UNBOUND> - TAG13>
1043 <GEN-LVAL 'ALL-TEMPS-LIST = TEMP16>
1044 <NTH1 TEMP16 = STACK>
1047 <CALL '
\1aNTH 2 = TEMP16>
1048 <NTHUV TEMP16 1 = TNAME9 (TYPE ATOM)>
1051 <TYPE? LTMP8 <TYPE-CODE UNBOUND> + PHRASE20>
1056 <FRAME '
\1aGEN-TEMP>
1057 <CALL '
\1aGEN-TEMP 0 = XTMP10>
1059 <GETS 'BIND = TEMP3 (TYPE LBIND)>
1060 <GEN-LVAL 'ALL-TEMPS-LIST = TEMP16>
1061 <NTH1 TEMP16 = TEMP16>
1062 <NTH1 TEMP16 = TEMP16>
1063 <BBIND 'TMPS 'FORM 'FIX TEMP16>
1065 <GEN-LVAL 'ALL-TEMPS-LIST = TEMP25>
1066 <RESTL TEMP25 1 = TEMP16 (TYPE LIST)>
1068 <CHTYPE TEMP16 <TYPE-CODE LIST> = TEMP16>
1069 <BBIND 'ALL-TEMPS-LIST <LIST [REST <LIST FORM LIST LIST TEMP>]> 'FIX TEMP16>
1071 <NTHUV TMP7 3 = TEMP16>
1072 <NTHR 'TMPS 2 = TEMP25 (RECORD-TYPE ATOM) (TYPE LBIND)>
1073 <NTHR TEMP25 1 = TEMP25 (RECORD-TYPE LBIND)>
1074 <EQUAL? TEMP16 TEMP25 + PHRASE29>
1075 <DEAD TEMP16 TEMP25>
1078 <NTHUV XTMP10 1 = STACK (TYPE ATOM)>
1081 <NTHR 'ALL-TEMPS-LIST 2 = TEMP25 (RECORD-TYPE ATOM) (TYPE LBIND)>
1082 <NTHR TEMP25 1 = TEMP25 (RECORD-TYPE LBIND)>
1083 <NTHL TEMP25 1 = TEMP25 (TYPE LIST)>
1084 <RESTL TEMP25 1 = TEMP25 (TYPE LIST)>
1085 <RESTL TEMP25 1 = TEMP25 (TYPE LIST)>
1086 <RESTL TEMP25 1 = TEMP25 (TYPE LIST)>
1087 <NTHL TEMP25 1 = TEMP25 (TYPE TEMP)>
1088 <NTHUV TEMP25 1 = STACK (TYPE ATOM)>
1091 <FRAME '
\1aLOOP-FRAME>
1095 <NTHUV XTMP10 1 = STACK (TYPE ATOM)>
1096 <CALL '
\1aLOOP-FRAME 3>
1101 <NTHUV XTMP10 1 = STACK (TYPE ATOM)>
1104 <NTHUV TMP7 1 = STACK (TYPE ATOM)>
1114 "Generate a label in the code"
1117 <GFCN
\1aLABEL-TAG ("VALUE" <LIST ANY> ANY) TG4>
1123 <CALL '
\1aEMIT 1 = TEMP6>
1127 "Generate jump to label"
1130 <GFCN
\1aBRANCH-TAG ("VALUE" ATOM ANY) TG4>
1138 <CALL '
\1aIEMIT 3 = TEMP6>
1142 "Generate code to PUSH something onto stack. It can be called with various
1144 1) #TEMP - refernce to a named temporary
1145 3) #MIM-SPECIAL atom - MIM special variable
1146 4) other - quoted object "
1149 <GFCN
\1aPUSH ("VALUE" ANY ANY) ITM4>
1152 <TYPE? ITM4 <TYPE-CODE MIM-SPECIAL> - PHRASE6>
1155 <CHTYPE ITM4 <TYPE-CODE ATOM> = STACK>
1160 <TYPE? ITM4 <TYPE-CODE TEMP> - PHRASE8>
1168 <GVAL 'POP-STACK = TEMP10>
1169 <EQUAL? TEMP10 ITM4 + PHRASE11>
1176 <CALL '
\1aATOMCHK 1 = STACK>
1179 <GVAL 'TOP-STACK = TEMP10>
1184 <GFCN
\1aPOP ("VALUE" ANY ANY) ITM4>
1187 <TYPE? ITM4 <TYPE-CODE TEMP> - PHRASE6>
1191 <NTHUV ITM4 1 = STACK (TYPE ATOM)>
1196 <EQUAL? ITM4 'FLUSHED - PHRASE8>
1204 <GVAL 'TOP-STACK = TEMP12>
1205 <EQUAL? TEMP12 ITM4 + PHRASE10>
1207 <EQUAL? ITM4 'DONT-CARE + PHRASE10>
1208 <FRAME '
\1aCOMPILE-LOSSAGE>
1209 <PUSH "Bad arg to POP">
1211 <CALL '
\1aCOMPILE-LOSSAGE 2>
1215 <GVAL 'POP-STACK = ITM4>
1220 <GFCN
\1aPUSH-CONSTANT ("VALUE" ANY ANY) X4>
1227 <CALL '
\1aATOMCHK 1 = STACK>
1228 <CALL '
\1aPUSH 1 = TEMP7>
1231 <END
\1aPUSH-CONSTANT>
1232 " Generate FIXBIND to wrap bindings pending by linking up atoms."
1235 <GFCN
\1aGEN-FIX-BIND ("VALUE" ATOM)>
1240 <CALL '
\1aIEMIT 1 = TEMP5>
1243 <END
\1aGEN-FIX-BIND>
1244 " Generate code for optional arguments."
1247 <GFCN
\1aGEN-ARG-NUM ("VALUE" ATOM FIX) N4>
1254 <CALL '
\1aIEMIT 2 = TEMP6>
1257 <END
\1aGEN-ARG-NUM>
1259 <GFCN
\1aSPECIAL-BINDING ("VALUE" ATOM ANY ANY "OPTIONAL" ANY) SYM6 FIXB7 INIT8>
1260 <OPT-DISPATCH 2 %<> OPT4 OPT5>
1266 <TYPE? INIT8 <TYPE-CODE UNBOUND> + PHRASE10>
1270 <NTHUV SYM6 2 = STACK (TYPE ATOM)>
1271 <CALL '
\1aATOMCHK 1 = STACK>
1273 <NTHUV SYM6 7 = STACK>
1275 <CALL '
\1aATOMCHK 1 = STACK>
1276 <TYPE? FIXB7 <TYPE-CODE FALSE> + PHRASE15>
1278 <SET TEMP16 ''FIX (TYPE ATOM)>
1281 <SET TEMP16 %<> (TYPE FALSE)>
1287 <CALL '
\1aIEMIT 5 = TEMP16>
1294 <NTHUV SYM6 2 = STACK (TYPE ATOM)>
1295 <CALL '
\1aATOMCHK 1 = STACK>
1297 <NTHUV SYM6 7 = STACK>
1299 <CALL '
\1aATOMCHK 1 = STACK>
1300 <TYPE? FIXB7 <TYPE-CODE FALSE> + PHRASE23>
1302 <SET TEMP16 ''FIX (TYPE ATOM)>
1305 <SET TEMP16 %<> (TYPE FALSE)>
1309 <CALL '
\1aIEMIT 4 = TEMP16>
1312 <END
\1aSPECIAL-BINDING>
1313 "Get the value of a special variable bound in the current function"
1316 <GFCN
\1aGET-VALUE-X ("VALUE" ANY ANY ANY "OPTIONAL" ANY) ATM6 TMP7 EXT8>
1317 <OPT-DISPATCH 2 %<> OPT4 OPT5>
1321 <TEMP TEMP19 TEMP20>
1323 <TYPE? TMP7 <TYPE-CODE TEMP> - PHRASE16>
1324 <NTHUV TMP7 5 = TEMP19>
1325 <TYPE? TEMP19 <TYPE-CODE FALSE> + BOOL18>
1327 <NTHUV TMP7 5 = TEMP19>
1328 <EQUAL? TEMP19 'ANY - PHRASE16>
1331 <NTHUV TMP7 6 = TEMP19>
1332 <TYPE? TEMP19 <TYPE-CODE FALSE> - PHRASE16>
1334 <NTHUV TMP7 3 = TEMP19>
1335 <GEN-LVAL 'TMPS = TEMP20>
1336 <EQUAL? TEMP19 TEMP20 - PHRASE16>
1337 <DEAD TEMP19 TEMP20>
1341 <FRAME '
\1aGEN-TEMP>
1342 <CALL '
\1aGEN-TEMP 0 = TEMP20>
1347 <CALL '
\1aATOMCHK 1 = TEMP19>
1348 <FRAME '
\1aMAKE-TAG>
1349 <CALL '
\1aMAKE-TAG 0>
1350 <FRAME '
\1aMAKE-TAG>
1351 <CALL '
\1aMAKE-TAG 0>
1352 <TYPE? EXT8 <TYPE-CODE FALSE> + PHRASE29>
1364 <FRAME '
\1aUSE-TEMP>
1367 <CALL '
\1aUSE-TEMP 2>
1368 <FRAME '
\1aDEALLOCATE-TEMP>
1370 <CALL '
\1aDEALLOCATE-TEMP 1>
1379 <PUSH (`TYPE LBIND)>
1389 <EQUAL? TMP7 TEMP20 + PHRASE37>
1390 <FRAME '
\1aFREE-TEMP>
1393 <CALL '
\1aFREE-TEMP 1>
1397 <END
\1aGET-VALUE-X>
1398 "See if a special variable is assigned"
1401 <GFCN
\1aASS-GEN ("VALUE" ANY ANY ANY ANY "OPTIONAL" ANY) ATM6 TG7 DIR8 EXT9>
1402 <OPT-DISPATCH 3 %<> OPT4 OPT5>
1406 <TEMP BTMP10:TEMP FQA11>
1408 <FRAME '
\1aGEN-TEMP>
1409 <CALL '
\1aGEN-TEMP 0 = BTMP10>
1413 <CALL '
\1aATOMCHK 1 = FQA11>
1414 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE18>
1415 <FRAME '
\1aMAKE-TAG>
1416 <CALL '
\1aMAKE-TAG 0>
1418 <TYPE? EXT9 <TYPE-CODE FALSE> + PHRASE22>
1421 <PUSH '`GEN-ASSIGNED?>
1424 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE25>
1426 <SET FQA11 '+ (TYPE ATOM)>
1429 <SET FQA11 '- (TYPE ATOM)>
1435 <CALL '
\1aIEMIT 4 = FQA11>
1447 <PUSH (`TYPE LBIND)>
1457 <FRAME '
\1aGEN-TYPE?>
1462 <TYPE? DIR8 <TYPE-CODE FALSE> - TAG32>
1464 <SET FQA11 'T (TYPE ATOM)>
1467 <SET FQA11 %<> (TYPE FALSE)>
1471 <CALL '
\1aGEN-TYPE? 4>
1472 <FRAME '
\1aFREE-TEMP>
1475 <CALL '
\1aFREE-TEMP 1 = FQA11>
1479 "Set the value of a special variable bound in the current function"
1482 <GFCN
\1aSET-VALUE ("VALUE" ANY ANY ANY "OPTIONAL" ANY) ATM6 TMP7 EXT8>
1483 <OPT-DISPATCH 2 %<> OPT4 OPT5>
1492 <CALL '
\1aATOMCHK 1 = FQA10>
1493 <FRAME '
\1aMAKE-TAG>
1494 <CALL '
\1aMAKE-TAG 0>
1495 <FRAME '
\1aMAKE-TAG>
1496 <CALL '
\1aMAKE-TAG 0>
1497 <TYPE? EXT8 <TYPE-CODE FALSE> + PHRASE19>
1508 <FRAME '
\1aGEN-TEMP>
1510 <CALL '
\1aGEN-TEMP 1 = TG111>
1519 <PUSH (`TYPE LBIND)>
1527 <CALL '
\1aATOMCHK 1 = STACK>
1530 <FRAME '
\1aFREE-TEMP>
1533 <CALL '
\1aFREE-TEMP 1>
1537 "Generate code to set a MIM local"
1540 <GFCN
\1aSET-SYM ("VALUE" <OR FALSE TEMP> SYMTAB "OPTIONAL" ANY ANY) SYM7 VAL8 USE-IT9>
1541 <OPT-DISPATCH 1 %<> OPT4 OPT5 OPT6>
1547 <TEMP TMP10:TEMP (TY11 'ANY) REFS12:FIX TEMP22>
1549 <NTHUV SYM7 10 = TMP10 (TYPE TEMP)>
1551 <NTHUV TMP10 2 = REFS12 (TYPE FIX)>
1552 <TYPE? VAL8 <TYPE-CODE UNBOUND> + PHRASE14>
1553 <TYPE? VAL8 <TYPE-CODE TEMP> - PHRASE16>
1554 <NTHUV VAL8 6 = TY11>
1559 <CALL '
\1aTYPE 1 = TY11>
1561 <FRAME '
\1aSET-TEMP>
1565 <CALL '
\1aSET-TEMP 2>
1567 <SET TEMP22 USE-IT9>
1569 <TYPE? TEMP22 <TYPE-CODE FALSE> + PHRASE21>
1570 <FRAME '
\1aUSE-TEMP>
1574 <CALL '
\1aUSE-TEMP 2>
1575 <ADD REFS12 1 = REFS12 (TYPE FIX)>
1576 <PUTUV TMP10 2 REFS12 (TYPE FIX)>
1585 <GFCN
\1aSET-TEMP ("VALUE" <OR ATOM FALSE> TEMP "OPTIONAL" ANY ANY) TMP7 VAL8 XTRA9>
1586 <OPT-DISPATCH 1 %<> OPT4 OPT5 OPT6>
1594 <TYPE? VAL8 <TYPE-CODE UNBOUND> + PHRASE16>
1595 <TYPE? VAL8 <TYPE-CODE TEMP> - PHRASE15>
1596 <NTHUV VAL8 6 = TY11>
1601 <CALL '
\1aTYPE 1 = TY11>
1603 <FRAME '
\1aUSE-TEMP>
1607 <CALL '
\1aUSE-TEMP 2>
1608 <TYPE? VAL8 <TYPE-CODE UNBOUND> - TAG22>
1611 <TYPE? VAL8 <TYPE-CODE MIM-SPECIAL> - PHRASE24>
1612 <CHTYPE VAL8 <TYPE-CODE ATOM> = VAL8>
1618 <CALL '
\1aATOMCHK 1 = VAL8>
1620 <TYPE? XTRA9 <TYPE-CODE UNBOUND> + PHRASE28>
1629 <CALL '
\1aIEMIT 4 = TY11>
1639 <CALL '
\1aIEMIT 3 = TY11>
1643 "Quote atom to protect the MIM assembler"
1646 <GFCN
\1aATOMCHK ("VALUE" ANY ANY) X4>
1653 <TYPE? Y9 <TYPE-CODE ATOM> + EXIT7>
1654 <TYPE? Y9 <TYPE-CODE FORM> - PHRASE6>
1655 <EMPL? Y9 + PHRASE6>
1656 <RESTL Y9 1 = TEMP16 (TYPE LIST)>
1657 <EMPL? TEMP16 + PHRASE6>
1658 <RESTL TEMP16 1 = TEMP16 (TYPE LIST)>
1659 <EMPL? TEMP16 - PHRASE6>
1661 <NTHL Y9 1 = TEMP16>
1662 <EQUAL? TEMP16 'QUOTE - PHRASE6>
1664 <RESTL Y9 1 = TEMP16 (TYPE LIST)>
1666 <NTHL TEMP16 1 = Y9>
1674 <CALL '
\1aFORM 2 = TEMP16>
1681 " Return currently running FRAME "
1684 <GFCN
\1aCURRENT-FRAME ("VALUE" ANY "OPTIONAL" ANY) FR6>
1685 <OPT-DISPATCH 0 %<> OPT4 OPT5>
1691 <TYPE? FR6 <TYPE-CODE UNBOUND> - TAG7>
1692 <FRAME '
\1aGEN-TEMP>
1694 <CALL '
\1aGEN-TEMP 1 = FR6>
1700 <PUSH (`TYPE FRAME)>
1704 <END
\1aCURRENT-FRAME>
1705 " Return TUPLE of arguments"
1708 <GFCN
\1aGET-ARG-TUPLE ("VALUE" TEMP ANY) FR4>
1711 <FRAME '
\1aUSE-TEMP>
1714 <CALL '
\1aUSE-TEMP 2>
1716 <GEN-LVAL 'TMPS = STACK>
1720 <NTHUV FR4 1 = TEMP7 (TYPE ATOM)>
1721 <GEN-SET 'TMP-DEST TEMP7>
1725 <END
\1aGET-ARG-TUPLE>
1726 "Compare # of args supplied with a constant and jump in appropriate case"
1729 <GFCN
\1aTEST-ARG ("VALUE" ATOM TEMP ATOM) TMP4 TG5>
1732 <FRAME '
\1aGEN-TYPE?>
1739 <CALL '
\1aGEN-TYPE? 4>
1742 "Get current binding at top of world"
1745 <GFCN
\1aGET-BINDING ("VALUE" ATOM ANY) WHERE4>
1750 <GVAL 'QQ-BIND = STACK>
1754 <PUSH (`TYPE LBIND)>
1755 <CALL '
\1aIEMIT 5 = TEMP6>
1758 <END
\1aGET-BINDING>
1759 "Get an arg by arg number and mung into a local"
1762 <GFCN
\1aARG-TO-TEMP ("VALUE" ATOM SYMTAB) SYM4>
1765 <NTHUV SYM4 10 = TMP5 (TYPE TEMP)>
1766 <NTHUV SYM4 19 = ATMP6>
1770 <NTHUV TMP5 1 = STACK (TYPE ATOM)>
1772 <NTHUV ATMP6 1 = STACK (TYPE ATOM)>
1774 <CALL '
\1aIEMIT 3 = TMP5>
1777 <END
\1aARG-TO-TEMP>
1778 "Generate call to MSUBR"
1781 <GFCN
\1aMSUBR-CALL ("VALUE" ATOM ANY ANY ANY) NAM4 NARGS5 W6>
1784 <CHTYPE NAM4 <TYPE-CODE FCN-ATOM> = NAM4>
1785 <EQUAL? W6 'FLUSHED - PHRASE8>
1792 <CALL '
\1aFORM 2 = STACK>
1795 <CALL '
\1aIEMIT 3 = TEMP11>
1805 <CALL '
\1aFORM 2 = STACK>
1811 <CALL '
\1aIEMIT 5 = TEMP11>
1816 <GFCN
\1aSEG-SUBR-CALL ("VALUE" ATOM ANY ANY ANY ANY ANY) NAM4 NARGS5 W6 COUNT7 LABEL8>
1819 <CHTYPE NAM4 <TYPE-CODE FCN-ATOM> = NAM4>
1826 <CALL '
\1aFORM 2 = STACK>
1837 <CALL '
\1aIEMIT 8 = TEMP11>
1840 <END
\1aSEG-SUBR-CALL>
1841 "Begin building a FRAME for a future call"
1844 <GFCN
\1aSTART-FRAME ("VALUE" ATOM "OPTIONAL" ANY) NAME6>
1845 <OPT-DISPATCH 0 %<> OPT4 OPT5>
1851 <TYPE? NAME6 <TYPE-CODE FALSE> + PHRASE8>
1856 <CHTYPE NAME6 <TYPE-CODE FCN-ATOM> = STACK>
1858 <CALL '
\1aFORM 2 = STACK>
1859 <CALL '
\1aIEMIT 2 = TEMP11>
1865 <CALL '
\1aIEMIT 1 = TEMP11>
1868 <END
\1aSTART-FRAME>
1869 "Generate a VECTOR of the top N things on the stack"
1872 <GFCN
\1aGEN-VECTOR ("VALUE" ANY ANY ANY "OPTIONAL" ANY) N6 V7 S?8>
1873 <OPT-DISPATCH 2 %<> OPT4 OPT5>
1880 <TYPE? S?8 <TYPE-CODE FALSE> + PHRASE11>
1882 <SET TEMP12 '`SBLOCK (TYPE ATOM)>
1885 <SET TEMP12 '`UBLOCK (TYPE ATOM)>
1889 <PUSH <`TYPE-CODE VECTOR>>
1899 <GFCN
\1aGEN-UVECTOR ("VALUE" ANY ANY ANY "OPTIONAL" ANY) N6 V7 S?8>
1900 <OPT-DISPATCH 2 %<> OPT4 OPT5>
1907 <TYPE? S?8 <TYPE-CODE FALSE> + PHRASE11>
1909 <SET TEMP12 '`SBLOCK (TYPE ATOM)>
1912 <SET TEMP12 '`UBLOCK (TYPE ATOM)>
1916 <PUSH <`TYPE-CODE UVECTOR>>
1924 <END
\1aGEN-UVECTOR>
1928 <GFCN
\1aGEN-TUPLE ("VALUE" ANY ANY ANY) N4 V5>
1937 <PUSH (`TYPE TUPLE)>
1945 <GFCN
\1aGEN-LIST ("VALUE" ATOM ANY ANY) N4 L5>
1956 <CALL '
\1aIEMIT 5 = TEMP7>
1960 "Generate code to move datum from place to place"
1963 <GFCN
\1aMOVE-ARG ("VALUE" ANY ANY ANY "OPTIONAL" ANY) FROM6 TO7 XTRA8>
1964 <OPT-DISPATCH 2 %<> OPT4 OPT5>
1968 <TEMP (TY9 'ANY) TEMP19 TEMP40>
1970 <TYPE? XTRA8 <TYPE-CODE UNBOUND> - PHRASE11>
1971 <TYPE? FROM6 <TYPE-CODE TEMP> + PHRASE11>
1972 <TYPE? FROM6 <TYPE-CODE FORM> - PHRASE14>
1973 <EMPL? FROM6 + PHRASE14>
1974 <RESTL FROM6 1 = TY9 (TYPE LIST)>
1975 <EMPL? TY9 + PHRASE14>
1976 <RESTL TY9 1 = TY9 (TYPE LIST)>
1977 <EMPL? TY9 - PHRASE14>
1979 <NTHL FROM6 1 = TY9>
1980 <EQUAL? TY9 'QUOTE - PHRASE14>
1982 <RESTL FROM6 1 = TY9 (TYPE LIST)>
1984 <TYPE? TY9 <TYPE-CODE ATOM> - PHRASE14>
1986 <SET XTRA8 (`TYPE ATOM) (TYPE LIST)>
1989 <CONS '`TYPE () = TY9>
1992 <CALL '
\1aTYPE 1 = TEMP19>
1993 <CONS TEMP19 () = TEMP19>
1994 <PUTREST TY9 TEMP19>
1999 <RESTL XTRA8 1 = TY9 (TYPE LIST)>
2000 <NTHL TY9 1 = TY9 (TYPE ATOM)>
2003 <TYPE? XTRA8 <TYPE-CODE UNBOUND> + PHRASE20>
2004 <TYPE? XTRA8 <TYPE-CODE LIST> - PHRASE20>
2005 <RESTL XTRA8 1 = TY9 (TYPE LIST)>
2009 <TYPE? FROM6 <TYPE-CODE TEMP> - PHRASE22>
2010 <NTHUV FROM6 6 = TY9>
2015 <CALL '
\1aTYPE 1 = TY9>
2017 <EQUAL? TO7 'FLUSHED - PHRASE26>
2018 <GVAL 'POP-STACK = TY9>
2019 <EQUAL? TY9 FROM6 - PHRASE28>
2025 <FRAME '
\1aFREE-TEMP>
2028 <CALL '
\1aFREE-TEMP 1>
2029 <GVAL 'NO-DATUM = TY9>
2033 <TYPE? TO7 <TYPE-CODE LIST> - PHRASE31>
2034 <SET TEMP40 %<> (TYPE FALSE)>
2035 <SET TEMP19 TO7 (TYPE LIST)>
2040 <EMPL? TEMP19 + MAPAP36>
2041 <NTHL TEMP19 1 = TY9>
2042 <FRAME '
\1aMOVE-ARG>
2047 <CALL '
\1aMOVE-ARG 3 = TEMP40>
2048 <RESTL TEMP19 1 = TEMP19 (TYPE LIST)>
2054 <EQUAL? TO7 FROM6 + PHRASE44>
2055 <GVAL 'POP-STACK = TEMP19>
2056 <EQUAL? TEMP19 TO7 - PHRASE46>
2061 <FRAME '
\1aFREE-TEMP>
2064 <CALL '
\1aFREE-TEMP 1>
2068 <GEN-ASSIGNED? 'THE-BOOL - PHRASE49>
2069 <GEN-LVAL 'THE-BOOL = TEMP40>
2070 <EQUAL? TEMP40 TO7 - PHRASE49>
2072 <TYPE? FROM6 <TYPE-CODE FALSE> - PHRASE54>
2075 <GEN-LVAL 'THE-BOOL = STACK>
2076 <GEN-LVAL 'THE-BIT = STACK>
2078 <GEN-LVAL 'THE-BOOL = STACK>
2083 <EQUAL? FROM6 'T - PHRASE63>
2087 <GEN-LVAL 'THE-BOOL = STACK>
2088 <GEN-LVAL 'THE-BIT = STACK>
2090 <GEN-LVAL 'THE-BOOL = STACK>
2096 <PUSH 'OH-SHIT!-ERRORS>
2101 <TYPE? TO7 <TYPE-CODE TEMP> - PHRASE76>
2102 <FRAME '
\1aUSE-TEMP>
2106 <CALL '
\1aUSE-TEMP 2>
2107 <TYPE? FROM6 <TYPE-CODE TEMP> - PHRASE79>
2108 <TYPE? XTRA8 <TYPE-CODE UNBOUND> + PHRASE81>
2124 <FRAME '
\1aFREE-TEMP>
2127 <CALL '
\1aFREE-TEMP 1>
2131 <TYPE? XTRA8 <TYPE-CODE UNBOUND> + PHRASE88>
2138 <CALL '
\1aATOMCHK 1 = STACK>
2151 <CALL '
\1aATOMCHK 1 = STACK>
2156 <EQUAL? TO7 'DONT-CARE + TAG95>
2160 <GVAL 'TOP-STACK = TY9>
2161 <EQUAL? TY9 FROM6 - PHRASE97>
2163 <GVAL 'POP-STACK = TY9>
2174 <GFCN
\1aREFERENCE ("VALUE" ANY ANY) X4>
2180 "Generate a TYPE? instruction"
2183 <GFCN
\1aGEN-TYPE? ("VALUE" ATOM ANY ANY ANY ANY) ITM4 TYP5 TG6 DIR7>
2190 <TYPE? TYP5 <TYPE-CODE TEMP> - PHRASE10>
2199 <CALL '
\1aFORM 2 = TEMP11>
2203 <TYPE? DIR7 <TYPE-CODE FALSE> + PHRASE15>
2205 <SET TEMP11 '+ (TYPE ATOM)>
2208 <SET TEMP11 '- (TYPE ATOM)>
2214 <CALL '
\1aIEMIT 5 = TEMP11>
2219 <GFCN
\1aGEN-VT ("VALUE" ANY ANY ANY ANY "OPTIONAL" ANY) ITM6 TG7 DIR8 RTMP9>
2220 <OPT-DISPATCH 3 %<> OPT4 OPT5>
2224 <TEMP SIGN11:ATOM TMP10 TEMP20>
2226 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE13>
2227 <SET SIGN11 '- (TYPE ATOM)>
2230 <SET SIGN11 '+ (TYPE ATOM)>
2232 <TYPE? RTMP9 <TYPE-CODE UNBOUND> + PHRASE15>
2236 <FRAME '
\1aGEN-TEMP>
2238 <CALL '
\1aGEN-TEMP 1 = TMP10>
2240 <FRAME '
\1aUSE-TEMP>
2242 <CALL '
\1aUSE-TEMP 1>
2251 <CONS TG7 () = TEMP20>
2252 <CONS SIGN11 TEMP20 = TEMP20>
2254 <CONS '`BRANCH-FALSE TEMP20 = STACK>
2257 <FRAME '
\1aSPEC-IEMIT>
2260 <PUSH <`TYPE-CODE FALSE>>
2261 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE23>
2263 <SET TEMP20 '- (TYPE ATOM)>
2266 <SET TEMP20 '+ (TYPE ATOM)>
2272 <CALL '
\1aSPEC-IEMIT 5>
2273 <TYPE? RTMP9 <TYPE-CODE UNBOUND> + TAG27>
2277 <FRAME '
\1aFREE-TEMP>
2280 <CALL '
\1aFREE-TEMP 1 = TEMP20>
2285 <GFCN
\1aGEN-TC ("VALUE" TEMP ANY "OPTIONAL" ANY) TMP6 RTMP7>
2286 <OPT-DISPATCH 1 %<> OPT4 OPT5>
2292 <TYPE? RTMP7 <TYPE-CODE UNBOUND> + PHRASE9>
2293 <FRAME '
\1aUSE-TEMP>
2296 <CALL '
\1aUSE-TEMP 2>
2299 <FRAME '
\1aGEN-TEMP>
2301 <CALL '
\1aGEN-TEMP 1 = RTMP7>
2303 <GEN-LVAL 'CAREFUL = TEMP15>
2304 <TYPE? TEMP15 <TYPE-CODE FALSE> + PHRASE14>
2314 <PUSH (`BRANCH-FALSE + `COMPERR)>
2316 <FRAME '
\1aSPEC-IEMIT>
2319 <PUSH <`TYPE-CODE FALSE>>
2322 <CALL '
\1aSPEC-IEMIT 5>
2334 <PUSH (`TYPE TYPE-C)>
2339 "Generate SETG/GVAL things"
2342 <GFCN
\1aGEN-GVAL ("VALUE" ATOM ANY ANY "OPTIONAL" ANY) ATM6 W7 TYP8>
2343 <OPT-DISPATCH 2 %<> OPT4 OPT5>
2349 <TYPE? ATM6 <TYPE-CODE ATOM> - PHRASE13>
2354 <CALL '
\1aFORM 2 = ATM6>
2356 <TYPE? TYP8 <TYPE-CODE FALSE> + PHRASE16>
2364 <CONS TYP8 () = TEMP18>
2366 <CONS '`TYPE TEMP18 = STACK>
2368 <CALL '
\1aIEMIT 5 = TEMP18>
2379 <CALL '
\1aIEMIT 4 = TEMP18>
2385 <GFCN
\1aGEN-GASS ("VALUE" ANY ANY ANY ANY ANY) ATM4 TG5 DIR6 NM7>
2386 <TEMP TG18 (SIGN9 '+) TEMP23 TEM10:TEMP>
2388 <EQUAL? NM7 'GASSIGNED? + PHRASE12>
2392 <TYPE? DIR6 <TYPE-CODE FALSE> + PHRASE13>
2393 <FRAME '
\1aMAKE-TAG>
2394 <CALL '
\1aMAKE-TAG 0 = TG18>
2399 <TYPE? DIR6 <TYPE-CODE FALSE> + PHRASE17>
2400 <EQUAL? NM7 'GASSIGNED? + PHRASE17>
2401 <SET SIGN9 '- (TYPE ATOM)>
2405 <TYPE? ATM4 <TYPE-CODE ATOM> - PHRASE21>
2410 <CALL '
\1aFORM 2 = TEMP23>
2420 <FRAME '
\1aGEN-TEMP>
2421 <CALL '
\1aGEN-TEMP 0 = TEM10>
2424 <CONS TG18 () = TEMP23>
2425 <CONS SIGN9 TEMP23 = TEMP23>
2426 <CONS '`BRANCH-FALSE TEMP23 = STACK>
2429 <FRAME '
\1aSPEC-IEMIT>
2432 <PUSH <`TYPE-CODE FALSE>>
2436 <CALL '
\1aSPEC-IEMIT 5>
2437 <EQUAL? NM7 'GASSIGNED? - PHRASE28>
2445 <GVAL 'RGBN = STACK>
2447 <FRAME '
\1aGEN-TYPE?>
2451 <TYPE? DIR6 <TYPE-CODE FALSE> - TAG31>
2453 <SET TEMP23 'T (TYPE ATOM)>
2456 <SET TEMP23 %<> (TYPE FALSE)>
2460 <CALL '
\1aGEN-TYPE? 4>
2462 <EQUAL? TG5 TG18 + PHRASE34>
2464 <FRAME '
\1aLABEL-TAG>
2467 <CALL '
\1aLABEL-TAG 1>
2469 <FRAME '
\1aFREE-TEMP>
2472 <CALL '
\1aFREE-TEMP 1 = TEMP23>
2477 <GFCN
\1aGEN-SETG ("VALUE" ANY ANY ANY ANY ANY) ATM4 VAL5 DCL6 WHERE7>
2478 <TEMP TEMP16 TEM8:TEMP TEMP21 TG19 TEMP23:LIST>
2480 <TYPE? ATM4 <TYPE-CODE ATOM> - PHRASE12>
2487 <CALL '
\1aFORM 2 = STACK>
2491 <CALL '
\1aATOMCHK 1 = STACK>
2492 <CALL '
\1aIEMIT 3 = TEMP16>
2501 <FRAME '
\1aGEN-TEMP>
2502 <CALL '
\1aGEN-TEMP 0 = TEM8>
2505 <CONS '`BRANCH-FALSE () = TEMP16>
2506 <CONS '+ () = TEMP21>
2507 <PUTREST TEMP16 TEMP21>
2508 <FRAME '
\1aMAKE-TAG>
2509 <CALL '
\1aMAKE-TAG 0 = TG19>
2510 <CONS TG19 () = TEMP23>
2511 <PUTREST TEMP21 TEMP23>
2512 <DEAD TEMP21 TEMP23>
2516 <FRAME '
\1aSPEC-IEMIT>
2519 <PUSH <`TYPE-CODE FALSE>>
2522 <CALL '
\1aSPEC-IEMIT 5>
2528 <GVAL 'RGBN = STACK>
2530 <TYPE? DCL6 <TYPE-CODE FALSE> + PHRASE27>
2536 <GVAL 'RGBN = STACK>
2539 <FRAME '
\1aBRANCH-TAG>
2540 <FRAME '
\1aMAKE-TAG>
2541 <CALL '
\1aMAKE-TAG 0 = TEMP21>
2543 <CALL '
\1aBRANCH-TAG 1>
2544 <FRAME '
\1aLABEL-TAG>
2547 <CALL '
\1aLABEL-TAG 1>
2548 <FRAME '
\1aSTART-FRAME>
2550 <CALL '
\1aSTART-FRAME 1>
2558 <TYPE? DCL6 <TYPE-CODE FALSE> + PHRASE36>
2563 <EQUAL? WHERE7 'FLUSHED + PHRASE39>
2565 <FRAME '
\1aMSUBR-CALL>
2567 <TYPE? DCL6 <TYPE-CODE FALSE> + PHRASE42>
2569 <SET TEMP16 3 (TYPE FIX)>
2572 <SET TEMP16 2 (TYPE FIX)>
2578 <CALL '
\1aMSUBR-CALL 3>
2581 <FRAME '
\1aMSUBR-CALL>
2583 <TYPE? DCL6 <TYPE-CODE FALSE> + PHRASE47>
2585 <SET TEMP16 3 (TYPE FIX)>
2588 <SET TEMP16 2 (TYPE FIX)>
2593 <CALL '
\1aMSUBR-CALL 3>
2595 <FRAME '
\1aLABEL-TAG>
2598 <CALL '
\1aLABEL-TAG 1>
2599 <FRAME '
\1aFREE-TEMP>
2602 <CALL '
\1aFREE-TEMP 1 = TEMP16>
2609 <GFCN
\1aGEN-CHTYPE ("VALUE" ATOM ANY ANY ANY) ITM4 TYP5 W6>
2616 <TYPE? TYP5 <TYPE-CODE ATOM> - PHRASE9>
2617 <NTHR TYP5 5 = TEMP11 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE9)>
2618 <TYPE? TEMP11 <TYPE-CODE FALSE> + PHRASE9>
2624 <CALL '
\1aFORM 2 = TEMP11>
2635 <CALL '
\1aIEMIT 5 = TEMP11>
2640 <GFCN
\1aD-B-TAG ("VALUE" ATOM ANY ANY ANY ANY) BR4 WH5 DIR6 TYP7>
2643 <FRAME '
\1aTYPE-OK?>
2646 <CALL '
\1aTYPE-OK? 2 = TEMP12>
2647 <TYPE? TEMP12 <TYPE-CODE FALSE> - PHRASE9>
2649 <FRAME '
\1aTYPE-AND>
2653 <CALL '
\1aTYPE-AND 2 = TYP7>
2654 <TYPE? TYP7 <TYPE-CODE FALSE> + PHRASE9>
2655 <FRAME '
\1aTYPE-OK?>
2657 <PUSH <PRIMTYPE FIX>>
2658 <CALL '
\1aTYPE-OK? 2 = TEMP12>
2659 <TYPE? TEMP12 <TYPE-CODE FALSE> - PHRASE9>
2661 <FRAME '
\1aTYPE-AND>
2664 <PUSH <PRIMTYPE LIST>>
2665 <CALL '
\1aTYPE-AND 2 = TYP7>
2666 <TYPE? TYP7 <TYPE-CODE FALSE> + BOOL15>
2670 <CALL '
\1aMINL 1 = TEMP12>
2671 <GRTR? TEMP12 0 - PHRASE9 (TYPE FIX)>
2679 <TYPE? DIR6 <TYPE-CODE FALSE> + PHRASE22>
2681 <SET TEMP12 '- (TYPE ATOM)>
2684 <SET TEMP12 '+ (TYPE ATOM)>
2690 <CALL '
\1aIEMIT 5 = TEMP12>
2694 <FRAME '
\1aGEN-TYPE?>
2700 <TYPE? DIR6 <TYPE-CODE FALSE> - TAG26>
2702 <SET TEMP12 'T (TYPE ATOM)>
2705 <SET TEMP12 %<> (TYPE FALSE)>
2709 <CALL '
\1aGEN-TYPE? 4 = TEMP12>
2714 <GFCN
\1aMIM-RETURN ("VALUE" ATOM "OPTIONAL" ANY) VAL6>
2715 <OPT-DISPATCH 0 %<> OPT4 OPT5>
2721 <TYPE? VAL6 <TYPE-CODE UNBOUND> - TAG7>
2722 <GVAL 'POP-STACK = VAL6>
2729 <CALL '
\1aATOMCHK 1 = STACK>
2730 <CALL '
\1aIEMIT 2 = TEMP11>
2735 <GFCN
\1aRET-TMP-AC ("VALUE" ANY ANY) X4>
2742 <GFCN
\1aGEN-SHIFT ("VALUE" ATOM ANY ANY ANY) DAT4 AMT5 W6>
2755 <CALL '
\1aIEMIT 6 = TEMP8>
2760 <GFCN
\1aNTH-LIST ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 DST7 AMT8 RESTYP9>
2761 <OPT-DISPATCH 3 %<> OPT4 OPT5>
2767 <TYPE? RESTYP9 <TYPE-CODE FALSE> + PHRASE11>
2777 <CONS RESTYP9 () = TEMP13>
2779 <CONS '`TYPE TEMP13 = STACK>
2781 <CALL '
\1aIEMIT 6 = TEMP13>
2794 <CALL '
\1aIEMIT 5 = TEMP13>
2799 <GFCN
\1aNTH-UVECTOR ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 DST7 AMT8 RESTYP9>
2800 <OPT-DISPATCH 3 %<> OPT4 OPT5>
2806 <TYPE? RESTYP9 <TYPE-CODE FALSE> + PHRASE11>
2816 <CONS RESTYP9 () = TEMP13>
2818 <CONS '`TYPE TEMP13 = STACK>
2820 <CALL '
\1aIEMIT 6 = TEMP13>
2833 <CALL '
\1aIEMIT 5 = TEMP13>
2836 <END
\1aNTH-UVECTOR>
2838 <GFCN
\1aNTH-VECTOR ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 DST7 AMT8 RESTYP9>
2839 <OPT-DISPATCH 3 %<> OPT4 OPT5>
2845 <TYPE? RESTYP9 <TYPE-CODE FALSE> + PHRASE11>
2855 <CONS RESTYP9 () = TEMP13>
2857 <CONS '`TYPE TEMP13 = STACK>
2859 <CALL '
\1aIEMIT 6 = TEMP13>
2872 <CALL '
\1aIEMIT 5 = TEMP13>
2877 <GFCN
\1aNTH-STRING ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 DST7 AMT8 RESTYP9>
2878 <OPT-DISPATCH 3 %<> OPT4 OPT5>
2884 <TYPE? RESTYP9 <TYPE-CODE FALSE> + PHRASE11>
2894 <CONS RESTYP9 () = TEMP13>
2896 <CONS '`TYPE TEMP13 = STACK>
2898 <CALL '
\1aIEMIT 6 = TEMP13>
2911 <CALL '
\1aIEMIT 5 = TEMP13>
2916 <GFCN
\1aNTH-BYTES ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 DST7 AMT8 RESTYP9>
2917 <OPT-DISPATCH 3 %<> OPT4 OPT5>
2923 <TYPE? RESTYP9 <TYPE-CODE FALSE> + PHRASE11>
2933 <CONS RESTYP9 () = TEMP13>
2935 <CONS '`TYPE TEMP13 = STACK>
2937 <CALL '
\1aIEMIT 6 = TEMP13>
2950 <CALL '
\1aIEMIT 5 = TEMP13>
2955 <GFCN
\1aNTH-RECORD ("VALUE" ATOM ANY ANY ANY ANY "OPTIONAL" ANY) SRC6 DST7 AMT8 TPS9 RESTYP10>
2956 <OPT-DISPATCH 4 %<> OPT4 OPT5>
2962 <TYPE? RESTYP10 <TYPE-CODE FALSE> + PHRASE12>
2972 <CONS TPS9 () = TEMP14>
2974 <CONS '`RECORD-TYPE TEMP14 = STACK>
2976 <CONS RESTYP10 () = TEMP14>
2978 <CONS '`TYPE TEMP14 = STACK>
2980 <CALL '
\1aIEMIT 7 = TEMP14>
2993 <CONS TPS9 () = TEMP14>
2995 <CONS '`RECORD-TYPE TEMP14 = STACK>
2997 <CALL '
\1aIEMIT 6 = TEMP14>
3002 <GFCN
\1aREST-LIST ("VALUE" ATOM ANY ANY ANY) SRC4 DST5 AMT6>
3015 <CALL '
\1aIEMIT 6 = TEMP8>
3020 <GFCN
\1aREST-UVECTOR ("VALUE" ATOM ANY ANY ANY) SRC4 DST5 AMT6>
3032 <PUSH (`TYPE UVECTOR)>
3033 <CALL '
\1aIEMIT 6 = TEMP8>
3036 <END
\1aREST-UVECTOR>
3038 <GFCN
\1aREST-VECTOR ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 DST7 AMT8 TY9>
3039 <OPT-DISPATCH 3 %<> OPT4 OPT5>
3045 <TYPE? TY9 <TYPE-CODE UNBOUND> + PHRASE11>
3055 <CONS TY9 () = TEMP13>
3057 <CONS '`TYPE TEMP13 = STACK>
3059 <CALL '
\1aIEMIT 6 = TEMP13>
3072 <CALL '
\1aIEMIT 5 = TEMP13>
3075 <END
\1aREST-VECTOR>
3077 <GFCN
\1aREST-STRING ("VALUE" ATOM ANY ANY ANY) SRC4 DST5 AMT6>
3089 <PUSH (`TYPE STRING)>
3090 <CALL '
\1aIEMIT 6 = TEMP8>
3093 <END
\1aREST-STRING>
3095 <GFCN
\1aREST-BYTES ("VALUE" ATOM ANY ANY ANY) SRC4 DST5 AMT6>
3107 <PUSH (`TYPE BYTES)>
3108 <CALL '
\1aIEMIT 6 = TEMP8>
3113 <GFCN
\1aEMPTY-LIST ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 TG7 DIR8 TY9>
3114 <OPT-DISPATCH 3 %<> OPT4 OPT5>
3120 <TYPE? TY9 <TYPE-CODE FALSE> + PHRASE11>
3125 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE14>
3127 <SET TEMP15 '+ (TYPE ATOM)>
3130 <SET TEMP15 '- (TYPE ATOM)>
3136 <CONS TY9 () = TEMP15>
3138 <CONS '`TYPE TEMP15 = STACK>
3140 <CALL '
\1aIEMIT 5 = TEMP15>
3148 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE20>
3150 <SET TEMP15 '+ (TYPE ATOM)>
3153 <SET TEMP15 '- (TYPE ATOM)>
3159 <CALL '
\1aIEMIT 4 = TEMP15>
3164 <GFCN
\1aEMPTY-UVECTOR ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 TG7 DIR8 TY9>
3165 <OPT-DISPATCH 3 %<> OPT4 OPT5>
3171 <TYPE? TY9 <TYPE-CODE FALSE> + PHRASE11>
3176 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE14>
3178 <SET TEMP15 '+ (TYPE ATOM)>
3181 <SET TEMP15 '- (TYPE ATOM)>
3187 <CONS TY9 () = TEMP15>
3189 <CONS '`TYPE TEMP15 = STACK>
3191 <CALL '
\1aIEMIT 5 = TEMP15>
3199 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE20>
3201 <SET TEMP15 '+ (TYPE ATOM)>
3204 <SET TEMP15 '- (TYPE ATOM)>
3210 <CALL '
\1aIEMIT 4 = TEMP15>
3213 <END
\1aEMPTY-UVECTOR>
3215 <GFCN
\1aEMPTY-VECTOR ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 TG7 DIR8 TY9>
3216 <OPT-DISPATCH 3 %<> OPT4 OPT5>
3222 <TYPE? TY9 <TYPE-CODE FALSE> + PHRASE11>
3227 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE14>
3229 <SET TEMP15 '+ (TYPE ATOM)>
3232 <SET TEMP15 '- (TYPE ATOM)>
3238 <CONS TY9 () = TEMP15>
3240 <CONS '`TYPE TEMP15 = STACK>
3242 <CALL '
\1aIEMIT 5 = TEMP15>
3250 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE20>
3252 <SET TEMP15 '+ (TYPE ATOM)>
3255 <SET TEMP15 '- (TYPE ATOM)>
3261 <CALL '
\1aIEMIT 4 = TEMP15>
3264 <END
\1aEMPTY-VECTOR>
3266 <GFCN
\1aEMPTY-STRING ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 TG7 DIR8 TY9>
3267 <OPT-DISPATCH 3 %<> OPT4 OPT5>
3273 <TYPE? TY9 <TYPE-CODE FALSE> + PHRASE11>
3278 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE14>
3280 <SET TEMP15 '+ (TYPE ATOM)>
3283 <SET TEMP15 '- (TYPE ATOM)>
3289 <CONS TY9 () = TEMP15>
3291 <CONS '`TYPE TEMP15 = STACK>
3293 <CALL '
\1aIEMIT 5 = TEMP15>
3301 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE20>
3303 <SET TEMP15 '+ (TYPE ATOM)>
3306 <SET TEMP15 '- (TYPE ATOM)>
3312 <CALL '
\1aIEMIT 4 = TEMP15>
3315 <END
\1aEMPTY-STRING>
3317 <GFCN
\1aEMPTY-BYTES ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 TG7 DIR8 TY9>
3318 <OPT-DISPATCH 3 %<> OPT4 OPT5>
3324 <TYPE? TY9 <TYPE-CODE FALSE> + PHRASE11>
3329 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE14>
3331 <SET TEMP15 '+ (TYPE ATOM)>
3334 <SET TEMP15 '- (TYPE ATOM)>
3340 <CONS TY9 () = TEMP15>
3342 <CONS '`TYPE TEMP15 = STACK>
3344 <CALL '
\1aIEMIT 5 = TEMP15>
3352 <TYPE? DIR8 <TYPE-CODE FALSE> + PHRASE20>
3354 <SET TEMP15 '+ (TYPE ATOM)>
3357 <SET TEMP15 '- (TYPE ATOM)>
3363 <CALL '
\1aIEMIT 4 = TEMP15>
3366 <END
\1aEMPTY-BYTES>
3368 <GFCN
\1aEMPTY-RECORD ("VALUE" ATOM ANY ANY ANY ANY) SRC4 TG5 DIR6 TPS7>
3375 <TYPE? DIR6 <TYPE-CODE FALSE> + PHRASE10>
3377 <SET TEMP11 '+ (TYPE ATOM)>
3380 <SET TEMP11 '- (TYPE ATOM)>
3386 <CONS TPS7 () = TEMP11>
3388 <CONS '`RECORD-TYPE TEMP11 = STACK>
3390 <CALL '
\1aIEMIT 5 = TEMP11>
3393 <END
\1aEMPTY-RECORD>
3395 <GFCN
\1aLENGTH-LIST ("VALUE" ATOM ANY ANY) SRC4 DST5>
3406 <CALL '
\1aIEMIT 5 = TEMP7>
3409 <END
\1aLENGTH-LIST>
3411 <GFCN
\1aLENGTH-UVECTOR ("VALUE" ATOM ANY ANY) SRC4 DST5>
3422 <CALL '
\1aIEMIT 5 = TEMP7>
3425 <END
\1aLENGTH-UVECTOR>
3427 <GFCN
\1aLENGTH-VECTOR ("VALUE" ATOM ANY ANY) SRC4 DST5>
3438 <CALL '
\1aIEMIT 5 = TEMP7>
3441 <END
\1aLENGTH-VECTOR>
3443 <GFCN
\1aLENGTH-STRING ("VALUE" ATOM ANY ANY) SRC4 DST5>
3454 <CALL '
\1aIEMIT 5 = TEMP7>
3457 <END
\1aLENGTH-STRING>
3459 <GFCN
\1aLENGTH-BYTES ("VALUE" ATOM ANY ANY) SRC4 DST5>
3470 <CALL '
\1aIEMIT 5 = TEMP7>
3473 <END
\1aLENGTH-BYTES>
3475 <GFCN
\1aLENGTH-RECORD ("VALUE" ATOM ANY ANY ANY) SRC4 DST5 TPS6>
3485 <CONS TPS6 () = TEMP8>
3487 <CONS '`RECORD-TYPE TEMP8 = STACK>
3490 <CALL '
\1aIEMIT 6 = TEMP8>
3493 <END
\1aLENGTH-RECORD>
3495 <GFCN
\1aPUT-LIST ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 NUM7 NEW8 TY9>
3496 <OPT-DISPATCH 3 %<> OPT4 OPT5>
3502 <TYPE? TY9 <TYPE-CODE FALSE> + PHRASE11>
3512 <CALL '
\1aATOMCHK 1 = STACK>
3515 <CALL '
\1aIEMIT 5 = TEMP14>
3528 <CALL '
\1aATOMCHK 1 = STACK>
3529 <CALL '
\1aIEMIT 4 = TEMP14>
3534 <GFCN
\1aPUT-VECTOR ("VALUE" ATOM ANY ANY ANY "OPTIONAL" ANY) SRC6 NUM7 NEW8 TY9>
3535 <OPT-DISPATCH 3 %<> OPT4 OPT5>
3541 <TYPE? TY9 <TYPE-CODE FALSE> + PHRASE11>
3551 <CALL '
\1aATOMCHK 1 = STACK>
3554 <CALL '
\1aIEMIT 5 = TEMP14>
3567 <CALL '
\1aATOMCHK 1 = STACK>
3568 <CALL '
\1aIEMIT 4 = TEMP14>
3573 <GFCN
\1aPUT-UVECTOR ("VALUE" ATOM ANY ANY ANY) SRC4 NUM5 NEW6>
3584 <CALL '
\1aIEMIT 4 = TEMP8>
3587 <END
\1aPUT-UVECTOR>
3589 <GFCN
\1aPUT-STRING ("VALUE" ATOM ANY ANY ANY) SRC4 NUM5 NEW6>
3600 <CALL '
\1aIEMIT 4 = TEMP8>
3605 <GFCN
\1aPUT-BYTES ("VALUE" ATOM ANY ANY ANY) SRC4 NUM5 NEW6>
3616 <CALL '
\1aIEMIT 4 = TEMP8>
3621 <GFCN
\1aPUT-RECORD ("VALUE" ATOM ANY ANY ANY ANY "OPTIONAL" ANY) SRC6 NUM7 NEW8 TPS9 TY10>
3622 <OPT-DISPATCH 4 %<> OPT4 OPT5>
3628 <TYPE? TY10 <TYPE-CODE FALSE> + PHRASE12>
3638 <CALL '
\1aATOMCHK 1 = STACK>
3639 <CONS TPS9 () = TEMP15>
3641 <CONS '`RECORD-TYPE TEMP15 = STACK>
3645 <CALL '
\1aIEMIT 6 = TEMP15>
3658 <CALL '
\1aATOMCHK 1 = STACK>
3659 <CONS TPS9 () = TEMP15>
3661 <CONS '`RECORD-TYPE TEMP15 = STACK>
3663 <CALL '
\1aIEMIT 5 = TEMP15>
3668 <GFCN
\1aPROTECT ("VALUE" ANY ANY) ITM4>
3671 <TYPE? ITM4 <TYPE-CODE TEMP> - PHRASE6>
3672 <NTHUV ITM4 2 = TEMP8 (TYPE FIX)>
3673 <VEQUAL? TEMP8 0 - PHRASE6 (TYPE FIX)>
3681 <CALL '
\1aPUSH 1 = TEMP8>
3686 <GFCN
\1aGEN-VAL-==? ("VALUE" ATOM ANY ANY ANY ANY) D14 D25 DIR6 BR7>
3694 <CALL '
\1aATOMCHK 1 = STACK>
3698 <CALL '
\1aATOMCHK 1 = STACK>
3699 <TYPE? DIR6 <TYPE-CODE FALSE> + PHRASE12>
3701 <SET TEMP13 '+ (TYPE ATOM)>
3704 <SET TEMP13 '- (TYPE ATOM)>
3710 <CALL '
\1aIEMIT 5 = TEMP13>
3713 <END
\1aGEN-VAL-==?>
3715 <GFCN
\1aGEN-==? ("VALUE" ATOM ANY ANY ANY ANY) D14 D25 DIR6 BR7>
3723 <CALL '
\1aATOMCHK 1 = STACK>
3727 <CALL '
\1aATOMCHK 1 = STACK>
3728 <TYPE? DIR6 <TYPE-CODE FALSE> + PHRASE12>
3730 <SET TEMP13 '+ (TYPE ATOM)>
3733 <SET TEMP13 '- (TYPE ATOM)>
3739 <CALL '
\1aIEMIT 5 = TEMP13>
3744 <GFCN
\1aPREV-FRAME ("VALUE" ANY ANY) WHERE4>
3758 <CONS 'FRAME () = TEMP7>
3759 <CONS '`RECORD-TYPE TEMP7 = STACK>