4 <ENTRY PASS1 PCOMP PMACRO PAPPLY-OBJECT PAPPLY-TYPE PTHIS-OBJECT PTHIS-TYPE GEN-D ACT-FIX FIND_DECL SEG? PSUBR-C>
8 <USE "GC-DUMP" "CHKDCL" "COMPDEC" "MIMGEN" "ADVMESS" "CDRIVE">
10 " This file contains the first pass of the MUDDLE compiler.
11 The functions therein take a MUDDLE function and build a more detailed
12 model of it. Each entity in the function is represented by an object
13 of type NODE. The entire function is represented by the functions node
14 and it points to the rest of the nodes for the function."
16 " Nodes vary in complexity and size depending on what they represent.
17 A function or prog/repeat node is contains more information than a node
18 for a quoted object. All nodes have some fields in common to allow
19 general programs to traverse the model."
21 " The model built by PASS1 is used by the analyzer (SYMANA), the
22 variable allocator (VARANA) and the code generator (CODGEN). In some
23 cases the analyzers and generators for certain classes of SUBRs are
24 together in their own files (e.g. CARITH, STRUCT, ISTRUC)."
26 " This the top level program for PASS1. It takes a function as
27 input and returns the data structure representing the model."
29 <COND (<NOT ,MIM> <SETG PMAX ,NUMPRI!-MUDDLE>)>
35 <COND (<NOT ,MIM> <FLOAD "PRCOD.NBIN">)>
38 <GFCN
\1aPASS1 ("VALUE" NODE ATOM FUNCTION) FNAME4 FUNC5>
39 <TEMP (TEMP3 ()) TEMP16 (DCL8 #DECL ()) (ARGL9:LIST ()) (HATOM10 %<>) FCN12 TEMP47>
41 <GETS 'BIND = TEMP3 (TYPE LBIND)>
42 <BBIND 'FNAME 'ATOM %<> FNAME4>
45 <BBIND 'RESULT 'NODE 'FIX>
46 <GVAL 'LVARTBL = TEMP16>
47 <BBIND 'VARTBL 'SYMTAB 'FIX TEMP16>
51 <BBIND 'RQRG 'FIX 'FIX 0>
52 <BBIND 'TRG 'FIX 'FIX 0>
53 <EMPL? FCN12 - PHRASE18 (TYPE FUNCTION)>
54 <FRAME '
\1aCOMPILE-ERROR>
55 <PUSH "Empty function: ">
56 <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
57 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
59 <CALL '
\1aCOMPILE-ERROR 2>
61 <NTHL FCN12 1 = TEMP16>
62 <TYPE? TEMP16 <TYPE-CODE ATOM> + TAG24>
63 <TYPE? TEMP16 <TYPE-CODE ADECL> - PHRASE23>
66 <NTHL FCN12 1 = HATOM10>
67 <RESTL FCN12 1 = FCN12 (TYPE LIST)>
68 <CHTYPE FCN12 <TYPE-CODE LIST> = FCN12>
70 <EMPL? FCN12 - PHRASE26>
71 <FRAME '
\1aCOMPILE-ERROR>
72 <PUSH "Empty function: ">
73 <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
74 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
76 <CALL '
\1aCOMPILE-ERROR 2>
78 <NTHL FCN12 1 = ARGL9 (TYPE LIST)>
79 <RESTL FCN12 1 = FCN12 (TYPE LIST)>
80 <CHTYPE FCN12 <TYPE-CODE LIST> = FCN12>
81 <EMPL? FCN12 + PHRASE32 (TYPE LIST)>
82 <NTHL FCN12 1 = TEMP16>
83 <TYPE? TEMP16 <TYPE-CODE DECL> - PHRASE32>
85 <NTHL FCN12 1 = DCL8 (TYPE DECL)>
86 <RESTL FCN12 1 = FCN12 (TYPE LIST)>
88 <EMPL? FCN12 - PHRASE35 (TYPE LIST)>
89 <FRAME '
\1aCOMPILE-ERROR>
90 <PUSH "Function has no body: ">
91 <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
92 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
94 <CALL '
\1aCOMPILE-ERROR 2>
102 <CALL '
\1aFIND_DECL 2 = STACK>
103 <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
104 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
110 <NTHR 'VARTBL 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
111 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
115 <CALL '
\1aNODEF 11 = TEMP16>
116 <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
117 <PUTR TEMP47 1 TEMP16 (RECORD-TYPE LBIND)>
126 <NTHR 'RESULT 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
127 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
131 <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
132 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
134 <GEN-LVAL 'IND = STACK>
135 <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
136 <NTHR TEMP47 1 = STACK (RECORD-TYPE LBIND)>
140 <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
141 <NTHR TEMP47 1 = TEMP47 (RECORD-TYPE LBIND)>
142 <NTHUV TEMP47 3 = STACK>
144 <SET DCL8 2 (TYPE FIX)>
145 <NTHR 'RESULT 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
146 <NTHR TEMP16 1 = TEMP16 (RECORD-TYPE LBIND)>
147 <NTHUV TEMP16 9 = TEMP47>
149 <TYPE TEMP47 = TEMP16>
150 <AND TEMP16 7 = TEMP16>
151 <VEQUAL? TEMP16 1 + TAG66>
153 <LOOP (TEMP47 TYPE VALUE LENGTH) (DCL8 VALUE)>
156 <EMPTY? TEMP47 + TAG70>
157 <NTH1 TEMP47 = STACK>
158 <REST1 TEMP47 = TEMP47>
159 <ADD DCL8 1 = DCL8 (TYPE FIX)>
162 <LIST DCL8 = TEMP16 (TYPE LIST)>
168 <VEQUAL? DCL8 0 + TAG68>
170 <CONS TEMP16 TEMP47 = TEMP47 (TYPE LIST)>
172 <SUB DCL8 1 = DCL8 (TYPE FIX)>
178 <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
179 <NTHR TEMP47 1 = TEMP47 (RECORD-TYPE LBIND)>
180 <PUTUV TEMP47 9 TEMP16>
182 <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
183 <NTHR TEMP47 1 = TEMP47 (RECORD-TYPE LBIND)>
184 <SET HATOM10 () (TYPE LIST)>
185 <SET DCL8 () (TYPE LIST)>
186 <SET TEMP16 FCN12 (TYPE LIST)>
191 <EMPL? TEMP16 + MAPAP80>
192 <NTHL TEMP16 1 = FCN12>
196 <NTHR 'RESULT 2 = FCN12 (RECORD-TYPE ATOM) (TYPE LBIND)>
197 <NTHR FCN12 1 = STACK (RECORD-TYPE LBIND)>
199 <CALL '
\1aPCOMP 2 = FCN12>
200 <CONS FCN12 () = FCN12 (TYPE LIST)>
201 <EMPL? HATOM10 - TAG91>
202 <SET HATOM10 FCN12 (TYPE LIST)>
208 <SET DCL8 FCN12 (TYPE LIST)>
210 <RESTL TEMP16 1 = TEMP16 (TYPE LIST)>
213 <PUTUV TEMP47 5 HATOM10 (TYPE LIST)>
214 <DEAD TEMP47 HATOM10>
216 <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
217 <NTHR TEMP47 1 = STACK (RECORD-TYPE LBIND)>
219 <NTHR 'RESULT 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
220 <NTHR TEMP47 1 = TEMP47 (RECORD-TYPE LBIND)>
221 <NTHUV TEMP47 10 = STACK (TYPE LIST)>
225 <NTHR 'FNAME 2 = TEMP47 (RECORD-TYPE ATOM) (TYPE LBIND)>
226 <NTHR TEMP47 1 = STACK (RECORD-TYPE LBIND)>
228 <GEN-LVAL 'IND = STACK>
231 <NTHR 'FNAME 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
232 <NTHR TEMP16 1 = STACK (RECORD-TYPE LBIND)>
235 <NTHR 'RESULT 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
236 <NTHR TEMP16 1 = TEMP16 (RECORD-TYPE LBIND)>
237 <NTHUV TEMP16 9 = STACK>
240 <NTHR 'RESULT 2 = TEMP16 (RECORD-TYPE ATOM) (TYPE LBIND)>
241 <NTHR TEMP16 1 = TEMP16 (RECORD-TYPE LBIND)>
248 "Vector of legal strings in decl list."
250 <SETG TOT-MODES ["BIND" "CALL" "OPT" "OPTIONAL" "ARGS" "TUPLE" "AUX" "EXTRA" "ACT" "NAME" "DECL" "VALUE"]>
252 <PROG ((N <LENGTH ,TOT-MODES>)) <MAPF <> <FUNCTION (S "AUX" (ATM <PARSE <STRING "ACODE-" .S>>)) <SETG .ATM .N> <MANIFEST .ATM> <SET N <- .N 1>>> ,TOT-MODES> <SET N <+ <LENGTH ,TOT-MODES> 1>> <MAPF <> <FUNCTION (ATM) <SETG .ATM .N> <MANIFEST .ATM> <SET N <+ .N 1>>> '[ACODE-INIT ACODE-INIT1 ACODE-ERR ACODE-NORM]>>
254 "Amount to rest off decl vector after each encounter."
256 <SETG RESTS ![1 1 1 2 1 2 1 2 1 2 1 1!]>
258 " This function (and others on this page) take an arg list and
259 decls and parses them.
261 1) An RSUBR decl list.
263 2) A machine readable binding specification.
265 Atoms are also entered into the symbol table."
268 <GFCN
\1aGEN-D ("VALUE" NODE LIST <PRIMTYPE LIST> ANY ANY) ARGL4 DCL5 HATOM6 FCNNOD7>
269 <TEMP TEMP3:LBIND TEMP22 RES_TOP9:LIST BNDL_TOP12:LIST TEMP25 (ST17 %<>) TEMP34 TIX14 TEMP53 TEMP66>
271 <GETS 'BIND = TEMP3 (TYPE LBIND)>
272 <BBIND 'DCL <PRIMTYPE LIST> %<> DCL5>
275 <GEN-LVAL 'VARTBL = TEMP22>
276 <CONS () () = RES_TOP9>
277 <BBIND 'RES_BOT 'LIST 'FIX RES_TOP9>
278 <BBIND 'ARGN 'FIX 'FIX 1>
279 <CONS () () = BNDL_TOP12>
280 <BBIND 'BNDL_BOT 'LIST 'FIX BNDL_TOP12>
281 <GVAL 'TOT-MODES = TEMP25>
282 <BBIND 'MODE <VECTOR [REST STRING]> 'FIX TEMP25>
284 <BBIND 'IX 'FIX 'FIX 13>
288 <EMPL? ARGL4 + EXIT26 (TYPE LIST)>
289 <NTHL ARGL4 1 = TEMP25>
290 <TYPE? TEMP25 <TYPE-CODE ATOM> + TAG32>
291 <TYPE? TEMP25 <TYPE-CODE FORM> + TAG32>
292 <TYPE? TEMP25 <TYPE-CODE LIST> + TAG32>
293 <TYPE? TEMP25 <TYPE-CODE ADECL> - PHRASE31>
295 <SET ST17 %<> (TYPE FALSE)>
296 <FRAME '
\1aRUN-ARGER>
297 <NTHR 'IX 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
298 <NTHR TEMP34 1 = STACK (RECORD-TYPE LBIND)>
303 <CALL '
\1aRUN-ARGER 3>
306 <TYPE? TEMP25 <TYPE-CODE STRING> - PHRASE37>
307 <TYPE? ST17 <TYPE-CODE FALSE> + PHRASE39>
308 <FRAME '
\1aCOMPILE-ERROR>
309 <PUSH "Two arg list strings in a row: ">
313 <CALL '
\1aCOMPILE-ERROR 3>
318 <NTHR 'MODE 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
319 <NTHR TEMP34 1 = STACK (RECORD-TYPE LBIND)>
321 <CALL '
\1aMEMBER 2 = TIX14>
322 <TYPE? TIX14 <TYPE-CODE FALSE> - PHRASE42>
323 <FRAME '
\1aCOMPILE-ERROR>
324 <PUSH "Unrecognized arg list string: ">
327 <CALL '
\1aCOMPILE-ERROR 2>
329 <NTHR 'MODE 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
330 <NTHR TEMP34 1 = TEMP34 (RECORD-TYPE LBIND)>
331 <GVAL 'RESTS = TEMP25>
332 <LENUV TIX14 = TIX14 (TYPE FIX)>
333 <NTHR 'IX 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
334 <PUTR TEMP53 1 TIX14 (RECORD-TYPE LBIND)>
336 <NTHUU TEMP25 TIX14 = TEMP53 (TYPE FIX)>
338 <RESTUV TEMP34 TEMP53 = TEMP53 (TYPE VECTOR)>
340 <NTHR 'MODE 2 = TEMP34 (RECORD-TYPE ATOM) (TYPE LBIND)>
341 <PUTR TEMP34 1 TEMP53 (RECORD-TYPE LBIND)>
343 <NTHR 'IX 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
344 <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
345 <LESS? TEMP53 7 + PHRASE69 (TYPE FIX)>
347 <NTHR 'IX 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
348 <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
349 <GRTR? TEMP53 11 + PHRASE69 (TYPE FIX)>
352 <NTHL ARGL4 1 = TEMP53>
353 <TYPE? TEMP53 <TYPE-CODE STRING> - PHRASE65>
354 <IFCAN "STRING-EQUAL?">
355 <STRING-EQUAL? TEMP53 "OPT" - PHRASE65>
356 <ENDIF "STRING-EQUAL?">
357 <IFCANNOT "STRING-EQUAL?">
358 <SET TEMP34 "OPT" (TYPE STRING)>
359 <LENUS TEMP53 = TIX14 (TYPE FIX)>
360 <VEQUAL? TIX14 3 - PHRASE65>
361 <LOOP (TEMP53 VALUE LENGTH) (TEMP34 VALUE LENGTH) (TIX14 VALUE)>
363 <NTHUS TEMP53 1 = TEMP25>
364 <NTHUS TEMP34 1 = TEMP66>
365 <VEQUAL? TEMP25 TEMP66 - PHRASE65>
367 <RESTUS TEMP53 1 = TEMP53 (TYPE STRING)>
368 <RESTUS TEMP34 1 = TEMP34 (TYPE STRING)>
369 <SUB TIX14 1 = TIX14 (TYPE FIX)>
370 <GRTR? TIX14 0 + TAG67 (TYPE FIX)>
371 <ENDIF "STRING-EQUAL?">
372 <SET TEMP34 "OPTIONAL" (TYPE STRING)>
375 <NTHL ARGL4 1 = TEMP34>
377 <CONS TEMP34 () = STACK>
382 <FRAME '
\1aCOMPILE-ERROR>
383 <PUSH "Unknown type of object in arglist ">
386 <CALL '
\1aCOMPILE-ERROR 2>
388 <RESTL ARGL4 1 = ARGL4 (TYPE LIST)>
391 <TYPE? HATOM6 <TYPE-CODE FALSE> + PHRASE72>
400 <NTHR 'DCL 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
401 <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
402 <EMPL? TEMP53 + EXIT74>
404 <NTHR 'DCL 2 = TEMP66 (RECORD-TYPE ATOM) (TYPE LBIND)>
405 <NTHR TEMP66 1 = TEMP66 (RECORD-TYPE LBIND)>
406 <RESTL TEMP66 1 = TEMP53 (TYPE LIST)>
408 <CHTYPE TEMP53 <TYPE-CODE LIST> = TEMP53>
409 <EMPL? TEMP53 - PHRASE82 (TYPE LIST)>
411 <FRAME '
\1aCOMPILE-ERROR>
412 <PUSH "DECL in bad format (no DECL for): ">
413 <NTHR 'DCL 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
414 <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
415 <NTHL TEMP53 1 = STACK>
417 <CALL '
\1aCOMPILE-ERROR 2>
419 <NTHR 'DCL 2 = TEMP53 (RECORD-TYPE ATOM) (TYPE LBIND)>
420 <NTHR TEMP53 1 = TEMP53 (RECORD-TYPE LBIND)>
421 <RESTL TEMP53 1 = TEMP53 (TYPE LIST)>
422 <NTHL TEMP53 1 = ST17>
424 <TYPE? ST17 <TYPE-CODE FORM> - PHRASE91>
426 <EMPL? TEMP25 + PHRASE91>
427 <RESTL TEMP25 1 = TEMP53 (TYPE LIST)>
428 <EMPL? TEMP53 + PHRASE91>
429 <RESTL TEMP53 1 = TEMP53 (TYPE LIST)>
430 <EMPL? TEMP53 - PHRASE91>
432 <NTHL TEMP25 1 = TEMP53>
433 <EQUAL? TEMP53 'SPECIAL + BOOL93>
435 <NTHL TEMP25 1 = TEMP53>
436 <EQUAL? TEMP53 'UNSPECIAL - PHRASE91>
439 <RESTL TEMP25 1 = TEMP53 (TYPE LIST)>
441 <NTHL TEMP53 1 = ST17>
444 <NTHR 'DCL 2 = TEMP25 (RECORD-TYPE ATOM) (TYPE LBIND)>
445 <NTHR TEMP25 1 = TEMP25 (RECORD-TYPE LBIND)>
446 <NTHL TEMP25 1 = TEMP25>
447 <CHTYPE TEMP25 <TYPE-CODE LIST> = TEMP25>
451 <EMPL? TEMP25 + MAPAP98>
452 <NTHL TEMP25 1 = TEMP34>
453 <EQUAL? TEMP34 'VALUE + PHRASE107>
456 <CALL '
\1aSRCH-SYM 1 = TIX14>
457 <VEQUAL? TIX14 0 - PHRASE107>
471 <RESTL TEMP25 1 = TEMP25 (TYPE LIST)>
474 <NTHR 'DCL 2 = ST17 (RECORD-TYPE ATOM) (TYPE LBIND)>
475 <NTHR ST17 1 = ST17 (RECORD-TYPE LBIND)>
476 <RESTL ST17 1 = ST17 (TYPE LIST)>
477 <RESTL ST17 1 = TEMP25 (TYPE LIST)>
479 <CHTYPE TEMP25 <TYPE-CODE LIST> = TEMP25>
480 <NTHR 'DCL 2 = ST17 (RECORD-TYPE ATOM) (TYPE LBIND)>
481 <PUTR ST17 1 TEMP25 (RECORD-TYPE LBIND)>
485 <GEN-LVAL 'VARTBL = ST17>
486 <GEN-SET 'VARTBL TEMP22>
487 <VEQUAL? TEMP22 ST17 + EXIT122>
492 <NTHUV TEMP25 1 = TEMP66>
493 <EQUAL? TEMP66 TEMP22 - PHRASE126>
495 <GEN-LVAL 'VARTBL = TEMP66>
496 <PUTUV TEMP25 1 TEMP66>
498 <GEN-SET 'VARTBL ST17>
502 <NTHUV TEMP25 1 = TEMP25 (TYPE SYMTAB)>
505 <NTHR 'ARGN 2 = TEMP66 (RECORD-TYPE ATOM) (TYPE LBIND)>
506 <NTHR TEMP66 1 = TEMP66 (RECORD-TYPE LBIND)>
507 <SUB TEMP66 1 = TEMP66 (TYPE FIX)>
508 <GEN-SET 'TRG TEMP66>
509 <LESS? TEMP66 0 - BOOL132 (TYPE FIX)>
513 <RESTL BNDL_TOP12 1 = TEMP66 (TYPE LIST)>
515 <PUTUV FCNNOD7 10 TEMP66 (TYPE LIST)>
517 <NTHUV FCNNOD7 1 = TEMP66 (TYPE FIX)>
518 <VEQUAL? TEMP66 1 - PHRASE142 (TYPE FIX)>
520 <GEN-LVAL 'RQRG = TEMP66>
521 <PUTUV FCNNOD7 21 TEMP66>
523 <GEN-LVAL 'TRG = TEMP66>
524 <PUTUV FCNNOD7 20 TEMP66>
526 <RESTL RES_TOP9 1 = TEMP66 (TYPE LIST)>
528 <PUTUV FCNNOD7 9 TEMP66>
531 <GEN-LVAL 'VARTBL = TEMP66>
532 <PUTUV FCNNOD7 11 TEMP66>
540 "RUN-ARGER dispatches to different arg handlers"
543 <GFCN
\1aRUN-ARGER ("VALUE" ANY FIX ANY ANY) INDX4 ARG5 N6>
546 <DISPATCH INDX4 1 CASE23 CASE22 CASE18 CASE17 CASE16 CASE15 CASE14 CASE13 CASE12 CASE11 CASE10 CASE9 CASE19 CASE20 CASE24 CASE21>
553 <CALL '
\1aBIND-D 1 = TEMP25>
560 <CALL '
\1aCALL-D 1 = TEMP25>
567 <CALL '
\1aOPT-D 1 = TEMP25>
574 <CALL '
\1aOPT-D 1 = TEMP25>
581 <CALL '
\1aARGS-D 1 = TEMP25>
588 <CALL '
\1aTUPL-D 1 = TEMP25>
595 <CALL '
\1aAUX-D 1 = TEMP25>
602 <CALL '
\1aAUX-D 1 = TEMP25>
609 <CALL '
\1aACT-D 1 = TEMP25>
616 <CALL '
\1aACT-D 1 = TEMP25>
623 <CALL '
\1aINIT-D 1 = TEMP25>
630 <CALL '
\1aINIT1-D 1 = TEMP25>
637 <CALL '
\1aNORM-D 1 = TEMP25>
644 <CALL '
\1aDECL-D 1 = TEMP25>
653 <CALL '
\1aVDECL-D 2 = TEMP25>
660 <CALL '
\1aERR-D 1 = TEMP25>
663 <END
\1aRUN-ARGER>
\r\r
665 <GFCN
\1aSRCH-SYM ("VALUE" <OR !<FALSE> <<PRIMTYPE VECTOR> ANY ATOM>> ATOM) ATM4>
666 <TEMP TEMP6 TEMP17:ATOM>
668 <GEN-LVAL 'VARTBL = TEMP6>
672 <EMPUV? TEMP6 - PHRASE14>
675 <NTHUV TEMP6 2 = TEMP17 (TYPE ATOM)>
676 <VEQUAL? TEMP17 ATM4 - PHRASE16>
681 <NTHUV TEMP6 1 = TEMP6>
684 "This function used for normal args when \"BIND\" and \"CALL\" still possible."
687 <GFCN
\1aINIT-D ("VALUE" <OR FALSE FIX> ANY) OBJ4>
690 <GEN-LVAL 'MODE = TEMP5>
691 <RESTUV TEMP5 1 = TEMP5 (TYPE VECTOR)>
692 <GEN-SET 'MODE TEMP5>
697 <CALL '
\1aINIT1-D 1 = TEMP5>
701 "This function for normal args when \"CALL\" still possible."
704 <GFCN
\1aINIT1-D ("VALUE" <OR FALSE FIX> ANY) OBJ4>
707 <GEN-LVAL 'MODE = TEMP5>
708 <RESTUV TEMP5 1 = TEMP5 (TYPE VECTOR)>
709 <GEN-SET 'MODE TEMP5>
715 <CALL '
\1aNORM-D 1 = TEMP5>
719 "Handle a normal argument or quoted normal argument."
722 <GFCN
\1aNORM-D ("VALUE" <OR FALSE FIX> ANY "OPTIONAL" ANY) OBJ6 DC7>
723 <OPT-DISPATCH 1 %<> OPT4 OPT5>
729 <TYPE? OBJ6 <TYPE-CODE LIST> - PHRASE10>
730 <FRAME '
\1aCOMPILE-ERROR>
731 <PUSH "LIST not in OPT(IONAL) or AUX: ">
733 <CALL '
\1aCOMPILE-ERROR 2>
735 <TYPE? OBJ6 <TYPE-CODE ATOM> - PHRASE13>
741 <TYPE? DC7 <TYPE-CODE UNBOUND> + PHRASE17>
745 <FRAME '
\1aFIND_DECL>
748 <GEN-LVAL 'DCL = STACK>
749 <CALL '
\1aFIND_DECL 2 = TEMP18>
754 <CALL '
\1aPUT-DCL 5 = TEMP18>
755 <CONS TEMP18 () = STACK>
760 <TYPE? OBJ6 <TYPE-CODE ADECL> - PHRASE24>
761 <LENUV OBJ6 = TEMP18 (TYPE FIX)>
762 <VEQUAL? TEMP18 2 + PHRASE26 (TYPE FIX)>
764 <FRAME '
\1aCOMPILE-ERROR>
767 <CALL '
\1aCOMPILE-ERROR 2>
770 <NTHUV OBJ6 1 = STACK>
771 <NTHUV OBJ6 2 = STACK>
779 <CALL '
\1aQUOTCH 1 = OBJ6>
780 <TYPE? OBJ6 <TYPE-CODE ADECL> - PHRASE32>
781 <LENUV OBJ6 = TEMP18 (TYPE FIX)>
782 <VEQUAL? TEMP18 2 + PHRASE34 (TYPE FIX)>
784 <FRAME '
\1aCOMPILE-ERROR>
787 <CALL '
\1aCOMPILE-ERROR 2>
789 <NTHUV OBJ6 2 = DC1-8>
790 <NTHUV OBJ6 1 = OBJ6>
793 <CONS "QUOTE" () = TEMP18>
798 <TYPE? DC7 <TYPE-CODE UNBOUND> + PHRASE39>
802 <TYPE? DC1-8 <TYPE-CODE UNBOUND> - PHRASE42>
803 <FRAME '
\1aFIND_DECL>
806 <GEN-LVAL 'DCL = STACK>
807 <CALL '
\1aFIND_DECL 2 = DC1-8>
812 <CALL '
\1aPUT-DCL 5 = DC1-8>
813 <CONS DC1-8 () = DC1-8>
814 <PUTREST TEMP18 DC1-8>
820 <TYPE? DC7 <TYPE-CODE UNBOUND> + TAG49>
824 <GEN-LVAL 'ARGN = DC1-8>
825 <ADD DC1-8 1 = DC1-8 (TYPE FIX)>
826 <GEN-SET 'ARGN DC1-8>
828 <GEN-LVAL 'RQRG = DC1-8>
829 <ADD DC1-8 1 = TEMP18 (TYPE FIX)>
831 <GEN-SET 'RQRG TEMP18>
835 "Handle \"BIND\" decl."
838 <GFCN
\1aBIND-D ("VALUE" FIX ANY) OBJ4>
841 <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE7>
842 <LENUV OBJ4 = DC5 (TYPE FIX)>
843 <VEQUAL? DC5 2 + PHRASE9 (TYPE FIX)>
845 <FRAME '
\1aCOMPILE-ERROR>
848 <CALL '
\1aCOMPILE-ERROR 2>
850 <NTHUV OBJ4 1 = OBJ4>
854 <CALL '
\1aNTH 2 = DC5>
856 <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE14>
857 <FRAME '
\1aCOMPILE-ERROR>
858 <PUSH "Bad object after \"BIND\": ">
860 <CALL '
\1aCOMPILE-ERROR 2>
866 <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE19>
867 <FRAME '
\1aFIND_DECL>
869 <GEN-LVAL 'DCL = STACK>
870 <CALL '
\1aFIND_DECL 2 = DC5>
875 <CALL '
\1aPUT-DCL 5 = DC5>
876 <FRAME '
\1aTYPE-ATOM-OK?>
882 <CALL '
\1aTYPE-ATOM-OK? 3>
886 "Handle \"CALL\" decl."
889 <GFCN
\1aCALL-D ("VALUE" FIX ANY) OBJ4>
892 <GEN-LVAL 'RQRG = TEMP6>
893 <ADD TEMP6 1 = TEMP6 (TYPE FIX)>
894 <GEN-SET 'RQRG TEMP6>
896 <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE12>
897 <LENUV OBJ4 = TEMP6 (TYPE FIX)>
898 <VEQUAL? TEMP6 2 + PHRASE14 (TYPE FIX)>
900 <FRAME '
\1aCOMPILE-ERROR>
903 <CALL '
\1aCOMPILE-ERROR 2>
906 <NTHUV OBJ4 1 = OBJ4>
908 <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE17>
909 <FRAME '
\1aCOMPILE-ERROR>
910 <PUSH "Bad object after \"CALL\": ">
912 <CALL '
\1aCOMPILE-ERROR 2>
919 <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE22>
924 <FRAME '
\1aFIND_DECL>
926 <GEN-LVAL 'DCL = STACK>
927 <CALL '
\1aFIND_DECL 2 = TEMP6>
932 <CALL '
\1aPUT-DCL 5 = DC5>
933 <CONS DC5 () = STACK>
935 <FRAME '
\1aTYPE-ATOM-OK?>
941 <CALL '
\1aTYPE-ATOM-OK? 3>
942 <GEN-LVAL 'ARGN = TEMP6>
943 <ADD TEMP6 1 = TEMP6 (TYPE FIX)>
944 <GEN-SET 'ARGN TEMP6>
949 "Flush on extra atoms after \"CALL\", \"ARGS\" etc."
952 <GFCN
\1aERR-D ("VALUE" ANY ANY) OBJ4>
955 <FRAME '
\1aCOMPILE-ERROR>
956 <PUSH "Bad DECL syntax: ">
959 <CALL '
\1aCOMPILE-ERROR 2 = TEMP6>
963 "Handle \"OPTIONAL\" decl."
966 <GFCN
\1aOPT-D ("VALUE" FIX ANY) OBJ4>
967 <TEMP DC5 TEMP11 OBJ1-6 TEMP66>
969 <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE8>
970 <LENUV OBJ4 = TEMP11 (TYPE FIX)>
971 <VEQUAL? TEMP11 2 + PHRASE10 (TYPE FIX)>
973 <FRAME '
\1aCOMPILE-ERROR>
976 <CALL '
\1aCOMPILE-ERROR 2>
979 <NTHUV OBJ4 1 = OBJ4>
981 <TYPE? OBJ4 <TYPE-CODE ATOM> - PHRASE14>
987 <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE18>
992 <FRAME '
\1aFIND_DECL>
995 <GEN-LVAL 'DCL = STACK>
996 <CALL '
\1aFIND_DECL 2 = TEMP11>
1001 <CALL '
\1aPUT-DCL 5 = TEMP11>
1002 <CONS TEMP11 () = STACK>
1004 <CALL '
\1aPUT-RES 1>
1007 <TYPE? OBJ4 <TYPE-CODE FORM> - PHRASE24>
1011 <CALL '
\1aQUOTCH 1 = OBJ4>
1012 <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE27>
1013 <LENUV OBJ4 = TEMP11 (TYPE FIX)>
1014 <VEQUAL? TEMP11 2 + PHRASE29 (TYPE FIX)>
1016 <FRAME '
\1aCOMPILE-ERROR>
1017 <PUSH "Bad ADECL: ">
1019 <CALL '
\1aCOMPILE-ERROR 2>
1021 <NTHUV OBJ4 2 = DC5>
1022 <NTHUV OBJ4 1 = OBJ4>
1025 <CONS "QUOTE" () = TEMP11>
1030 <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE36>
1031 <FRAME '
\1aFIND_DECL>
1034 <GEN-LVAL 'DCL = STACK>
1035 <CALL '
\1aFIND_DECL 2 = DC5>
1040 <CALL '
\1aPUT-DCL 5 = DC5>
1042 <PUTREST TEMP11 DC5>
1046 <CALL '
\1aPUT-RES 1>
1051 <CALL '
\1aLISTCH 1 = OBJ1-6>
1052 <TYPE? OBJ1-6 <TYPE-CODE ATOM> + TAG43>
1053 <TYPE? OBJ1-6 <TYPE-CODE ADECL> - PHRASE41>
1055 <TYPE? OBJ1-6 <TYPE-CODE ADECL> - PHRASE45>
1056 <LENUV OBJ1-6 = TEMP11 (TYPE FIX)>
1057 <VEQUAL? TEMP11 2 + PHRASE47 (TYPE FIX)>
1059 <FRAME '
\1aCOMPILE-ERROR>
1060 <PUSH "Bad ADECL: ">
1062 <CALL '
\1aCOMPILE-ERROR 2>
1064 <NTHUV OBJ1-6 2 = DC5>
1065 <NTHUV OBJ1-6 1 = OBJ1-6>
1070 <RESTL OBJ4 1 = TEMP11 (TYPE LIST)>
1072 <NTHL TEMP11 1 = STACK>
1074 <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE52>
1079 <FRAME '
\1aFIND_DECL>
1082 <GEN-LVAL 'DCL = STACK>
1083 <CALL '
\1aFIND_DECL 2 = TEMP11>
1088 <CALL '
\1aPAUX 4 = TEMP11>
1089 <CONS TEMP11 () = STACK>
1091 <CALL '
\1aPUT-RES 1>
1094 <TYPE? OBJ1-6 <TYPE-CODE FORM> - PHRASE57>
1098 <CALL '
\1aQUOTCH 1 = OBJ1-6>
1099 <TYPE? OBJ1-6 <TYPE-CODE ADECL> - PHRASE60>
1100 <LENUV OBJ1-6 = TEMP11 (TYPE FIX)>
1101 <VEQUAL? TEMP11 2 + PHRASE62 (TYPE FIX)>
1103 <FRAME '
\1aCOMPILE-ERROR>
1104 <PUSH "Bad ADECL: ">
1106 <CALL '
\1aCOMPILE-ERROR 2>
1108 <NTHUV OBJ1-6 2 = DC5>
1109 <NTHUV OBJ1-6 1 = OBJ1-6>
1112 <CONS "QUOTE" () = TEMP11>
1115 <RESTL OBJ4 1 = TEMP66 (TYPE LIST)>
1117 <NTHL TEMP66 1 = STACK>
1119 <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE68>
1124 <FRAME '
\1aFIND_DECL>
1127 <GEN-LVAL 'DCL = STACK>
1128 <CALL '
\1aFIND_DECL 2 = TEMP66>
1133 <CALL '
\1aPAUX 4 = TEMP66>
1134 <CONS TEMP66 () = TEMP66>
1135 <PUTREST TEMP11 TEMP66>
1139 <CALL '
\1aPUT-RES 1>
1142 <FRAME '
\1aCOMPILE-ERROR>
1143 <PUSH "Bad use of \"OPT(IONAL)\": ">
1146 <CALL '
\1aCOMPILE-ERROR 2>
1148 <GEN-LVAL 'ARGN = TEMP11>
1149 <ADD TEMP11 1 = TEMP11 (TYPE FIX)>
1150 <GEN-SET 'ARGN TEMP11>
1154 "Handle \"ARGS\" decl."
1157 <GFCN
\1aARGS-D ("VALUE" FIX ANY) OBJ4>
1160 <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE7>
1161 <LENUV OBJ4 = DC5 (TYPE FIX)>
1162 <VEQUAL? DC5 2 + PHRASE9 (TYPE FIX)>
1164 <FRAME '
\1aCOMPILE-ERROR>
1165 <PUSH "Bad ADECL: ">
1167 <CALL '
\1aCOMPILE-ERROR 2>
1169 <NTHUV OBJ4 2 = DC5>
1170 <NTHUV OBJ4 1 = OBJ4>
1172 <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE13>
1173 <FRAME '
\1aCOMPILE-ERROR>
1174 <PUSH "Bad use of \"ARGS\": ">
1176 <CALL '
\1aCOMPILE-ERROR 2>
1183 <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE19>
1184 <FRAME '
\1aFIND_DECL>
1186 <GEN-LVAL 'DCL = STACK>
1187 <CALL '
\1aFIND_DECL 2 = DC5>
1192 <CALL '
\1aPUT-DCL 5 = DC5>
1193 <CONS DC5 () = STACK>
1194 <CALL '
\1aPUT-RES 1>
1195 <FRAME '
\1aTYPE-ATOM-OK?>
1201 <CALL '
\1aTYPE-ATOM-OK? 3>
1203 <GEN-LVAL 'ARGN = DC5>
1204 <ADD DC5 1 = DC5 (TYPE FIX)>
1209 "Handle \"TUPLE\" decl."
1212 <GFCN
\1aTUPL-D ("VALUE" FIX ANY) OBJ4>
1215 <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE7>
1216 <LENUV OBJ4 = DC5 (TYPE FIX)>
1217 <VEQUAL? DC5 2 + PHRASE9 (TYPE FIX)>
1219 <FRAME '
\1aCOMPILE-ERROR>
1220 <PUSH "Bad ADECL: ">
1222 <CALL '
\1aCOMPILE-ERROR 2>
1224 <NTHUV OBJ4 2 = DC5>
1225 <NTHUV OBJ4 1 = OBJ4>
1227 <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE13>
1228 <FRAME '
\1aCOMPILE-ERROR>
1229 <PUSH "Bad use of \"TUPLE\": ">
1231 <CALL '
\1aCOMPILE-ERROR 2>
1238 <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE19>
1239 <FRAME '
\1aFIND_DECL>
1241 <GEN-LVAL 'DCL = STACK>
1242 <CALL '
\1aFIND_DECL 2 = DC5>
1247 <CALL '
\1aPUT-DCL 5 = DC5>
1248 <CONS DC5 () = STACK>
1249 <CALL '
\1aPUT-RES 1>
1250 <FRAME '
\1aTYPE-ATOM-OK?>
1256 <CALL '
\1aTYPE-ATOM-OK? 3>
1260 "Handle \"AUX\" decl."
1263 <GFCN
\1aAUX-D ("VALUE" ANY ANY) OBJ4>
1264 <TEMP DC5 OBJ1-6 TEMP31>
1266 <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE8>
1267 <LENUV OBJ4 = DC5 (TYPE FIX)>
1268 <VEQUAL? DC5 2 + PHRASE10 (TYPE FIX)>
1270 <FRAME '
\1aCOMPILE-ERROR>
1271 <PUSH "Bad ADECL: ">
1273 <CALL '
\1aCOMPILE-ERROR 2>
1275 <NTHUV OBJ4 2 = DC5>
1276 <NTHUV OBJ4 1 = OBJ4>
1278 <TYPE? OBJ4 <TYPE-CODE ATOM> - PHRASE14>
1283 <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE18>
1284 <FRAME '
\1aFIND_DECL>
1287 <GEN-LVAL 'DCL = STACK>
1288 <CALL '
\1aFIND_DECL 2 = DC5>
1293 <CALL '
\1aPUT-DCL 5 = DC5>
1297 <TYPE? OBJ4 <TYPE-CODE LIST> - PHRASE23>
1300 <CALL '
\1aLISTCH 1 = OBJ1-6>
1301 <TYPE? OBJ1-6 <TYPE-CODE ADECL> + TAG26>
1302 <TYPE? OBJ1-6 <TYPE-CODE ATOM> - PHRASE23>
1304 <TYPE? OBJ1-6 <TYPE-CODE ADECL> - PHRASE28>
1305 <LENUV OBJ1-6 = TEMP31 (TYPE FIX)>
1306 <VEQUAL? TEMP31 2 + PHRASE30 (TYPE FIX)>
1308 <FRAME '
\1aCOMPILE-ERROR>
1309 <PUSH "Bad ADECL: ">
1311 <CALL '
\1aCOMPILE-ERROR 2>
1313 <NTHUV OBJ1-6 2 = DC5>
1314 <NTHUV OBJ1-6 1 = OBJ1-6>
1318 <RESTL OBJ4 1 = TEMP31 (TYPE LIST)>
1320 <NTHL TEMP31 1 = STACK>
1322 <TYPE? DC5 <TYPE-CODE UNBOUND> + PHRASE35>
1327 <FRAME '
\1aFIND_DECL>
1330 <GEN-LVAL 'DCL = STACK>
1331 <CALL '
\1aFIND_DECL 2 = TEMP31>
1336 <CALL '
\1aPAUX 4 = DC5>
1340 <FRAME '
\1aCOMPILE-ERROR>
1341 <PUSH "Bad usage of \"AUX\" : ">
1344 <CALL '
\1aCOMPILE-ERROR 2 = DC5>
1348 "Handle \"NAME\" and \"ACT\" decl."
1351 <GFCN
\1aACT-D ("VALUE" ANY ANY) OBJ4>
1354 <TYPE? OBJ4 <TYPE-CODE ADECL> - PHRASE7>
1355 <LENUV OBJ4 = DC5 (TYPE FIX)>
1356 <VEQUAL? DC5 2 + PHRASE9 (TYPE FIX)>
1358 <FRAME '
\1aCOMPILE-ERROR>
1359 <PUSH "Bad ADECL: ">
1361 <CALL '
\1aCOMPILE-ERROR 2>
1363 <NTHUV OBJ4 2 = DC5>
1364 <NTHUV OBJ4 1 = OBJ4>
1366 <TYPE? OBJ4 <TYPE-CODE ATOM> + PHRASE13>
1367 <FRAME '
\1aCOMPILE-ERROR>
1368 <PUSH "Bad use of \"ACT\": ">
1370 <CALL '
\1aCOMPILE-ERROR 2>
1376 <TYPE? DC5 <TYPE-CODE UNBOUND> - PHRASE18>
1377 <FRAME '
\1aFIND_DECL>
1379 <GEN-LVAL 'DCL = STACK>
1380 <CALL '
\1aFIND_DECL 2 = DC5>
1385 <CALL '
\1aPUT-DCL 5 = DC5>
1386 <FRAME '
\1aTYPE-ATOM-OK?>
1392 <CALL '
\1aTYPE-ATOM-OK? 3 = DC5>
1396 "Fixup activation atoms after node generated."
1399 <GFCN
\1aACT-FIX ("VALUE" <OR ATOM FALSE> NODE <LIST [REST SYMTAB]>) N4 L5>
1400 <TEMP (FLG6 %<>) SYM10:SYMTAB TEMP17>
1405 <EMPL? L5 - PHRASE13 (TYPE LIST)>
1409 <NTHL L5 1 = SYM10 (TYPE SYMTAB)>
1410 <NTHUV SYM10 4 = TEMP17 (TYPE FIX)>
1411 <VEQUAL? TEMP17 1 - PHRASE15 (TYPE FIX)>
1413 <SET FLG6 'T (TYPE ATOM)>
1414 <NTHUV SYM10 3 = TEMP17>
1415 <TYPE? TEMP17 <TYPE-CODE FALSE> - PHRASE15>
1420 <RESTL L5 1 = L5 (TYPE LIST)>
1424 <GFCN
\1aDECL-D ("VALUE" ANY ANY) ARG4>
1427 <TYPE? ARG4 <TYPE-CODE ADECL> - PHRASE6>
1428 <FRAME '
\1aSRCH-SYM>
1429 <NTHUV ARG4 1 = STACK (TYPE ATOM)>
1430 <CALL '
\1aSRCH-SYM 1 = TEMP11>
1431 <VEQUAL? TEMP11 0 + TAG12>
1436 <NTHUV ARG4 1 = STACK>
1441 <NTHUV ARG4 2 = STACK>
1445 <CALL '
\1aADDVAR 8 = TEMP11>
1449 <FRAME '
\1aCOMPILE-ERROR>
1450 <PUSH "DECL in bad format (no DECL for): ">
1453 <CALL '
\1aCOMPILE-ERROR 2 = TEMP11>
1458 <GFCN
\1aVDECL-D ("VALUE" NODE ANY NODE) ARG4 N5>
1467 <GDECL (TOT-MODES) <VECTOR [REST STRING]> (RESTS) <UVECTOR [REST FIX]>>
1469 "Check for quoted arguments."
1472 <GFCN
\1aQUOTCH ("VALUE" <OR ADECL ATOM> FORM) OB4>
1475 <EMPL? OB4 + PHRASE6>
1476 <RESTL OB4 1 = TEMP8 (TYPE LIST)>
1477 <EMPL? TEMP8 + PHRASE6>
1478 <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
1479 <EMPL? TEMP8 - PHRASE6>
1481 <NTHL OB4 1 = TEMP8>
1482 <EQUAL? TEMP8 'QUOTE - PHRASE6>
1484 <RESTL OB4 1 = TEMP8 (TYPE LIST)>
1485 <NTHL TEMP8 1 = TEMP8>
1486 <TYPE? TEMP8 <TYPE-CODE ATOM> + TAG9>
1487 <TYPE? TEMP8 <TYPE-CODE ADECL> - PHRASE6>
1490 <RESTL OB4 1 = TEMP8 (TYPE LIST)>
1492 <NTHL TEMP8 1 = TEMP8>
1496 <FRAME '
\1aCOMPILE-ERROR>
1497 <PUSH "Bad form in argument list">
1500 <CALL '
\1aCOMPILE-ERROR 2>
1503 "Chech for (arg init) or ('arg init)."
1506 <GFCN
\1aLISTCH ("VALUE" ANY LIST) OB4>
1509 <EMPL? OB4 + PHRASE6>
1510 <RESTL OB4 1 = TEMP8 (TYPE LIST)>
1511 <EMPL? TEMP8 + PHRASE6>
1512 <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
1513 <EMPL? TEMP8 - PHRASE6>
1515 <NTHL OB4 1 = TEMP8>
1516 <TYPE? TEMP8 <TYPE-CODE ATOM> + BOOL9>
1517 <TYPE? TEMP8 <TYPE-CODE ADECL> + BOOL9>
1519 <NTHL OB4 1 = TEMP8>
1520 <TYPE? TEMP8 <TYPE-CODE FORM> - PHRASE6>
1523 <NTHL OB4 1 = STACK (TYPE FORM)>
1526 <NTHL OB4 1 = TEMP8>
1531 <FRAME '
\1aCOMPILE-ERROR>
1532 <PUSH "Bad list in arg list: ">
1535 <CALL '
\1aCOMPILE-ERROR 2>
1538 "Add a decl to RSUBR decls and update AC call spec."
1541 <GFCN
\1aPUT-RES ("VALUE" ATOM LIST) L4>
1542 <TEMP TEMP5 TEMP8:FIX>
1544 <GEN-LVAL 'RES_BOT = TEMP5>
1546 <LENL L4 = TEMP8 (TYPE FIX)>
1548 <GRTR? TEMP8 0 - RESTL10 (TYPE FIX)>
1549 <LOOP (TEMP5 VALUE) (TEMP8 VALUE)>
1552 <RESTL TEMP5 1 = TEMP5 (TYPE LIST)>
1553 <SUB TEMP8 1 = TEMP8 (TYPE FIX)>
1554 <GRTR? TEMP8 0 + RESTL9 (TYPE FIX)>
1556 <GEN-SET 'RES_BOT TEMP5>
1560 "Add code to set up a certain kind of argument."
1563 <GFCN
\1aPUT-DCL ("VALUE" ANY FIX ATOM ANY ANY ANY) COD4 ATM5 VAL6 DC7 COM8>
1564 <TEMP DC1-10 TEMP16 SPC9>
1566 <TYPE? DC7 <TYPE-CODE FORM> - PHRASE14>
1568 <EMPL? DC1-10 + PHRASE14>
1569 <RESTL DC1-10 1 = TEMP16 (TYPE LIST)>
1570 <EMPL? TEMP16 + PHRASE14>
1571 <RESTL TEMP16 1 = TEMP16 (TYPE LIST)>
1572 <EMPL? TEMP16 - PHRASE14>
1574 <SET SPC9 %<> (TYPE FALSE)>
1575 <NTHL DC1-10 1 = TEMP16>
1576 <EQUAL? TEMP16 'SPECIAL - TAG18>
1578 <SET SPC9 'T (TYPE ATOM)>
1581 <NTHL DC1-10 1 = TEMP16>
1582 <EQUAL? TEMP16 'UNSPECIAL - PHRASE14>
1585 <RESTL DC1-10 1 = TEMP16 (TYPE LIST)>
1587 <NTHL TEMP16 1 = DC7>
1591 <GEN-LVAL 'GLOSP = SPC9>
1600 <GEN-LVAL 'ARGN = STACK>
1606 <CALL '
\1aADDVAR 8 = TEMP16>
1607 <GEN-LVAL 'BNDL_BOT = DC1-10>
1608 <CONS TEMP16 () = TEMP16>
1609 <PUTREST DC1-10 TEMP16>
1611 <GEN-SET 'BNDL_BOT TEMP16>
1616 "Find decl associated with a variable, if none, use ANY."
1619 <GFCN
\1aFIND_DECL ("VALUE" ANY ATOM "OPTIONAL" <PRIMTYPE LIST>) ATM6 DC7>
1620 <OPT-DISPATCH 1 %<> OPT4 OPT5>
1624 <TEMP TEMP10 TT16:LIST TEMP30>
1626 <TYPE? DC7 <TYPE-CODE UNBOUND> - TAG8>
1627 <GEN-LVAL 'DECLS = DC7>
1632 <EMPL? DC7 + BOOL20>
1633 <RESTL DC7 1 = TT16 (TYPE LIST)>
1634 <CHTYPE TT16 <TYPE-CODE LIST> = TT16>
1635 <EMPL? TT16 - PHRASE19 (TYPE LIST)>
1639 <NTHL DC7 1 = TEMP10>
1640 <TYPE? TEMP10 <TYPE-CODE LIST> + PHRASE22>
1642 <FRAME '
\1aCOMPILE-ERROR>
1643 <PUSH "Malformed DECL: ">
1645 <CALL '
\1aCOMPILE-ERROR 2>
1647 <NTHL DC7 1 = TEMP10>
1649 <CHTYPE TEMP10 <TYPE-CODE LIST> = TEMP10>
1650 <EMPL? TEMP10 + PHRASE26>
1651 <LOOP (ATM6 VALUE) (TEMP10 VALUE)>
1653 <NTHL TEMP10 1 = TEMP30>
1654 <TYPE? TEMP30 <TYPE-CODE ATOM> - TAG29>
1655 <VEQUAL? TEMP30 ATM6 + TAG27>
1658 <RESTL TEMP10 1 = TEMP10 (TYPE LIST)>
1659 <EMPL? TEMP10 - TAG28>
1662 <NTHL TT16 1 = TEMP10>
1667 <RESTL TT16 1 = DC7 (TYPE LIST)>
1671 "Add an AUX variable spec to structure."
1673 <SETG OBJ-BUILDERS '[VECTOR UVECTOR STRING BYTES ISTRING IBYTES IVECTOR IUVECTOR]>
1675 <GDECL (OBJ-BUILDERS) <VECTOR [REST ATOM]>>
1678 <GFCN
\1aPAUX ("VALUE" ANY ATOM ANY ANY FIX) ATM4 OBJ5 DC6 NTUP7>
1679 <TEMP OBJ16 AP10 TEMP23 OBJ2-11 TEMP29 TEMP30 TT9:NODE>
1685 <TYPE? OBJ16 <TYPE-CODE FORM> - PHRASE63>
1686 <EMPL? OBJ16 + PHRASE63 (TYPE FORM)>
1687 <NTHL OBJ16 1 = AP10>
1688 <EQUAL? AP10 'STACK - BOOL22>
1689 <EMPL? OBJ16 + BOOL22>
1690 <RESTL OBJ16 1 = TEMP23 (TYPE LIST)>
1691 <EMPL? TEMP23 + BOOL22>
1692 <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
1693 <EMPL? TEMP23 - BOOL22>
1695 <RESTL OBJ16 1 = TEMP23 (TYPE LIST)>
1696 <NTHL TEMP23 1 = OBJ2-11>
1698 <TYPE? OBJ2-11 <TYPE-CODE FORM> - TAG26>
1699 <EMPL? OBJ2-11 + TAG26 (TYPE FORM)>
1700 <NTHL OBJ2-11 1 = TEMP23>
1701 <GVAL 'OBJ-BUILDERS = TEMP29>
1702 <TYPE? TEMP23 <TYPE-CODE ATOM> - TAG26>
1703 <EMPUV? TEMP29 + TAG26>
1704 <LOOP (TEMP23 VALUE) (TEMP29 LENGTH VALUE)>
1706 <NTHUV TEMP29 1 = TEMP30>
1707 <VEQUAL? TEMP30 TEMP23 + BOOL21>
1709 <RESTUV TEMP29 1 = TEMP29 (TYPE VECTOR)>
1710 <EMPUV? TEMP29 - TAG27>
1712 <TYPE? OBJ2-11 <TYPE-CODE VECTOR> + BOOL21>
1713 <TYPE? OBJ2-11 <TYPE-CODE UVECTOR> + BOOL21>
1715 <EQUAL? AP10 'CHTYPE - PHRASE20>
1717 <SET TEMP23 3 (TYPE FIX)>
1718 <LOOP (TEMP29 VALUE) (TEMP23 VALUE)>
1720 <EMPL? TEMP29 + PHRASE20>
1721 <RESTL TEMP29 1 = TEMP29 (TYPE LIST)>
1722 <SUB TEMP23 1 = TEMP23 (TYPE FIX)>
1723 <GRTR? TEMP23 0 + TAG32 (TYPE FIX)>
1724 <EMPL? TEMP29 - PHRASE20>
1726 <RESTL OBJ16 1 = TEMP29 (TYPE LIST)>
1727 <NTHL TEMP29 1 = OBJ2-11>
1729 <TYPE? OBJ2-11 <TYPE-CODE FORM> - PHRASE20>
1730 <EMPL? OBJ2-11 + PHRASE20>
1731 <RESTL OBJ2-11 1 = TEMP29 (TYPE LIST)>
1732 <EMPL? TEMP29 + PHRASE20>
1733 <RESTL TEMP29 1 = TEMP29 (TYPE LIST)>
1734 <EMPL? TEMP29 - PHRASE20>
1736 <NTHL OBJ2-11 1 = TEMP29>
1737 <EQUAL? TEMP29 'STACK - PHRASE20>
1739 <RESTL OBJ2-11 1 = TEMP29 (TYPE LIST)>
1741 <NTHL TEMP29 1 = OBJ2-11>
1743 <TYPE? OBJ2-11 <TYPE-CODE FORM> - TAG35>
1744 <EMPL? OBJ2-11 + TAG35 (TYPE FORM)>
1745 <NTHL OBJ2-11 1 = TEMP29>
1746 <GVAL 'OBJ-BUILDERS = TEMP30>
1747 <TYPE? TEMP29 <TYPE-CODE ATOM> - TAG35>
1748 <EMPUV? TEMP30 + TAG35>
1749 <LOOP (TEMP29 VALUE) (TEMP30 LENGTH VALUE)>
1751 <NTHUV TEMP30 1 = TEMP23>
1752 <VEQUAL? TEMP23 TEMP29 + TAG39>
1754 <RESTUV TEMP30 1 = TEMP30 (TYPE VECTOR)>
1755 <EMPUV? TEMP30 - TAG36>
1757 <TYPE? OBJ2-11 <TYPE-CODE VECTOR> + TAG39>
1758 <TYPE? OBJ2-11 <TYPE-CODE UVECTOR> - PHRASE20>
1760 <RESTL OBJ16 1 = TEMP30 (TYPE LIST)>
1762 <RESTL TEMP30 1 = TEMP30 (TYPE LIST)>
1763 <NTHL TEMP30 1 = TEMP30>
1764 <CONS TEMP30 () = TEMP30>
1765 <CONS OBJ2-11 TEMP30 = TEMP30>
1767 <CONS 'CHTYPE TEMP30 = TEMP30>
1768 <CHTYPE TEMP30 <TYPE-CODE FORM> = OBJ2-11>
1778 <CALL '
\1aNODEFM 6 = TT9>
1783 <CALL '
\1aPCOMP 2 = TEMP30>
1784 <CONS TEMP30 () = TEMP30>
1785 <PUTUV TT9 5 TEMP30 (TYPE LIST)>
1789 <EQUAL? AP10 'TUPLE - PHRASE42>
1798 <CALL '
\1aNODEFM 6 = TT9>
1799 <SET AP10 () (TYPE LIST)>
1800 <SET TEMP29 () (TYPE LIST)>
1801 <RESTL OBJ16 1 = TEMP23 (TYPE LIST)>
1803 <CHTYPE TEMP23 <TYPE-CODE LIST> = TEMP23>
1807 <EMPL? TEMP23 + MAPAP48>
1808 <NTHL TEMP23 1 = OBJ16>
1813 <CALL '
\1aPCOMP 2 = OBJ16>
1814 <CONS OBJ16 () = OBJ16 (TYPE LIST)>
1815 <EMPL? AP10 - TAG56>
1816 <SET AP10 OBJ16 (TYPE LIST)>
1819 <PUTREST TEMP29 OBJ16>
1822 <SET TEMP29 OBJ16 (TYPE LIST)>
1824 <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
1827 <PUTUV TT9 5 AP10 (TYPE LIST)>
1831 <EQUAL? AP10 'ITUPLE - PHRASE58>
1832 <GETS 'BIND = TEMP23 (TYPE LBIND)>
1833 <BBIND 'PARENT 'ANY 'FIX ()>
1840 <CALL '
\1aPSTRUC 4 = TT9>
1846 <TYPE? AP10 <TYPE-CODE ATOM> - PHRASE63>
1847 <NTHR AP10 1 = TEMP23 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE63)>
1848 <TYPE? TEMP23 <TYPE-CODE FALSE> + PHRASE63>
1849 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE GBIND)>
1850 <TYPE? TEMP23 <TYPE-CODE UNBOUND> + PHRASE63>
1852 <GVAL AP10 = TEMP23>
1854 <TYPE? TEMP23 <TYPE-CODE MACRO> - PHRASE63>
1859 <CALL '
\1aEXPAND 1 = OBJ16>
1866 <CALL '
\1aPCOMP 2 = TT9>
1878 <CALL '
\1aPUT-DCL 5 = TEMP23>
1882 "Main dispatch function during pass1."
1885 <GFCN
\1aPCOMP ("VALUE" NODE ANY ANY) OBJ4 PARENT5>
1886 <TEMP TEMP3:LBIND TEMP8>
1888 <GETS 'BIND = TEMP3 (TYPE LBIND)>
1889 <BBIND 'PARENT 'ANY %<> PARENT5>
1895 <PUSH 'PTHIS-OBJECT>
1896 <CALL '
\1aGETPROP 2 = TEMP8>
1897 <TYPE? TEMP8 <TYPE-CODE FALSE> - BOOL7>
1901 <CALL '
\1aTYPE 1 = STACK>
1903 <CALL '
\1aGETPROP 2 = TEMP8>
1904 <TYPE? TEMP8 <TYPE-CODE FALSE> - BOOL7>
1905 <GVAL 'PDEFAULT = TEMP8>
1909 <ACALL TEMP8 1 = TEMP8>
1916 "Build a node for <> or #FALSE ()."
1919 <GFCN
\1aFALSE-QT ("VALUE" NODE ANY) O4>
1924 <GEN-LVAL 'PARENT = STACK>
1928 <CALL '
\1aNODE1 5 = TEMP6>
1932 <COND (<GASSIGNED? FALSE-QT> <PUTPROP '<> PTHIS-OBJECT ,FALSE-QT>)>
1934 "Build a node for ()."
1937 <GFCN
\1aNIL-QT ("VALUE" NODE ANY) O4>
1942 <GEN-LVAL 'PARENT = STACK>
1946 <CALL '
\1aNODE1 5 = TEMP6>
1950 <COND (<GASSIGNED? NIL-QT> <PUTPROP () PTHIS-OBJECT ,NIL-QT>)>
1952 "Build a node for a LIST, VECTOR or UVECTOR."
1955 <GFCN
\1aPCOPY ("VALUE" NODE ANY) OBJ4>
1956 <TEMP TEMP7 TT5:NODE TEMP19 TEMP18 O23>
1960 <GEN-LVAL 'PARENT = STACK>
1963 <CALL '
\1aTYPE 1 = STACK>
1966 <CALL '
\1aTYPE 1 = STACK>
1969 <CALL '
\1aNODEFM 6 = TT5>
1970 <SET TEMP7 () (TYPE LIST)>
1971 <SET TEMP19 () (TYPE LIST)>
1977 <EMPTY? TEMP18 + MAPAP16>
1983 <CALL '
\1aPCOMP 2 = O23>
1984 <CONS O23 () = O23 (TYPE LIST)>
1985 <EMPL? TEMP7 - TAG26>
1986 <SET TEMP7 O23 (TYPE LIST)>
1989 <PUTREST TEMP19 O23>
1992 <SET TEMP19 O23 (TYPE LIST)>
1994 <REST1 TEMP18 = TEMP18>
1997 <PUTUV TT5 5 TEMP7 (TYPE LIST)>
2002 <COND (<GASSIGNED? PCOPY> <PUTPROP VECTOR PTHIS-TYPE ,PCOPY> <PUTPROP UVECTOR PTHIS-TYPE ,PCOPY> <PUTPROP LIST PTHIS-TYPE ,PCOPY>)>
2004 "Build a node for unknown things."
2007 <GFCN
\1aPDEFAULT ("VALUE" NODE ANY) OBJ4>
2012 <GEN-LVAL 'PARENT = STACK>
2015 <CALL '
\1aTYPE 1 = STACK>
2019 <CALL '
\1aNODE1 5 = TEMP6>
2023 "Further analyze a FORM and build appropriate node."
2026 <GFCN
\1aPFORM ("VALUE" NODE <FORM ANY>) OBJ4>
2029 <ICALL EXIT6 = TEMP5>
2030 <TEMP TEMP7 TEMP11 TEMP12>
2033 <NTHR TEMP7 5 = TEMP7 (RECORD-TYPE FRAME)>
2034 <SETLR TEMP12 TEMP7 OBJ4>
2035 <NTHL TEMP12 1 = TEMP11>
2037 <BBIND 'APPLY 'ANY 'FIX TEMP11>
2039 <CFRAME = TEMP11 (TYPE FRAME)>
2040 <BBIND 'APPLICATION 'ANY 'FIX TEMP11>
2045 <NTHR 'APPLY 2 = TEMP12 (RECORD-TYPE ATOM) (TYPE LBIND)>
2046 <NTHR TEMP12 1 = STACK (RECORD-TYPE LBIND)>
2048 <PUSH 'PAPPLY-OBJECT>
2049 <CALL '
\1aGETPROP 2 = TEMP11>
2050 <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL15>
2052 <NTHR 'APPLY 2 = TEMP12 (RECORD-TYPE ATOM) (TYPE LBIND)>
2053 <NTHR TEMP12 1 = STACK (RECORD-TYPE LBIND)>
2056 <CALL '
\1aGETPROP 2 = TEMP12>
2057 <TYPE? TEMP12 <TYPE-CODE FALSE> + BOOL19>
2059 <GVAL 'PSUBR-C = TEMP11>
2060 <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL15>
2064 <NTHR 'APPLY 2 = TEMP12 (RECORD-TYPE ATOM) (TYPE LBIND)>
2065 <NTHR TEMP12 1 = STACK (RECORD-TYPE LBIND)>
2067 <CALL '
\1aTYPE 1 = STACK>
2069 <CALL '
\1aGETPROP 2 = TEMP11>
2070 <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL15>
2071 <GVAL 'PAPDEF = TEMP11>
2073 <SETLR TEMP12 TEMP7 OBJ4>
2076 <NTHR 'APPLY 2 = TEMP12 (RECORD-TYPE ATOM) (TYPE LBIND)>
2077 <NTHR TEMP12 1 = STACK (RECORD-TYPE LBIND)>
2079 <ACALL TEMP11 2 = TEMP11>
2086 <COND (<GASSIGNED? PFORM> <PUTPROP FORM PTHIS-TYPE ,PFORM>)>
2088 "Build a SEGMENT node."
2091 <GFCN
\1aSEG-FCN ("VALUE" NODE ANY) OBJ4>
2092 <TEMP TEMP7 TT5:NODE TEMP12:LBIND>
2096 <GEN-LVAL 'PARENT = STACK>
2100 <CALL '
\1aNODE1 5 = TT5>
2101 <GETS 'BIND = TEMP12 (TYPE LBIND)>
2102 <BBIND 'PARENT 'NODE 'FIX TT5>
2104 <CHTYPE OBJ4 <TYPE-CODE FORM> = STACK>
2106 <CALL '
\1aPFORM 1 = TEMP7>
2107 <CONS TEMP7 () = TEMP7>
2108 <PUTUV TT5 5 TEMP7 (TYPE LIST)>
2116 <COND (<GASSIGNED? SEG-FCN> <PUTPROP SEGMENT PTHIS-TYPE ,SEG-FCN>)>
2118 "Analyze a form or the form <ATM .....>"
2121 <GFCN
\1aATOM-FCN ("VALUE" ANY ANY ATOM) OB4 AP5>
2122 <TEMP TEMP9 L6 TEMP29:FIX>
2124 <NTHR AP5 1 = TEMP9 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE8)>
2125 <TYPE? TEMP9 <TYPE-CODE FALSE> + PHRASE8>
2126 <NTHR TEMP9 1 = TEMP9 (RECORD-TYPE GBIND)>
2127 <TYPE? TEMP9 <TYPE-CODE UNBOUND> + PHRASE8>
2131 <GEN-SET 'APPLY TEMP9>
2134 <GEN-LVAL 'APPLICATION = STACK>
2135 <CALL '
\1aAGAIN 1 = TEMP9>
2139 <GEN-LVAL 'REASONABLE = TEMP9>
2140 <TYPE? TEMP9 <TYPE-CODE FALSE> + PHRASE16>
2142 <NTHR 'REFERENCED 1 = TEMP9 (RECORD-TYPE ATOM) (BRANCH-FALSE + TAG22)>
2143 <TYPE? TEMP9 <TYPE-CODE FALSE> + TAG22>
2144 <NTHR TEMP9 1 = TEMP9 (RECORD-TYPE GBIND)>
2145 <TYPE? TEMP9 <TYPE-CODE UNBOUND> - PHRASE21>
2149 <CONS AP5 TEMP9 = TEMP9>
2151 <SETG 'REFERENCED TEMP9>
2155 <GVAL 'REFERENCED = L6>
2157 <LOOP (AP5 VALUE) (L6 VALUE)>
2160 <TYPE? TEMP9 <TYPE-CODE ATOM> - TAG27>
2161 <VEQUAL? TEMP9 AP5 + PHRASE23>
2164 <RESTL L6 1 = L6 (TYPE LIST)>
2170 <SET TEMP29 2 (TYPE FIX)>
2171 <GVAL 'REFERENCED = TEMP9>
2174 <VEQUAL? L6 1 + TAG31>
2176 <LOOP (TEMP9 TYPE VALUE LENGTH) (TEMP29 VALUE)>
2179 <EMPTY? TEMP9 + TAG36>
2180 <NTH1 TEMP9 = STACK>
2181 <REST1 TEMP9 = TEMP9>
2182 <ADD TEMP29 1 = TEMP29 (TYPE FIX)>
2185 <LIST TEMP29 = TEMP9 (TYPE LIST)>
2191 <VEQUAL? TEMP29 0 + TAG33>
2193 <CONS L6 TEMP9 = TEMP9 (TYPE LIST)>
2195 <SUB TEMP29 1 = TEMP29 (TYPE FIX)>
2198 <SETG 'REFERENCED TEMP9>
2202 <RESTL L6 1 = TEMP9 (TYPE LIST)>
2203 <NTHL TEMP9 1 = TEMP9 (TYPE FIX)>
2204 <ADD TEMP9 1 = TEMP9 (TYPE FIX)>
2205 <RESTL L6 1 = L6 (TYPE LIST)>
2213 <CALL '
\1aPSUBR-C 2 = TEMP9>
2217 <FRAME '
\1aCOMPILE-WARNING>
2218 <PUSH "No value for: ">
2220 <PUSH " using EVAL">
2221 <CALL '
\1aCOMPILE-WARNING 3>
2227 <CALL '
\1aPAPDEF 2 = TEMP9>
2232 <COND (<GASSIGNED? ATOM-FCN> <PUTPROP ATOM PAPPLY-TYPE ,ATOM-FCN>)>
2234 "Expand MACRO and process result."
2236 <NEWTYPE FUNNY VECTOR>
2239 <GFCN
\1aPMACRO ("VALUE" ANY ANY ANY) OBJ4 AP5>
2245 <GVAL 'MACROERR = STACK>
2247 <CALL '
\1aHANDLER 3 = ERR6>
2250 <ICALL EXIT10 = TEM7>
2251 <TEMP TEMP11 TEMP14>
2254 <NTHR TEMP11 5 = TEMP11 (RECORD-TYPE FRAME)>
2255 <CFRAME = TEMP14 (TYPE FRAME)>
2256 <BBIND 'MACACT 'ANY 'FIX TEMP14>
2259 <SETLR TEMP14 TEMP11 ERR6>
2262 <NTHR 'MACACT 2 = TEMP14 (RECORD-TYPE ATOM) (TYPE LBIND)>
2263 <NTHR TEMP14 1 = TEMP14 (RECORD-TYPE LBIND)>
2264 <SETG 'MACACT TEMP14>
2267 <SETLR TEMP14 TEMP11 OBJ4>
2270 <CALL '
\1aEXPAND 1 = TEMP14>
2278 <TYPE? TEM7 <TYPE-CODE FUNNY> - PHRASE21>
2279 <FRAME '
\1aCOMPILE-ERROR>
2280 <PUSH "ERROR during macro expansion">
2282 <SET ERR6 2 (TYPE FIX)>
2283 <LOOP (TEM7 VALUE LENGTH) (ERR6 VALUE)>
2286 <EMPUV? TEM7 + TAG22>
2287 <NTHUV TEM7 1 = STACK>
2288 <RESTUV TEM7 1 = TEM7 (TYPE VECTOR)>
2289 <ADD ERR6 1 = ERR6 (TYPE FIX)>
2292 <CALL '
\1aCOMPILE-ERROR ERR6 = ERR6>
2299 <GEN-LVAL 'PARENT = STACK>
2300 <CALL '
\1aPCOMP 2 = ERR6>
2304 <COND (<GASSIGNED? PMACRO> <PUTPROP MACRO PAPPLY-TYPE ,PMACRO>)>
2307 <GFCN
\1aMACROERR ("VALUE" ANY ANY ANY "TUPLE" TUPLE) IGN4 FR5>
2308 <MAKTUP T6:TUPLE TEMP10 TEMP14 = T6>
2310 <EMPUV? T6 + PHRASE8 (TYPE TUPLE)>
2311 <NTHUV T6 1 = TEMP10>
2312 <EQUAL? TEMP10 'CONTROL-G!-ERRORS - PHRASE8>
2314 <FRAME '
\1aINT-LEVEL>
2316 <CALL '
\1aINT-LEVEL 1>
2321 <SET TEMP14 0 (TYPE FIX)>
2324 <LOOP (TEMP10 VALUE LENGTH) (TEMP14 VALUE)>
2327 <EMPUV? TEMP10 + TAG13>
2328 <NTHUV TEMP10 1 = STACK>
2329 <RESTUV TEMP10 1 = TEMP10 (TYPE VECTOR)>
2330 <ADD TEMP14 1 = TEMP14 (TYPE FIX)>
2333 <CALL '
\1aERROR TEMP14>
2342 <CALL '
\1aERRET 2 = TEMP14>
2346 <NTHR 'MACACT 1 = TEMP10 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE19)>
2347 <TYPE? TEMP10 <TYPE-CODE FALSE> + PHRASE19>
2348 <NTHR TEMP10 1 = TEMP10 (RECORD-TYPE GBIND)>
2349 <TYPE? TEMP10 <TYPE-CODE UNBOUND> + PHRASE19>
2352 <GVAL 'MACACT = STACK>
2353 <CALL '
\1aLEGAL? 1 = TEMP10>
2354 <TYPE? TEMP10 <TYPE-CODE FALSE> + PHRASE19>
2357 <SET TEMP14 0 (TYPE FIX)>
2360 <LOOP (TEMP10 VALUE LENGTH) (TEMP14 VALUE)>
2363 <EMPUV? TEMP10 + TAG23>
2364 <NTHUV TEMP10 1 = STACK>
2365 <RESTUV TEMP10 1 = TEMP10 (TYPE VECTOR)>
2366 <ADD TEMP14 1 = TEMP14 (TYPE FIX)>
2369 <UBLOCK <TYPE-CODE VECTOR> TEMP14 = TEMP10>
2371 <CHTYPE TEMP10 <TYPE-CODE FUNNY> = STACK>
2373 <GVAL 'MACACT = STACK>
2374 <CALL '
\1aDISMISS 2 = TEMP14>
2382 <PUSH 'INTERNAL-COMPILER-LOSSAGE!-ERRORS>
2383 <CALL '
\1aERROR 1 = TEMP14>
2387 "Build a node for a form whose 1st element is a form (could be NTH)."
2390 <GFCN
\1aPFORM-FORM ("VALUE" NODE FORM ANY) OBJ4 AP5>
2391 <TEMP TEMP10 TT6:NODE TEMP22 TEMP21 O26>
2393 <EMPL? OBJ4 + PHRASE8>
2394 <RESTL OBJ4 1 = TEMP10 (TYPE LIST)>
2395 <EMPL? TEMP10 + PHRASE8>
2396 <RESTL TEMP10 1 = TEMP10 (TYPE LIST)>
2397 <EMPL? TEMP10 - PHRASE8>
2401 <CALL '
\1aSEG? 1 = TEMP10>
2402 <VEQUAL? TEMP10 0 - PHRASE8>
2406 <GEN-LVAL 'PARENT = STACK>
2412 <CALL '
\1aNODEFM 6 = TT6>
2413 <SET TEMP10 () (TYPE LIST)>
2414 <SET TEMP22 () (TYPE LIST)>
2415 <CHTYPE OBJ4 <TYPE-CODE LIST> = TEMP21>
2420 <EMPL? TEMP21 + MAPAP19>
2421 <NTHL TEMP21 1 = O26>
2426 <CALL '
\1aPCOMP 2 = O26>
2427 <CONS O26 () = O26 (TYPE LIST)>
2428 <EMPL? TEMP10 - TAG29>
2429 <SET TEMP10 O26 (TYPE LIST)>
2432 <PUTREST TEMP22 O26>
2435 <SET TEMP22 O26 (TYPE LIST)>
2437 <RESTL TEMP21 1 = TEMP21 (TYPE LIST)>
2440 <PUTUV TT6 5 TEMP10 (TYPE LIST)>
2450 <CALL '
\1aPAPDEF 2 = TEMP21>
2454 <COND (<GASSIGNED? PFORM-FORM> <PUTPROP FORM PAPPLY-TYPE ,PFORM-FORM>)>
2456 "Build a node for strange forms."
2459 <GFCN
\1aPAPDEF ("VALUE" NODE ANY ANY) OBJ4 AP5>
2462 <FRAME '
\1aCOMPILE-WARNING>
2463 <PUSH "Form not being compiled: ">
2465 <CALL '
\1aCOMPILE-WARNING 2>
2466 <FRAME '
\1aSPECIALIZE>
2468 <CALL '
\1aSPECIALIZE 1>
2471 <GEN-LVAL 'PARENT = STACK>
2478 <CALL '
\1aNODEFM 6 = TEMP9>
2482 "For objects that require EVAL, make sure all atoms used are special."
2485 <GFCN
\1aSPECIALIZE ("VALUE" ANY ANY) OBJ4>
2486 <TEMP OB8 T1-5:FIX TEMP15 SYM7>
2488 <TYPE? OBJ4 <TYPE-CODE FORM> + TAG12>
2489 <TYPE? OBJ4 <TYPE-CODE SEGMENT> - PHRASE19>
2491 <CHTYPE OBJ4 <TYPE-CODE FORM> = OB8>
2492 <LENL OB8 = T1-5 (TYPE FIX)>
2493 <VEQUAL? T1-5 2 - BOOL14 (TYPE FIX)>
2494 <NTHL OB8 1 = TEMP15>
2495 <EQUAL? TEMP15 'LVAL - BOOL14>
2497 <RESTL OB8 1 = TEMP15 (TYPE LIST)>
2498 <NTHL TEMP15 1 = SYM7>
2500 <TYPE? SYM7 <TYPE-CODE ATOM> + BOOL13>
2502 <VEQUAL? T1-5 3 - PHRASE19 (TYPE FIX)>
2504 <NTHL OB8 1 = TEMP15>
2505 <EQUAL? TEMP15 'SET - PHRASE19>
2507 <RESTL OB8 1 = TEMP15 (TYPE LIST)>
2509 <NTHL TEMP15 1 = SYM7>
2511 <TYPE? SYM7 <TYPE-CODE ATOM> - PHRASE19>
2513 <FRAME '
\1aSRCH-SYM>
2515 <CALL '
\1aSRCH-SYM 1 = OB8>
2516 <VEQUAL? OB8 0 + PHRASE19>
2517 <NTHUV OB8 3 = TEMP15>
2518 <TYPE? TEMP15 <TYPE-CODE FALSE> - PHRASE19>
2520 <FRAME '
\1aCOMPILE-NOTE>
2521 <PUSH "Redclared special: ">
2524 <CALL '
\1aCOMPILE-NOTE 2>
2528 <FRAME '
\1aPRIMTYPE>
2530 <CALL '
\1aPRIMTYPE 1 = SYM7>
2531 <SET TEMP15 [FORM LIST UVECTOR VECTOR] (TYPE VECTOR)>
2532 <LOOP (SYM7 VALUE) (TEMP15 LENGTH VALUE)>
2534 <NTHUV TEMP15 1 = OB8>
2535 <VEQUAL? OB8 SYM7 + TAG24>
2537 <RESTUV TEMP15 1 = TEMP15 (TYPE VECTOR)>
2538 <EMPUV? TEMP15 - TAG25>
2541 <SET OB8 %<> (TYPE FALSE)>
2547 <EMPTY? SYM7 + MAP30>
2548 <FRAME '
\1aSPECIALIZE>
2550 <CALL '
\1aSPECIALIZE 1 = OB8>
2557 "Build a MSUBR call node."
2560 <GFCN
\1aPSUBR-C ("VALUE" NODE FORM ANY) OBJ4 AP5>
2561 <TEMP TEMP8 TT6:NODE TEMP21 TEMP25:LIST O26>
2565 <GEN-LVAL 'PARENT = STACK>
2567 <TYPE? AP5 <TYPE-CODE MSUBR> - PHRASE12>
2568 <NTHUV AP5 2 = TEMP8>
2571 <NTHL OBJ4 1 = TEMP8>
2578 <CALL '
\1aNODEFM 6 = TT6>
2579 <SET TEMP8 () (TYPE LIST)>
2580 <SET TEMP21 () (TYPE LIST)>
2581 <RESTL OBJ4 1 = TEMP25 (TYPE LIST)>
2583 <CHTYPE TEMP25 <TYPE-CODE LIST> = TEMP25>
2587 <EMPL? TEMP25 + MAPAP19>
2588 <NTHL TEMP25 1 = O26>
2593 <CALL '
\1aPCOMP 2 = O26>
2594 <CONS O26 () = O26 (TYPE LIST)>
2595 <EMPL? TEMP8 - TAG29>
2596 <SET TEMP8 O26 (TYPE LIST)>
2599 <PUTREST TEMP21 O26>
2602 <SET TEMP21 O26 (TYPE LIST)>
2604 <RESTL TEMP25 1 = TEMP25 (TYPE LIST)>
2607 <PUTUV TT6 5 TEMP8 (TYPE LIST)>
2613 <GFCN
\1aLVAL-FCN ("VALUE" NODE ANY) OBJ4>
2614 <TEMP TEMP7 TT5:NODE>
2618 <GEN-LVAL 'PARENT = STACK>
2622 <GVAL 'LVAL = STACK>
2623 <CALL '
\1aNODEFM 6 = TT5>
2625 <CHTYPE OBJ4 <TYPE-CODE ATOM> = STACK>
2628 <CALL '
\1aPCOMP 2 = TEMP7>
2629 <CONS TEMP7 () = TEMP7>
2630 <PUTUV TT5 5 TEMP7 (TYPE LIST)>
2636 <GFCN
\1aGVAL-FCN ("VALUE" NODE ANY) OBJ4>
2637 <TEMP TEMP7 TT5:NODE>
2641 <GEN-LVAL 'PARENT = STACK>
2645 <GVAL 'GVAL = STACK>
2646 <CALL '
\1aNODEFM 6 = TT5>
2648 <CHTYPE OBJ4 <TYPE-CODE ATOM> = STACK>
2651 <CALL '
\1aPCOMP 2 = TEMP7>
2652 <CONS TEMP7 () = TEMP7>
2653 <PUTUV TT5 5 TEMP7 (TYPE LIST)>
2658 <COND (<GASSIGNED? LVAL-FCN> <PUTPROP LVAL PTHIS-TYPE ,LVAL-FCN> <PUTPROP GVAL PTHIS-TYPE ,GVAL-FCN>)>
2661 <GFCN
\1aFIX-FCN ("VALUE" NODE FORM ANY) OBJ4 AP5>
2662 <TEMP LN7 TEMP13 TT6:NODE TEMP25>
2664 <LENL OBJ4 = LN7 (TYPE FIX)>
2665 <VEQUAL? LN7 2 + PHRASE9 (TYPE FIX)>
2666 <VEQUAL? LN7 3 + PHRASE9 (TYPE FIX)>
2667 <FRAME '
\1aCOMPILE-ERROR>
2668 <PUSH "Number (FIX) applied to other than 2 or 3 args: ">
2670 <CALL '
\1aCOMPILE-ERROR 2>
2674 <GEN-LVAL 'PARENT = STACK>
2676 <VEQUAL? LN7 2 - PHRASE17 (TYPE FIX)>
2677 <SET TEMP13 'INTH (TYPE ATOM)>
2680 <SET TEMP13 'IPUT (TYPE ATOM)>
2685 <VEQUAL? LN7 2 - PHRASE21 (TYPE FIX)>
2686 <GVAL 'NTH = TEMP13>
2689 <GVAL 'PUT = TEMP13>
2693 <CALL '
\1aNODEFM 6 = TT6>
2695 <RESTL OBJ4 1 = TEMP13 (TYPE LIST)>
2696 <NTHL TEMP13 1 = STACK>
2699 <CALL '
\1aPCOMP 2 = TEMP13>
2700 <CONS TEMP13 () = TEMP13>
2705 <CALL '
\1aPCOMP 2 = TEMP25>
2706 <CONS TEMP25 () = TEMP25>
2707 <PUTREST TEMP13 TEMP25>
2708 <VEQUAL? LN7 2 - PHRASE27 (TYPE FIX)>
2710 <SET LN7 () (TYPE LIST)>
2714 <RESTL OBJ4 1 = LN7 (TYPE LIST)>
2716 <RESTL LN7 1 = LN7 (TYPE LIST)>
2717 <NTHL LN7 1 = STACK>
2720 <CALL '
\1aPCOMP 2 = LN7>
2723 <PUTREST TEMP25 LN7>
2725 <PUTUV TT6 5 TEMP13 (TYPE LIST)>
2730 <COND (<GASSIGNED? FIX-FCN> <PUTPROP FIX PAPPLY-TYPE ,FIX-FCN> <PUTPROP OFFSET PAPPLY-TYPE ,FIX-FCN>)>
2735 <GFCN
\1aPPROG-REPEAT ("VALUE" NODE <PRIMTYPE LIST> ANY) OBJ4 AP5>
2736 <TEMP NAME6 (DCL8 #DECL ()) (HATOM9 %<>) TEMP3:LBIND TEMP13 ARGL10:LIST TT7:NODE>
2738 <NTHL OBJ4 1 = NAME6>
2739 <GETS 'BIND = TEMP3 (TYPE LBIND)>
2740 <GEN-LVAL 'VARTBL = TEMP13>
2741 <BBIND 'VARTBL 'SYMTAB 'FIX TEMP13>
2743 <GEN-ASSIGNED? 'IN-IFSYS + TAG18>
2744 <SET TEMP13 %<> (TYPE FALSE)>
2747 <GEN-LVAL 'IN-IFSYS = TEMP13>
2749 <BBIND 'IN-IFSYS 'ANY 'FIX TEMP13>
2751 <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
2752 <CHTYPE OBJ4 <TYPE-CODE LIST> = OBJ4>
2753 <EMPL? OBJ4 - PHRASE24 (TYPE LIST)>
2754 <FRAME '
\1aCOMPILE-ERROR>
2759 <CALL '
\1aCOMPILE-ERROR 4>
2761 <NTHL OBJ4 1 = TEMP13>
2762 <TYPE? TEMP13 <TYPE-CODE ATOM> + TAG28>
2763 <TYPE? TEMP13 <TYPE-CODE ADECL> - PHRASE27>
2766 <NTHL OBJ4 1 = HATOM9>
2767 <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
2769 <NTHL OBJ4 1 = ARGL10 (TYPE LIST)>
2770 <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
2771 <EMPL? OBJ4 + PHRASE30 (TYPE LIST)>
2772 <NTHL OBJ4 1 = TEMP13>
2773 <TYPE? TEMP13 <TYPE-CODE DECL> - PHRASE30>
2775 <NTHL OBJ4 1 = DCL8 (TYPE DECL)>
2776 <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
2778 <EMPL? OBJ4 - PHRASE34 (TYPE LIST)>
2779 <FRAME '
\1aCOMPILE-ERROR>
2780 <PUSH "Empty body for ">
2783 <CALL '
\1aCOMPILE-ERROR 3>
2787 <GEN-LVAL 'PARENT = STACK>
2788 <FRAME '
\1aFIND_DECL>
2791 <CALL '
\1aFIND_DECL 2 = STACK>
2799 <NTHR 'VARTBL 2 = NAME6 (RECORD-TYPE ATOM) (TYPE LBIND)>
2800 <NTHR NAME6 1 = STACK (RECORD-TYPE LBIND)>
2802 <CALL '
\1aNODEPR 9 = TT7>
2804 <EMPL? ARGL10 + PHRASE45 (TYPE LIST)>
2805 <NTHL ARGL10 1 = NAME6>
2806 <TYPE? NAME6 <TYPE-CODE STRING> - PHRASE45>
2812 <CONS "AUX" ARGL10 = NAME6>
2825 <NTHUV TT7 10 = STACK (TYPE LIST)>
2826 <CALL '
\1aACT-FIX 2>
2827 <SET HATOM9 () (TYPE LIST)>
2828 <SET TEMP13 () (TYPE LIST)>
2829 <SET NAME6 OBJ4 (TYPE LIST)>
2834 <EMPL? NAME6 + MAPAP53>
2835 <NTHL NAME6 1 = DCL8>
2840 <CALL '
\1aPCOMP 2 = DCL8>
2841 <CONS DCL8 () = DCL8 (TYPE LIST)>
2842 <EMPL? HATOM9 - TAG62>
2843 <SET HATOM9 DCL8 (TYPE LIST)>
2846 <PUTREST TEMP13 DCL8>
2849 <SET TEMP13 DCL8 (TYPE LIST)>
2851 <RESTL NAME6 1 = NAME6 (TYPE LIST)>
2854 <PUTUV TT7 5 HATOM9 (TYPE LIST)>
2861 <END
\1aPPROG-REPEAT>
2862 <COND (<GASSIGNED? PPROG-REPEAT> <PUTPROP ,PROG PAPPLY-OBJECT ,PPROG-REPEAT> <PUTPROP ,REPEAT PAPPLY-OBJECT ,PPROG-REPEAT> <PUTPROP ,BIND PAPPLY-OBJECT ,PPROG-REPEAT>)>
2867 <GFCN
\1aUNWIND-FCN ("VALUE" NODE FORM ANY) OBJ4 AP5>
2868 <TEMP TEMP8 TT6:NODE TEMP14>
2872 <GEN-LVAL 'PARENT = STACK>
2874 <NTHL OBJ4 1 = STACK>
2878 <CALL '
\1aNODEFM 6 = TT6>
2880 <SET TEMP14 3 (TYPE FIX)>
2881 <LOOP (TEMP8 VALUE) (TEMP14 VALUE)>
2883 <EMPL? TEMP8 + PHRASE12>
2884 <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
2885 <SUB TEMP14 1 = TEMP14 (TYPE FIX)>
2886 <GRTR? TEMP14 0 + TAG15 (TYPE FIX)>
2887 <EMPL? TEMP8 - PHRASE12>
2890 <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
2891 <NTHL TEMP8 1 = STACK>
2894 <CALL '
\1aPCOMP 2 = TEMP8>
2895 <CONS TEMP8 () = TEMP8>
2897 <RESTL OBJ4 1 = TEMP14 (TYPE LIST)>
2899 <RESTL TEMP14 1 = TEMP14 (TYPE LIST)>
2900 <NTHL TEMP14 1 = STACK>
2903 <CALL '
\1aPCOMP 2 = TEMP14>
2904 <CONS TEMP14 () = TEMP14>
2905 <PUTREST TEMP8 TEMP14>
2907 <PUTUV TT6 5 TEMP8 (TYPE LIST)>
2912 <FRAME '
\1aCOMPILE-ERROR>
2913 <PUSH "Wrong number of args to UNIWND: ">
2916 <CALL '
\1aCOMPILE-ERROR 2 = TEMP8>
2920 <COND (<AND <GASSIGNED? UNWIND-FCN> <GASSIGNED? UNWIND>> <PUTPROP ,UNWIND PAPPLY-OBJECT ,UNWIND-FCN>)>
2922 "Build a node for a COND."
2925 <GFCN
\1aCOND-FCN ("VALUE" NODE <FORM ANY> ANY) OBJ4 AP5>
2926 <TEMP TEMP3:LBIND TEMP8 TEMP11:NODE TEMP21 TEMP25:LIST CLA26 TEMP29 TT27 TEMP42 O47>
2928 <GETS 'BIND = TEMP3 (TYPE LBIND)>
2929 <FRAME '
\1aNODECOND>
2931 <GEN-LVAL 'PARENT = STACK>
2935 <CALL '
\1aNODECOND 5 = TEMP11>
2936 <BBIND 'PARENT 'NODE 'FIX TEMP11>
2938 <NTHR 'PARENT 2 = TEMP8 (RECORD-TYPE ATOM) (TYPE LBIND)>
2939 <NTHR TEMP8 1 = TEMP11 (RECORD-TYPE LBIND)>
2941 <SET TEMP8 () (TYPE LIST)>
2942 <SET TEMP21 () (TYPE LIST)>
2943 <RESTL OBJ4 1 = TEMP25 (TYPE LIST)>
2944 <CHTYPE TEMP25 <TYPE-CODE LIST> = TEMP25>
2948 <EMPL? TEMP25 + MAPAP19>
2949 <NTHL TEMP25 1 = CLA26>
2952 <NTHR 'PARENT 2 = TEMP29 (RECORD-TYPE ATOM) (TYPE LBIND)>
2953 <NTHR TEMP29 1 = STACK (RECORD-TYPE LBIND)>
2958 <CALL '
\1aNODEB 5 = TT27>
2959 <TYPE? CLA26 <TYPE-CODE LIST> - PHRASE33>
2960 <EMPL? CLA26 + PHRASE33 (TYPE LIST)>
2962 <NTHL CLA26 1 = STACK>
2964 <CALL '
\1aPCOMP 2 = TEMP29>
2965 <PUTUV TT27 4 TEMP29>
2967 <SET TEMP29 () (TYPE LIST)>
2968 <SET TEMP42 () (TYPE LIST)>
2969 <RESTL CLA26 1 = CLA26 (TYPE LIST)>
2973 <EMPL? CLA26 + MAPAP40>
2974 <NTHL CLA26 1 = O47>
2979 <CALL '
\1aPCOMP 2 = O47>
2980 <CONS O47 () = O47 (TYPE LIST)>
2981 <EMPL? TEMP29 - TAG50>
2982 <SET TEMP29 O47 (TYPE LIST)>
2985 <PUTREST TEMP42 O47>
2988 <SET TEMP42 O47 (TYPE LIST)>
2990 <RESTL CLA26 1 = CLA26 (TYPE LIST)>
2993 <PUTUV TT27 5 TEMP29 (TYPE LIST)>
2999 <FRAME '
\1aCOMPILE-ERROR>
3000 <PUSH "COND clause not a LIST or empty: ">
3002 <CALL '
\1aCOMPILE-ERROR 2 = CLA26>
3004 <CONS CLA26 () = CLA26 (TYPE LIST)>
3005 <EMPL? TEMP8 - TAG54>
3006 <SET TEMP8 CLA26 (TYPE LIST)>
3009 <PUTREST TEMP21 CLA26>
3012 <SET TEMP21 CLA26 (TYPE LIST)>
3014 <RESTL TEMP25 1 = TEMP25 (TYPE LIST)>
3017 <PUTUV TEMP11 5 TEMP8 (TYPE LIST)>
3025 <COND (<GASSIGNED? COND-FCN> <PUTPROP ,COND PAPPLY-OBJECT ,COND-FCN> <PUTPROP ,AND PAPPLY-OBJECT ,PSUBR-C> <PUTPROP ,OR PAPPLY-OBJECT ,PSUBR-C>)>
3027 "Build a node for '<
\b-object>
\b-."
3030 <GFCN
\1aQUOTE-FCN ("VALUE" <OR FALSE NODE> FORM ANY) OBJ4 AP5>
3031 <TEMP TEMP8 TT6:NODE>
3035 <GEN-LVAL 'PARENT = STACK>
3039 <CALL '
\1aNODE1 5 = TT6>
3040 <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
3041 <CHTYPE TEMP8 <TYPE-CODE LIST> = TEMP8>
3042 <EMPL? TEMP8 - TAG14 (TYPE LIST)>
3046 <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
3047 <NTHL TEMP8 1 = TEMP8>
3048 <EQUAL? TEMP8 %<> - PHRASE17>
3050 <SET TEMP8 'BOOL-FALSE (TYPE ATOM)>
3054 <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
3055 <NTHL TEMP8 1 = STACK>
3057 <CALL '
\1aTYPE 1 = TEMP8>
3061 <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
3063 <NTHL TEMP8 1 = TEMP8>
3069 <COND (<GASSIGNED? QUOTE-FCN> <PUTPROP ,QUOTE PAPPLY-OBJECT ,QUOTE-FCN>)>
3071 "Build a node for a call to an RSUBR."
3074 <GFCN
\1aRSUBR-FCN ("VALUE" NODE FORM MSUBR) OBJ4 AP5>
3075 <TEMP TEMP3:LBIND TEMP8 TEMP16:NODE>
3077 <GETS 'BIND = TEMP3 (TYPE LBIND)>
3080 <GEN-LVAL 'PARENT = STACK>
3082 <NTHL OBJ4 1 = STACK>
3085 <CALL '
\1aNODEFM 6 = TEMP8>
3086 <BBIND 'PARENT 'NODE 'FIX TEMP8>
3088 <LENUV AP5 = TEMP8 (TYPE FIX)>
3089 <GRTR? TEMP8 2 - PHRASE13 (TYPE FIX)>
3091 <NTHUV AP5 3 = TEMP8>
3092 <TYPE? TEMP8 <TYPE-CODE DECL> + TAG15>
3093 <TYPE? TEMP8 <TYPE-CODE LIST> - PHRASE13>
3096 <NTHR 'PARENT 2 = TEMP8 (RECORD-TYPE ATOM) (TYPE LBIND)>
3097 <NTHR TEMP8 1 = TEMP16 (RECORD-TYPE LBIND)>
3099 <FRAME '
\1aPRSUBR-C>
3100 <NTHL OBJ4 1 = STACK>
3103 <NTHUV AP5 3 = STACK>
3104 <CALL '
\1aPRSUBR-C 3 = TEMP8>
3105 <PUTUV TEMP16 5 TEMP8>
3107 <NTHR 'PARENT 2 = TEMP8 (RECORD-TYPE ATOM) (TYPE LBIND)>
3108 <NTHR TEMP8 1 = TEMP16 (RECORD-TYPE LBIND)>
3110 <FRAME '
\1aSANITIZE-DECL>
3111 <NTHUV AP5 3 = STACK (TYPE LIST)>
3113 <CALL '
\1aSANITIZE-DECL 1 = TEMP8>
3114 <PUTUV TEMP16 7 TEMP8 (TYPE LIST)>
3123 <CALL '
\1aPSUBR-C 2 = TEMP16>
3131 <COND (<GASSIGNED? RSUBR-FCN> <PUTPROP MSUBR PAPPLY-TYPE ,RSUBR-FCN>)>
3134 <GFCN
\1aSANITIZE-DECL ("VALUE" <LIST [REST <LIST ATOM ANY>]> LIST) DCL4>
3135 <TEMP (OPT5 %<>) (TUPF6 %<>) TEMP9 TEMP10 TEMP11 TEMP12 TEMP13 TEMP28 TEMP29 TEMP30 TEMP31>
3137 <NTHL DCL4 1 = TEMP9>
3138 <TYPE? TEMP9 <TYPE-CODE STRING> - PHRASE8>
3139 <IFCAN "STRING-EQUAL?">
3140 <STRING-EQUAL? TEMP9 "VALUE" - PHRASE8>
3141 <ENDIF "STRING-EQUAL?">
3142 <IFCANNOT "STRING-EQUAL?">
3143 <SET TEMP10 "VALUE" (TYPE STRING)>
3144 <LENUS TEMP9 = TEMP11 (TYPE FIX)>
3145 <VEQUAL? TEMP11 5 - PHRASE8>
3146 <LOOP (TEMP9 VALUE LENGTH) (TEMP10 VALUE LENGTH) (TEMP11 VALUE)>
3148 <NTHUS TEMP9 1 = TEMP12>
3149 <NTHUS TEMP10 1 = TEMP13>
3150 <VEQUAL? TEMP12 TEMP13 - PHRASE8>
3151 <DEAD TEMP12 TEMP13>
3152 <RESTUS TEMP9 1 = TEMP9 (TYPE STRING)>
3153 <RESTUS TEMP10 1 = TEMP10 (TYPE STRING)>
3154 <SUB TEMP11 1 = TEMP11 (TYPE FIX)>
3155 <GRTR? TEMP11 0 + TAG14 (TYPE FIX)>
3156 <ENDIF "STRING-EQUAL?">
3157 <RESTL DCL4 1 = DCL4 (TYPE LIST)>
3158 <RESTL DCL4 1 = DCL4 (TYPE LIST)>
3160 <SET TEMP12 () (TYPE LIST)>
3161 <SET TEMP9 () (TYPE LIST)>
3162 <SET TEMP10 DCL4 (TYPE LIST)>
3167 <EMPL? TEMP10 + MAPAP19>
3168 <NTHL TEMP10 1 = TEMP11>
3169 <TYPE? TEMP11 <TYPE-CODE STRING> - TAG26>
3170 <IFCAN "STRING-EQUAL?">
3171 <STRING-EQUAL? TEMP11 "QUOTE" + MAP17>
3172 <ENDIF "STRING-EQUAL?">
3173 <IFCANNOT "STRING-EQUAL?">
3175 <SET TEMP28 "QUOTE" (TYPE STRING)>
3176 <LENUS TEMP13 = TEMP29 (TYPE FIX)>
3177 <VEQUAL? TEMP29 5 - TAG26>
3178 <LOOP (TEMP13 VALUE LENGTH) (TEMP28 VALUE LENGTH) (TEMP29 VALUE)>
3180 <NTHUS TEMP13 1 = TEMP30>
3181 <NTHUS TEMP28 1 = TEMP31>
3182 <VEQUAL? TEMP30 TEMP31 - TAG26>
3183 <DEAD TEMP30 TEMP31>
3184 <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3185 <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3186 <SUB TEMP29 1 = TEMP29 (TYPE FIX)>
3187 <GRTR? TEMP29 0 + TAG32 (TYPE FIX)>
3189 <ENDIF "STRING-EQUAL?">
3191 <TYPE? TEMP11 <TYPE-CODE STRING> - PHRASE24>
3192 <IFCAN "STRING-EQUAL?">
3193 <STRING-EQUAL? TEMP11 "ARGS" - PHRASE24>
3194 <ENDIF "STRING-EQUAL?">
3195 <IFCANNOT "STRING-EQUAL?">
3197 <SET TEMP13 "ARGS" (TYPE STRING)>
3198 <LENUS TEMP28 = TEMP31 (TYPE FIX)>
3199 <VEQUAL? TEMP31 4 - PHRASE24>
3200 <LOOP (TEMP28 VALUE LENGTH) (TEMP13 VALUE LENGTH) (TEMP31 VALUE)>
3202 <NTHUS TEMP28 1 = TEMP30>
3203 <NTHUS TEMP13 1 = TEMP29>
3204 <VEQUAL? TEMP30 TEMP29 - PHRASE24>
3205 <DEAD TEMP30 TEMP29>
3206 <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3207 <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3208 <SUB TEMP31 1 = TEMP31 (TYPE FIX)>
3209 <GRTR? TEMP31 0 + TAG34 (TYPE FIX)>
3210 <ENDIF "STRING-EQUAL?">
3213 <TYPE? TEMP11 <TYPE-CODE STRING> - TAG38>
3214 <IFCAN "STRING-EQUAL?">
3215 <STRING-EQUAL? TEMP11 "OPT" + BOOL37>
3216 <ENDIF "STRING-EQUAL?">
3217 <IFCANNOT "STRING-EQUAL?">
3219 <SET TEMP28 "OPT" (TYPE STRING)>
3220 <LENUS TEMP13 = TEMP29 (TYPE FIX)>
3221 <VEQUAL? TEMP29 3 - TAG38>
3222 <LOOP (TEMP13 VALUE LENGTH) (TEMP28 VALUE LENGTH) (TEMP29 VALUE)>
3224 <NTHUS TEMP13 1 = TEMP30>
3225 <NTHUS TEMP28 1 = TEMP31>
3226 <VEQUAL? TEMP30 TEMP31 - TAG38>
3227 <DEAD TEMP30 TEMP31>
3228 <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3229 <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3230 <SUB TEMP29 1 = TEMP29 (TYPE FIX)>
3231 <GRTR? TEMP29 0 + TAG40 (TYPE FIX)>
3233 <ENDIF "STRING-EQUAL?">
3235 <TYPE? TEMP11 <TYPE-CODE STRING> - PHRASE36>
3236 <IFCAN "STRING-EQUAL?">
3237 <STRING-EQUAL? TEMP11 "OPTIONAL" - PHRASE36>
3238 <ENDIF "STRING-EQUAL?">
3239 <IFCANNOT "STRING-EQUAL?">
3241 <SET TEMP13 "OPTIONAL" (TYPE STRING)>
3242 <LENUS TEMP28 = TEMP31 (TYPE FIX)>
3243 <VEQUAL? TEMP31 8 - PHRASE36>
3244 <LOOP (TEMP28 VALUE LENGTH) (TEMP13 VALUE LENGTH) (TEMP31 VALUE)>
3246 <NTHUS TEMP28 1 = TEMP30>
3247 <NTHUS TEMP13 1 = TEMP29>
3248 <VEQUAL? TEMP30 TEMP29 - PHRASE36>
3249 <DEAD TEMP30 TEMP29>
3250 <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3251 <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3252 <SUB TEMP31 1 = TEMP31 (TYPE FIX)>
3253 <GRTR? TEMP31 0 + TAG42 (TYPE FIX)>
3254 <ENDIF "STRING-EQUAL?">
3256 <SET OPT5 'T (TYPE ATOM)>
3259 <TYPE? TEMP11 <TYPE-CODE STRING> - PHRASE44>
3260 <IFCAN "STRING-EQUAL?">
3261 <STRING-EQUAL? TEMP11 "TUPLE" - PHRASE44>
3262 <ENDIF "STRING-EQUAL?">
3263 <IFCANNOT "STRING-EQUAL?">
3265 <SET TEMP28 "TUPLE" (TYPE STRING)>
3266 <LENUS TEMP13 = TEMP29 (TYPE FIX)>
3267 <VEQUAL? TEMP29 5 - PHRASE44>
3268 <LOOP (TEMP13 VALUE LENGTH) (TEMP28 VALUE LENGTH) (TEMP29 VALUE)>
3270 <NTHUS TEMP13 1 = TEMP30>
3271 <NTHUS TEMP28 1 = TEMP31>
3272 <VEQUAL? TEMP30 TEMP31 - PHRASE44>
3273 <DEAD TEMP30 TEMP31>
3274 <RESTUS TEMP13 1 = TEMP13 (TYPE STRING)>
3275 <RESTUS TEMP28 1 = TEMP28 (TYPE STRING)>
3276 <SUB TEMP29 1 = TEMP29 (TYPE FIX)>
3277 <GRTR? TEMP29 0 + TAG46 (TYPE FIX)>
3278 <ENDIF "STRING-EQUAL?">
3279 <SET TUPF6 'T (TYPE ATOM)>
3282 <VEQUAL? TUPF6 0 + PHRASE49>
3283 <CONS TEMP11 () = TEMP28>
3285 <CONS 'TUPLE TEMP28 = TEMP28>
3288 <VEQUAL? OPT5 0 + PHRASE50>
3289 <CONS TEMP11 () = TEMP28>
3291 <CONS 'OPTIONAL TEMP28 = TEMP28>
3294 <CONS TEMP11 () = TEMP28>
3296 <CONS 'NORMAL TEMP28 = TEMP28>
3298 <CONS TEMP28 () = TEMP28 (TYPE LIST)>
3299 <EMPL? TEMP12 - TAG52>
3300 <SET TEMP12 TEMP28 (TYPE LIST)>
3303 <PUTREST TEMP9 TEMP28>
3306 <SET TEMP9 TEMP28 (TYPE LIST)>
3309 <RESTL TEMP10 1 = TEMP10 (TYPE LIST)>
3314 <END
\1aSANITIZE-DECL>
3315 "Predicate: any segments in this object?"
3318 <GFCN
\1aSEG? ("VALUE" <OR ATOM !<FALSE>> <PRIMTYPE LIST>) OB4>
3324 <EMPL? OB4 - PHRASE10>
3327 <NTHL OB4 1 = TEMP5>
3328 <TYPE? TEMP5 <TYPE-CODE SEGMENT> - PHRASE12>
3332 <RESTL OB4 1 = OB4 (TYPE LIST)>
3333 <CHTYPE OB4 <TYPE-CODE LIST> = OB4>
3336 "Analyze a call to an MSUBR with decls checking number of args and types wherever
3340 <FCN
\1aPRSUBR-C ("VALUE" ANY ANY <PRIMTYPE LIST> <PRIMTYPE LIST>) NAME4 OBJ5 RDCL6>
3341 <TEMP TEMP3:LBIND TEMP23 (SGD9:FORM <>) (SGP10:LIST (1)) (IX12 0) (ARG-NUMBER15:FIX 0) OB19:LIST (ST20 %<>) (ODC21 "FOO") DC13 TEMP42 TEMP52 TEMP53 SGN11 TT132:NODE>
3343 <GETS 'BIND = TEMP3 (TYPE LBIND)>
3344 <BBIND 'NAME 'ANY %<> NAME4>
3346 <BBIND 'OBJ <PRIMTYPE LIST> %<> OBJ5>
3348 <BBIND 'RDCL <PRIMTYPE LIST> %<> RDCL6>
3351 <GVAL 'INIT-R = TEMP23>
3352 <BBIND 'DOIT 'ANY 'FIX TEMP23>
3354 <BBIND 'SEGSW 'ANY 'FIX %<>>
3355 <GVAL 'RMODES = TEMP23>
3356 <BBIND 'RM <VECTOR [REST STRING]> 'FIX TEMP23>
3358 <CONS () () = TEMP23>
3359 <BBIND 'KDS 'LIST 'FIX TEMP23>
3361 <NTHR 'KDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3362 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3363 <BBIND 'TKDS 'LIST 'FIX TEMP23>
3365 <NTHR 'OBJ 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3366 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3367 <RESTL TEMP23 1 = OB19 (TYPE LIST)>
3369 <CHTYPE OB19 <TYPE-CODE LIST> = OB19>
3370 <CFRAME = TEMP23 (TYPE FRAME)>
3371 <BBIND 'RSB 'ANY 'FIX TEMP23>
3377 <NTHR 'RDCL 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3378 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3379 <EMPL? TEMP23 + PHRASE32>
3381 <NTHR 'RM 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3382 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3383 <EMPUV? TEMP23 + PHRASE37 (TYPE VECTOR)>
3385 <NTHR 'RDCL 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3386 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3387 <NTHL TEMP23 1 = DC13>
3389 <NTHR 'RDCL 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3390 <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3391 <RESTL TEMP42 1 = TEMP23 (TYPE LIST)>
3393 <CHTYPE TEMP23 <TYPE-CODE LIST> = TEMP23>
3394 <NTHR 'RDCL 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3395 <PUTR TEMP42 1 TEMP23 (RECORD-TYPE LBIND)>
3396 <DEAD TEMP42 TEMP23>
3398 <TYPE? DC13 <TYPE-CODE STRING> - PHRASE48>
3399 <IFCAN "STRING-EQUAL?">
3400 <STRING-EQUAL? DC13 "OPT" - PHRASE50>
3401 <ENDIF "STRING-EQUAL?">
3402 <IFCANNOT "STRING-EQUAL?">
3404 <SET TEMP42 "OPT" (TYPE STRING)>
3405 <LENUS TEMP23 = IX12 (TYPE FIX)>
3406 <VEQUAL? IX12 3 - PHRASE50>
3407 <LOOP (TEMP23 VALUE LENGTH) (TEMP42 VALUE LENGTH) (IX12 VALUE)>
3409 <NTHUS TEMP23 1 = TEMP52>
3410 <NTHUS TEMP42 1 = TEMP53>
3411 <VEQUAL? TEMP52 TEMP53 - PHRASE50>
3412 <DEAD TEMP52 TEMP53>
3413 <RESTUS TEMP23 1 = TEMP23 (TYPE STRING)>
3414 <RESTUS TEMP42 1 = TEMP42 (TYPE STRING)>
3415 <SUB IX12 1 = IX12 (TYPE FIX)>
3416 <GRTR? IX12 0 + TAG54 (TYPE FIX)>
3417 <ENDIF "STRING-EQUAL?">
3418 <SET DC13 "OPTIONAL" (TYPE STRING)>
3422 <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3423 <NTHR TEMP42 1 = STACK (RECORD-TYPE LBIND)>
3425 <CALL '
\1aMEMBER 2 = TEMP23>
3426 <TYPE? TEMP23 <TYPE-CODE FALSE> - PHRASE56>
3427 <FRAME '
\1aCOMPILE-ERROR>
3428 <PUSH "Unknown string in MSUBR decl: ">
3431 <NTHR 'NAME 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3432 <NTHR TEMP42 1 = STACK (RECORD-TYPE LBIND)>
3434 <CALL '
\1aCOMPILE-ERROR 4>
3436 <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3437 <PUTR TEMP42 1 TEMP23 (RECORD-TYPE LBIND)>
3438 <DEAD TEMP42 TEMP23>
3439 <GVAL 'RDOIT = TEMP42>
3440 <NTHR 'RM 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3441 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3442 <LENUV TEMP23 = IX12 (TYPE FIX)>
3444 <NTHUV TEMP42 IX12 = TEMP23>
3446 <NTHR 'DOIT 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3447 <PUTR TEMP42 1 TEMP23 (RECORD-TYPE LBIND)>
3448 <DEAD TEMP42 TEMP23>
3450 <GVAL 'SDOIT = TEMP23>
3451 <NTHUV TEMP23 IX12 = TEMP42>
3457 <ACALL TEMP42 3 = ST20>
3460 <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3461 <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3462 <EMPUV? TEMP42 - AGAIN30 (TYPE VECTOR)>
3464 <FRAME '
\1aGET-ELE-TYPE>
3465 <NTHR 'RDCL 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3466 <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3467 <NTHL TEMP42 1 = STACK>
3470 <CALL '
\1aGET-ELE-TYPE 2 = DC13>
3473 <EMPL? OB19 - PHRASE78 (TYPE LIST)>
3474 <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3475 <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3476 <LENUV TEMP42 = TEMP42 (TYPE FIX)>
3477 <LESS? TEMP42 4 - BOOL79 (TYPE FIX)>
3479 <NTHR 'TKDS 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3480 <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3481 <RESTL TEMP42 1 = TEMP23 (TYPE LIST)>
3485 <FRAME '
\1aCOMPILE-ERROR>
3486 <PUSH "Too few arguments to: ">
3487 <NTHR 'NAME 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3488 <NTHR TEMP42 1 = STACK (RECORD-TYPE LBIND)>
3491 <NTHR 'OBJ 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3492 <NTHR TEMP42 1 = STACK (RECORD-TYPE LBIND)>
3494 <CALL '
\1aCOMPILE-ERROR 4>
3497 <NTHR 'SEGSW 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3498 <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3499 <TYPE? TEMP42 <TYPE-CODE FALSE> + PHRASE89>
3501 <SET ST20 %<> (TYPE FALSE)>
3502 <NTHR 'RM 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3503 <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3504 <EMPUV? TEMP42 - PHRASE93 (TYPE VECTOR)>
3508 <UBLOCK <TYPE-CODE VECTOR> 2 = TEMP42>
3509 <CONS TEMP42 () = TEMP42>
3510 <PUTREST SGP10 TEMP42>
3512 <FRAME '
\1aTYPE-AND>
3513 <NTHUV SGN11 3 = STACK>
3515 <CALL '
\1aTYPE-AND 2 = TEMP42>
3516 <PUTUV SGN11 3 TEMP42>
3518 <NTHR 'TKDS 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3519 <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3520 <RESTL TEMP42 1 = TEMP23 (TYPE LIST)>
3524 <CONS DC13 () = TEMP42>
3525 <PUTREST SGP10 TEMP42>
3531 <NTHL OB19 1 = TEMP42>
3532 <TYPE? TEMP42 <TYPE-CODE SEGMENT> - PHRASE101>
3534 <NTHR 'KDS 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3535 <NTHR TEMP42 1 = TEMP42 (RECORD-TYPE LBIND)>
3537 <NTHL OB19 1 = STACK (TYPE SEGMENT)>
3538 <CALL '
\1aSEGCHK 1 = SGN11>
3539 <CONS SGN11 () = TEMP23>
3540 <PUTREST TEMP42 TEMP23>
3542 <NTHR 'KDS 2 = TEMP42 (RECORD-TYPE ATOM) (TYPE LBIND)>
3543 <PUTR TEMP42 1 TEMP23 (RECORD-TYPE LBIND)>
3544 <DEAD TEMP42 TEMP23>
3545 <RESTL OB19 1 = TEMP23 (TYPE LIST)>
3546 <EMPL? TEMP23 - PHRASE108 (TYPE LIST)>
3548 <NTHR 'RM 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3549 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3550 <EMPUV? TEMP23 - PHRASE110 (TYPE VECTOR)>
3554 <NTHUV SGN11 3 = STACK>
3555 <NTHL OB19 1 = STACK>
3556 <CALL '
\1aSEGCH1 3 = TEMP23>
3557 <PUTUV SGN11 3 TEMP23>
3559 <NTHR 'TKDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3560 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3561 <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
3564 <NTHR 'SEGSW 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3565 <PUTR TEMP23 1 'T (RECORD-TYPE LBIND)>
3569 <NTHR 'KDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3570 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3571 <SET TEMP42 () (TYPE LIST)>
3572 <SET TEMP53 () (TYPE LIST)>
3573 <RESTL OB19 1 = IX12 (TYPE LIST)>
3577 <EMPL? IX12 + MAPAP126>
3578 <NTHL IX12 1 = TEMP52>
3582 <GEN-LVAL 'PARENT = STACK>
3583 <CALL '
\1aPCOMP 2 = TT132>
3584 <NTHR 'RM 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3585 <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3586 <EMPUV? TEMP52 - PHRASE161 (TYPE VECTOR)>
3588 <NTHUV TT132 1 = TEMP52 (TYPE FIX)>
3589 <VEQUAL? TEMP52 3 - PHRASE144 (TYPE FIX)>
3591 <FRAME '
\1aTYPE-OK?>
3592 <NTHUV TT132 5 = TEMP52 (TYPE LIST)>
3593 <NTHL TEMP52 1 = TEMP52 (TYPE NODE)>
3594 <NTHUV TEMP52 3 = STACK>
3597 <PUSH <OR MULTI STRUCTURED>>
3600 <UBLOCK <TYPE-CODE VECTOR> 2 = STACK>
3601 <CALL '
\1aFORM 2 = STACK>
3602 <CALL '
\1aTYPE-OK? 2 = TEMP52>
3603 <TYPE? TEMP52 <TYPE-CODE FALSE> - PHRASE161>
3605 <FRAME '
\1aCOMPILE-ERROR>
3606 <PUSH "Argument wrong type to: ">
3607 <NTHR 'NAME 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3608 <NTHR TEMP52 1 = STACK (RECORD-TYPE LBIND)>
3611 <CALL '
\1aCOMPILE-ERROR 3>
3614 <FRAME '
\1aTYPE-OK?>
3615 <NTHUV TT132 3 = STACK>
3617 <CALL '
\1aTYPE-OK? 2 = TEMP52>
3618 <TYPE? TEMP52 <TYPE-CODE FALSE> - PHRASE155>
3620 <FRAME '
\1aCOMPILE-ERROR>
3621 <PUSH "Argument wrong type to: ">
3622 <NTHR 'NAME 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3623 <NTHR TEMP52 1 = STACK (RECORD-TYPE LBIND)>
3626 <CALL '
\1aCOMPILE-ERROR 3>
3628 <NTHUV TT132 3 = TEMP52>
3629 <TYPE? TEMP52 <TYPE-CODE FALSE> - PHRASE161>
3631 <PUTUV TT132 3 DC13>
3633 <CONS TT132 () = TEMP52 (TYPE LIST)>
3635 <EMPL? TEMP42 - TAG162>
3636 <SET TEMP42 TEMP52 (TYPE LIST)>
3639 <PUTREST TEMP53 TEMP52>
3642 <SET TEMP53 TEMP52 (TYPE LIST)>
3644 <RESTL IX12 1 = IX12 (TYPE LIST)>
3647 <PUTREST TEMP23 TEMP42>
3648 <DEAD TEMP23 TEMP42>
3649 <NTHR 'TKDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3650 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3651 <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
3657 <CALL '
\1aFORM 2 = SGD9>
3658 <RESTL SGD9 1 = SGP10 (TYPE LIST)>
3659 <CHTYPE SGP10 <TYPE-CODE LIST> = SGP10>
3660 <SET ST20 %<> (TYPE FALSE)>
3663 <NTHR 'KDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3664 <NTHR TEMP23 1 = TEMP23 (RECORD-TYPE LBIND)>
3666 <NTHR 'DOIT 2 = IX12 (RECORD-TYPE ATOM) (TYPE LBIND)>
3667 <NTHR IX12 1 = IX12 (RECORD-TYPE LBIND)>
3670 <ACALL IX12 2 = TEMP52>
3672 <CONS TEMP52 () = TEMP52>
3673 <PUTREST TEMP23 TEMP52>
3675 <NTHR 'KDS 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3676 <PUTR TEMP23 1 TEMP52 (RECORD-TYPE LBIND)>
3677 <DEAD TEMP23 TEMP52>
3678 <RESTL OB19 1 = OB19 (TYPE LIST)>
3679 <ADD ARG-NUMBER15 1 = ARG-NUMBER15 (TYPE FIX)>
3680 <SET ST20 %<> (TYPE FALSE)>
3683 <EMPL? OB19 - PHRASE175 (TYPE LIST)>
3684 <NTHR 'TKDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3685 <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3686 <RESTL TEMP52 1 = TEMP23 (TYPE LIST)>
3690 <NTHR 'SEGSW 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3691 <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3692 <TYPE? TEMP52 <TYPE-CODE FALSE> + PHRASE178>
3694 <NTHUV SGN11 3 = TEMP52>
3695 <TYPE? TEMP52 <TYPE-CODE FALSE> + PHRASE182>
3697 <FRAME '
\1aTYPE-AND>
3698 <NTHUV SGN11 3 = STACK>
3700 <CALL '
\1aTYPE-AND 2 = TEMP52>
3706 <PUTUV SGN11 3 TEMP52>
3708 <NTHR 'TKDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3709 <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3710 <RESTL TEMP52 1 = TEMP23 (TYPE LIST)>
3714 <SET TEMP52 OB19 (TYPE LIST)>
3718 <EMPL? TEMP52 + MAPAP192>
3719 <NTHL TEMP52 1 = TEMP23>
3720 <TYPE? TEMP23 <TYPE-CODE SEGMENT> - PHRASE187>
3722 <RESTL TEMP52 1 = TEMP52 (TYPE LIST)>
3725 <NTHR 'KDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3726 <NTHR TEMP52 1 = TEMP52 (RECORD-TYPE LBIND)>
3728 <NTHL OB19 1 = STACK>
3729 <CALL '
\1aSEGCHK 1 = SGN11>
3730 <CONS SGN11 () = TEMP23>
3731 <PUTREST TEMP52 TEMP23>
3733 <NTHR 'KDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3734 <PUTR TEMP52 1 TEMP23 (RECORD-TYPE LBIND)>
3735 <DEAD TEMP52 TEMP23>
3736 <NTHR 'TKDS 2 = TEMP52 (RECORD-TYPE ATOM) (TYPE LBIND)>
3737 <NTHR TEMP52 1 = TEMP23 (RECORD-TYPE LBIND)>
3739 <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
3742 <FRAME '
\1aCOMPILE-ERROR>
3743 <PUSH "Too many arguments too: ">
3744 <NTHR 'NAME 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3745 <NTHR TEMP23 1 = STACK (RECORD-TYPE LBIND)>
3748 <NTHR 'OBJ 2 = TEMP23 (RECORD-TYPE ATOM) (TYPE LBIND)>
3749 <NTHR TEMP23 1 = STACK (RECORD-TYPE LBIND)>
3751 <CALL '
\1aCOMPILE-ERROR 4>
3761 <GFCN
\1aSQUOT ("VALUE" ATOM ANY ANY ANY) F4 S1-5 S2-6>
3766 "Flush one possible decl away."
3769 <GFCN
\1aCHOPPER ("VALUE" ATOM ANY ANY ANY) F4 S1-5 S2-6>
3772 <TYPE? F4 <TYPE-CODE FALSE> + PHRASE8>
3774 <FRAME '
\1aCOMPILE-ERROR>
3775 <PUSH "Two DECL strings in a row in: ">
3781 <CALL '
\1aCOMPILE-ERROR 4>
3783 <GEN-LVAL 'RM = TEMP10>
3784 <RESTUV TEMP10 1 = TEMP10 (TYPE VECTOR)>
3785 <GEN-SET 'RM TEMP10>
3789 "Handle Normal arg when \"VALUE\" still possible."
3792 <GFCN
\1aINIT-R ("VALUE" NODE ANY ANY) DC4 OB5>
3795 <GEN-LVAL 'RM = TEMP6>
3796 <RESTUV TEMP6 2 = TEMP6 (TYPE VECTOR)>
3799 <GVAL 'INIT1-R = TEMP6>
3800 <GEN-SET 'DOIT TEMP6>
3807 <CALL '
\1aINIT1-R 2 = TEMP6>
3811 "Handle Normal arg when \"CALL\" still possible."
3814 <GFCN
\1aINIT2-R ("VALUE" NODE ANY ANY) DC4 OB5>
3817 <GEN-LVAL 'RM = TEMP6>
3818 <RESTUV TEMP6 1 = TEMP6 (TYPE VECTOR)>
3821 <GVAL 'INIT1-R = TEMP6>
3822 <GEN-SET 'DOIT TEMP6>
3829 <CALL '
\1aINIT1-R 2 = TEMP6>
3833 "Handle normal arg."
3836 <GFCN
\1aINIT1-R ("VALUE" NODE ANY LIST) DC4 OB5>
3837 <TEMP TEMP11 TT6:NODE>
3839 <FRAME '
\1aTYPE-OK?>
3841 <NTHL OB5 1 = STACK>
3842 <GEN-LVAL 'PARENT = STACK>
3843 <CALL '
\1aPCOMP 2 = TT6>
3844 <NTHUV TT6 3 = STACK>
3846 <CALL '
\1aTYPE-OK? 2 = TEMP11>
3847 <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
3849 <FRAME '
\1aCOMPILE-ERROR>
3850 <PUSH "Argument wrong type to: ">
3851 <GEN-LVAL 'NAME = STACK>
3853 <NTHL OB5 1 = STACK>
3855 <CALL '
\1aCOMPILE-ERROR 4>
3857 <NTHUV TT6 3 = TEMP11>
3858 <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE19>
3866 "Handle \"QUOTE\" arg."
3869 <GFCN
\1aQINIT-R ("VALUE" NODE ANY LIST) DC4 OB5>
3870 <TEMP TEMP11 TT6:NODE>
3872 <FRAME '
\1aTYPE-OK?>
3875 <GEN-LVAL 'PARENT = STACK>
3877 <NTHL OB5 1 = STACK>
3878 <CALL '
\1aTYPE 1 = STACK>
3879 <NTHL OB5 1 = STACK>
3881 <CALL '
\1aNODE1 5 = TT6>
3882 <NTHUV TT6 3 = STACK>
3885 <CALL '
\1aTYPE-OK? 2 = TEMP11>
3886 <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
3888 <FRAME '
\1aCOMPILE-ERROR>
3889 <PUSH "Argument wrong type to: ">
3890 <GEN-LVAL 'NAME = STACK>
3892 <NTHL OB5 1 = STACK>
3894 <CALL '
\1aCOMPILE-ERROR 4>
3896 <GVAL 'INIT1-R = TEMP11>
3897 <GEN-SET 'DOIT TEMP11>
3902 "Handle \"CALL\" decl."
3905 <GFCN
\1aCAL-R ("VALUE" ANY ANY ANY) DC4 OB5>
3908 <FRAME '
\1aTYPE-OK?>
3911 <GEN-LVAL 'PARENT = STACK>
3913 <GEN-LVAL 'OBJ = STACK>
3915 <CALL '
\1aNODE1 5 = TT6>
3916 <NTHUV TT6 3 = STACK>
3919 <CALL '
\1aTYPE-OK? 2 = TEMP11>
3920 <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
3922 <FRAME '
\1aCOMPILE-ERROR>
3923 <PUSH "Argument wrong type to: ">
3924 <GEN-LVAL 'NAME = STACK>
3928 <CALL '
\1aCOMPILE-ERROR 4>
3930 <GEN-LVAL 'KDS = TEMP11>
3932 <PUTREST TEMP11 TT6>
3935 <GEN-LVAL 'TKDS = TEMP11>
3936 <RESTL TEMP11 1 = STACK (TYPE LIST)>
3938 <GEN-LVAL 'RSB = STACK>
3939 <CALL '
\1aRETURN 2 = TT6>
3943 "Handle \"ARGS\" decl."
3946 <GFCN
\1aARGS-R ("VALUE" ANY ANY ANY) DC4 OB5>
3949 <FRAME '
\1aTYPE-OK?>
3952 <GEN-LVAL 'PARENT = STACK>
3956 <CALL '
\1aNODE1 5 = TT6>
3957 <NTHUV TT6 3 = STACK>
3960 <CALL '
\1aTYPE-OK? 2 = TEMP11>
3961 <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
3963 <FRAME '
\1aCOMPILE-ERROR>
3964 <PUSH "Argument wrong type to: ">
3965 <GEN-LVAL 'NAME = STACK>
3969 <CALL '
\1aCOMPILE-ERROR 4>
3971 <GEN-LVAL 'KDS = TEMP11>
3973 <PUTREST TEMP11 TT6>
3976 <GEN-LVAL 'TKDS = TEMP11>
3977 <RESTL TEMP11 1 = STACK (TYPE LIST)>
3979 <GEN-LVAL 'RSB = STACK>
3980 <CALL '
\1aRETURN 2 = TT6>
3984 "Handle \"TUPLE\" decl."
3987 <GFCN
\1aTUPL-R ("VALUE" NODE ANY LIST) DC4 OB5>
3988 <TEMP TEMP11 TT6:NODE>
3990 <FRAME '
\1aTYPE-OK?>
3992 <NTHL OB5 1 = STACK>
3993 <GEN-LVAL 'PARENT = STACK>
3994 <CALL '
\1aPCOMP 2 = TT6>
3995 <NTHUV TT6 3 = STACK>
3997 <CALL '
\1aTYPE-OK? 2 = TEMP11>
3998 <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE8>
4000 <FRAME '
\1aCOMPILE-ERROR>
4001 <PUSH "Argument wrong type to: ">
4002 <GEN-LVAL 'NAME = STACK>
4004 <NTHL OB5 1 = STACK>
4006 <CALL '
\1aCOMPILE-ERROR 4>
4008 <NTHUV TT6 3 = TEMP11>
4009 <TYPE? TEMP11 <TYPE-CODE FALSE> - PHRASE19>
4017 "Handle stuff with segments in arguments."
4020 <GFCN
\1aSEGCHK ("VALUE" NODE ANY) OB4>
4021 <TEMP TEMP10 TT5:NODE>
4023 <FRAME '
\1aTYPE-OK?>
4026 <GEN-LVAL 'PARENT = STACK>
4027 <CALL '
\1aPCOMP 2 = TT5>
4028 <NTHUV TT5 3 = STACK>
4029 <PUSH <OR MULTI STRUCTURED>>
4030 <CALL '
\1aTYPE-OK? 2 = TEMP10>
4031 <TYPE? TEMP10 <TYPE-CODE FALSE> - PHRASE7>
4033 <FRAME '
\1aCOMPILE-ERROR>
4034 <PUSH "Non-structured segment? ">
4037 <CALL '
\1aCOMPILE-ERROR 2>
4043 <GFCN
\1aSEGCH1 ("VALUE" ANY ANY ANY ANY) DC4 RT5 OB6>
4046 <FRAME '
\1aTYPE-AND>
4050 <PUSH <OR MULTI STRUCTURED>>
4054 <UBLOCK <TYPE-CODE VECTOR> 2 = STACK>
4055 <CALL '
\1aFORM 2 = STACK>
4056 <CALL '
\1aTYPE-AND 2 = TEMP13>
4057 <TYPE? TEMP13 <TYPE-CODE FALSE> + TAG14>
4061 <FRAME '
\1aCOMPILE-ERROR>
4062 <PUSH "Argument wrong type to: ">
4063 <GEN-LVAL 'NAME = STACK>
4067 <CALL '
\1aCOMPILE-ERROR 4 = TEMP13>
4071 "Handle \"VALUE\" chop decl and do the rest."
4074 <GFCN
\1aVAL-R ("VALUE" <OR FALSE ATOM> ANY ANY ANY) F4 S1-5 S2-6>
4084 <CALL '
\1aCHOPPER 3>
4085 <GEN-LVAL 'PARENT = TEMP8>
4086 <GEN-LVAL 'RDCL = TEMP11>
4087 <NTHL TEMP11 1 = TEMP11>
4088 <PUTUV TEMP8 3 TEMP11>
4090 <GVAL 'INIT2-R = TEMP8>
4091 <GEN-SET 'DOIT TEMP8>
4093 <GEN-LVAL 'RDCL = TEMP8>
4094 <NTHL TEMP8 1 = TEMP8>
4095 <TYPE? TEMP8 <TYPE-CODE STRING> - TAG19>
4097 <SET F4 'STRING (TYPE ATOM)>
4100 <SET F4 %<> (TYPE FALSE)>
4102 <GEN-LVAL 'RDCL = TEMP11>
4103 <RESTL TEMP11 1 = TEMP8 (TYPE LIST)>
4105 <CHTYPE TEMP8 <TYPE-CODE LIST> = TEMP8>
4106 <GEN-SET 'RDCL TEMP8>
4112 <GFCN
\1aERR-R ("VALUE" ANY ANY ANY) DC4 OB5>
4115 <FRAME '
\1aCOMPILE-LOSSAGE>
4116 <PUSH "Entered MSUBR application illegal state">
4121 <CALL '
\1aCOMPILE-LOSSAGE 3 = TEMP7>
4125 <SETG RMODES ["VALUE" "CALL" "QUOTE" "OPTIONAL" "QUOTE" "ARGS" "TUPLE"]>
4127 <COND (<GASSIGNED? TUPL-R> <SETG RDOIT [,TUPL-R ,ARGS-R ,QINIT-R ,INIT1-R ,QINIT-R ,CAL-R ,ERR-R]> <SETG SDOIT [,CHOPPER ,CHOPPER ,SQUOT ,CHOPPER ,SQUOT ,CHOPPER ,VAL-R]>)>
4129 <GDECL (RMODES) <VECTOR [REST STRING]> (RDOIT SDOIT) VECTOR>
4131 "Create a node for a call to a function."
4134 <GFCN
\1aPFUNC ("VALUE" <OR FALSE NODE> <PRIMTYPE LIST> ANY) OB4 AP5>
4135 <TEMP TEMP10 TEMP13>
4137 <NTHL OB4 1 = TEMP10>
4138 <TYPE? TEMP10 <TYPE-CODE ATOM> - PHRASE9>
4140 <NTHL OB4 1 = TEMP10 (TYPE ATOM)>
4141 <GEN-LVAL 'FNAME = TEMP13>
4142 <EQUAL? TEMP10 TEMP13 - PHRASE12>
4143 <DEAD TEMP10 TEMP13>
4144 <FRAME '
\1aRSUBR-CALL2>
4145 <NTHL OB4 1 = TEMP13 (TYPE ATOM)>
4146 <GVAL TEMP13 = STACK>
4148 <NTHL OB4 1 = STACK (TYPE ATOM)>
4151 <CALL '
\1aRSUBR-CALL2 3 = TEMP13>
4156 <NTHL OB4 1 = STACK (TYPE ATOM)>
4158 <CALL '
\1aGETPROP 2 = TEMP10>
4159 <TYPE? TEMP10 <TYPE-CODE FALSE> + PHRASE17>
4160 <FRAME '
\1aRSUBR-CALL3>
4163 <NTHL OB4 1 = STACK (TYPE ATOM)>
4166 <CALL '
\1aRSUBR-CALL3 3 = TEMP13>
4170 <GEN-LVAL 'REASONABLE = TEMP10>
4171 <TYPE? TEMP10 <TYPE-CODE FALSE> + PHRASE20>
4177 <CALL '
\1aPSUBR-C 2 = TEMP13>
4181 <FRAME '
\1aCOMPILE-WARNING>
4182 <PUSH "Uncompiled function called: ">
4183 <NTHL OB4 1 = STACK (TYPE ATOM)>
4184 <CALL '
\1aCOMPILE-WARNING 2>
4187 <NTHL OB4 1 = TEMP10 (TYPE ATOM)>
4189 <GVAL TEMP10 = STACK>
4191 <CALL '
\1aPAPDEF 2 = TEMP13>
4195 <NTHL OB4 1 = TEMP10>
4196 <TYPE? TEMP10 <TYPE-CODE FUNCTION> + TAG28>
4200 <FRAME '
\1aMAKE-TAG>
4202 <GEN-LVAL 'FNAME = TEMP10>
4203 <NTHR TEMP10 3 = STACK (RECORD-TYPE ATOM)>
4205 <UBLOCK <TYPE-CODE STRING> 2 = STACK (TYPE STRING)>
4206 <CALL '
\1aMAKE-TAG 1 = TEMP10>
4209 <NTHL OB4 1 = STACK>
4211 <FRAME '
\1aRSUBR-CALL1>
4212 <GVAL TEMP10 = STACK>
4217 <CALL '
\1aRSUBR-CALL1 3 = TEMP13>
4221 "Call compiler recursively to compile anonymous function."
4224 <GFCN
\1aANONF ("VALUE" NODE ANY ANY) NAME4 BODY5>
4225 <TEMP (INT?6 %<>) TEMP16>
4227 <FRAME '
\1aCOMPILE-NOTE>
4228 <PUSH "Compiling anonymous function">
4229 <CALL '
\1aCOMPILE-NOTE 1>
4230 <NTHR NAME4 1 = INT?6 (RECORD-TYPE ATOM) (BRANCH-FALSE + TAG11)>
4231 <TYPE? INT?6 <TYPE-CODE FALSE> + TAG11>
4232 <PUTR INT?6 1 BODY5 (RECORD-TYPE GBIND)>
4242 <GEN-LVAL 'EXTRA-CODE = INT?6>
4244 <GVAL 'COMPILE = TEMP16>
4246 <ACALL TEMP16 1 = TEMP16>
4247 <PUTREST INT?6 TEMP16>
4249 <GEN-LVAL 'EXTRA-CODE = INT?6>
4250 <GEN-LVAL 'EXTRA-CODE = TEMP16>
4251 <LENL TEMP16 = TEMP16 (TYPE FIX)>
4252 <SUB TEMP16 1 = TEMP16 (TYPE FIX)>
4253 <GRTR? TEMP16 0 - RESTL23 (TYPE FIX)>
4254 <LOOP (INT?6 VALUE) (TEMP16 VALUE)>
4257 <RESTL INT?6 1 = INT?6 (TYPE LIST)>
4258 <SUB TEMP16 1 = TEMP16 (TYPE FIX)>
4259 <GRTR? TEMP16 0 + RESTL22 (TYPE FIX)>
4261 <GEN-SET 'EXTRA-CODE INT?6>
4263 <FRAME '
\1aGUNASSIGN>
4265 <CALL '
\1aGUNASSIGN 1>
4266 <FRAME '
\1aCOMPILE-NOTE>
4267 <PUSH "Finished anonymous function">
4268 <CALL '
\1aCOMPILE-NOTE 1>
4274 <CALL '
\1aFORM 2 = STACK>
4275 <GEN-LVAL 'PARENT = STACK>
4276 <CALL '
\1aPCOMP 2 = TEMP16>
4280 "#FUNCTION (....) compiler -- call ANONF."
4283 <GFCN
\1aFCN-FCN ("VALUE" NODE ANY) OB4>
4286 <FRAME '
\1aMAKE-TAG>
4288 <GEN-LVAL 'FNAME = TEMP8>
4289 <NTHR TEMP8 3 = STACK (RECORD-TYPE ATOM)>
4291 <UBLOCK <TYPE-CODE STRING> 2 = STACK (TYPE STRING)>
4292 <CALL '
\1aMAKE-TAG 1 = TEMP8>
4298 <CALL '
\1aANONF 2 = TEMP8>
4302 <COND (<GASSIGNED? FCN-FCN> <PUTPROP FUNCTION PTHIS-TYPE ,FCN-FCN> <PUTPROP FUNCTION PAPPLY-TYPE ,PFUNC>)>
4304 "<FUNCTION (..) ....> compiler -- call ANONF."
4307 <GFCN
\1aFCN-FCN1 ("VALUE" NODE <PRIMTYPE LIST> ANY) OB4 AP5>
4310 <FRAME '
\1aMAKE-TAG>
4312 <GEN-LVAL 'FNAME = TEMP9>
4313 <NTHR TEMP9 3 = STACK (RECORD-TYPE ATOM)>
4315 <UBLOCK <TYPE-CODE STRING> 2 = STACK (TYPE STRING)>
4316 <CALL '
\1aMAKE-TAG 1 = TEMP9>
4320 <RESTL OB4 1 = TEMP9 (TYPE LIST)>
4322 <CHTYPE TEMP9 <TYPE-CODE LIST> = TEMP9>
4323 <CHTYPE TEMP9 <TYPE-CODE FUNCTION> = STACK>
4325 <CALL '
\1aANONF 2 = TEMP9>
4329 <COND (<GASSIGNED? FCN-FCN1> <PUTPROP ,FUNCTION PAPPLY-OBJECT ,FCN-FCN1>)>
4331 "Handle RSUBR that is really a function."
4334 <GFCN
\1aRSUBR-CALL2 ("VALUE" NODE ANY ANY ANY) BODY4 NAME5 OBJ6>
4335 <TEMP TEMP3:LBIND TEMP11 TEMP14:NODE TEMP22>
4337 <GETS 'BIND = TEMP3 (TYPE LBIND)>
4340 <GEN-LVAL 'PARENT = STACK>
4346 <CALL '
\1aNODEFM 6 = TEMP14>
4347 <BBIND 'PARENT 'NODE 'FIX TEMP14>
4349 <NTHR 'PARENT 2 = TEMP11 (RECORD-TYPE ATOM) (TYPE LBIND)>
4350 <NTHR TEMP11 1 = TEMP14 (RECORD-TYPE LBIND)>
4352 <FRAME '
\1aPRSUBR-C>
4359 <GEN-LVAL 'IND = STACK>
4360 <CALL '
\1aGETPROP 2 = TEMP11>
4361 <NTHUV TEMP11 9 = TEMP11>
4363 <CALL '
\1aPRSUBR-C 3 = TEMP22>
4364 <PUTUV TEMP14 5 TEMP22>
4365 <DEAD TEMP14 TEMP22>
4366 <NTHR 'PARENT 2 = TEMP22 (RECORD-TYPE ATOM) (TYPE LBIND)>
4367 <NTHR TEMP22 1 = TEMP14 (RECORD-TYPE LBIND)>
4369 <FRAME '
\1aSANITIZE-DECL>
4372 <CALL '
\1aSANITIZE-DECL 1 = TEMP22>
4373 <PUTUV TEMP14 7 TEMP22 (TYPE LIST)>
4380 <END
\1aRSUBR-CALL2>
4381 "Handle an RSUBR that is already an RSUBR."
4384 <GFCN
\1aRSUBR-CALL1 ("VALUE" NODE <PRIMTYPE LIST> ANY ANY) BODY4 NAME5 OBJ6>
4385 <TEMP TEMP3:LBIND TEMP9 TEMP12:NODE>
4387 <GETS 'BIND = TEMP3 (TYPE LBIND)>
4390 <GEN-LVAL 'PARENT = STACK>
4395 <CALL '
\1aNODEFM 6 = TEMP12>
4396 <BBIND 'PARENT 'NODE 'FIX TEMP12>
4398 <NTHR 'PARENT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
4399 <NTHR TEMP9 1 = TEMP12 (RECORD-TYPE LBIND)>
4401 <FRAME '
\1aPRSUBR-C>
4406 <RESTL BODY4 1 = TEMP9 (TYPE LIST)>
4407 <RESTL TEMP9 1 = TEMP9 (TYPE LIST)>
4408 <NTHL TEMP9 1 = STACK>
4410 <CALL '
\1aPRSUBR-C 3 = TEMP9>
4411 <PUTUV TEMP12 5 TEMP9>
4413 <NTHR 'PARENT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
4414 <NTHR TEMP9 1 = TEMP12 (RECORD-TYPE LBIND)>
4416 <FRAME '
\1aSANITIZE-DECL>
4417 <RESTL BODY4 1 = TEMP9 (TYPE LIST)>
4419 <NTHL TEMP9 1 = STACK (TYPE LIST)>
4421 <CALL '
\1aSANITIZE-DECL 1 = TEMP9>
4422 <PUTUV TEMP12 7 TEMP9 (TYPE LIST)>
4429 <END
\1aRSUBR-CALL1>
4431 <GFCN
\1aRSUBR-CALL3 ("VALUE" NODE ANY ANY ANY) DC4 NAME5 OBJ6>
4432 <TEMP TEMP3:LBIND TEMP9 TEMP12:NODE>
4434 <GETS 'BIND = TEMP3 (TYPE LBIND)>
4437 <GEN-LVAL 'PARENT = STACK>
4442 <CALL '
\1aNODEFM 6 = TEMP12>
4443 <BBIND 'PARENT 'NODE 'FIX TEMP12>
4445 <NTHR 'PARENT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
4446 <NTHR TEMP9 1 = TEMP12 (RECORD-TYPE LBIND)>
4448 <FRAME '
\1aPRSUBR-C>
4454 <CALL '
\1aPRSUBR-C 3 = TEMP9>
4455 <PUTUV TEMP12 5 TEMP9>
4457 <NTHR 'PARENT 2 = TEMP9 (RECORD-TYPE ATOM) (TYPE LBIND)>
4458 <NTHR TEMP9 1 = TEMP12 (RECORD-TYPE LBIND)>
4460 <FRAME '
\1aSANITIZE-DECL>
4463 <CALL '
\1aSANITIZE-DECL 1 = TEMP9>
4464 <PUTUV TEMP12 7 TEMP9 (TYPE LIST)>
4471 <END
\1aRSUBR-CALL3>
4473 <GFCN
\1aPLIST ("VALUE" NODE ANY ANY) O4 A5>
4483 <CALL '
\1aPSTRUC 4 = TEMP7>
4488 <GFCN
\1aPIVECTOR ("VALUE" NODE ANY ANY) O4 A5>
4498 <CALL '
\1aPSTRUC 4 = TEMP7>
4503 <GFCN
\1aPISTRING ("VALUE" NODE ANY ANY) O4 A5>
4513 <CALL '
\1aPSTRUC 4 = TEMP7>
4518 <GFCN
\1aPIUVECTOR ("VALUE" NODE ANY ANY) O4 A5>
4528 <CALL '
\1aPSTRUC 4 = TEMP7>
4533 <GFCN
\1aPIFORM ("VALUE" NODE ANY ANY) O4 A5>
4543 <CALL '
\1aPSTRUC 4 = TEMP7>
4548 <GFCN
\1aPIBYTES ("VALUE" NODE ANY ANY) O4 A5>
4558 <CALL '
\1aPSTRUC 4 = TEMP7>
4562 <COND (<GASSIGNED? PLIST> <PUTPROP ,ILIST PAPPLY-OBJECT ,PLIST> <PUTPROP ,IUVECTOR PAPPLY-OBJECT ,PIUVECTOR> <COND (<NOT ,MIM> <PUTPROP ,IFORM PAPPLY-OBJECT ,PIFORM>)> <PUTPROP ,IBYTES PAPPLY-OBJECT ,PIBYTES> <PUTPROP ,IVECTOR PAPPLY-OBJECT ,PIVECTOR> <PUTPROP ,ISTRING PAPPLY-OBJECT ,PISTRING>)>
4565 <GFCN
\1aPSTRUC ("VALUE" NODE <PRIMTYPE LIST> ANY ANY ANY) OBJ4 AP5 NAME6 TYP7>
4566 <TEMP TEMP14 TT8:NODE LN9:FIX TEMP20 N10:NODE>
4570 <GEN-LVAL 'PARENT = STACK>
4574 <GVAL NAME6 = STACK>
4576 <CALL '
\1aNODEFM 6 = TT8>
4577 <LENL OBJ4 = LN9 (TYPE FIX)>
4580 <CALL '
\1aSEG? 1 = TEMP20>
4581 <VEQUAL? TEMP20 0 + PHRASE18>
4583 <FRAME '
\1aRSUBR-FCN>
4588 <CALL '
\1aRSUBR-FCN 2 = TEMP20>
4592 <VEQUAL? LN9 1 - PHRASE24 (TYPE FIX)>
4593 <FRAME '
\1aCOMPILE-ERROR>
4594 <PUSH "Too few args: ">
4595 <NTHL OBJ4 1 = STACK>
4596 <CALL '
\1aCOMPILE-ERROR 2>
4599 <GRTR? LN9 3 - PHRASE28 (TYPE FIX)>
4600 <FRAME '
\1aCOMPILE-ERROR>
4601 <PUSH "Too many args: ">
4602 <NTHL OBJ4 1 = STACK>
4603 <CALL '
\1aCOMPILE-ERROR 2>
4606 <RESTL OBJ4 1 = TEMP20 (TYPE LIST)>
4607 <NTHL TEMP20 1 = STACK>
4610 <CALL '
\1aPCOMP 2 = N10>
4611 <VEQUAL? LN9 3 - PHRASE33 (TYPE FIX)>
4614 <RESTL OBJ4 1 = TEMP20 (TYPE LIST)>
4616 <RESTL TEMP20 1 = TEMP20 (TYPE LIST)>
4617 <NTHL TEMP20 1 = STACK>
4619 <GEN-LVAL 'PARENT = STACK>
4620 <CALL '
\1aPCOMP 2 = TEMP14>
4621 <NTHUV TEMP14 1 = TEMP20 (TYPE FIX)>
4622 <VEQUAL? TEMP20 2 - PHRASE41 (TYPE FIX)>
4625 <NTHUV TEMP14 4 = STACK>
4628 <CALL '
\1aPCOMP 2 = TEMP14>
4629 <PUTUV TT8 1 45 (TYPE FIX)>
4632 <PUTUV TT8 1 45 (TYPE FIX)>
4636 <TYPE? TEMP14 <TYPE-CODE UNBOUND> + PHRASE43>
4637 <CONS TEMP14 () = TEMP20>
4639 <CONS N10 TEMP20 = TEMP20>
4641 <PUTUV TT8 5 TEMP20 (TYPE LIST)>
4646 <CONS N10 () = TEMP20>
4648 <PUTUV TT8 5 TEMP20 (TYPE LIST)>
4653 "READ, READCHR, READSTRING, NEXTCHR, READB, GET, GETL, GETPROP, GETPL"
4655 <PUTPROP ,READ PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READ 2 ANY>>>
4657 <COND (<NOT <GASSIGNED? READ-INTERNAL>> <SETG READ-INTERNAL (1)>)>
4659 <PUTPROP ,READ-INTERNAL PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READ-INTERNAL 2 ANY>>>
4661 <COND (<GASSIGNED? GC-READ> <PUTPROP ,GC-READ PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A GC-READ 2 ANY>>>)>
4663 <PUTPROP ,READCHR PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READCHR 2 ANY>>>
4665 <PUTPROP ,NEXTCHR PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A NEXTCHR 2 ANY>>>
4667 <PUTPROP ,READB PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READB 4 ANY>>>
4669 <PUTPROP ,READSTRING PAPPLY-OBJECT <FUNCTION (O A) <CHANFCNS .O .A READSTRING 4 ANY>>>
4672 <GFCN
\1aCHANFCNS ("VALUE" NODE <PRIMTYPE LIST> ANY ANY FIX ANY) OBJ4 AP5 NAME6 ARGN7 TYP8>
4673 <TEMP LN10 (TEM12:FIX 0) TEMP17 TEMP31 TEMP35:LIST OB36 TEMP43>
4675 <LENL OBJ4 = LN10 (TYPE FIX)>
4678 <CALL '
\1aSEG? 1 = TEMP17>
4679 <VEQUAL? TEMP17 0 - BOOL15>
4681 <SUB LN10 1 = TEMP17 (TYPE FIX)>
4683 <GRTR? ARGN7 TEMP17 - PHRASE14 (TYPE FIX)>
4686 <FRAME '
\1aRSUBR-FCN>
4691 <CALL '
\1aRSUBR-FCN 2 = TEMP17>
4697 <GEN-LVAL 'PARENT = STACK>
4702 <GVAL NAME6 = STACK>
4704 <CALL '
\1aNODEFM 6 = LN10>
4705 <SET TEMP17 () (TYPE LIST)>
4706 <SET TEMP31 () (TYPE LIST)>
4707 <RESTL OBJ4 1 = TEMP35 (TYPE LIST)>
4709 <CHTYPE TEMP35 <TYPE-CODE LIST> = TEMP35>
4713 <EMPL? TEMP35 + MAPAP28>
4714 <NTHL TEMP35 1 = OB36>
4719 <CALL '
\1aPCOMP 2 = OB36>
4720 <ADD TEM12 1 = TEM12 (TYPE FIX)>
4721 <VEQUAL? TEM12 ARGN7 - PHRASE40 (TYPE FIX)>
4722 <NTHUV OB36 1 = TEMP43 (TYPE FIX)>
4723 <VEQUAL? TEMP43 2 - PHRASE42 (TYPE FIX)>
4726 <NTHUV OB36 4 = STACK>
4729 <CALL '
\1aPCOMP 2 = OB36>
4730 <PUTUV LN10 1 54 (TYPE FIX)>
4735 <NTHUV OB36 3 = STACK>
4737 <CONS OB36 () = STACK>
4739 <CALL '
\1aNODE1 5 = OB36>
4741 <CONS OB36 () = TEMP43 (TYPE LIST)>
4743 <EMPL? TEMP17 - TAG46>
4744 <SET TEMP17 TEMP43 (TYPE LIST)>
4747 <PUTREST TEMP31 TEMP43>
4750 <SET TEMP31 TEMP43 (TYPE LIST)>
4752 <RESTL TEMP35 1 = TEMP35 (TYPE LIST)>
4755 <PUTUV LN10 5 TEMP17 (TYPE LIST)>
4760 <PUTPROP ,GETPROP PAPPLY-OBJECT <FUNCTION (O A) <GETFCNS .O .A GETPROP>>>
4762 '<PUTPROP ,GETPL PAPPLY-OBJECT <FUNCTION (O A) <GETFCNS .O .A GETPL>>>
4765 <GFCN
\1aGETFCNS ("VALUE" NODE FORM ANY ANY) OBJ4 AP5 NAME6>
4766 <TEMP LN10 TEMP17 TT11:NODE TEM8:NODE T2-9:NODE>
4768 <LENL OBJ4 = LN10 (TYPE FIX)>
4769 <VEQUAL? LN10 4 + BOOL15 (TYPE FIX)>
4770 <VEQUAL? LN10 3 - BOOL14 (TYPE FIX)>
4774 <CALL '
\1aSEG? 1 = TEMP17>
4775 <VEQUAL? TEMP17 0 + PHRASE13>
4778 <FRAME '
\1aRSUBR-FCN>
4783 <CALL '
\1aRSUBR-FCN 2 = TEMP17>
4789 <GEN-LVAL 'PARENT = STACK>
4793 <GVAL NAME6 = STACK>
4795 <CALL '
\1aNODEFM 6 = TT11>
4797 <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
4798 <NTHL TEMP17 1 = STACK>
4801 <CALL '
\1aPCOMP 2 = TEM8>
4803 <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
4804 <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
4805 <NTHL TEMP17 1 = STACK>
4808 <CALL '
\1aPCOMP 2 = T2-9>
4809 <VEQUAL? LN10 3 - PHRASE28 (TYPE FIX)>
4811 <PUTUV TT11 1 57 (TYPE FIX)>
4812 <CONS T2-9 () = TEMP17>
4814 <CONS TEM8 TEMP17 = TEMP17>
4816 <PUTUV TT11 5 TEMP17 (TYPE LIST)>
4821 <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
4823 <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
4824 <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
4825 <NTHL TEMP17 1 = STACK>
4828 <CALL '
\1aPCOMP 2 = LN10>
4829 <NTHUV LN10 1 = TEMP17 (TYPE FIX)>
4830 <VEQUAL? TEMP17 2 - PHRASE32 (TYPE FIX)>
4833 <NTHUV LN10 4 = STACK>
4836 <CALL '
\1aPCOMP 2 = LN10>
4837 <PUTUV TT11 1 57 (TYPE FIX)>
4839 <CONS LN10 () = TEMP17>
4841 <CONS T2-9 TEMP17 = TEMP17>
4843 <CONS TEM8 TEMP17 = TEMP17>
4845 <PUTUV TT11 5 TEMP17 (TYPE LIST)>
4852 <GFCN
\1aARGCHK ("VALUE" ATOM FIX <OR <LIST FIX FIX> FIX> ANY ANY) GIV4 REQ5 NAME6 OBJ7>
4857 <TYPE? REQ5 <TYPE-CODE LIST> - PHRASE11>
4858 <RESTL REQ5 1 = HI8 (TYPE LIST)>
4859 <NTHL HI8 1 = HI8 (TYPE FIX)>
4860 <NTHL REQ5 1 = LO9 (TYPE FIX)>
4863 <LESS? GIV4 LO9 - PHRASE14 (TYPE FIX)>
4865 <FRAME '
\1aCOMPILE-ERROR>
4866 <PUSH "Too few arguments to: ">
4871 <CALL '
\1aCOMPILE-ERROR 3>
4874 <GRTR? GIV4 HI8 - PHRASE16 (TYPE FIX)>
4876 <FRAME '
\1aCOMPILE-ERROR>
4877 <PUSH "Too many arguments to: ">
4882 <CALL '
\1aCOMPILE-ERROR 3>
4889 <GFCN
\1aPMAPF-R ("VALUE" NODE <PRIMTYPE LIST> ANY) OB4 AP5>
4890 <TEMP NAME6 TEMP3:LBIND OBJ9:LIST (LN11 ()) (APL14 ()) (DCL15 #DECL ()) (HATOM17 %<>) (NN18 0) TT7:NODE FINALF12:NODE TAPL13 TEM19 TEMP40 L1-76:LIST SYM77:SYMTAB>
4892 <NTHL OB4 1 = NAME6>
4893 <GETS 'BIND = TEMP3 (TYPE LBIND)>
4894 <BBIND 'RQRG 'FIX 'FIX 0>
4895 <RESTL OB4 1 = OBJ9 (TYPE LIST)>
4897 <CHTYPE OBJ9 <TYPE-CODE LIST> = OBJ9>
4898 <LENL OBJ9 = LN11 (TYPE FIX)>
4899 <BBIND 'TRG 'FIX 'FIX 0>
4900 <LESS? LN11 2 - PHRASE28 (TYPE FIX)>
4901 <FRAME '
\1aCOMPILE-ERROR>
4902 <PUSH "Too few arguments: ">
4905 <CALL '
\1aCOMPILE-ERROR 3>
4909 <GEN-LVAL 'PARENT = STACK>
4916 <CALL '
\1aNODEFM 6 = TT7>
4918 <NTHL OBJ9 1 = STACK>
4920 <CALL '
\1aPCOMP 2 = FINALF12>
4921 <RESTL OBJ9 1 = NAME6 (TYPE LIST)>
4922 <NTHL NAME6 1 = TAPL13>
4924 <TYPE? TAPL13 <TYPE-CODE FUNCTION> + BOOL37>
4925 <TYPE? TAPL13 <TYPE-CODE FORM> - PHRASE36>
4926 <CHTYPE TAPL13 <TYPE-CODE LIST> = APL14>
4927 <EMPL? APL14 + PHRASE36 (TYPE LIST)>
4928 <NTHL APL14 1 = TEM19>
4929 <TYPE? TEM19 <TYPE-CODE ATOM> - PHRASE36>
4930 <NTHR TEM19 1 = NAME6 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE36)>
4931 <TYPE? NAME6 <TYPE-CODE FALSE> + PHRASE36>
4932 <NTHR NAME6 1 = NAME6 (RECORD-TYPE GBIND)>
4933 <TYPE? NAME6 <TYPE-CODE UNBOUND> + PHRASE36>
4935 <GVAL TEM19 = NAME6>
4936 <GVAL 'FUNCTION = TEMP40>
4937 <EQUAL? NAME6 TEMP40 - PHRASE36>
4939 <RESTL APL14 1 = TAPL13 (TYPE LIST)>
4942 <CHTYPE TAPL13 <TYPE-CODE LIST> = APL14>
4944 <EMPL? APL14 - PHRASE42 (TYPE LIST)>
4945 <FRAME '
\1aCOMPILE-ERROR>
4946 <PUSH "MAPF/R function is empty: ">
4948 <CALL '
\1aCOMPILE-ERROR 2>
4950 <NTHL APL14 1 = TEMP40>
4951 <TYPE? TEMP40 <TYPE-CODE ATOM> + TAG46>
4952 <TYPE? TEMP40 <TYPE-CODE ADECL> - PHRASE45>
4955 <NTHL APL14 1 = HATOM17>
4956 <RESTL APL14 1 = APL14 (TYPE LIST)>
4958 <EMPL? APL14 + BOOL49 (TYPE LIST)>
4959 <NTHL APL14 1 = NAME6>
4960 <TYPE? NAME6 <TYPE-CODE LIST> + PHRASE48>
4963 <FRAME '
\1aCOMPILE-ERROR>
4964 <PUSH "MAPF/R function lacks arg list: ">
4966 <CALL '
\1aCOMPILE-ERROR 2>
4968 <NTHL APL14 1 = LN11 (TYPE LIST)>
4969 <RESTL APL14 1 = APL14 (TYPE LIST)>
4970 <EMPL? APL14 + PHRASE52 (TYPE LIST)>
4971 <NTHL APL14 1 = NAME6>
4972 <TYPE? NAME6 <TYPE-CODE DECL> - PHRASE52>
4974 <NTHL APL14 1 = DCL15 (TYPE DECL)>
4975 <RESTL APL14 1 = APL14 (TYPE LIST)>
4977 <EMPL? APL14 - PHRASE55 (TYPE LIST)>
4978 <FRAME '
\1aCOMPILE-ERROR>
4979 <PUSH "MAPF/R function has no body: ">
4981 <CALL '
\1aCOMPILE-ERROR 2>
4983 <GETS 'BIND = NAME6 (TYPE LBIND)>
4984 <GEN-LVAL 'VARTBL = TAPL13>
4985 <BBIND 'VARTBL 'SYMTAB 'FIX TAPL13>
4990 <FRAME '
\1aFIND_DECL>
4993 <CALL '
\1aFIND_DECL 2 = TAPL13>
4994 <TYPE? TAPL13 <TYPE-CODE FALSE> - BOOL64>
4995 <SET TAPL13 'ANY (TYPE ATOM)>
5004 <NTHR 'VARTBL 2 = TAPL13 (RECORD-TYPE ATOM) (TYPE LBIND)>
5005 <NTHR TAPL13 1 = STACK (RECORD-TYPE LBIND)>
5007 <CALL '
\1aNODEPR 9 = TEM19>
5019 <NTHUV TEM19 10 = STACK (TYPE LIST)>
5020 <CALL '
\1aACT-FIX 2 = TAPL13>
5021 <TYPE? TAPL13 <TYPE-CODE FALSE> + PHRASE70>
5023 <SET LN11 () (TYPE LIST)>
5025 <NTHUV TEM19 10 = DCL15 (TYPE LIST)>
5031 <EMPL? DCL15 - BOOL79 (TYPE LIST)>
5036 <NTHL DCL15 1 = SYM77 (TYPE SYMTAB)>
5037 <NTHUV SYM77 4 = TEMP40 (TYPE FIX)>
5038 <VEQUAL? TEMP40 1 - PHRASE93 (TYPE FIX)>
5040 <NTHUV SYM77 2 = TEMP40 (TYPE ATOM)>
5041 <CONS TEMP40 LN11 = TEMP40>
5043 <CONS "ACT" TEMP40 = LN11>
5045 <NTHUV SYM77 2 = TEMP40 (TYPE ATOM)>
5046 <CONS TEMP40 () = TEMP40>
5047 <CONS TEMP40 () = TEMP40>
5048 <NTHUV SYM77 3 = TAPL13>
5049 <TYPE? TAPL13 <TYPE-CODE FALSE> + PHRASE86>
5053 <NTHUV SYM77 7 = STACK>
5055 <CALL '
\1aFORM 2 = TAPL13>
5060 <NTHUV SYM77 7 = STACK>
5062 <CALL '
\1aFORM 2 = TAPL13>
5064 <CONS TAPL13 () = TAPL13>
5065 <PUTREST TEMP40 TAPL13>
5066 <PUTREST TAPL13 HATOM17>
5067 <DEAD TAPL13 HATOM17>
5068 <SET HATOM17 TEMP40>
5070 <VEQUAL? DCL15 L1-76 - PHRASE92>
5071 <RESTL L1-76 1 = L1-76 (TYPE LIST)>
5074 <RESTL DCL15 1 = TEMP40 (TYPE LIST)>
5075 <PUTREST NN18 TEMP40>
5080 <RESTL NN18 1 = DCL15 (TYPE LIST)>
5083 <PUTUV TEM19 10 TAPL13 (TYPE LIST)>
5089 <CHTYPE HATOM17 <TYPE-CODE DECL> = STACK>
5091 <SET TEMP40 3 (TYPE FIX)>
5094 <LOOP (TAPL13 VALUE) (TEMP40 VALUE)>
5097 <EMPL? TAPL13 + TAG94>
5098 <NTHL TAPL13 1 = STACK>
5099 <RESTL TAPL13 1 = TAPL13 (TYPE LIST)>
5100 <ADD TEMP40 1 = TEMP40 (TYPE FIX)>
5103 <CALL '
\1aFORM TEMP40 = TEMP40>
5104 <CONS TEMP40 () = APL14>
5107 <SET HATOM17 () (TYPE LIST)>
5108 <SET TAPL13 () (TYPE LIST)>
5109 <SET TEMP40 APL14 (TYPE LIST)>
5114 <EMPL? TEMP40 + MAPAP101>
5115 <NTHL TEMP40 1 = LN11>
5120 <CALL '
\1aPCOMP 2 = LN11>
5121 <CONS LN11 () = LN11 (TYPE LIST)>
5122 <EMPL? HATOM17 - TAG108>
5123 <SET HATOM17 LN11 (TYPE LIST)>
5126 <PUTREST TAPL13 LN11>
5129 <SET TAPL13 LN11 (TYPE LIST)>
5131 <RESTL TEMP40 1 = TEMP40 (TYPE LIST)>
5134 <PUTUV TEM19 5 HATOM17 (TYPE LIST)>
5141 <TYPE? TAPL13 <TYPE-CODE FIX> - BOOL112>
5142 <VEQUAL? LN11 3 + BOOL121 (TYPE FIX)>
5144 <TYPE? TAPL13 <TYPE-CODE FORM> - BOOL115>
5145 <CHTYPE TAPL13 <TYPE-CODE LIST> = APL14>
5146 <EMPL? APL14 + BOOL115>
5147 <RESTL APL14 1 = NAME6 (TYPE LIST)>
5148 <EMPL? NAME6 + BOOL115>
5149 <RESTL NAME6 1 = NAME6 (TYPE LIST)>
5150 <EMPL? NAME6 - BOOL115>
5152 <NTHL APL14 1 = TEM19>
5153 <TYPE? TEM19 <TYPE-CODE ATOM> - BOOL115>
5154 <NTHR TEM19 1 = NAME6 (RECORD-TYPE ATOM) (BRANCH-FALSE + BOOL115)>
5155 <TYPE? NAME6 <TYPE-CODE FALSE> + BOOL115>
5156 <NTHR NAME6 1 = NAME6 (RECORD-TYPE GBIND)>
5157 <TYPE? NAME6 <TYPE-CODE UNBOUND> + BOOL115>
5159 <GVAL TEM19 = NAME6>
5161 <GVAL 'GVAL = TEMP40>
5162 <EQUAL? NAME6 TEMP40 - BOOL115>
5164 <RESTL APL14 1 = TEMP40 (TYPE LIST)>
5166 <NTHL TEMP40 1 = TEM19>
5168 <TYPE? TEM19 <TYPE-CODE ATOM> + BOOL114>
5170 <TYPE? TAPL13 <TYPE-CODE GVAL> - PHRASE110>
5171 <CHTYPE TAPL13 <TYPE-CODE ATOM> = TEM19>
5173 <GEN-LVAL 'REASONABLE = TEMP40>
5174 <TYPE? TEMP40 <TYPE-CODE FALSE> - BOOL121>
5176 <NTHR TEM19 1 = TEMP40 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE110)>
5177 <TYPE? TEMP40 <TYPE-CODE FALSE> + PHRASE110>
5178 <NTHR TEMP40 1 = TEMP40 (RECORD-TYPE GBIND)>
5179 <TYPE? TEMP40 <TYPE-CODE UNBOUND> + PHRASE110>
5181 <GVAL TEM19 = TEMP40>
5182 <TYPE? TEMP40 <TYPE-CODE FUNCTION> - BOOL121>
5184 <GEN-LVAL 'FNAME = TEMP40>
5185 <EQUAL? TEMP40 TEM19 - PHRASE110>
5189 <GEN-LVAL 'IND = STACK>
5190 <PUSH 'PTHIS-OBJECT>
5191 <GVAL 'PMARGS = STACK>
5192 <CALL '
\1aPUTPROP 3>
5193 <TYPE? TAPL13 <TYPE-CODE FIX> - PHRASE128>
5197 <GEN-LVAL 'IND = STACK>
5200 <CALL '
\1aFORM 3 = STACK>
5202 <CALL '
\1aPCOMP 2 = LN11>
5209 <SET APL14 1 (TYPE FIX)>
5210 <SET NAME6 () (TYPE LIST)>
5211 <SET HATOM17 () (TYPE LIST)>
5215 <VEQUAL? LN11 2 + MAPAP142 (TYPE FIX)>
5216 <SUB LN11 1 = LN11 (TYPE FIX)>
5217 <GEN-LVAL 'IND = TAPL13>
5218 <CONS TAPL13 () = TAPL13 (TYPE LIST)>
5219 <EMPL? NAME6 - TAG155>
5220 <SET NAME6 TAPL13 (TYPE LIST)>
5223 <PUTREST HATOM17 TAPL13>
5226 <SET HATOM17 TAPL13 (TYPE LIST)>
5230 <LOOP (NAME6 VALUE) (APL14 VALUE)>
5233 <EMPL? NAME6 + TAG135>
5234 <NTHL NAME6 1 = STACK>
5235 <RESTL NAME6 1 = NAME6 (TYPE LIST)>
5236 <ADD APL14 1 = APL14 (TYPE FIX)>
5239 <CALL '
\1aFORM APL14 = STACK>
5242 <CALL '
\1aPCOMP 2 = LN11>
5247 <GEN-LVAL 'IND = STACK>
5248 <PUSH 'PTHIS-OBJECT>
5249 <CALL '
\1aPUTPROP 2>
5250 <NTHUV TEM19 5 = APL14 (TYPE LIST)>
5254 <EMPL? APL14 + MAPAP166>
5255 <NTHL APL14 1 = LN11>
5256 <NTHUV LN11 1 = NAME6 (TYPE FIX)>
5257 <VEQUAL? NAME6 61 - BOOL172 (TYPE FIX)>
5259 <ADD NN18 1 = NN18 (TYPE FIX)>
5263 <RESTL APL14 1 = APL14 (TYPE LIST)>
5271 <CONS TEM19 () = STACK>
5274 <CALL '
\1aNODEFM 6 = TEM19>
5281 <CALL '
\1aPCOMP 2 = TEM19>
5283 <SET NAME6 () (TYPE LIST)>
5284 <SET HATOM17 () (TYPE LIST)>
5285 <RESTL OBJ9 1 = TAPL13 (TYPE LIST)>
5287 <RESTL TAPL13 1 = OBJ9 (TYPE LIST)>
5292 <EMPL? OBJ9 + MAPAP181>
5293 <NTHL OBJ9 1 = TAPL13>
5298 <CALL '
\1aPCOMP 2 = TAPL13>
5299 <CONS TAPL13 () = TAPL13 (TYPE LIST)>
5300 <EMPL? NAME6 - TAG188>
5301 <SET NAME6 TAPL13 (TYPE LIST)>
5304 <PUTREST HATOM17 TAPL13>
5307 <SET HATOM17 TAPL13 (TYPE LIST)>
5309 <RESTL OBJ9 1 = OBJ9 (TYPE LIST)>
5312 <CONS TEM19 NAME6 = OBJ9>
5314 <CONS FINALF12 OBJ9 = OBJ9>
5316 <PUTUV TT7 5 OBJ9 (TYPE LIST)>
5327 <GFCN
\1aPMARGS ("VALUE" NODE ANY) O4>
5332 <GEN-LVAL 'PARENT = STACK>
5337 <CALL '
\1aNODEFM 6 = TEMP6>
5341 <COND (<GASSIGNED? PMAPF-R> <PUTPROP ,MAPF PAPPLY-OBJECT ,PMAPF-R> <PUTPROP ,MAPR PAPPLY-OBJECT ,PMAPF-R>)>
5344 <GFCN
\1aADECL-FCN ("VALUE" NODE ADECL) OBJ4>
5345 <TEMP TEMP8 TT5:NODE>
5349 <GEN-LVAL 'PARENT = STACK>
5354 <CALL '
\1aNODEFM 6 = TT5>
5355 <LENUV OBJ4 = TEMP8 (TYPE FIX)>
5356 <VEQUAL? TEMP8 2 - PHRASE12 (TYPE FIX)>
5358 <NTHUV OBJ4 1 = TEMP8>
5359 <TYPE? TEMP8 <TYPE-CODE SEGMENT> - PHRASE15>
5360 <PUTUV TT5 1 3 (TYPE FIX)>
5362 <FRAME '
\1aADECL-FCN>
5363 <CHTYPE TEMP8 <TYPE-CODE FORM> = STACK>
5365 <NTHUV OBJ4 2 = STACK>
5367 <UBLOCK <TYPE-CODE VECTOR> 2 = TEMP8>
5368 <CHTYPE TEMP8 <TYPE-CODE ADECL> = STACK>
5370 <CALL '
\1aADECL-FCN 1 = TEMP8>
5371 <CONS TEMP8 () = TEMP8>
5372 <PUTUV TT5 5 TEMP8 (TYPE LIST)>
5377 <NTHUV OBJ4 2 = TEMP8>
5381 <NTHUV OBJ4 1 = STACK>
5384 <CALL '
\1aPCOMP 2 = TEMP8>
5385 <CONS TEMP8 () = TEMP8>
5386 <PUTUV TT5 5 TEMP8 (TYPE LIST)>
5391 <FRAME '
\1aCOMPILE-ERROR>
5392 <PUSH "ADECL has an incorrect number of elements: ">
5395 <CALL '
\1aCOMPILE-ERROR 2 = TEMP8>
5399 <COND (<GASSIGNED? ADECL-FCN> <PUTPROP ADECL PTHIS-TYPE ,ADECL-FCN>)>
5402 <GFCN
\1aCASE-FCN ("VALUE" NODE <FORM ANY> ANY) OBJ4 AP5>
5403 <TEMP OP6 TEMP3:LBIND TEMP17 (FLG8 'T) (WIN9 'T) TYP10 (DF11 %<>) TEMP23 P12 TEM13 TEMP86 TEMP40 TEMP121:LIST TT124:NODE>
5405 <GEN-LVAL 'PARENT = OP6>
5406 <GETS 'BIND = TEMP3 (TYPE LBIND)>
5407 <GEN-LVAL 'PARENT = TEMP17>
5408 <BBIND 'PARENT 'NODE 'FIX TEMP17>
5411 <SET TEMP23 4 (TYPE FIX)>
5412 <LOOP (TEMP17 VALUE) (TEMP23 VALUE)>
5414 <EMPL? TEMP17 + PHRASE21>
5415 <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
5416 <SUB TEMP23 1 = TEMP23 (TYPE FIX)>
5417 <GRTR? TEMP23 0 + TAG24 (TYPE FIX)>
5419 <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
5420 <NTHL TEMP17 1 = TEMP23>
5423 <CALL '
\1aTYPE 1 = TEMP17>
5424 <VEQUAL? TEMP17 'GVAL - BOOL29>
5426 <CHTYPE TEMP23 <TYPE-CODE ATOM> = P12>
5428 <VEQUAL? P12 '==? + PHRASE33>
5430 <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
5431 <NTHL TEMP17 1 = TEMP23>
5433 <TYPE? TEMP23 <TYPE-CODE FORM> - BOOL32>
5434 <EMPL? TEMP23 + BOOL32>
5435 <RESTL TEMP23 1 = TEMP17 (TYPE LIST)>
5436 <EMPL? TEMP17 + BOOL32>
5437 <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
5438 <EMPL? TEMP17 - BOOL32>
5440 <NTHL TEMP23 1 = TEMP17>
5441 <EQUAL? TEMP17 'GVAL - BOOL32>
5443 <RESTL TEMP23 1 = TEMP17 (TYPE LIST)>
5445 <NTHL TEMP17 1 = P12>
5447 <EQUAL? P12 '==? + PHRASE33>
5449 <SET WIN9 %<> (TYPE FALSE)>
5451 <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
5452 <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
5453 <RESTL TEMP17 1 = TEMP23 (TYPE LIST)>
5455 <CHTYPE TEMP23 <TYPE-CODE LIST> = TEMP23>
5456 <EMPL? TEMP23 + PHRASE21>
5460 <EMPL? TEMP23 + MAPAP38>
5461 <NTHL TEMP23 1 = TEMP17>
5462 <VEQUAL? FLG8 0 + PHRASE48>
5463 <EQUAL? TEMP17 'DEFAULT - PHRASE48>
5464 <SET DF11 'T (TYPE ATOM)>
5467 <VEQUAL? DF11 0 + PHRASE50>
5468 <TYPE? TEMP17 <TYPE-CODE LIST> - PHRASE50>
5469 <SET DF11 %<> (TYPE FALSE)>
5470 <SET FLG8 %<> (TYPE FALSE)>
5473 <VEQUAL? DF11 0 - PHRASE21>
5474 <TYPE? TEMP17 <TYPE-CODE LIST> - PHRASE21>
5475 <EMPL? TEMP17 + PHRASE21 (TYPE LIST)>
5477 <NTHL TEMP17 1 = STACK>
5478 <CALL '
\1aVAL-CHK 1 = TEM13>
5479 <TYPE? TEM13 <TYPE-CODE FALSE> + PHRASE55>
5480 <TYPE? TYP10 <TYPE-CODE UNBOUND> + PHRASE58>
5484 <CALL '
\1aTYPE 1 = TEMP17>
5485 <VEQUAL? TYP10 TEMP17 + PHRASE90>
5487 <SET WIN9 %<> (TYPE FALSE)>
5493 <CALL '
\1aTYPE 1 = TYP10>
5496 <NTHL TEMP17 1 = TEM13>
5498 <TYPE? TEM13 <TYPE-CODE SEGMENT> - PHRASE63>
5499 <EMPL? TEM13 + PHRASE63>
5500 <RESTL TEM13 1 = TEMP17 (TYPE LIST)>
5501 <EMPL? TEMP17 + PHRASE63>
5502 <RESTL TEMP17 1 = TEMP17 (TYPE LIST)>
5503 <EMPL? TEMP17 - PHRASE63>
5505 <NTHL TEM13 1 = TEMP17>
5506 <EQUAL? TEMP17 'QUOTE - PHRASE63>
5508 <RESTL TEM13 1 = TEMP17 (TYPE LIST)>
5510 <NTHL TEMP17 1 = TEM13>
5512 <MONAD? TEM13 - TAG65>
5513 <SET TEMP17 'T (TYPE ATOM)>
5516 <SET TEMP17 %<> (TYPE FALSE)>
5518 <VEQUAL? TEMP17 0 - PHRASE63>
5525 <EMPTY? TEMP17 + PHRASE90>
5526 <NTH1 TEMP17 = TEM13>
5530 <CALL '
\1aVAL-CHK 1 = TEM13>
5531 <TYPE? TEM13 <TYPE-CODE FALSE> - PHRASE79>
5532 <SET WIN9 %<> (TYPE FALSE)>
5535 <TYPE? TYP10 <TYPE-CODE UNBOUND> + PHRASE83>
5539 <CALL '
\1aTYPE 1 = TEMP86>
5540 <VEQUAL? TYP10 TEMP86 + PHRASE87>
5542 <SET WIN9 %<> (TYPE FALSE)>
5548 <CALL '
\1aTYPE 1 = TYP10>
5550 <REST1 TEMP17 = TEMP17>
5553 <SET WIN9 %<> (TYPE FALSE)>
5555 <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
5558 <VEQUAL? DF11 0 - PHRASE21>
5559 <VEQUAL? WIN9 0 + PHRASE92>
5560 <FRAME '
\1aTYPEPRIM>
5562 <CALL '
\1aTYPEPRIM 1 = TEMP23>
5563 <SET FLG8 [WORD FIX] (TYPE VECTOR)>
5564 <TYPE? TEMP23 <TYPE-CODE ATOM> - BOOL95>
5565 <LOOP (TEMP23 VALUE) (FLG8 LENGTH VALUE)>
5567 <NTHUV FLG8 1 = TEMP40>
5568 <VEQUAL? TEMP40 TEMP23 + TAG96>
5570 <RESTUV FLG8 1 = FLG8 (TYPE VECTOR)>
5571 <EMPUV? FLG8 - TAG97>
5574 <EQUAL? P12 '==? + PHRASE92>
5576 <EQUAL? P12 '==? + BOOL100>
5578 <VEQUAL? TYP10 'ATOM + PHRASE92>
5581 <SET WIN9 %<> (TYPE FALSE)>
5583 <VEQUAL? WIN9 0 + PHRASE102>
5585 <FRAME '
\1aNODECOND>
5592 <CALL '
\1aNODECOND 5 = P12>
5593 <NTHR 'PARENT 2 = FLG8 (RECORD-TYPE ATOM) (TYPE LBIND)>
5594 <PUTR FLG8 1 P12 (RECORD-TYPE LBIND)>
5596 <NTHR 'PARENT 2 = FLG8 (RECORD-TYPE ATOM) (TYPE LBIND)>
5597 <NTHR FLG8 1 = P12 (RECORD-TYPE LBIND)>
5600 <RESTL OBJ4 1 = TEMP17 (TYPE LIST)>
5601 <NTHL TEMP17 1 = STACK>
5603 <NTHR 'PARENT 2 = TEMP17 (RECORD-TYPE ATOM) (TYPE LBIND)>
5604 <NTHR TEMP17 1 = STACK (RECORD-TYPE LBIND)>
5606 <CALL '
\1aPCOMP 2 = TEMP17>
5607 <CONS TEMP17 () = TEMP17>
5609 <RESTL OBJ4 1 = FLG8 (TYPE LIST)>
5610 <RESTL FLG8 1 = FLG8 (TYPE LIST)>
5611 <NTHL FLG8 1 = STACK>
5613 <NTHR 'PARENT 2 = FLG8 (RECORD-TYPE ATOM) (TYPE LBIND)>
5614 <NTHR FLG8 1 = STACK (RECORD-TYPE LBIND)>
5616 <CALL '
\1aPCOMP 2 = FLG8>
5617 <CONS FLG8 () = FLG8>
5618 <PUTREST TEMP17 FLG8>
5619 <SET TEMP86 () (TYPE LIST)>
5620 <SET TEMP40 () (TYPE LIST)>
5621 <RESTL OBJ4 1 = OP6 (TYPE LIST)>
5623 <RESTL OP6 1 = OP6 (TYPE LIST)>
5624 <RESTL OP6 1 = TEMP121 (TYPE LIST)>
5626 <CHTYPE TEMP121 <TYPE-CODE LIST> = TEMP121>
5630 <EMPL? TEMP121 + MAPAP118>
5631 <NTHL TEMP121 1 = WIN9>
5632 <VEQUAL? DF11 0 + TAG130>
5635 <SET TEMP23 1 (TYPE FIX)>
5639 <AND TYP10 7 = TYP10>
5640 <VEQUAL? TYP10 1 + TAG129>
5642 <LOOP (OP6 TYPE VALUE LENGTH) (TEMP23 VALUE)>
5645 <EMPTY? OP6 + TAG134>
5648 <ADD TEMP23 1 = TEMP23 (TYPE FIX)>
5651 <LIST TEMP23 = WIN9 (TYPE LIST)>
5657 <VEQUAL? TEMP23 0 + TAG131>
5659 <CONS TYP10 OP6 = OP6 (TYPE LIST)>
5661 <SUB TEMP23 1 = TEMP23 (TYPE FIX)>
5667 <TYPE? WIN9 <TYPE-CODE ATOM> + PHRASE137>
5670 <NTHR 'PARENT 2 = OP6 (RECORD-TYPE ATOM) (TYPE LBIND)>
5671 <NTHR OP6 1 = STACK (RECORD-TYPE LBIND)>
5676 <CALL '
\1aNODEB 5 = TT124>
5678 <NTHL WIN9 1 = TEM13>
5679 <TYPE? TEM13 <TYPE-CODE SEGMENT> - PHRASE143>
5682 <SET TYP10 () (TYPE LIST)>
5683 <SET OP6 () (TYPE LIST)>
5684 <RESTL TEM13 1 = DF11 (TYPE LIST)>
5686 <NTHL DF11 1 = DF11>
5690 <EMPTY? DF11 + MAP145>
5693 <CALL '
\1aVAL-CHK 1 = TEMP23>
5694 <CONS TEMP23 () = TEMP23 (TYPE LIST)>
5695 <EMPL? TYP10 - TAG152>
5696 <SET TYP10 TEMP23 (TYPE LIST)>
5699 <PUTREST OP6 TEMP23>
5702 <SET OP6 TEMP23 (TYPE LIST)>
5709 <CALL '
\1aFORM 2 = DF11>
5712 <TYPE? TEM13 <TYPE-CODE ORQ> - PHRASE154>
5715 <SET OP6 () (TYPE LIST)>
5716 <SET TYP10 () (TYPE LIST)>
5717 <CHTYPE TEM13 <TYPE-CODE LIST> = TEMP23>
5722 <EMPL? TEMP23 + MAP156>
5724 <NTHL TEMP23 1 = STACK>
5725 <CALL '
\1aVAL-CHK 1 = DF11>
5726 <CONS DF11 () = DF11 (TYPE LIST)>
5727 <EMPL? OP6 - TAG163>
5728 <SET OP6 DF11 (TYPE LIST)>
5731 <PUTREST TYP10 DF11>
5734 <SET TYP10 DF11 (TYPE LIST)>
5736 <RESTL TEMP23 1 = TEMP23 (TYPE LIST)>
5741 <CALL '
\1aFORM 2 = DF11>
5747 <CALL '
\1aVAL-CHK 1 = DF11>
5752 <CALL '
\1aPCOMP 2 = DF11>
5753 <PUTUV TT124 4 DF11>
5755 <SET OP6 () (TYPE LIST)>
5756 <SET TEMP23 () (TYPE LIST)>
5757 <RESTL WIN9 1 = WIN9 (TYPE LIST)>
5761 <EMPL? WIN9 + MAPAP171>
5762 <NTHL WIN9 1 = TYP10>
5767 <CALL '
\1aPCOMP 2 = TYP10>
5768 <CONS TYP10 () = TYP10 (TYPE LIST)>
5769 <EMPL? OP6 - TAG179>
5770 <SET OP6 TYP10 (TYPE LIST)>
5773 <PUTREST TEMP23 TYP10>
5776 <SET TEMP23 TYP10 (TYPE LIST)>
5778 <RESTL WIN9 1 = WIN9 (TYPE LIST)>
5781 <PUTUV TT124 5 OP6 (TYPE LIST)>
5783 <SET DF11 %<> (TYPE FALSE)>
5788 <SET DF11 'T (TYPE ATOM)>
5792 <NTHR 'PARENT 2 = TYP10 (RECORD-TYPE ATOM) (TYPE LBIND)>
5793 <NTHR TYP10 1 = STACK (RECORD-TYPE LBIND)>
5795 <CALL '
\1aPCOMP 2 = WIN9>
5797 <CONS WIN9 () = WIN9 (TYPE LIST)>
5798 <EMPL? TEMP86 - TAG185>
5799 <SET TEMP86 WIN9 (TYPE LIST)>
5802 <PUTREST TEMP40 WIN9>
5805 <SET TEMP40 WIN9 (TYPE LIST)>
5807 <RESTL TEMP121 1 = TEMP121 (TYPE LIST)>
5810 <PUTREST FLG8 TEMP86>
5812 <PUTUV P12 5 TEMP17 (TYPE LIST)>
5821 <CALL '
\1aPMACRO 2 = P12>
5824 <FRAME '
\1aCOMPILE-ERROR>
5825 <PUSH "CASE in incorrect format ">
5828 <CALL '
\1aCOMPILE-ERROR 2 = P12>
5837 <GFCN
\1aVAL-CHK ("VALUE" ANY ANY) TEM4>
5838 <TEMP TEMP11 TEMP26>
5840 <TYPE? TEM4 <TYPE-CODE ATOM> + BOOL9>
5841 <FRAME '
\1aPRIMTYPE>
5843 <CALL '
\1aPRIMTYPE 1 = TEMP11>
5844 <VEQUAL? TEMP11 'WORD + BOOL9>
5846 <FRAME '
\1aPRIMTYPE>
5848 <CALL '
\1aPRIMTYPE 1 = TEMP11>
5849 <VEQUAL? TEMP11 'FIX - BOOL8>
5853 <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5857 <CALL '
\1aTYPE 1 = TEMP11>
5858 <VEQUAL? TEMP11 'GVAL - BOOL13>
5860 <FRAME '
\1aMANIFESTQ>
5861 <CHTYPE TEM4 <TYPE-CODE ATOM> = TEM4>
5863 <CALL '
\1aMANIFESTQ 1 = TEMP11>
5864 <TYPE? TEMP11 <TYPE-CODE FALSE> + BOOL13>
5866 <GVAL TEM4 = TEMP11>
5867 <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5869 <TYPE? TEM4 <TYPE-CODE FORM> - BOOL21>
5870 <EMPL? TEM4 + BOOL21>
5871 <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5872 <EMPL? TEMP11 + BOOL21>
5873 <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
5874 <EMPL? TEMP11 - BOOL21>
5876 <NTHL TEM4 1 = TEMP11>
5877 <EQUAL? TEMP11 'QUOTE - BOOL18>
5879 <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5880 <NTHL TEMP11 1 = TEMP11>
5881 <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5883 <NTHL TEM4 1 = TEMP11>
5884 <EQUAL? TEMP11 'GVAL - BOOL19>
5886 <FRAME '
\1aMANIFESTQ>
5887 <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5888 <NTHL TEMP11 1 = STACK (TYPE ATOM)>
5890 <CALL '
\1aMANIFESTQ 1 = TEMP11>
5891 <TYPE? TEMP11 <TYPE-CODE FALSE> + BOOL19>
5893 <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5894 <NTHL TEMP11 1 = TEMP11 (TYPE ATOM)>
5895 <GVAL TEMP11 = TEMP11>
5896 <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5898 <NTHL TEM4 1 = TEMP11>
5899 <EQUAL? TEMP11 'ASCII - BOOL21>
5901 <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5902 <NTHL TEMP11 1 = TEMP11>
5903 <TYPE? TEMP11 <TYPE-CODE CHARACTER> + TAG22>
5904 <TYPE? TEMP11 <TYPE-CODE FIX> - BOOL21>
5909 <CALL '
\1aEVAL 1 = TEMP11>
5910 <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5912 <TYPE? TEM4 <TYPE-CODE FORM> - BOOL24>
5914 <SET TEMP26 3 (TYPE FIX)>
5915 <LOOP (TEMP11 VALUE) (TEMP26 VALUE)>
5917 <EMPL? TEMP11 + BOOL24>
5918 <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
5919 <SUB TEMP26 1 = TEMP26 (TYPE FIX)>
5920 <GRTR? TEMP26 0 + TAG27 (TYPE FIX)>
5921 <EMPL? TEMP11 - BOOL24>
5923 <NTHL TEM4 1 = TEMP11>
5924 <EQUAL? TEMP11 'CHTYPE - BOOL24>
5926 <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5927 <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
5928 <NTHL TEMP11 1 = TEMP11>
5929 <TYPE? TEMP11 <TYPE-CODE ATOM> - BOOL24>
5931 <RESTL TEM4 1 = TEMP11 (TYPE LIST)>
5932 <NTHL TEMP11 1 = TEMP11>
5933 <TYPE? TEMP11 <TYPE-CODE FORM> + BOOL24>
5934 <TYPE? TEMP11 <TYPE-CODE LIST> + BOOL24>
5935 <TYPE? TEMP11 <TYPE-CODE VECTOR> + BOOL24>
5936 <TYPE? TEMP11 <TYPE-CODE UVECTOR> + BOOL24>
5937 <TYPE? TEMP11 <TYPE-CODE SEGMENT> + BOOL24>
5941 <CALL '
\1aEVAL 1 = TEMP11>
5942 <TYPE? TEMP11 <TYPE-CODE FALSE> - BOOL29>
5944 <TYPE? TEM4 <TYPE-CODE FORM> + TAG30>
5947 <EMPL? TEM4 - TAG32 (TYPE FORM)>
5950 <NTHL TEM4 1 = TEMP26>
5951 <TYPE? TEMP26 <TYPE-CODE ATOM> + TAG33>
5954 <NTHR TEMP26 1 = TEMP11 (RECORD-TYPE ATOM) (BRANCH-FALSE + TAG36)>
5955 <TYPE? TEMP11 <TYPE-CODE FALSE> + TAG36>
5956 <NTHR TEMP11 1 = TEMP11 (RECORD-TYPE GBIND)>
5957 <TYPE? TEMP11 <TYPE-CODE UNBOUND> - TAG35>
5962 <GVAL TEMP26 = TEMP11>
5964 <TYPE? TEMP11 <TYPE-CODE MACRO> + TAG37>
5972 <CALL '
\1aEMACRO 1 = STACK>
5973 <CALL '
\1aVAL-CHK 1 = TEMP11>
5979 <GFCN
\1aMANIFESTQ ("VALUE" <OR ATOM FALSE> ATOM) ATM4>
5982 <FRAME '
\1aMANIFEST?>
5984 <CALL '
\1aMANIFEST? 1 = TEMP6>
5985 <TYPE? TEMP6 <TYPE-CODE FALSE> + TAG12>
5986 <NTHR ATM4 1 = TEMP6 (RECORD-TYPE ATOM) (BRANCH-FALSE + TAG9)>
5987 <TYPE? TEMP6 <TYPE-CODE FALSE> + TAG9>
5988 <NTHR TEMP6 1 = TEMP6 (RECORD-TYPE GBIND)>
5989 <TYPE? TEMP6 <TYPE-CODE UNBOUND> - TAG8>
5996 <TYPE? TEMP6 <TYPE-CODE MSUBR> - TAG11>
6000 <SET TEMP6 'T (TYPE ATOM)>
6006 <GFCN
\1aEMACRO ("VALUE" ANY ANY) OBJ4>
6010 <GVAL 'MACROERR = STACK>
6012 <CALL '
\1aHANDLER 2 = ERR5>
6016 <ICALL EXIT11 = TEM6>
6017 <TEMP TEMP12 TEMP15>
6020 <NTHR TEMP12 5 = TEMP12 (RECORD-TYPE FRAME)>
6021 <CFRAME = TEMP15 (TYPE FRAME)>
6022 <BBIND 'MACACT 'ANY 'FIX TEMP15>
6025 <SETLR TEMP15 TEMP12 ERR5>
6028 <NTHR 'MACACT 2 = TEMP15 (RECORD-TYPE ATOM) (TYPE LBIND)>
6029 <NTHR TEMP15 1 = TEMP15 (RECORD-TYPE LBIND)>
6030 <SETG 'MACACT TEMP15>
6033 <SETLR TEMP15 TEMP12 OBJ4>
6036 <CALL '
\1aEXPAND 1 = TEMP15>
6040 <TYPE? TEM6 <TYPE-CODE FUNNY> - PHRASE10>
6045 <FRAME '
\1aCOMPILE-ERROR>
6046 <PUSH "Macro expansion lossage ">
6048 <SET ERR5 2 (TYPE FIX)>
6049 <LOOP (TEM6 VALUE LENGTH) (ERR5 VALUE)>
6052 <EMPUV? TEM6 + TAG21>
6053 <NTHUV TEM6 1 = STACK>
6054 <RESTUV TEM6 1 = TEM6 (TYPE VECTOR)>
6055 <ADD ERR5 1 = ERR5 (TYPE FIX)>
6058 <CALL '
\1aCOMPILE-ERROR ERR5 = ERR5>
6069 <COND (<AND <GASSIGNED? CASE> <GASSIGNED? CASE-FCN>> <PUTPROP ,CASE PAPPLY-OBJECT ,CASE-FCN>)>
6072 <GFCN
\1aP-CALL ("VALUE" NODE FORM ANY) OBJ4 AP5>
6073 <TEMP TEMP8 TT6:NODE TEMP34 TEMP38:LIST O39>
6077 <GEN-LVAL 'PARENT = STACK>
6083 <CALL '
\1aNODEFM 6 = TT6>
6084 <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
6085 <CHTYPE TEMP8 <TYPE-CODE LIST> = TEMP8>
6086 <EMPL? TEMP8 + PHRASE23 (TYPE LIST)>
6088 <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
6089 <NTHL TEMP8 1 = TEMP8>
6090 <GEN-SET 'CALLED TEMP8>
6091 <TYPE? TEMP8 <TYPE-CODE ATOM> - PHRASE23>
6093 <GEN-LVAL 'CALLED = TEMP8>
6094 <EQUAL? TEMP8 'IFSYS - PHRASE18>
6096 <RESTL OBJ4 1 = TEMP8 (TYPE LIST)>
6097 <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
6098 <NTHL TEMP8 1 = TEMP8>
6099 <GEN-SET 'IN-IFSYS TEMP8>
6103 <GEN-LVAL 'CALLED = TEMP8>
6104 <EQUAL? TEMP8 'ENDIF - PHRASE23>
6106 <GEN-SET 'IN-IFSYS %<>>
6108 <SET TEMP8 () (TYPE LIST)>
6109 <SET TEMP34 () (TYPE LIST)>
6110 <RESTL OBJ4 1 = TEMP38 (TYPE LIST)>
6112 <CHTYPE TEMP38 <TYPE-CODE LIST> = TEMP38>
6116 <EMPL? TEMP38 + MAPAP32>
6117 <NTHL TEMP38 1 = O39>
6122 <CALL '
\1aPCOMP 2 = O39>
6123 <CONS O39 () = O39 (TYPE LIST)>
6124 <EMPL? TEMP8 - TAG42>
6125 <SET TEMP8 O39 (TYPE LIST)>
6128 <PUTREST TEMP34 O39>
6131 <SET TEMP34 O39 (TYPE LIST)>
6133 <RESTL TEMP38 1 = TEMP38 (TYPE LIST)>
6136 <PUTUV TT6 5 TEMP8 (TYPE LIST)>
6142 <GFCN
\1aP-APPLY ("VALUE" NODE FORM ANY) OBJ4 AP5>
6143 <TEMP PAP10 ITM7 TEMP22 TEMP21 TT6:NODE>
6145 <RESTL OBJ4 1 = PAP10 (TYPE LIST)>
6146 <CHTYPE PAP10 <TYPE-CODE LIST> = PAP10>
6147 <EMPL? PAP10 + PHRASE12 (TYPE LIST)>
6149 <RESTL OBJ4 1 = PAP10 (TYPE LIST)>
6150 <NTHL PAP10 1 = ITM7>
6152 <TYPE? ITM7 <TYPE-CODE SEGMENT> - PHRASE12>
6153 <EMPL? ITM7 + PHRASE16>
6154 <RESTL ITM7 1 = PAP10 (TYPE LIST)>
6155 <EMPL? PAP10 + PHRASE16>
6156 <RESTL PAP10 1 = PAP10 (TYPE LIST)>
6157 <EMPL? PAP10 - PHRASE16>
6159 <NTHL ITM7 1 = PAP10>
6160 <EQUAL? PAP10 'GVAL + BOOL18>
6161 <EQUAL? PAP10 'LVAL - PHRASE16>
6167 <CALL '
\1aFORM 2 = PAP10>
6168 <CONS PAP10 () = PAP10>
6169 <CONS ITM7 () = ITM7>
6170 <CONS 'REST ITM7 = ITM7>
6171 <CHTYPE ITM7 <TYPE-CODE SEGMENT> = ITM7>
6172 <CONS ITM7 () = ITM7>
6173 <PUTREST PAP10 ITM7>
6174 <RESTL OBJ4 1 = TEMP22 (TYPE LIST)>
6176 <RESTL TEMP22 1 = TEMP21 (TYPE LIST)>
6178 <CHTYPE TEMP21 <TYPE-CODE LIST> = TEMP21>
6179 <PUTREST ITM7 TEMP21>
6181 <CHTYPE PAP10 <TYPE-CODE FORM> = OBJ4>
6188 <FRAME '
\1aMAKE-TAG>
6190 <CALL '
\1aMAKE-TAG 1 = PAP10>
6191 <CONS PAP10 () = TEMP21>
6192 <CONS ITM7 () = TEMP22>
6194 <PUTREST TEMP21 TEMP22>
6196 <CONS TEMP21 () = STACK>
6198 <CONS 'APPLY () = TEMP21>
6204 <CALL '
\1aFORM 2 = STACK>
6205 <CALL '
\1aFORM 2 = TEMP22>
6206 <CONS TEMP22 () = TEMP22>
6207 <PUTREST TEMP21 TEMP22>
6208 <CONS 'REST () = ITM7>
6213 <CALL '
\1aFORM 2 = PAP10>
6214 <CONS PAP10 () = PAP10>
6215 <PUTREST ITM7 PAP10>
6217 <CHTYPE ITM7 <TYPE-CODE SEGMENT> = ITM7>
6218 <CONS ITM7 () = ITM7>
6219 <PUTREST TEMP22 ITM7>
6221 <RESTL OBJ4 1 = PAP10 (TYPE LIST)>
6223 <RESTL PAP10 1 = TEMP22 (TYPE LIST)>
6225 <CHTYPE TEMP22 <TYPE-CODE LIST> = TEMP22>
6226 <PUTREST ITM7 TEMP22>
6228 <CHTYPE TEMP21 <TYPE-CODE FORM> = STACK>
6230 <CALL '
\1aFORM 3 = STACK>
6231 <GEN-LVAL 'PARENT = STACK>
6232 <CALL '
\1aPCOMP 2 = PAP10>
6236 <RESTL OBJ4 1 = ITM7 (TYPE LIST)>
6238 <CHTYPE ITM7 <TYPE-CODE LIST> = ITM7>
6239 <CHTYPE ITM7 <TYPE-CODE FORM> = OBJ4>
6244 <GEN-LVAL 'PARENT = STACK>
6250 <CALL '
\1aNODEFM 6 = TT6>
6251 <SET ITM7 () (TYPE LIST)>
6252 <SET PAP10 () (TYPE LIST)>
6253 <CHTYPE OBJ4 <TYPE-CODE LIST> = TEMP22>
6258 <EMPL? TEMP22 + MAPAP41>
6259 <NTHL TEMP22 1 = TEMP21>
6264 <CALL '
\1aPCOMP 2 = TEMP21>
6265 <CONS TEMP21 () = TEMP21 (TYPE LIST)>
6266 <EMPL? ITM7 - TAG49>
6267 <SET ITM7 TEMP21 (TYPE LIST)>
6270 <PUTREST PAP10 TEMP21>
6273 <SET PAP10 TEMP21 (TYPE LIST)>
6275 <RESTL TEMP22 1 = TEMP22 (TYPE LIST)>
6278 <PUTUV TT6 5 ITM7 (TYPE LIST)>
6283 <COND (<GASSIGNED? P-CALL> <PUTPROP `CALL PAPPLY-OBJECT ,P-CALL>)>
6286 <GFCN
\1aPRINT-HACKERS ("VALUE" NODE FORM ANY) OBJ4 AP5>
6289 <NTHL OBJ4 1 = TEMP9>
6290 <EQUAL? TEMP9 'CRLF - PHRASE8>
6292 <SET TEMP9 1 (TYPE FIX)>
6295 <SET TEMP9 2 (TYPE FIX)>
6299 <LENL OBJ4 = TEMP9 (TYPE FIX)>
6300 <VEQUAL? LEN6 TEMP9 - PHRASE18 (TYPE FIX)>
6302 <VEQUAL? LEN6 1 - PHRASE14 (TYPE FIX)>
6304 <CONS .OUTCHAN () = TEMP9>
6305 <NTHL OBJ4 1 = LEN6>
6307 <CONS LEN6 TEMP9 = TEMP9>
6309 <CHTYPE TEMP9 <TYPE-CODE FORM> = OBJ4>
6313 <CONS .OUTCHAN () = TEMP9>
6314 <RESTL OBJ4 1 = LEN6 (TYPE LIST)>
6315 <NTHL LEN6 1 = LEN6>
6316 <CONS LEN6 TEMP9 = TEMP9>
6318 <NTHL OBJ4 1 = LEN6>
6320 <CONS LEN6 TEMP9 = TEMP9>
6322 <CHTYPE TEMP9 <TYPE-CODE FORM> = OBJ4>
6325 <FRAME '
\1aRSUBR-FCN>
6330 <CALL '
\1aRSUBR-FCN 2 = TEMP9>
6333 <END
\1aPRINT-HACKERS>
6334 <COND (<GASSIGNED? PRINT-HACKERS> <PUTPROP ,PRINT PAPPLY-OBJECT ,PRINT-HACKERS> <PUTPROP ,PRIN1 PAPPLY-OBJECT ,PRINT-HACKERS> <PUTPROP ,PRINC PAPPLY-OBJECT ,PRINT-HACKERS> <PUTPROP ,CRLF PAPPLY-OBJECT ,PRINT-HACKERS>)>
6337 <GFCN
\1aP-MULTI-SET ("VALUE" NODE FORM ANY) OBJ4 AP5>
6338 <TEMP TEMP9 TT6:NODE TEMP15:LIST X30 TEMP48 TEMP47:LIST>
6342 <GEN-LVAL 'PARENT = STACK>
6346 <GVAL 'MULTI-SET = STACK>
6347 <CALL '
\1aNODEFM 6 = TT6>
6348 <EMPL? OBJ4 + TAG14>
6349 <RESTL OBJ4 1 = TEMP15 (TYPE LIST)>
6350 <EMPL? TEMP15 - PHRASE13>
6353 <FRAME '
\1aCOMPILE-ERROR>
6354 <PUSH "Too few args to MULTI-SET: ">
6356 <CALL '
\1aCOMPILE-ERROR 2>
6358 <RESTL OBJ4 1 = TEMP15 (TYPE LIST)>
6359 <NTHL TEMP15 1 = TEMP9>
6361 <TYPE? TEMP9 <TYPE-CODE LIST> - MAPAP24>
6362 <EMPL? TEMP9 + MAPAP24 (TYPE LIST)>
6363 <SET TEMP15 TEMP9 (TYPE LIST)>
6367 <EMPL? TEMP15 + PHRASE18>
6368 <NTHL TEMP15 1 = X30>
6369 <TYPE? X30 <TYPE-CODE ATOM> + PHRASE32>
6370 <TYPE? X30 <TYPE-CODE ADECL> - MAPAP24>
6372 <TYPE? X30 <TYPE-CODE ATOM> - MAPAP24>
6375 <RESTL TEMP15 1 = TEMP15 (TYPE LIST)>
6378 <FRAME '
\1aCOMPILE-ERROR>
6379 <PUSH "Arg wrong type to MULTI-SET: ">
6381 <CALL '
\1aCOMPILE-ERROR 2>
6388 <CALL '
\1aFORM 2 = STACK>
6390 <CALL '
\1aPCOMP 2 = TEMP9>
6391 <CONS TEMP9 () = TEMP15>
6393 <SET TEMP9 () (TYPE LIST)>
6394 <SET X30 () (TYPE LIST)>
6395 <RESTL OBJ4 1 = TEMP48 (TYPE LIST)>
6397 <RESTL TEMP48 1 = TEMP47 (TYPE LIST)>
6399 <CHTYPE TEMP47 <TYPE-CODE LIST> = TEMP47>
6403 <EMPL? TEMP47 + MAPAP43>
6404 <NTHL TEMP47 1 = TEMP48>
6409 <CALL '
\1aPCOMP 2 = TEMP48>
6410 <CONS TEMP48 () = TEMP48 (TYPE LIST)>
6411 <EMPL? TEMP9 - TAG51>
6412 <SET TEMP9 TEMP48 (TYPE LIST)>
6415 <PUTREST X30 TEMP48>
6418 <SET X30 TEMP48 (TYPE LIST)>
6420 <RESTL TEMP47 1 = TEMP47 (TYPE LIST)>
6423 <PUTREST TEMP15 TEMP9>
6425 <PUTUV TT6 5 TEMP15 (TYPE LIST)>
6429 <END
\1aP-MULTI-SET>
6430 <COND (<AND <GASSIGNED? MULTI-SET> <GASSIGNED? P-MULTI-SET>> <PUTPROP ,MULTI-SET PAPPLY-OBJECT ,P-MULTI-SET>)>
6433 <GFCN
\1aPIFSYS ("VALUE" ANY <OR FORM LIST> ANY) OBJ4 AP5>
6434 <TEMP TEMP11 STUFF17:LIST L6 SYS7 TEMP39 TEMP40 TEMP41 TEMP42>
6436 <GEN-ASSIGNED? 'IN-IFSYS - PHRASE9>
6437 <GEN-LVAL 'IN-IFSYS = TEMP11>
6438 <TYPE? TEMP11 <TYPE-CODE FALSE> + PHRASE9>
6440 <SET STUFF17 () (TYPE LIST)>
6444 <RESTL OBJ4 1 = OBJ4 (TYPE LIST)>
6445 <CHTYPE OBJ4 <TYPE-CODE LIST> = OBJ4>
6446 <EMPL? OBJ4 - PHRASE20 (TYPE LIST)>
6447 <EMPL? STUFF17 - PHRASE22 (TYPE LIST)>
6448 <FRAME '
\1aPDEFAULT>
6450 <CALL '
\1aPDEFAULT 1 = TEMP11>
6454 <FRAME '
\1aPPROG-REPEAT>
6455 <CONS () STUFF17 = TEMP11>
6457 <CONS 'BIND TEMP11 = TEMP11>
6458 <CHTYPE TEMP11 <TYPE-CODE FORM> = STACK>
6461 <CALL '
\1aPPROG-REPEAT 2 = TEMP11>
6466 <TYPE? L6 <TYPE-CODE LIST> - BOOL28>
6467 <EMPL? L6 + BOOL28 (TYPE LIST)>
6469 <TYPE? SYS7 <TYPE-CODE STRING> + PHRASE27>
6470 <TYPE? SYS7 <TYPE-CODE ATOM> + PHRASE27>
6473 <PUSH 'ARG-WRONG-TYPE>
6474 <NTHL OBJ4 1 = STACK>
6479 <TYPE? SYS7 <TYPE-CODE ATOM> - PHRASE32>
6480 <NTHR SYS7 3 = SYS7 (RECORD-TYPE ATOM)>
6482 <GEN-LVAL 'IN-IFSYS = TEMP11>
6483 <TYPE? TEMP11 <TYPE-CODE STRING> - TAG36>
6484 <IFCAN "STRING-EQUAL?">
6485 <STRING-EQUAL? SYS7 TEMP11 + BOOL35>
6486 <ENDIF "STRING-EQUAL?">
6487 <IFCANNOT "STRING-EQUAL?">
6489 <LENUS TEMP39 = TEMP40 (TYPE FIX)>
6490 <LENUS TEMP11 = TEMP41 (TYPE FIX)>
6491 <VEQUAL? TEMP40 TEMP41 - TAG36>
6493 <LOOP (TEMP39 VALUE LENGTH) (TEMP11 VALUE LENGTH) (TEMP40 VALUE)>
6495 <NTHUS TEMP39 1 = TEMP41>
6496 <NTHUS TEMP11 1 = TEMP42>
6497 <VEQUAL? TEMP41 TEMP42 - TAG36>
6498 <DEAD TEMP41 TEMP42>
6499 <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6500 <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6501 <SUB TEMP40 1 = TEMP40 (TYPE FIX)>
6502 <GRTR? TEMP40 0 + TAG43 (TYPE FIX)>
6504 <ENDIF "STRING-EQUAL?">
6506 <IFCAN "STRING-EQUAL?">
6507 <STRING-EQUAL? SYS7 "UNIX" - TAG53>
6508 <ENDIF "STRING-EQUAL?">
6509 <IFCANNOT "STRING-EQUAL?">
6511 <SET TEMP39 "UNIX" (TYPE STRING)>
6512 <LENUS TEMP11 = TEMP42 (TYPE FIX)>
6513 <VEQUAL? TEMP42 4 - TAG53>
6514 <LOOP (TEMP11 VALUE LENGTH) (TEMP39 VALUE LENGTH) (TEMP42 VALUE)>
6516 <NTHUS TEMP11 1 = TEMP41>
6517 <NTHUS TEMP39 1 = TEMP40>
6518 <VEQUAL? TEMP41 TEMP40 - TAG53>
6519 <DEAD TEMP41 TEMP40>
6520 <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6521 <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6522 <SUB TEMP42 1 = TEMP42 (TYPE FIX)>
6523 <GRTR? TEMP42 0 + TAG46 (TYPE FIX)>
6524 <ENDIF "STRING-EQUAL?">
6525 <GEN-LVAL 'IN-IFSYS = TEMP39>
6526 <TYPE? TEMP39 <TYPE-CODE STRING> - TAG48>
6527 <IFCAN "STRING-EQUAL?">
6528 <STRING-EQUAL? TEMP39 "VAX" + BOOL35>
6529 <ENDIF "STRING-EQUAL?">
6530 <IFCANNOT "STRING-EQUAL?">
6531 <SET TEMP11 "VAX" (TYPE STRING)>
6532 <LENUS TEMP39 = TEMP40 (TYPE FIX)>
6533 <VEQUAL? TEMP40 3 - TAG48>
6534 <LOOP (TEMP39 VALUE LENGTH) (TEMP11 VALUE LENGTH) (TEMP40 VALUE)>
6536 <NTHUS TEMP39 1 = TEMP41>
6537 <NTHUS TEMP11 1 = TEMP42>
6538 <VEQUAL? TEMP41 TEMP42 - TAG48>
6539 <DEAD TEMP41 TEMP42>
6540 <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6541 <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6542 <SUB TEMP40 1 = TEMP40 (TYPE FIX)>
6543 <GRTR? TEMP40 0 + TAG52 (TYPE FIX)>
6545 <ENDIF "STRING-EQUAL?">
6547 <GEN-LVAL 'IN-IFSYS = TEMP11>
6548 <TYPE? TEMP11 <TYPE-CODE STRING> - TAG53>
6549 <IFCAN "STRING-EQUAL?">
6550 <STRING-EQUAL? TEMP11 "MAC" + BOOL35>
6551 <ENDIF "STRING-EQUAL?">
6552 <IFCANNOT "STRING-EQUAL?">
6553 <SET TEMP39 "MAC" (TYPE STRING)>
6554 <LENUS TEMP11 = TEMP42 (TYPE FIX)>
6555 <VEQUAL? TEMP42 3 - TAG53>
6556 <LOOP (TEMP11 VALUE LENGTH) (TEMP39 VALUE LENGTH) (TEMP42 VALUE)>
6558 <NTHUS TEMP11 1 = TEMP41>
6559 <NTHUS TEMP39 1 = TEMP40>
6560 <VEQUAL? TEMP41 TEMP40 - TAG53>
6561 <DEAD TEMP41 TEMP40>
6562 <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6563 <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6564 <SUB TEMP42 1 = TEMP42 (TYPE FIX)>
6565 <GRTR? TEMP42 0 + TAG57 (TYPE FIX)>
6567 <ENDIF "STRING-EQUAL?">
6569 <IFCAN "STRING-EQUAL?">
6570 <STRING-EQUAL? SYS7 "VAX" + BOOL59>
6571 <ENDIF "STRING-EQUAL?">
6572 <IFCANNOT "STRING-EQUAL?">
6574 <SET TEMP11 "VAX" (TYPE STRING)>
6575 <LENUS TEMP39 = TEMP40 (TYPE FIX)>
6576 <VEQUAL? TEMP40 3 - TAG60>
6577 <LOOP (TEMP39 VALUE LENGTH) (TEMP11 VALUE LENGTH) (TEMP40 VALUE)>
6579 <NTHUS TEMP39 1 = TEMP41>
6580 <NTHUS TEMP11 1 = TEMP42>
6581 <VEQUAL? TEMP41 TEMP42 - TAG60>
6582 <DEAD TEMP41 TEMP42>
6583 <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6584 <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6585 <SUB TEMP40 1 = TEMP40 (TYPE FIX)>
6586 <GRTR? TEMP40 0 + TAG62 (TYPE FIX)>
6588 <ENDIF "STRING-EQUAL?">
6590 <IFCAN "STRING-EQUAL?">
6591 <STRING-EQUAL? SYS7 "MAC" - AGAIN18>
6592 <ENDIF "STRING-EQUAL?">
6593 <IFCANNOT "STRING-EQUAL?">
6596 <SET TEMP39 "MAC" (TYPE STRING)>
6597 <LENUS TEMP11 = TEMP42 (TYPE FIX)>
6598 <VEQUAL? TEMP42 3 - AGAIN18>
6599 <LOOP (TEMP11 VALUE LENGTH) (TEMP39 VALUE LENGTH) (TEMP42 VALUE)>
6601 <NTHUS TEMP11 1 = TEMP41>
6602 <NTHUS TEMP39 1 = SYS7>
6603 <VEQUAL? TEMP41 SYS7 - AGAIN18>
6605 <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6606 <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6607 <SUB TEMP42 1 = TEMP42 (TYPE FIX)>
6608 <GRTR? TEMP42 0 + TAG64 (TYPE FIX)>
6609 <ENDIF "STRING-EQUAL?">
6611 <GEN-LVAL 'IN-IFSYS = TEMP39>
6612 <TYPE? TEMP39 <TYPE-CODE STRING> - AGAIN18>
6613 <IFCAN "STRING-EQUAL?">
6614 <STRING-EQUAL? TEMP39 "UNIX" - AGAIN18>
6615 <ENDIF "STRING-EQUAL?">
6616 <IFCANNOT "STRING-EQUAL?">
6617 <SET TEMP11 "UNIX" (TYPE STRING)>
6618 <LENUS TEMP39 = SYS7 (TYPE FIX)>
6619 <VEQUAL? SYS7 4 - AGAIN18>
6620 <LOOP (TEMP39 VALUE LENGTH) (TEMP11 VALUE LENGTH) (SYS7 VALUE)>
6622 <NTHUS TEMP39 1 = TEMP41>
6623 <NTHUS TEMP11 1 = TEMP40>
6624 <VEQUAL? TEMP41 TEMP40 - AGAIN18>
6625 <DEAD TEMP41 TEMP40>
6626 <RESTUS TEMP39 1 = TEMP39 (TYPE STRING)>
6627 <RESTUS TEMP11 1 = TEMP11 (TYPE STRING)>
6628 <SUB SYS7 1 = SYS7 (TYPE FIX)>
6629 <GRTR? SYS7 0 + TAG68 (TYPE FIX)>
6630 <ENDIF "STRING-EQUAL?">
6632 <RESTL L6 1 = TEMP11 (TYPE LIST)>
6634 <SET TEMP39 STUFF17>
6635 <EMPL? TEMP11 + TAG70>
6636 <NTHL TEMP11 1 = TEMP40>
6637 <CONS TEMP40 STUFF17 = TEMP40>
6639 <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
6640 <EMPL? TEMP11 + TAG70>
6641 <LOOP (TEMP11 VALUE) (TEMP40 VALUE) (STUFF17 VALUE)>
6643 <NTHL TEMP11 1 = TEMP41>
6644 <CONS TEMP41 STUFF17 = TEMP41>
6645 <PUTREST TEMP40 TEMP41>
6649 <RESTL TEMP11 1 = TEMP11 (TYPE LIST)>
6650 <EMPL? TEMP11 - TAG69>
6652 <SET STUFF17 TEMP39>
6657 <RESTL OBJ4 1 = TEMP39 (TYPE LIST)>
6659 <CHTYPE TEMP39 <TYPE-CODE LIST> = TEMP39>
6660 <CONS 'IFSYS-MIMC TEMP39 = TEMP39>
6661 <CHTYPE TEMP39 <TYPE-CODE FORM> = STACK>
6665 <CALL '
\1aPMACRO 2 = TEMP11>
6669 <COND (<AND <GASSIGNED? IFSYS> <GASSIGNED? PIFSYS>> <PUTPROP ,IFSYS PAPPLY-OBJECT ,PIFSYS>)>
6672 <GFCN
\1aIFSYS-MIMC ("VALUE" FORM "ARGS" LIST) ARGS6>
6673 <OPT-DISPATCH 0 %<> OPT4 OPT5>
6677 <TEMP (STUFF7:LIST ()) L10 TEMP17 TEMP26 TEMP27 TEMP28>
6682 <EMPL? ARGS6 + EXIT8 (TYPE LIST)>
6683 <NTHL ARGS6 1 = L10>
6684 <TYPE? L10 <TYPE-CODE LIST> - BOOL16>
6685 <EMPL? L10 + BOOL16 (TYPE LIST)>
6686 <NTHL L10 1 = TEMP17>
6687 <TYPE? TEMP17 <TYPE-CODE STRING> + PHRASE15>
6688 <TYPE? TEMP17 <TYPE-CODE ATOM> + PHRASE15>
6692 <PUSH 'ARG-WRONG-TYPE>
6693 <NTHL ARGS6 1 = STACK>
6698 <NTHL L10 1 = TEMP17>
6699 <TYPE? TEMP17 <TYPE-CODE ATOM> - PHRASE21>
6701 <NTHL L10 1 = TEMP17 (TYPE ATOM)>
6702 <NTHR TEMP17 3 = TEMP17 (RECORD-TYPE ATOM)>
6709 <NTHL L10 1 = STACK (TYPE STRING)>
6710 <CALL '
\1aFORM 3 = TEMP17>
6711 <CONS TEMP17 () = TEMP17>
6712 <RESTL L10 1 = TEMP26 (TYPE LIST)>
6714 <EMPL? TEMP26 + TAG25>
6715 <LOOP (TEMP26 VALUE) (TEMP27 VALUE)>
6717 <NTHL TEMP26 1 = TEMP28>
6718 <CONS TEMP28 () = TEMP28>
6719 <PUTREST TEMP27 TEMP28>
6723 <RESTL TEMP26 1 = TEMP26 (TYPE LIST)>
6724 <EMPL? TEMP26 - TAG24>
6729 <NTHL L10 1 = STACK>
6731 <CALL '
\1aFORM 3 = TEMP26>
6732 <CONS TEMP26 () = TEMP26>
6733 <PUTREST TEMP27 TEMP26>
6735 <PUTREST TEMP26 STUFF7>
6736 <DEAD TEMP26 STUFF7>
6740 <RESTL ARGS6 1 = ARGS6 (TYPE LIST)>
6743 <CONS () STUFF7 = TEMP26>
6745 <CONS 'BIND TEMP26 = TEMP26>
6746 <CHTYPE TEMP26 <TYPE-CODE FORM> = TEMP26>
6749 <END
\1aIFSYS-MIMC><COND (<AND <GASSIGNED? IFSYS-MIMC> <NOT <TYPE? ,IFSYS-MIMC MACRO>>> <SETG IFSYS-MIMC <CHTYPE (,IFSYS-MIMC) MACRO>>)>