3 <ENTRY MAPFR-GEN MAPRET-STOP-GEN MAPLEAVE-GEN NOTIMP MBINDERS MPARGS-GEN
6 <USE "CODGEN" "CACS" "COMCOD" "COMPDEC" "CHKDCL" "CARGEN" "CUP" "NEWREP" "CARGEN">
9 " Definitions of offsets into MAPINFO vector used by MAP hackers inferiors."
35 <MANIFEST MAP-FR MAP-TAG MAP-STK MAP-STOF MAP-OFF MAP-TGL MAP-STSTR MAP-STKFX MAP-POFF
39 <DEFINE MAPFR-GEN (NOD WHERE "AUX" (K <KIDS .NOD>) (COD <NODE-TYPE <2 .K>>))
40 #DECL ((NOD) NODE (COD) FIX (K) <LIST [REST NODE]>)
42 (<==? .COD ,MFCN-CODE> <REGSTO <> <>> <HMAPFR .NOD .WHERE .K>)
45 <PROG ((FAP <1 .K>) MPINFO (INRAP <2 .K>) (W <GOODACS .NOD .WHERE>)
46 (DTEM <DATUM FIX ANY-AC>) F? FF? (MAYBE-FALSE <>) (ANY? <>)
47 (NARG <LENGTH <SET K <REST .K 2>>>) (RW .WHERE) (POFF 0)
48 (R? <==? <NODE-SUBR .NOD> ,MAPR>) (OFFS 0) (STKOFFS <>)
49 (MAPEND <ILIST .NARG '<MAKE:TAG "MAP">>) (MAPLP <MAKE:TAG "MAP">)
50 (SUBRC <AP? .FAP>) (STB .STK) STOP (STK (0 !.STK)) TT)
51 #DECL ((FAP INRAP) NODE (DTEM) DATUM (NARG POFF OFFS) FIX
52 (STKOFFS) <OR FALSE LIST> (MAPLP) ATOM (MAPEND) <LIST [REST
54 (STK) <SPECIAL LIST> (STOP STB) LIST
55 (MPINFO) <SPECIAL <VECTOR <LIST [REST NODE]>
67 <COND (<==? .WHERE FLUSHED> FLUSHED) (ELSE <GOODACS .NOD .WHERE>)>>
68 <SET F? <DO-FIRST-SETUP .FAP .WHERE <> <> <> <>>>
69 <OR .F? <SET FF? <==? <NODE-TYPE .FAP> ,MFIRST-CODE>>>
70 <SET ANY? <PUSH-STRUCS .K T <> () <>>>
73 <COND (.F? <SET MAYBE-FALSE <DO-FINAL-SETUP .FAP .SUBRC>>)>
76 <EMIT '<INTGO!-OP!-PACKAGE>>
77 <COND (<N==? .COD ,MPSBR-CODE>
78 <RET-TMP-AC <STACK:ARGUMENT <GEN .INRAP DONT-CARE>>>
80 <COND (.F? <SET STKOFFS <FIND-FIRST-STRUC .DTEM .STB <NOT .PRE>>>)>
81 <SET OFFS <- 1 <* .NARG 2>>>
93 <SET POFF <COND (.MAYBE-FALSE -2) (.F? -1) (ELSE 0)>>]>
96 (<==? .COD ,MPSBR-CODE>
98 <DO-STACK-ARGS .MAYBE-FALSE <GEN <1 <KIDS .INRAP>> DONT-CARE>>)
100 <DO-FUNNY-HACK <GEN <1 <KIDS .INRAP>> DONT-CARE>
105 (<N==? .WHERE FLUSHED>
106 <MOVE:ARG <GEN <1 <KIDS .INRAP>> .W>
107 <DATUM <SET TT <ADDRESS:C <+ -2 .OFFS> '`(TP) >>
109 (ELSE <GEN <1 <KIDS .INRAP>> FLUSHED>)>)
113 <RET-TMP-AC <STACK:ARGUMENT <MPARGS-GEN .NOD DONT-CARE>>>
114 <AND <0? <SET I <- .I 1>>> <RETURN>>>
115 <SUBR:CALL APPLY <+ .NARG 1>>
116 <COND (.F? <DO-STACK-ARGS .MAYBE-FALSE <FUNCTION:VALUE>>)
118 <DO-FUNNY-HACK <FUNCTION:VALUE>
123 (<N==? .WHERE FLUSHED>
124 <MOVE:ARG <FUNCTION:VALUE>
125 <DATUM <SET TT <ADDRESS:C <+ -2 .OFFS> '`(TP) >>
127 <COND (<AND .F? <NOT .STKOFFS>> <RET-TMP-AC .DTEM>)>
128 <COND (.ANY? <EMIT <INSTRUCTION `SETZM .POFF '`(P) >>)>
130 <GEN-TAGS <MAP-TGL .MPINFO> <>>
134 <COND (<NOT <ISTYPE? <STRUCTYP <RESULT-TYPE .N>>>>
135 <EMIT '<`SETZM |DSTORE >>
138 <COND (.F? <SET WHERE <DO-LAST .SUBRC .MAYBE-FALSE .WHERE>>)
139 (.FF? <SET WHERE <DO-FUNNY-LAST .FAP <- .OFFS 2> .WHERE>>)
140 (<N==? .WHERE FLUSHED>
142 <MOVE:ARG <DATUM <SET TT <ADDRESS:C <+ -2 .OFFS> '`(TP) >>
145 <POP:LOCS .STOP .STB>
147 <MOVE:ARG .WHERE .RW>>)>>
151 <DEFINE PUSH-STRUCS (K SM ACS BST NONO "AUX" (NL <>) S TEM TT NEW)
152 #DECL ((K) <LIST [REST NODE]> (BST) <LIST [REST SYMTAB]> (S) SYMTAB)
154 <FUNCTION (N "AUX" (RT <RESULT-TYPE .N>))
159 <COND (<SET TT <ISTYPE-GOOD? .RT>> <DATUM .TT ANY-AC>)
160 (ELSE <DATUM ANY-AC ANY-AC>)>>>
162 <RET-TMP-AC <DATTYP .TEM> .TEM>
163 <PUT .TEM ,DATTYP .TT>)>
164 <COND (<TYPE? .NONO DATUM>
165 <COND (<OR <==? <DATVAL .NONO> <DATTYP .TEM>>
166 <==? <DATTYP .NONO> <DATTYP .TEM>>>
167 <SET NEW <DATUM <GETREG <>> <DATVAL .TEM>>>
168 <PUT <DATTYP .NEW> ,ACPROT T>)>
169 <COND (<OR <==? <DATVAL .NONO> <DATVAL .TEM>>
170 <==? <DATTYP .NONO> <DATVAL .TEM>>>
171 <COND (<ASSIGNED? NEW>
172 <PUT .NEW ,DATVAL <GETREG <>>>
173 <PUT <DATTYP .NEW> ,ACPROT <>>)
176 <DATUM <DATTYP .TEM> <GETREG <>>>>)>)>
177 <SET TEM <MOVE:ARG .TEM .NEW>>)>
178 <MUNG-AC <DATVAL .TEM>>
180 <COND (<TYPE? <ADDR-SYM .S> TEMPV>
181 <SET TT <CREATE-TMP .TT>>
186 <COND (<=? .AC-HACK '(FUNNY-STACK)>
187 <* <TOTARGS .FCN> -2>)
193 <COND (<TYPE? <SET TT <DATTYP .TEM>> AC>
194 <PUT .TT ,ACRESIDUE (.S !<ACRESIDUE .TT>)>)>
195 <PUT <SET TT <DATVAL .TEM>> ,ACRESIDUE (.S !<ACRESIDUE .TT>)>
197 <SET BST <REST .BST>>)
199 <RET-TMP-AC <STACK:ARGUMENT <GEN .N DONT-CARE>>>
200 <AND .SM <ADD:STACK 2>>)>
201 <COND (<AND <SET RT <STRUCTYP .RT>>
203 <OR <==? .RT LIST> <==? .RT TEMPLATE>>>
205 (<NOT .RT> <SET NL T>)>>
207 <COND (.NL <EMIT '<`PUSH `P* [-1]>> <AND .SM <ADD:STACK PSLOT>>)>
210 <DEFINE KEEP-IN-ACS (BST K R? "AUX" D S PTYP)
211 #DECL ((BST) <LIST [REST SYMTAB]> (K) <LIST [REST NODE]>)
214 "AUX" (D <INACS .S>) (PTYP <STRUCTYP <RESULT-TYPE .N>>) A1 A)
215 #DECL ((S) SYMTAB (D) <OR DATUM FALSE> (N) NODE (A) AC)
216 <COND (<N==? <NAME-SYM .S> DUMMY-MAPF> <MAPLEAVE>)>
218 <OR .R? <AND <N==? .PTYP STRING> <N==? .PTYP BYTES>>>>
220 <MOVE:ARG <LADDR .S <> <>>
221 <DATUM <COND (<OR <==? .PTYP STRING>
226 <PUT .S ,INACS <DATUM <DATTYP .D> <DATVAL .D>>>
227 <PUT <SET A <DATVAL .D>> ,ACRESIDUE (.S !<ACRESIDUE .A>)>
228 <COND (<TYPE? <SET A1 <DATTYP .D>> AC>
229 <PUT .A1 ,ACRESIDUE (.S !<ACRESIDUE .A1>)>)>
236 <DEFINE REST-STRUCS (BST K LV NR TG R? "AUX" DAT PTYP (CNT 0) TEM ACFLG)
237 #DECL ((BST) <LIST [REST SYMTAB]> (K) <LIST [REST NODE]> (CNT) FIX
240 #DECL ((BST) <LIST [REST SYMTAB]>)
241 <COND (<OR <EMPTY? .BST> <N==? <NAME-SYM <1 .BST>> DUMMY-MAPF>> <RETURN>)>
243 <SET PTYP <STRUCTYP <RESULT-TYPE <1 .K>>>>
244 <COND (<SET TEM <MEMQ <1 .BST> .LV>> <SET DAT <2 .TEM>>)
245 (ELSE <SET DAT <LADDR <1 .BST> <> <>>>)>
246 <COND (<TYPE? <DATVAL .DAT> AC> <SET ACFLG T>) (ELSE <SET ACFLG <>>)>
250 <EMIT <INSTRUCTION `HRRZ
251 <ACSYM <DATVAL .DAT>>
252 (<ADDRSYM <DATVAL .DAT>>)>>
254 <EMIT <INSTRUCTION `JUMPN <ACSYM <DATVAL .DAT>> .TG>>)>)
256 <EMIT <INSTRUCTION `HRRZ `@ !<ADDR:VALUE .DAT>>>
257 <EMIT <INSTRUCTION `MOVEM !<ADDR:VALUE .DAT>>>
258 <COND (<1? .NR> <EMIT <INSTRUCTION `JUMPN .TG>>)>)>)
259 (<OR <==? .PTYP VECTOR> <==? .PTYP TUPLE>>
261 <EMIT <INSTRUCTION `ADD <ACSYM <DATVAL .DAT>> '[<2 (2)>]>>
263 <EMIT <INSTRUCTION `JUMPL <ACSYM <DATVAL .DAT>> .TG>>)>)
265 <EMIT '<`MOVE [<2 (2)>]>>
266 <EMIT <INSTRUCTION `ADDB !<ADDR:VALUE .DAT>>>
267 <COND (<1? .NR> <EMIT <INSTRUCTION `JUMPL .TG>>)>)>)
268 (<OR <==? .PTYP UVECTOR> <==? .PTYP STORAGE>>
271 <EMIT <INSTRUCTION `AOBJN <ACSYM <DATVAL .DAT>> .TG>>)
272 (<EMIT <INSTRUCTION `ADD
273 <ACSYM <DATVAL .DAT>>
276 <EMIT '<`MOVE [<1 (1)>]>>
277 <EMIT <INSTRUCTION `ADDB !<ADDR:VALUE .DAT>>>
278 <COND (<1? .NR> <EMIT <INSTRUCTION `JUMPL .TG>>)>)>)
279 (<OR <==? .PTYP STRING> <==? .PTYP BYTES>>
281 <EMIT <INSTRUCTION `IBP !<ADDR:VALUE .DAT>>>
282 <EMIT <INSTRUCTION `SOS !<ADDR:TYPE .DAT>>>)>
284 <COND (<TYPE? <DATTYP .DAT> AC>
285 <EMIT <INSTRUCTION `TRNE <ACSYM <DATTYP .DAT>> -1>>
288 <EMIT <INSTRUCTION `HRRZ `O* !<ADDR:TYPE .DAT>>>
289 <EMIT <INSTRUCTION `JUMPN `O* .TG>>)>)>)>
290 <SET BST <REST .BST>>
293 <COND (<L? <SET CNT <- .CNT 1>> 0> <RETURN>)>
294 <PUT <1 .BST> ,STORED T>
295 <PUT <1 .BST> ,INACS <>>
296 <SET BST <REST .BST>>>>
298 <DEFINE FIND-FIRST-STRUC (DTEM STB FL "AUX" DAC (STKOFFS <>))
299 #DECL ((DTEM) DATUM (DAC) AC (STB) LIST)
300 <COND (<AND .FL <SET STKOFFS <STACK:L .STB <2 .FRMS>>>>)
302 <MOVE:ARG <REFERENCE 524290> .DTEM>
303 <PUT .DTEM ,DATTYP <ADDRESS:PAIR |$TTP >>
304 <EMIT <INSTRUCTION `IMUL
305 <ACSYM <SET DAC <DATVAL .DTEM>>>
307 <EMIT <INSTRUCTION `SUBM `TP* <ADDRSYM .DAC>>>)>
310 <DEFINE DO-FINAL-SETUP (FAP SUBRC "AUX" (MAYBE-FALSE <>))
313 <RET-TMP-AC <STACK:ARGUMENT <GEN .FAP DONT-CARE>>>)>
314 <COND (<AND <NOT .SUBRC>
315 <OR <NOT .REASONABLE> <N==? <NODE-TYPE .FAP> ,GVAL-CODE>>
316 <SET MAYBE-FALSE <TYPE-OK? <RESULT-TYPE .FAP> FALSE>>>
317 <EMIT '<`PUSH `P* [0]>>
320 <EMIT '<GETYP!-OP!-PACKAGE `O* -1 `(TP) >>
321 <EMIT '<`CAIN `O* <TYPE-CODE!-OP!-PACKAGE FALSE>>>
322 <EMIT '<`SETOM -1 `(P) >>)
323 (ELSE <PCOUNTER <COND (.SUBRC 0) (ELSE 1)>>)>
327 <DEFINE DO-STACK-ARGS (MAYBE-FALSE DAT "AUX" TT (T1 <MAKE:TAG>) (T2
329 #DECL ((DAT) DATUM (T1 T2) ATOM)
331 (<N==? .DAT ,NO-DATUM>
333 <SET DAT <MOVE:ARG .DAT <DATUM ANY-AC ANY-AC>>>
334 <EMIT '<`SKIPGE -1 `(P) >>
336 <STACK:ARGUMENT .DAT>
340 <RET-TMP-AC <MOVE:ARG .DAT
341 <DATUM <SET TT <ADDRESS:C -1 '`(TP) >> .TT>>>
343 (<RET-TMP-AC <STACK:ARGUMENT .DAT>> <COUNTP>)>)>>
347 <DEFINE DO-FUNNY-LAST (N OFFS W "AUX" TT TYP)
348 #DECL ((N) NODE (OFFS) FIX)
349 <COND (<==? <NODE-SUBR .N> 5> <SET OFFS <- .OFFS 2>>)>
350 <SET TYP <ISTYPE-GOOD? <RESULT-TYPE <PARENT .N>>>>
351 <SET TT <ADDRESS:C .OFFS '`(TP) >>
352 <MOVE:ARG <DATUM <COND (.TYP .TYP) (ELSE .TT)> .TT> .W>>
355 '![![`CAMGE `CAMLE `IMULM `ADDM !]
356 ![`CAMGE `CAMLE `FMPRM `FADRM !]!]>
358 <DEFINE DO-FUNNY-HACK (DAT OFFS N FAP NN
359 "AUX" (COD <NODE-SUBR .FAP>) (LMOD <RESULT-TYPE .NN>)
360 (MOD <RESULT-TYPE .N>) ACSY)
361 #DECL ((OFFS) <LIST FIX LIST> (DAT) DATUM (COD) FIX (N FAP NN) NODE)
363 <RET-TMP-AC <MOVE:ARG .DAT <DATUM ,AC-C ,AC-D>>>
365 <EMIT '<`MOVEI `E* 0>>
366 <EMIT '<`PUSHJ `P* |CICONS >>
367 <EMIT <INSTRUCTION `SKIPE <1 .OFFS> !<2 .OFFS> '`(TP) >>
368 <EMIT <INSTRUCTION `HRRM
374 <EMIT <INSTRUCTION `MOVEM `B* <1 .OFFS> !<2 .OFFS> '`(TP) >>
375 <SET OFFS <STFIXIT .OFFS '(-2)>>
376 <EMIT <INSTRUCTION `SKIPN <1 .OFFS> !<2 .OFFS> '`(TP) >>
377 <EMIT <INSTRUCTION `MOVEM `B* <1 .OFFS> !<2 .OFFS> '`(TP) >>)
379 <SET DAT <MOVE:ARG .DAT <DATUM .LMOD ANY-AC>>>
380 <SET MOD <OR <AND <==? .MOD FIX> 1> 2>>
381 <AND <==? .MOD 2> <==? .LMOD FIX> <SET DAT <GEN-FLOAT .DAT>>>
382 <SET ACSY <ACSYM <DATVAL .DAT>>>
384 <EMIT <INSTRUCTION <NTH <NTH ,MINS .MOD> .COD>
390 <EMIT <INSTRUCTION `MOVEM
397 <DEFINE DO-LAST (SUBRC MAYBE-FALSE WHERE "AUX" TG TG2)
400 <EMIT '<`POP `P* `A >>
402 <EMIT <INSTRUCTION `JUMPL `O <SET TG <MAKE:TAG>>>>
403 <COND (.SUBRC <GOOD-CALL .SUBRC>)
404 (ELSE <EMIT '<ACALL!-OP!-PACKAGE `A* APPLY>>)>
405 <BRANCH:TAG <SET TG2 <MAKE:TAG>>>
407 <EMIT '<`POP `TP* `B >>
408 <EMIT '<`POP `TP* `A >>
410 <SET WHERE <MOVE:ARG <FUNCTION:VALUE T> .WHERE>>)
412 <EMIT '<`POP `P* `A >>
413 <COND (.SUBRC <GOOD-CALL .SUBRC>)
414 (ELSE <EMIT '<ACALL!-OP!-PACKAGE `A* APPLY>>)>
415 <SET WHERE <MOVE:ARG <FUNCTION:VALUE T> .WHERE>>)>>
417 <DEFINE GOOD-CALL (SBR "AUX" TP SB)
419 <COND (<AND <GASSIGNED? .SBR>
420 <TYPE? <SET SB ,.SBR> SUBR>
421 <SET TP <GET-TMPS .SB>>
424 <EMIT <INSTRUCTION `PUSHJ `P* <6 .TP>>>)
425 (ELSE <EMIT <INSTRUCTION ACALL!-OP!-PACKAGE `A* .SBR>>)>>
427 <SETG SLOT-FIRST [<CHTYPE <MIN> FIX> <CHTYPE <MAX> FIX> 1 0]>
429 <SETG FSLOT-FIRST [<MIN> <MAX> 1.0 0.0000000]>
433 <DEFINE DO-FIRST-SETUP (FAP W ACS CHF ONES FLS
435 (TYP <ISTYPE? <RESULT-TYPE <PARENT .FAP>>>) DAT
437 #DECL ((FAP) NODE (COD) FIX)
439 (<==? <NODE-TYPE .FAP> ,MFIRST-CODE>
440 <SET COD <NODE-SUBR .FAP>>
442 <STACK:ARGUMENT <REFERENCE <COND (.TYP <CHTYPE () .TYP>)
444 <STACK:ARGUMENT <REFERENCE ()>>
449 <REFERENCE <COND (<==? .TYP FLOAT> <NTH ,FSLOT-FIRST .COD>)
450 (ELSE <NTH ,SLOT-FIRST .COD>)>>>
455 <RET-TMP-AC <STACK:ARGUMENT <REFERENCE <>>>>
461 <DEFINE DO-FIRST-SETUP-2 (FAP W ACS CHF ONES FLS
463 (TYP <ISTYPE? <RESULT-TYPE <PARENT .FAP>>>) DAT
465 #DECL ((FAP) NODE (COD) FIX (ACS) <OR FALSE SYMTAB>)
467 (<AND <NOT <NODE-NAME .FAP>> .FLS> <SET TEM <SET ACS <>>>)
468 (<==? <NODE-TYPE .FAP> ,MFIRST-CODE>
469 <SET COD <NODE-SUBR .FAP>>
470 <COND (<==? .COD 5> <SET TEM #FALSE (1)>)
473 <MOVE:ARG <REFERENCE <COND (<==? .TYP FLOAT>
474 <NTH ,FSLOT-FIRST .COD>)
475 (ELSE <NTH ,SLOT-FIRST .COD>)>>
476 <GOODACS <PARENT .FAP> .W>>>
478 (ELSE <SET TEM <>>)>)
479 (<NODE-NAME .FAP> <SET TEM T>)
480 (<AND .ACS <NOT .CHF>>
481 <SET DAT <GOODACS <PARENT .FAP> .W>>
483 <COND (<==? <SET TEM <DATTYP .DAT>> ANY-AC>
484 <PUT .DAT ,DATTYP <GETREG .DAT>>)
485 (<TYPE? .TEM AC> <SGETREG .TEM .DAT>)>
486 <COND (<==? <SET TEM <DATVAL .DAT>> ANY-AC>
487 <PUT .DAT ,DATVAL <GETREG .DAT>>)
488 (<TYPE? .TEM AC> <SGETREG .TEM .DAT>)>)>
492 <SET T1 <MOVE:ARG <REFERENCE <>> <GOODACS <PARENT .FAP> .W>>>
495 <COND (<AND .ACS <NOT .TEM> <EMPTY? .TEM>>
496 <SET TT <CREATE-TMP .TYP>>
501 <COND (<=? .AC-HACK '(FUNNY-STACK)>
502 <* <TOTARGS .FCN> -2>)
506 <COND (<OR .CHF <NOT .ONES>>
507 <PUT .ACS ,INACS .T1>
508 <PUT .ACS ,STORED <>>
509 <PUT <SET TT <DATVAL .T1>>
511 (.ACS !<ACRESIDUE .TT>)>
512 <COND (<AND <NOT .TYP> <TYPE? <DATTYP .T1> AC>>
513 <PUT <SET TT <DATTYP .T1>>
515 (.ACS !<ACRESIDUE .TT>)>)>)>
522 <DEFINE MPARGS-GEN (N W
523 "AUX" (MP .MPINFO) DAT TT ETAG
524 (STKD <STACK:L .STK <MAP-STSTR .MP>>)
525 (OFFS <FORM - <MAP-OFF .MP> !.STKD>))
527 <VECTOR <LIST [REST NODE]>
543 <COND (<NOT <MAP-STK .MP>>
544 <SET DAT <DATUM <SET TT <ADDRESS:C .OFFS '`(TP) >> .TT>>
545 <PUT .MP ,MAP-OFF <+ <MAP-OFF .MP> 2>>)
546 (<NOT <MAP-STOF .MP>>
548 <FORM + <MAP-OFF .MP> !<STACK:L .STK <MAP-STSTR .MP>>>>
550 <DATUM <SET TT <SPEC-OFFPTR 0 <MAP-SRC .MP> VECTOR (.OFFS)>>
552 <PUT .MP ,MAP-OFF <+ <MAP-OFF .MP> 2>>)
556 <ADDRESS:C !<MAP-STOF .MP>
557 <COND (.AC-HACK `(FRM) ) (`(TB) )>
558 <COND (.AC-HACK <+ <* <TOTARGS .FCN> -2> 1>)
561 <COND (<AND <MAP-STK .MP> <MAP-STOF .MP>>
562 <PUT .MP ,MAP-STOF (2 !<MAP-STOF .MP>)>)>
564 <MOVE:ARG <STACKM <1 <MAP-STRS .MP>>
567 <SET ETAG <1 <MAP-TAG .MP>>>
570 <PUT .MP ,MAP-STRS <REST <MAP-STRS .MP>>>
571 <AND <EMPTY? <MAP-STRS .MP>> <RET-TMP-AC <MAP-SRC .MP>>>
574 ((.ETAG (<FORM - !<MAP-STKFX .MP>> !.STKD))
576 <PUT .MP ,MAP-STKFX .STKD>
577 <PUT .MP ,MAP-TAG <REST <MAP-TAG .MP>>>
582 <DEFINE STACKM (N SRC R? LBL POFF
583 "AUX" (STY <STRUCTYP <RESULT-TYPE .N>>) (COD 0) TT
584 (ETY <GET-ELE-TYPE <RESULT-TYPE .N> ALL>) SAC TEM)
585 #DECL ((N) NODE (SRC TEM) DATUM (SAC) AC (COD POFF) FIX)
586 <SET ETY <ISTYPE-GOOD? .ETY>>
588 (<OR <==? .STY TUPLE> <==? .STY VECTOR>>
590 <DATVAL <SET TEM <MOVE:ARG .SRC <DATUM .STY ANY-AC> T>>>>
591 <EMIT <INSTRUCTION `JUMPGE <ACSYM .SAC> .LBL>>
592 <EMIT <INSTRUCTION `MOVE `O '[<2 (2)>]>>
593 <EMIT <INSTRUCTION `ADDM `O !<ADDR:VALUE .SRC>>>
595 <COND (<==? .STY TUPLE> <PUT .TEM ,DATTYP <DATTYP .SRC>>)
598 <SET TT <OFFPTR 0 .TEM .STY>>
599 <COND (.ETY <DATUM .ETY .TT>) (ELSE <DATUM .TT .TT>)>)>)
602 <DATVAL <SET TEM <MOVE:ARG .SRC <DATUM LIST ANY-AC> T>>>>
603 <EMIT <INSTRUCTION `SKIPL .POFF `(P) >>
604 <EMIT <INSTRUCTION `HRRZ <ACSYM .SAC> (<ADDRSYM .SAC>)>>
605 <EMIT <INSTRUCTION `JUMPE <ACSYM .SAC> .LBL>>
606 <EMIT <INSTRUCTION `MOVEM <ACSYM .SAC> !<ADDR:VALUE .SRC>>>
610 <COND (<1? <SET COD <DEFERN <GET-ELE-TYPE <RESULT-TYPE .N> ALL>>>>
611 <EMIT <INSTRUCTION `MOVE <ACSYM .SAC> 1 (<ADDRSYM .SAC>)>>)
613 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O (<ADDRSYM .SAC>)>>
614 <EMIT <INSTRUCTION `CAIN `O TDEFER!-OP!-PACKAGE>>
615 <EMIT <INSTRUCTION `MOVE <ACSYM .SAC> 1 (<ADDRSYM .SAC>)>>)>
616 <SET TT <OFFPTR 0 .TEM LIST>>
617 <DATUM <COND (.ETY .ETY) (ELSE .TT)> .TT>)>)
618 (<OR <==? .STY UVECTOR> <==? .STY STORAGE>>
620 <DATVAL <SET TEM <MOVE:ARG .SRC <DATUM UVECTOR ANY-AC> T>>>>
621 <EMIT <INSTRUCTION `JUMPGE <ACSYM .SAC> .LBL>>
622 <EMIT <INSTRUCTION `MOVE `O '[<1 (1)>]>>
623 <EMIT <INSTRUCTION `ADDM `O !<ADDR:VALUE .SRC>>>
626 <SET TT <OFFPTR -1 .TEM UVECTOR>>
627 <DATUM <COND (.ETY .ETY) (ELSE .TT)> .TT>)>)
628 (<OR <==? .STY STRING> <==? .STY BYTES>>
629 <EMIT <INSTRUCTION `HRRZ `O !<ADDR:TYPE .SRC>>>
630 <EMIT <INSTRUCTION `SOJL `O .LBL>>
632 <SET TEM <MOVE:ARG .SRC <DATUM ANY-AC ANY-AC> T>>
633 <EMIT <INSTRUCTION `HRRM `O !<ADDR:TYPE .SRC>>>
634 <EMIT <INSTRUCTION `IBP !<ADDR:VALUE .SRC>>>
637 <EMIT <INSTRUCTION `HRRM `O !<ADDR:TYPE .SRC>>>
638 <SET TEM <DATUM <COND (<==? .STY STRING> CHARACTER)
640 <PUT .TEM ,DATVAL <GETREG .TEM>>
641 <EMIT <INSTRUCTION `ILDB
642 <ACSYM <DATVAL .TEM>>
645 (ELSE ;"Don't know type of structure, much more hair."
646 <RET-TMP-AC <MOVE:ARG .SRC <FUNCTION:VALUE> T>>
648 <SET TEM <FUNCTION:VALUE T>>
649 <PUT ,AC-D ,ACPROT T>
650 <EMIT '<`PUSHJ `P* |TYPSEG >>
651 <EMIT <INSTRUCTION `SKIPL .POFF '`(P) >>
652 <EMIT '<`XCT |INCR1 `(C) >>
653 <EMIT '<`XCT |TESTR `(C) >>
656 <EMIT '<`MOVE `A* |DSTORE>>
657 <EMIT '<`MOVE `B* `D >>)
659 <EMIT '<`XCT |TYPG `(C) >>
660 <EMIT '<`XCT |VALG `(C) >>
661 <EMIT '<`JSP `E* |CHKAB >>)>
662 <EMIT '<`MOVE `O |DSTORE>>
663 <EMIT <INSTRUCTION `MOVEM `O !<ADDR:TYPE .SRC>>>
664 <EMIT <INSTRUCTION `MOVEM `D* !<ADDR:VALUE .SRC>>>
665 <EMIT '<`SETZM |DSTORE>>
666 <PUT ,AC-D ,ACPROT <>>
669 <DEFINE ISET (TYP S1 S2 R? TG CHF NRG TG2
670 "AUX" (PTYP <STRUCTYP .TYP>) D1 A1 A2 COD D2
672 <TYPE-AND <1 <DECL-SYM .S2>> <GET-ELE-TYPE .TYP ALL .R?>>)
673 TEM (TT <ISTYPE-GOOD? <1 <DECL-SYM .S2>>>) ET (BIND <>))
674 #DECL ((S1 S2) SYMTAB (D1) <OR DATUM FALSE> (A1) AC (COD NR) FIX
675 (FSYM) <OR FALSE SYMTAB>)
678 <COND (<AND <NOT .D1> <OR .R? <AND <N==? .PTYP STRING> <N==? .PTYP BYTES>>>>
680 <MOVE:ARG <LADDR .S1 <> <>>
681 <DATUM <COND (<OR <==? .PTYP STRING> <==? .PTYP BYTES>>
685 <PUT .S1 ,INACS <DATUM <DATTYP .D1> <DATVAL .D1>>>
686 <PUT <SET A1 <DATVAL .D1>> ,ACRESIDUE (.S1 !<ACRESIDUE .A1>)>
688 (<NOT .D1> <SET D1 <LADDR .S1 <> <>>>)
689 (ELSE <SET A1 <DATVAL .D1>>)>
690 <COND (<INACS .S1> <PUT .S1 ,STORED <>>)>
691 <COND (<OR .CHF <NOT <1? .NRG>>>
692 <RETURN-UP .INRAP .STK>
693 <COND (<==? .PTYP LIST> <EMIT <INSTRUCTION `JUMPE <ACSYM .A1> .TG>>)
694 (<OR <==? .PTYP VECTOR>
698 <EMIT <INSTRUCTION `JUMPGE <ACSYM .A1> .TG>>)
699 (<TYPE? <SET A2 <DATTYP .D1>> AC>
700 <EMIT <INSTRUCTION `TRNN <ACSYM .A2> -1>>
703 <EMIT <INSTRUCTION `HRRZ `O* !<ADDR:TYPE .D1>>>
704 <EMIT <INSTRUCTION `JUMPE `O* .TG>>)>)>
709 <SALLOC:SLOTS <TMPLS .INRAP>>
710 <ADD:STACK <TMPLS .INRAP>>
711 <SET NTSLOTS (<FORM GVAL <TMPLS .INRAP>> !.NTSLOTS)>
713 <SET STK (0 !.STK)>>>
714 <AND .PRE <SET GSTK .STK> <SET STK (0 !.STK)>>)>
715 <COND (<TYPE? <ADDR-SYM .S2> TEMPV>
716 <SET TT <CREATE-TMP .TT>>
721 <COND (<=? .AC-HACK '(FUNNY-STACK)>
722 <* <TOTARGS .FCN> -2>)
729 <COND (.BIND <BINDUP .S2 <DATUM !.D1>>)
730 (ELSE <PUT .S2 ,INACS <SET D2 <DATUM !.D1>>>)>)
733 <COND (<TYPE? <DATTYP .D1> AC> <PUT <DATTYP .D1> ,ACPROT T>)>
734 <COND (<TYPE? <DATVAL .D1> AC> <PUT <DATVAL .D1> ,ACPROT T>)>
735 <COND (<SET ET <ISTYPE-GOOD? .ETYP>>
736 <PUT <SET D2 <DATUM .ET ANY-AC>> ,DATVAL <GETREG .D2>>)
738 <PUT <SET D2 <DATUM ANY-AC ANY-AC>>
740 <SET TEM <GETREG .D2>>>
742 <PUT .D2 ,DATVAL <GETREG .D2>>
743 <PUT .TEM ,ACPROT <>>)>
744 <COND (<TYPE? <DATVAL .D1> AC> <PUT <DATVAL .D1> ,ACPROT <>>)>
745 <COND (<TYPE? <DATTYP .D1> AC> <PUT <DATTYP .D1> ,ACPROT <>>)>
746 <PUT .S2 ,INACS .D2>)
747 (ELSE <SET ET <ISTYPE-GOOD? .ETYP>>)>
751 <COND (<TYPE? <DATVAL .D1> AC> <PUT <DATVAL .D1> ,ACPROT T>)>
752 <SET TEM <GETREG <>>>
753 <COND (<TYPE? <DATVAL .D1> AC> <PUT <DATVAL .D1> ,ACPROT <>>)>)
754 (ELSE <SET TEM <DATVAL .D2>>)>
755 <COND (<NOT <0? <SET COD <DEFERN .ETYP>>>>
757 <EMIT <INSTRUCTION `MOVE <ACSYM .TEM> 1 (<ADDRSYM .A1>)>>)
759 <EMIT <INSTRUCTION `MOVE <ACSYM .TEM> <ADDRSYM .A1>>>
760 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
763 <EMIT '<`CAIN `O* TDEFER!-OP!-PACKAGE>>
764 <EMIT <INSTRUCTION `MOVE
771 <EMIT <INSTRUCTION `MOVE
774 <EMIT <INSTRUCTION `MOVE
779 <SET TEM <OFFPTR 0 <DATUM LIST .A1> LIST>>
780 <BINDUP .S2 <DATUM .TEM .TEM>>)>)
781 (<OR <==? .PTYP VECTOR> <==? .PTYP TUPLE>>
783 <SET TEM <OFFPTR 0 .D1 VECTOR>>
784 <BINDUP .S2 <DATUM .TEM .TEM>>)
787 <EMIT <INSTRUCTION `MOVE
790 <EMIT <INSTRUCTION `MOVE
794 (<OR <==? .PTYP UVECTOR> <==? .PTYP STORAGE>>
796 <SET TEM <OFFPTR -1 .D1 .PTYP>>
798 <COND (.ET <DATUM .ET .TEM>) (ELSE <DATUM .TEM .TEM>)>>)
801 <EMIT <INSTRUCTION `HLRE
804 <EMIT <INSTRUCTION `SUBM
806 <ADDRSYM <DATTYP .D2>>>>
807 <EMIT <INSTRUCTION `MOVE
809 (<ADDRSYM <DATTYP .D2>>)>>)>
810 <EMIT <INSTRUCTION `MOVE
813 (<OR <==? .PTYP STRING> <==? .PTYP BYTES>>
815 <COND (<TYPE? <DATTYP .D1> AC> <PUT <DATTYP .D1> ,ACPROT T>)>
816 <COND (<TYPE? <DATVAL .D1> AC> <PUT <DATVAL .D1> ,ACPROT T>)>
818 <EMIT <INSTRUCTION `ILDB <ACSYM .A1> !<ADDR:VALUE .D1>>>
819 <EMIT <INSTRUCTION `SOS !<ADDR:TYPE .D1>>>
820 <BINDUP .S2 <SET D2 <DATUM <COND (<==? .PTYP STRING> CHARACTER)
824 <COND (<TYPE? <DATTYP .D1> AC> <PUT <DATTYP .D1> ,ACPROT <>>)>
825 <COND (<TYPE? <DATVAL .D1> AC> <PUT <DATVAL .D1> ,ACPROT <>>)>)
827 <EMIT <INSTRUCTION `ILDB
830 <EMIT <INSTRUCTION `SOS !<ADDR:TYPE .D1>>>)>)>)>
832 <COND (<TYPE? <DATTYP .D2> AC>
833 <PUT <SET A1 <DATTYP .D2>>
835 (.S2 !<ACRESIDUE .A1>)>)>
836 <COND (<TYPE? <DATVAL .D2> AC>
837 <PUT <SET A1 <DATVAL .D2>>
839 (.S2 !<ACRESIDUE .A1>)>)>
843 <DEFINE IISET (TYP SYM DAT R?
844 "AUX" (TT <ISTYPE-GOOD? <1 <DECL-SYM .SYM>>>)
846 <TYPE-AND <1 <DECL-SYM .SYM>>
847 <GET-ELE-TYPE .TYP ALL .R?>>) AC)
848 #DECL ((SYM) SYMTAB (DAT) DATUM)
849 <COND (<TYPE? <ADDR-SYM .SYM> TEMPV>
850 <SET TT <CREATE-TMP .TT>>
855 <COND (<=? .AC-HACK '(FUNNY-STACK)>
856 <* <TOTARGS .FCN> -2>)
864 <DATUM <COND (<ISTYPE-GOOD? .ETYP>) (ELSE ANY-AC)>
866 <COND (<TYPE? <SET AC <DATTYP .DAT>> AC>
867 <PUT .AC ,ACRESIDUE (.SYM !<ACRESIDUE .AC>)>)>
868 <PUT <SET AC <DATVAL .DAT>> ,ACRESIDUE (.SYM !<ACRESIDUE .AC>)>
869 <PUT .SYM ,STORED <>>
872 <DEFINE DO-EVEN-FUNNIER-HACK (D1 S N FAP NN LV
873 "AUX" (COD <NODE-SUBR .FAP>)
874 (LMOD <RESULT-TYPE .NN>)
875 (MOD <RESULT-TYPE .N>) ACSY
876 (D2 <LADDR .S <> <>>))
877 #DECL ((D1 D2 D3) DATUM (N FAP NN) NODE (COD) FIX)
878 <SET MOD <OR <AND <==? .MOD FIX> 1> 2>>
879 <AND <==? .MOD 2> <==? .LMOD FIX> <SET D1 <GENFLOAT .D1>>>
880 <SET ACSY <ACSYM <DATVAL .D1>>>
882 <EMIT <INSTRUCTION <NTH <NTH ,MINS .MOD> .COD>
886 <COND (<TYPE? <DATVAL .D2> AC>
887 <EMIT <INSTRUCTION `MOVE
889 <ADDRSYM <DATVAL .D1>>>>)
891 <EMIT <INSTRUCTION `MOVEM .ACSY !<ADDR:VALUE
896 <DEFINE HMAPFR (MNOD WHERE K
897 "AUX" XX (NTSLOTS .NTSLOTS)
899 <COND (.PRE .TMPS) (<STACK:L .STK .BSTB>) (ELSE (0))>)
900 TEM (NSLOTS 0) (SPECD <>) STB (DTEM <DATUM FIX ANY-AC>)
901 (STKOFFS <>) (FAP <1 .K>) (INRAP <2 .K>) F? (POFF 0)
902 (ANY? <>) (NARG <LENGTH <SET K <REST .K 2>>>) START:TAG
903 (R? <==? <NODE-SUBR .MNOD> ,MAPR>) STRV (FF? <>)
904 (MAPEND <ILIST .NARG '<MAKE:TAG "MAP">>) (OSTK .STK)
905 (MAPLP <MAKE:TAG "MAP">) (MAPL2 <MAKE:TAG "MAP">) MAP:OFF
906 (SUBRC <AP? .FAP>) STOP (STK (0 !.STK)) (TMPS .TMPS) BTP
907 (BASEF .BASEF) (FRMS .FRMS) (MAYBE-FALSE <>) (OPRE .PRE)
908 (OTAG ()) DEST CD (AC-HACK .AC-HACK)
909 (EXIT <MAKE:TAG "MAPEX">) (APPLTAG <MAKE:TAG "MAPAP">) TT
910 GMF (OUTD .WHERE) OUTSAV CHF (FLS <==? .WHERE FLUSHED>)
911 (RTAG <MAKE:TAG "MAP">) (NEED-INT T) FSYM OS NS (DOIT T)
913 #DECL ((NTSLOTS) <SPECIAL LIST> (DTEM) DATUM
914 (SPECD) <SPECIAL <OR FALSE ATOM>> (TEM) <OR ATOM DATUM> (OFFS) FIX
915 (TMPS) <SPECIAL LIST> (POFF NSLOTS NARG) <SPECIAL FIX> (FAP) NODE
916 (BASEF MNOD INRAP) <SPECIAL NODE> (K) <LIST [REST NODE]>
917 (MAPEND) <LIST [REST ATOM]> (MAP:OFF) ATOM
918 (EXIT MAPLP RTAG APPLTAG) <SPECIAL ATOM> (OSTK) LIST
919 (DEST CD) <SPECIAL <OR ATOM DATUM>> (FRMS) <SPECIAL LIST>
920 (STOP STRV STB BTP STK GSTK) <SPECIAL LIST>
921 (AC-HACK START:TAG) <SPECIAL ANY>
922 (GMF MAYBE-FALSE ANY?) <SPECIAL ANY> (FSYM) SYMTAB)
923 <PUT .INRAP ,SPECS-START <- <SPECS-START .INRAP> .TOT-SPEC>>
925 #DECL ((PRE) <SPECIAL ANY>)
926 <COND (<AND <NOT <EMPTY? .K>>
929 <AND <TYPE-OK? <RESULT-TYPE .Z>
935 <COND (<AND <NOT <AND <EMPTY? .K> <NODE-NAME .FAP>>>
936 <OR <==? <NODE-NAME .FAP> <>>
937 <AND <==? <NODE-TYPE .FAP> ,MFIRST-CODE>
938 <N==? <NODE-SUBR .FAP> 5>>
941 <==? <NAME-SYM <1 <BINDING-STRUCTURE .INRAP>>>
945 <COND (<AND <NOT <EMPTY? .K>>
949 <MINL <RESULT-TYPE .N>>>
954 <SET DEST <SET OUTD <COND (.FLS FLUSHED) (ELSE <GOODACS .MNOD .WHERE>)>>>
955 <OR .PRE <EMIT-PRE <NOT <OR <ACTIVATED .INRAP> <0? <SSLOTS .BASEF>>>>>>
963 <SET FSYM <1 <BINDING-STRUCTURE .INRAP>>>
964 <PUT .INRAP ,BINDING-STRUCTURE <REST <BINDING-STRUCTURE .INRAP>>>
969 <AND .GMF <NOT .FLS> <INACS .FSYM> <SET OUTD <INACS .FSYM>>>
970 <OR .F? <SET FF? <==? <NODE-TYPE .FAP> ,MFIRST-CODE>>>
971 <COND (<AND .GMF .CHF <NOT .FLS>> <PREFER-DATUM .WHERE>)>
972 <SET ANY? <PUSH-STRUCS .K T .GMF <BINDING-STRUCTURE .INRAP> .WHERE>>
973 <COND (.GMF <KEEP-IN-ACS <BINDING-STRUCTURE .INRAP> .K .R?>)>
974 <COND (<AND .GMF .CHF <NOT .FLS>> <UNPREFER>)>
975 <DO-FIRST-SETUP-2 .FAP .DEST <COND (.GMF .FSYM)> .CHF <1? .NARG> .FLS>
976 <BEGIN-FRAME <TMPLS .INRAP> <ACTIVATED .INRAP> <PRE-ALLOC .INRAP>>
977 <SET TMPS <COND (.PRE .NTMPS) (ELSE <STACK:L .STK <2 .FRMS>>)>>
981 <COND (.F? <SET MAYBE-FALSE <DO-FINAL-SETUP .FAP .SUBRC>>)>
982 <PROG-START-AC .INRAP>
984 <COND (<AND .F? <NOT .GMF>>
987 .DTEM .STB <AND <NOT .PRE> <NOT <ACTIVATED .INRAP>>>>>)>
988 <AND <ACTIVATED .INRAP> <ACT:INITIAL> <ADD:STACK 2>>
992 <AND .GMF <1? .NARG>>
994 <SALLOC:SLOTS <TMPLS .INRAP>>
995 <ADD:STACK <TMPLS .INRAP>>
997 <SET NTSLOTS (<FORM GVAL <TMPLS .INRAP>> !.NTSLOTS)>)>
998 <COND (.GMF <SET GSTK .STK> <SET STK (0 !.STK)>)>>>
999 <AND .PRE .GMF <NOT <1? .NARG>> <SET GSTK .STK> <SET STK (0 !.STK)>>
1000 <SET POFF <COND (.MAYBE-FALSE -2) (.F? -1) (ELSE 0)>>
1001 <COND (<AND .GMF <OR .CHF <NOT <1? .NARG>>> <NOT .FLS>> <LVAL-UP .FSYM>)>
1002 <REPEAT ((KK .K) (BS <BINDING-STRUCTURE .INRAP>)
1009 #DECL ((S) <LIST SYMTAB>)
1010 <COND (<N==? <NAME-SYM <1 .S>> DUMMY-MAPF>
1013 .BS>)>) (OFFSET (<- 1 <* .NARG 2>> ())) TEM
1014 (TOFF (0 ())) (GOFF '(0)))
1015 #DECL ((BST) <LIST [REST SYMTAB]> (TOFF OFFSET) <LIST FIX LIST>
1016 (KK) <LIST [REST NODE]>)
1019 <AND .GMF <NOT <1? .NARG>> <NOT .FF?> <NOT .FLS> <RET-TMP-AC .OUTD>>
1020 <COND (<AND .F? <NOT .STKOFFS>> <RET-TMP-AC .DTEM>)>
1023 #DECL ((SYM) SYMTAB)
1024 <APPLY <NTH ,MBINDERS <CODE-SYM .SYM>> .SYM>>
1028 <SET RV <TYPE? <ADDR-SYM <1 .BST>> TEMPV>>
1034 <COND (.AC-HACK `(FRM) ) (`(TB) )>
1035 <COND (.AC-HACK 1) (ELSE 0)>>>
1036 <OR .RV <SET STKOFFS <+ .STKOFFS 2>>>)
1039 <SPEC-OFFPTR <1 .OFFSET>
1043 !<STACK:L .STK .STRV>)>>
1048 <FORM - 0 !<2 .TOFF>>)>>)>)
1051 <ADDRESS:C <FORM - <1 .OFFSET> !<STACK:L .STK .STRV>>
1054 <SET OFFSET <STFIXIT .OFFSET (2)>>)>
1055 <IF <==? <CODE-SYM <1 .BST>> 4>
1056 <MESSAGE ERROR "NOT IMPLEMENTED MAPF/R TUPLES ">>
1059 <COND (.GMF (<FORM + !.GOFF>))
1060 ((<FORM - 0 <1 .TOFF> !<2 .TOFF>>
1061 <1 <SET TOFF <STFIXIT (0 ()) <STACK:L .STK .STRV>>>>
1065 <ISET <RESULT-TYPE <1 .KK>>
1074 <SET GOFF <STACK:L .STK .GSTK>>)
1076 <RETURN-UP .INRAP .STK>
1077 <IISET <RESULT-TYPE <1 .KK>>
1079 <STACKM <1 .KK> <DATUM .TEM .TEM> .R? <1 .MAPEND> .POFF>
1088 <SET MAPEND <REST .MAPEND>>
1090 <SET BST <REST .BST>>)>>
1092 (<AND .GMF <OR .CHF <NOT <1? .NARG>>> <NOT .FLS> <NOT .FF?>>
1096 <COND (<TYPE? <DATTYP <INACS .S>> AC>
1097 <FLUSH-RESIDUE <DATTYP <INACS .S>> .S>)>
1098 <COND (<TYPE? <DATVAL <INACS .S>> AC>
1099 <FLUSH-RESIDUE <DATVAL <INACS .S>> .S>)>
1100 <PUT .S ,INACS <>>)>>)>
1101 <COND (<AND .GMF <NOT .CHF> <1? .NARG> <NOT .FLS>> <LVAL-UP .FSYM>)>
1103 <0? <SET NSLOTS <SSLOTS .INRAP>>>
1105 <SALLOC:SLOTS .NSLOTS>
1107 <EMIT-PRE <SET PRE T>>>>
1108 <AND <ACTIVATED .INRAP> <ACT:FINAL>>
1110 <OR .OPRE <SET BASEF .INRAP>>
1112 <AND .NEED-INT <CALL-INTERRUPT>>
1119 <BLT-HACK <KIDS .INRAP>
1120 <BINDING-STRUCTURE .INRAP>
1121 <MINL <RESULT-TYPE <1 .K>>>>>
1124 <SET TEM <SEQ-GEN <KIDS .INRAP> <GOODACS .INRAP DONT-CARE> T>>)
1135 !<STACK:L .STK .STRV>>
1140 (ELSE <RET-TMP-AC <SET TEM <SEQ-GEN <KIDS .INRAP> FLUSHED T>>>)>
1142 (<AND .DOIT <N==? .TEM ,NO-DATUM>>
1143 <COND (<ACTIVATED .INRAP> <PROG:END> <LABEL:OFF .MAP:OFF>)
1146 <OR .OPRE <SET TEM <MOVE:ARG .TEM <DATUM ,AC-A ,AC-B>>>>>
1147 <POP:LOCS .STK .STRV>
1148 <UNBIND:FUNNY <SPECS-START .INRAP> !.NTSLOTS>)
1149 (ELSE <UNBIND:LOCS .STK .STB>)>
1151 (.F? <DO-STACK-ARGS .MAYBE-FALSE .TEM>)
1155 <SET NTSLOTS <REST <SET NS .NTSLOTS>>>
1158 <DO-EVEN-FUNNIER-HACK .TEM
1163 <LOOP-VARS .INRAP>>)
1164 (<AND .GMF <NOT .FLS>>
1167 <SET NTSLOTS <REST <SET NS .NTSLOTS>>>
1170 <PUT .FSYM ,INACS .TEM>
1171 <PUT .FSYM ,STORED <>>
1172 <COND (<TYPE? <DATTYP .TEM> AC>
1175 (.FSYM !<ACRESIDUE <DATTYP .TEM>>)>)>
1176 <PUT <DATVAL .TEM> ,ACRESIDUE (.FSYM !<ACRESIDUE <DATVAL .TEM>>)>
1177 <PUT .FSYM ,STORED <>>
1179 (<NOT <MEMQ .FSYM <LOOP-VARS .INRAP>>>
1180 <REPEAT ((L <LOOP-VARS .INRAP>) LL)
1181 #DECL ((L) LIST (LL) DATUM)
1182 <COND (<EMPTY? .L> <RETURN>)>
1183 <COND (<TYPE? <DATVAL <SET LL <LINACS-SLOT .L>>> AC>
1184 <PUT <DATVAL .LL> ,ACPROT T>)>
1185 <COND (<TYPE? <DATTYP .LL> AC>
1186 <PUT <DATTYP .LL> ,ACPROT T>)>
1187 <SET L <REST .L ,LOOPVARS-LENGTH>>>
1195 <COND (<ISTYPE-GOOD? <RESULT-TYPE .MNOD>>)
1196 (<AND <TYPE? .WHERE DATUM>
1197 <TYPE? <SET R <DATTYP .WHERE>> AC>
1199 <PUT <COND (<==? .R <DATVAL .TEM>> .R)
1200 (ELSE <SGETREG .R <>>)>
1203 (ELSE <PUT <SET R <GETREG <>>> ,ACPROT T>)>
1204 <COND (<AND <TYPE? .WHERE DATUM>
1205 <TYPE? <SET R2 <DATVAL .WHERE>> AC>
1207 <COND (<==? .R2 <DATVAL .TEM>> .R2)
1208 (ELSE <SGETREG .R2 <>>)>)
1209 (ELSE <SET R2 <GETREG <>>>)>>>
1210 <COND (<AND <ASSIGNED? R>>
1212 <PUT .R ,ACPROT <>>)>
1214 !<LOOP-VARS .INRAP>)>
1215 <REPEAT ((L <LOOP-VARS .INRAP>) LL)
1216 #DECL ((L) LIST (LL) DATUM)
1217 <COND (<EMPTY? .L> <RETURN>)>
1218 <COND (<TYPE? <DATVAL <SET LL <LINACS-SLOT .L>>> AC>
1219 <PUT <DATVAL .LL> ,ACPROT <>>)>
1220 <COND (<TYPE? <DATTYP .LL> AC>
1221 <PUT <DATTYP .LL> ,ACPROT <>>)>
1222 <SET L <REST .L ,LOOPVARS-LENGTH>>>)>)
1223 (.FF? <DO-FUNNY-HACK .TEM (<* .NARG -2> ()) .MNOD .FAP .INRAP>)>
1224 <COND (.ANY? <EMIT <INSTRUCTION `SETZM .POFF '`(P) >>)>
1226 <AND .GMF <NOT .FLS>>
1229 <SET NTSLOTS <REST <SET NS .NTSLOTS>>>
1233 <AGAIN-UP .INRAP <AND .GMF <1? .NARG>>>
1236 <REST-STRUCS <BINDING-STRUCTURE .INRAP>
1242 <COND (<NOT <AND .GMF <1? .NARG>>> <BRANCH:TAG .MAPLP>)>
1243 <GEN-TAGS .OTAG .SPECD>
1244 <COND (<AND .GMF <NOT .PRE>> <SET STK .GSTK> <SET NTSLOTS .NS>)>
1245 <COND (<AND .GMF <NOT <1? .NARG>>>
1246 <COND (<OR .OPRE .F?>
1247 <POP:LOCS .STK .STRV>
1248 <UNBIND:FUNNY <SPECS-START .INRAP> !.NTSLOTS>)
1249 (ELSE <UNBIND:LOCS .STK .STB>)>)>
1253 <COND (<NOT <ISTYPE? <STRUCTYP <RESULT-TYPE .N>>>>
1254 <EMIT '<`SETZM |DSTORE >>
1257 (ELSE <GEN-TAGS .OTAG .SPECD>)>
1258 <CLEANUP-STATE .INRAP>
1259 <LABEL:TAG .APPLTAG>
1261 (<TYPE? .DEST DATUM>
1263 <COND (.F? <DO-LAST .SUBRC .MAYBE-FALSE <DATUM !.DEST>>)
1265 <MOVE:ARG <LADDR .FSYM <> <>> <DATUM !.DEST>>)
1266 (.FF? <DO-FUNNY-LAST .FAP <- -1 <* 2 .NARG>> <DATUM !.DEST>>)
1267 (.GMF <MOVE:ARG .OUTD <DATUM !.DEST>>)
1270 <DATUM <SET TT <ADDRESS:C <- -1 <* 2 .NARG>> '`(TP) >> .TT>
1273 <AND <ISTYPE? <DATTYP .DEST>>
1274 <TYPE? <DATTYP .CD> AC>
1275 <RET-TMP-AC <DATTYP .CD> .CD>>)
1276 (.F? <DO-LAST .SUBRC .MAYBE-FALSE <FUNCTION:VALUE>>)
1277 (<AND .FF? .GMF> <MOVE:ARG .OUTD <FUNCTION:VALUE>>)
1278 (<AND .GMF .FF?> <MOVE:ARG .OUTD <FUNCTION:VALUE>>)
1279 (.FF? <DO-FUNNY-LAST .FAP <- -1 <* 2 .NARG>> <FUNCTION:VALUE>>)>
1280 <POP:LOCS .STB .STOP>
1282 <COND (<ASSIGNED? CD>
1283 <AND <TYPE? <DATTYP .DEST> AC> <FIX-ACLINK <DATTYP .DEST> .DEST .CD>>
1284 <AND <TYPE? <DATVAL .DEST> AC>
1285 <FIX-ACLINK <DATVAL .DEST> .DEST .CD>>)>
1287 <SET XX <MOVE:ARG .DEST .WHERE>>
1291 <DEFINE BLT-HACK (K B LN "AUX" N N1 AC EA D1 D2 TY TT (TG <MAKE:TAG>))
1292 <COND (<AND <==? <LENGTH .K> 1>
1293 <==? <NODE-TYPE <SET N <1 .K>>> ,PUT-CODE>
1294 <==? <LENGTH <SET K <KIDS .N>>> 3>
1295 <==? <NODE-TYPE <SET N1 <2 .K>>> ,QUOTE-CODE>
1296 <==? <NODE-NAME .N1> 1>
1297 <==? <NODE-TYPE <SET N1 <1 .K>>> ,LVAL-CODE>
1298 <MEMQ <NODE-NAME .N1> .B>
1299 <OR <==? <SET TT <STRUCTYP <RESULT-TYPE .N>>> UVECTOR>
1302 <COND (<==? .TT VECTOR>
1304 <OR <ISTYPE? <RESULT-TYPE <3 .K>>> ANY>)
1307 <ISTYPE? <RESULT-TYPE <3 .K>>>)>>
1308 <OR <==? <NODE-TYPE <3 .K>> ,QUOTE-CODE>
1309 <==? <NODE-TYPE <3 .K>> ,GVAL-CODE>
1310 <AND <G=? <LENGTH <3 .K>> <INDEX ,SIDE-EFFECTS>>
1311 <NOT <SIDE-EFFECTS <3 .K>>>
1312 <NO-INTERFERE <3 .K> .B>>>>
1315 <DATUM <COND (<ISTYPE? <RESULT-TYPE .N1>>)
1318 <SET D2 <GEN <3 .K> DONT-CARE>>
1320 <DATUM <COND (<AND .TT
1323 <RESULT-TYPE .N1> ALL>>>)
1324 (.TT <OFFPTR 0 .D1 VECTOR>)
1326 <OFFPTR <COND (.TT 0) (ELSE -1)>
1328 <COND (.TT VECTOR) (ELSE UVECTOR)>>>>
1331 <PUT .D1 ,DATTYP <COND (.TT VECTOR) (ELSE UVECTOR)>>
1333 <PUT <SET AC <DATVAL .D1>> ,ACPROT T>
1335 <SET EA <GETREG <>>>
1336 <PUT .AC ,ACPROT <>>
1337 <EMIT <INSTRUCTION `HLRE <ACSYM .EA> !<ADDR:VALUE .D1>>>
1338 <EMIT <INSTRUCTION `SUBM <ACSYM .AC> <ADDRSYM .EA>>>
1340 <EMIT <INSTRUCTION `HRLI <ACSYM .AC> (<ADDRSYM .AC>)>>
1341 <EMIT <INSTRUCTION `ADDI
1343 <COND (.TT 2) (ELSE 1)>>>)
1345 <EMIT <INSTRUCTION `ADD <ACSYM .AC> '[<2 (2)>]>>
1346 <EMIT <INSTRUCTION `JUMPGE <ACSYM .AC> .TG>>
1347 <EMIT <INSTRUCTION `HRLI
1352 <EMIT <INSTRUCTION `AOBJP <ACSYM .AC> .TG>>
1353 <EMIT <INSTRUCTION `HRLI
1357 <EMIT <INSTRUCTION `BLT <ACSYM .AC> -1 (<ADDRSYM .EA>)>>
1362 <DEFINE NO-INTERFERE (N B) #DECL ((N) NODE (B) <LIST [REST SYMTAB]>)
1363 <COND (<AND <==? <NODE-TYPE .N> ,LVAL-CODE>
1364 <MEMQ <NODE-NAME .N> .B>>
1366 (<MEMQ <NODE-TYPE .N> ,SNODES> T)
1367 (<AND <==? <NODE-TYPE .N> ,COND-CODE>
1368 <NOT <NO-INTERFERE <PREDIC .N> .B>>> <>)
1371 <FUNCTION (N) #DECL ((N) NODE)
1372 <COND (<NO-INTERFERE .N .B> T)
1373 (ELSE <MAPLEAVE <>>)>> <KIDS .N>>)>>
1377 <DEFINE GEN-TAGS (TGS SPECD)
1378 #DECL ((TGS) LIST (MNOD) NODE)
1380 <FUNCTION (LL "AUX" (L <1 .LL>) (TG <1 .L>) (OFF <2 .L>))
1381 #DECL ((LL) <LIST LIST> (L) LIST (TG) ATOM (OFF) LIST)
1383 <EMIT <INSTRUCTION DEALLOCATE .OFF>>
1385 (<EMPTY? <REST .LL>>
1388 <COND (.PRE <UNBIND:FUNNY <SPECS-START <2 <KIDS .MNOD>>> !.NTSLOTS>)
1389 (ELSE <EMIT '<`PUSHJ `P* |SSPECS >>)>)>)>>
1392 <DEFINE MOPTG (SYM) #DECL ((SYM) SYMTAB) <BINDUP .SYM <INIT-SYM .SYM>>>
1394 <DEFINE MOPTG2 (SYM) #DECL ((SYM) SYMTAB) <BINDUP .SYM <REFERENCE:UNBOUND>>>
1396 <DEFINE NOTIMP (ARG) <MESSAGE ERROR "NOT IMPLEMENTED MAPF/R TUPLES">>
1398 <DEFINE MAPLEAVE-GEN (N W)
1399 #DECL ((N) NODE (CD) DATUM (DEST) <OR DATUM ATOM>)
1400 <COND (<ACTIVATED <2 <KIDS .MNOD>>>
1401 <RET-TMP-AC <GEN <1 <KIDS .N>> .DEST>>
1405 <COND (<==? .DEST FLUSHED>
1406 <RET-TMP-AC <GEN <1 <KIDS .N>> FLUSHED>>
1407 <MAP:UNBIND .STOP .STOP>
1410 <SET CD <GEN <1 <KIDS .N>> <DATUM !.DEST>>>
1411 <MAP:UNBIND .STOP .STOP>
1415 <BRANCH:TAG .EXIT>)>
1418 <DEFINE MAP:UNBIND (STOP STOP1)
1421 <POP:LOCS .STK .STOP1>
1422 <UNBIND:FUNNY <SPECS-START <2 <KIDS .MNOD>>> !.NTSLOTS>)
1423 (ELSE <UNBIND:LOCS .STK .STOP1>)>>
1427 <DEFINE MAPRET-STOP-GEN (N W
1428 "AUX" (STA <STACKS .N>) (SG <SEGS .N>) (DWN '(0))
1429 (K <KIDS .N>) (LN <LENGTH .K>) (UNK <>) TEM DAT
1430 (FAP <1 <KIDS .MNOD>>) FTG
1431 (FF? <==? <NODE-TYPE .FAP> ,MFIRST-CODE>)
1432 (LEAVE <==? <NODE-SUBR .N> ,MAPSTOP>) (OS .STK)
1433 (FUZZY <* -2 .NARG>) (STK (0 !.STK)) AC-SY
1434 (OOS .STK) (NS .NTSLOTS))
1435 #DECL ((N) NODE (K) <LIST [REST NODE]> (LN FUZZY STA) FIX (DWN) LIST
1436 (DAT) DATUM (STK) <SPECIAL LIST> (OS) LIST)
1438 (<AND <NOT .SG> <L? .LN 2>>
1439 <OR <0? .LN> <SET DAT <GEN <1 .K> <GOODACS <1 .K> DONT-CARE>>>>
1440 <MAP:UNBIND .STB .STRV>
1443 <COND (<AND .GMF .FF?>
1444 <SET NTSLOTS <REST .NTSLOTS>>
1446 <DO-EVEN-FUNNIER-HACK
1448 <1 <BINDING-STRUCTURE .INRAP>>
1452 <LOOP-VARS .INRAP>>)
1453 (.FF? <DO-FUNNY-HACK .DAT (.FUZZY ()) .MNOD .FAP <1 .K>>)
1454 (ELSE <DO-STACK-ARGS .MAYBE-FALSE .DAT>)>)>)
1455 (.FF? <DO-FUNNY-MAPRET .N .FUZZY .K .FAP>)
1458 <FUNCTION (NOD "AUX" TG)
1460 <COND (<==? <NODE-TYPE .NOD> ,SEGMENT-CODE>
1461 <RET-TMP-AC <GEN <1 <KIDS .NOD>> <FUNCTION:VALUE>>>
1465 <EMIT '<`SKIPGE -1 `(P) >>
1467 <SEGMENT:STACK </ .STA 2> .UNK>
1469 <ADD:STACK <- .STA>>
1472 <AND .MAYBE-FALSE <LABEL:TAG .TG>>)
1476 <EMIT '<`SKIPGE -1 `(P) >>
1478 <RET-TMP-AC <STACK:ARGUMENT <GEN .NOD DONT-CARE>>>
1480 <AND .MAYBE-FALSE <LABEL:TAG .TG>>)>>
1482 <COND (<OR <ACTIVATED <2 <KIDS .MNOD>>>
1483 <NOT <SET TEM <STACK:L .OS .STRV>>>>
1484 <MESSAGE ERROR " NOT IMLEMENTED HAIRY MAPRET/STOP " .N>)
1486 <COND (.SPECD <UNBIND:FUNNY <SPECS-START <2 <KIDS .MNOD>>>>)>
1488 <SET FTG <MAKE:TAG>>
1489 <EMIT '<`SKIPGE -1 `(P) >>
1491 <SET AC-SY <GETREG <>>>
1492 <COND (.UNK <EMIT <INSTRUCTION `POP `P* <ADDRSYM .AC-SY>>>)
1493 (ELSE <EMIT <INSTRUCTION `MOVEI <ACSYM .AC-SY> </ .STA 2>>>)>
1494 <EMIT <INSTRUCTION `ADDM <ACSYM .AC-SY> `(P) >>
1495 <COND (<NOT <=? <SET DWN .TEM> '(0)>>
1496 <EMIT <INSTRUCTION `ASH <ACSYM .AC-SY> 1>>
1497 <EMIT <INSTRUCTION `HRLI <ACSYM .AC-SY> (<ADDRSYM .AC-SY>)>>
1498 <EMIT <INSTRUCTION `SUBM `TP* <ADDRSYM .AC-SY>>>
1499 <EMIT <INSTRUCTION `HRLI
1503 <EMIT <INSTRUCTION `BLT
1507 <EMIT <INSTRUCTION `SUB `TP* [<FORM !.DWN .DWN>]>>)>)>
1508 <AND .MAYBE-FALSE <LABEL:TAG .FTG>>)>
1509 <OR .PRE <AND .GMF .FF?> <PROG () <SET NTSLOTS <REST .NTSLOTS>> <SET STK .STB>>>
1510 <COND (.ANY? <EMIT <INSTRUCTION `SETZM .POFF '`(P) >>)>
1511 <COND (.LEAVE <RETURN-UP .INRAP>) (<AGAIN-UP .INRAP>)>
1514 <BRANCH:TAG <COND (.LEAVE .APPLTAG) (.GMF .RTAG) (ELSE .MAPLP)>>
1519 <DEFINE DO-FUNNY-MAPRET (N OFFS K FAP "AUX" (NOFFS (.OFFS ())))
1520 #DECL ((N FAP) NODE (K) <LIST [REST NODE]> (OFFS) FIX)
1522 <STFIXIT .NOFFS (<FORM - 0 !<STACK:L .STK .STB>>)>>
1524 <FUNCTION (NN "AUX" TG1 TG2 TT DAT (ANY? <>))
1525 #DECL ((NN) NODE (TG1 TG2) ATOM (DAT) DATUM (TT) ADDRESS:C)
1526 <COND (<==? <NODE-TYPE .NN> ,SEG-CODE>
1527 <SET ANY? <PUSH-STRUCS <KIDS .NN> <> <> () <>>>
1528 <LABEL:TAG <SET TG1 <MAKE:TAG>>>
1530 <STACKM <1 <KIDS .NN>>
1531 <DATUM <SET TT <ADDRESS:C -1 '`(TP) >> .TT>
1533 <SET TG2 <MAKE:TAG>>
1535 <DO-FUNNY-HACK .DAT <STFIXIT .NOFFS '(-2)> .MNOD .FAP .N>
1536 <AND .ANY? <EMIT '<`SETZM `(P) >>>
1539 <AND .ANY? <EMIT '<`SUB `P* [<1 (1)>]>>>
1540 <COND (<NOT <STRUCTYP <RESULT-TYPE <1 <KIDS .NN>>>>>
1541 <EMIT '<`SETZM |DSTORE>>)>
1542 <EMIT '<`SUB `TP* [<(2) 2>]>>)
1544 <SET DAT <GEN .NN DONT-CARE>>
1546 <DO-FUNNY-HACK .DAT .NOFFS .MNOD .FAP .NN>)>>
1548 <MAP:UNBIND .STB .STRV>>
1552 <DEFINE AP? (N "AUX" AT)
1554 <AND <==? <NODE-TYPE .N> ,GVAL-CODE>
1555 <==? <NODE-TYPE <SET N <1 <KIDS .N>>>> ,QUOTE-CODE>
1556 <SET AT <NODE-NAME .N>>
1558 <AND <GASSIGNED? .AT> <TYPE? ,.AT SUBR RSUBR RSUBR-ENTRY>>
1559 <AND <GASSIGNED? .AT>
1560 <TYPE? ,.AT FUNCTION>
1562 <AND <TYPE? .FCNS LIST> <MEMQ .AT .FCNS>>>>>