3 <COND (<NOT <GASSIGNED? WIDTH-MUNG>> <FLOAD "MIMOC20DEFS.MUD">)>
9 <SETG SETZ-R <CHTYPE <ORB *400000000000* <LSH ,AC-R 18>> FIX>>
11 <SETG SETZX-R <CHTYPE <ORB -25769803776 <LSH ,AC-R 18>> FIX>>
13 <SETG SETZQ-R <CHTYPE <ORB *600000000000* <LSH ,AC-R 18>> FIX>>
15 <SETG SETZ-IND -34355544064>
17 <SETG SETZ *400000000000*>
55 <COND (<EMPTY? <SET A <REST .A 2>>> <RETURN>)>>
57 <SETG ACNAMS [A1 A2 B1 B2 C1 C2 T O1 O2 R M SP F TP P]>
59 <GDECL (ACNAMS) <VECTOR [REST ATOM]>>
65 #DECL ((ITM) <OR ATOM FORM>)
66 <COND (<TYPE? .ITM FORM> <MAPLEAVE .ITM>)>>
72 '[#AC [O* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
73 #AC [A1* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
74 #AC [A2* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
75 #AC [B1* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
76 #AC [B2* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
77 #AC [C1* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
78 #AC [C2* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
79 #AC [X* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
80 #AC [T* #FALSE () DUMMY 34359738367 #FALSE () #FALSE ()]]>
83 <FUNCTION (TBL "AUX" (AC <1 .TBL>))
84 #DECL ((TBL) <VECTOR [REST AC]> (AC) AC)
85 <COND (<1? <LENGTH .TBL>>
86 <PUTPROP <AC-NAME .AC> AC .AC>
89 <PUTPROP <AC-NAME .AC>
91 <COND (<==? <AC-NAME <2 .TBL>> X*> T*)
92 (ELSE <AC-NAME <2 .TBL>>)>>
93 <PUTPROP <COND (<==? <AC-NAME <2 .TBL>> X*> T*)
94 (ELSE <AC-NAME <2 .TBL>>)>
97 <PUTPROP <COND (<==? <AC-NAME <2 .TBL>> X*> <3 .TBL>)
103 <COND (<==? <AC-NAME <2 .TBL>> X*> T*)
104 (ELSE <AC-NAME <2 .TBL>>)>>
105 <PUTPROP <AC-NAME .AC> AC .AC>)>>
118 <FUNCTION (AC) <CHTYPE [.AC <> <> <> DUMMY] ACSTATE>>
122 #DECL ((AC) <OR ATOM AC>)
123 <COND (<==? .AC STACK> STACK)
124 (T <GETPROP .AC NEXTAC>)>>
127 #DECL ((AC) ATOM (VALUE) AC)
130 <DEFINE IS-AC? (AC) #DECL ((AC) ATOM)
133 <DEFINE PA () <PPRINT ,AC-TABLE>>
135 <DEFINE ASSIGN-AC (ITM TYP "OPTIONAL" (AC-FORCE <>))
136 #DECL ((ITM) ANY (TYP) ATOM (AC-FORCE) <OR ATOM FALSE>)
137 <COND (<AND <==? .ITM STACK> <NOT .AC-FORCE>> STACK)
138 (T <LOAD-AC .ITM .TYP T T>)>>
140 <DEFINE IN-AC? (ITM TYP "AUX" (BOTH <==? .TYP BOTH>))
141 #DECL ((ITM) ANY (TYP) ATOM (BOTH) <OR FALSE ATOM>)
142 <COND (<TYPE? .ITM ATOM>
144 <FUNCTION (ACT "AUX" (AC <1 .ACT>) NAC)
145 #DECL ((ACT) VECTOR (NAC AC) AC)
146 <COND (<==? .TYP FREE> <MAPLEAVE <>>)
147 (<==? <AC-ITEM .AC> .ITM>
149 <COND (<AND <==? <AC-CODE .AC> TYPE>
151 <==? <AC-CODE .NAC> VALUE>
152 <==? <AC-ITEM .NAC> .ITM>>
153 <AC-TIME .AC ,AC-STAMP>
154 <AC-TIME .NAC ,AC-STAMP>
155 <MAPLEAVE <AC-NAME .AC>>)>)
156 (<==? <AC-CODE .AC> .TYP>
157 <AC-TIME .AC ,AC-STAMP>
158 <MAPLEAVE <AC-NAME .AC>>)>)>>
161 <DEFINE SMASH-AC (NAM ITM TYP "OPTIONAL" (AC? T) "AUX" AC RAC)
162 #DECL ((NAM TYP) ATOM (RAC) AC (ITM) ANY (AC AC?) <OR FALSE ATOM>)
163 <COND (<AND .AC? <SET AC <IN-AC? .ITM .TYP>>>
164 <COND (<==? .TYP BOTH>
165 <SET RAC <GET-AC .NAM>>
166 <COND (<N==? .NAM .AC>
168 <OCEMIT DMOVE .NAM .AC>
171 <COND (<TYPE? .ITM ATOM>
174 <AC-ITEM <SET RAC <GET-AC <NEXT-AC .NAM>>> .ITM>
175 <AC-CODE .RAC VALUE>)
178 <AC-CODE <GET-AC <NEXT-AC .NAM>> DUMMY>)>)
181 <AC-TYPE <SET RAC <GET-AC .NAM>> <>>
182 <OCEMIT MOVE .NAM .AC>
185 <COND (<TYPE? .ITM ATOM>
189 <AC-CODE .RAC DUMMY>)>)>
197 <COND (<==? .TYP BOTH> <GET-AC <NEXT-AC .NAM>>)>>)>>
199 <DEFINE CLEAN-ACS (ITM)
204 <COND (<==? <AC-ITEM .AC> .ITM>
206 <AC-CODE .AC DUMMY>)>>
209 <DEFINE LOAD-TYPE (AC L "AUX" NUM (OFF 0))
210 #DECL ((AC) ATOM (L) LIST (NUM) <OR CONSTANT FIX CONST-W-LOCAL>
214 <SET NUM <CHTYPE <ORB 19595788288 ,<1 .L>> CONSTANT>>)
216 <COND (<==? <LENGTH .L> 3> <SET OFF <1 .L>> <SET L <REST .L>>)>
219 <+ <CHTYPE <ORB 19595788288 <LSH ,<1 <2 .L>> 18>>
221 <ANDB .OFF *777777*>>)
224 <OCEMIT LDB .AC !<OBJ-VAL .NUM>>>
226 <DEFINE LOAD-AC (ITM TYP
227 "OPTIONAL" (UPDATE <>) (ASSIGN <>) (LAC <>) (NAC <>)
228 "AUX" (BOTH <==? .TYP BOTH>) (LOW <CHTYPE <MIN> FIX>) AC TIM
229 (FIRST-AC ,FIRST-AC) NUM LCL TAC PT IDX)
230 #DECL ((ITM) ANY (TYP) ATOM (LOW TIM) FIX (LAC NAC) <OR AC FALSE>
231 (BOTH UPDATE ASSIGN AC) <OR FALSE ATOM> (NUM) <OR FALSE FIX>
234 <SETG AC-STAMP <+ ,AC-STAMP 1>>
240 <AND <SET AC <IN-AC? .ITM .TYP>> <N==? .AC X*>>
243 <==? .TYP BOTH> ;"Check if either type or value already winning"
244 <OR <AND <SET AC <IN-AC? .ITM TYPE>>
245 ;"Either load value or flush type.."
246 <OR <AND <OR <==? .AC A1*>
253 <GET-AC <NEXT-AC .AC>>>
254 ;"Undo what CLEAN-ACS does to AC"
255 <AC-ITEM <AC-CODE <GET-AC .AC> TYPE> .ITM>>
256 <COND (<AC-UPDATE <GET-AC .AC>>
257 <UPDATE-AC <GET-AC .AC>>
258 <AC-UPDATE <GET-AC .AC> <>>
260 <AND <SET AC <IN-AC? .ITM VALUE>>
261 ;"Either load type or flush value..."
262 <OR <AND <OR <==? .AC A2*>
270 <GET-AC <GETPROP .AC AC-PAIR>>>>
271 ;"Undo what CLEAN-ACS does to AC"
272 <AC-ITEM <AC-CODE <GET-AC <NEXT-AC .AC>> VALUE>
274 <COND (<AC-UPDATE <GET-AC .AC>>
275 <UPDATE-AC <GET-AC .AC>>
276 <AC-UPDATE <GET-AC .AC> <>>
279 <AC-UPDATE <SET LAC <GET-AC .AC>> .UPDATE>
282 <SETG ACA-BOTH .BOTH>
284 <AC-UPDATE <SET NAC <GET-AC <NEXT-AC .AC>>> .UPDATE>
285 <SETG ACA-BOTH .NAC>)>)>
291 <AND <TYPE? .ITM ATOM>
292 <SET LAC <LOOK-AHEAD <REST .MIML> .ITM .TYP>>
294 <AND <NOT <TYPE? <AC-ITEM .LAC> ATOM>>
296 <NOT <TYPE? <AC-ITEM <GET-AC <NEXT-AC .LAC>>> ATOM>>>>>>
297 <REPEAT ((ACT <REST ,AC-TABLE>))
298 #DECL ((ACT) <VECTOR [REST AC]>)
300 (<OR <EMPTY? .ACT> <AND .BOTH <1? <LENGTH .ACT>>>> <RETURN>)
303 (<AND <N==? <AC-NAME <2 .ACT>> X*>
304 <N==? <AC-NAME <1 .ACT>> X*>>
305 <SET TIM <MAX <AC-TIME <1 .ACT>> <AC-TIME <2 .ACT>>>>
306 <COND (<AND .FIRST-AC
309 <OR <NOT <AC-ITEM <1 .ACT>>>
310 <AND <AC-UPDATE .LAC>
311 <NOT <AC-UPDATE <1 .ACT>>>>>>>>
312 <SET LOW <MIN .TIM .LOW>>
316 <COND (<OR <N==? .LOW .TIM>
319 <OR <NOT <AC-ITEM <1 .ACT>>>
320 <AND <AC-UPDATE .LAC>
321 <NOT <AC-UPDATE <1 .ACT>>>>>>>
324 <SET NAC <2 .ACT>>)>)>)>)
325 (<AND <N==? <AC-NAME <1 .ACT>> X*> <N==? <AC-NAME <1 .ACT>> T*>>
326 <SET TIM <AC-TIME <1 .ACT>>>
327 <COND (<AND .FIRST-AC
330 <OR <NOT <AC-ITEM <1 .ACT>>>
331 <AND <AC-UPDATE .LAC>
332 <NOT <AC-UPDATE <1 .ACT>>>>>>>>
336 <COND (<OR <N==? .LOW .TIM>
339 <OR <NOT <AC-ITEM <1 .ACT>>>
340 <AND <AC-UPDATE .LAC>
341 <NOT <AC-UPDATE <1 .ACT>>>>>>>
343 <SET LAC <1 .ACT>>)>)>)>
344 <COND (.BOTH <SET ACT <REST .ACT 2>>) (T <SET ACT <REST .ACT>>)>>>
345 <COND (<AND .BOTH <NOT .NAC>> <SET NAC <GET-AC <NEXT-AC .LAC>>>)>
346 <COND (<AC-UPDATE <CHTYPE .LAC AC>> <UPDATE-AC .LAC>)>
350 <SETG ACA-BOTH .BOTH>
351 <AC-ITEM <CHTYPE .LAC AC> #LOSE *000000000000*>)
352 (<TYPE? .ITM ATOM> <AC-ITEM <CHTYPE .LAC AC> .ITM>)
353 (ELSE <AC-ITEM <CHTYPE .LAC AC> <>>)>
354 <AC-CODE <CHTYPE .LAC AC> <COND (.BOTH TYPE) (.TYP)>>
355 <OR <==? .LAC <GET-AC T*>> <AC-TIME <CHTYPE .LAC AC> ,AC-STAMP>>
356 <AC-TYPE <CHTYPE .LAC AC> <>>
358 <COND (<AC-UPDATE <CHTYPE .NAC AC>> <UPDATE-AC .NAC>)>
361 <AC-ITEM <CHTYPE .NAC AC> #LOSE *000000000000*>)
362 (<TYPE? .ITM ATOM> <AC-ITEM <CHTYPE .NAC AC> .ITM>)
363 (ELSE <AC-ITEM <CHTYPE .NAC AC> <>>)>
364 <AC-CODE <CHTYPE .NAC AC> VALUE>
365 <AC-TIME <CHTYPE .NAC AC> ,AC-STAMP>
366 <AC-UPDATE <CHTYPE .NAC AC> .UPDATE>
367 <AC-TYPE <CHTYPE .NAC AC> <>>)>
368 <AC-UPDATE <CHTYPE .LAC AC> .UPDATE>
371 <COND (<OR <SET LCL <LMEMQ .ITM ,LOCALS>>
372 <AND ,ICALL-FLAG <SET LCL <LMEMQ .ITM ,ICALL-TEMPS>>>>
373 <SET ITM <LNAME <CHTYPE .LCL LOCAL>>>
374 <SET IDX <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>>
376 <OCEMIT DMOVE .LAC <- ,STACK-DEPTH> .ITM .IDX>)
378 <OCEMIT MOVE .LAC <- 1 ,STACK-DEPTH> .ITM .IDX>)
380 <OCEMIT HRRZ .LAC <- ,STACK-DEPTH> .ITM .IDX>)
382 <LOAD-TYPE <AC-NAME <CHTYPE .LAC AC>>
383 (<- ,STACK-DEPTH> .ITM .IDX)>)
384 (T <OCEMIT MOVE .LAC <- ,STACK-DEPTH> .ITM .IDX>)>)
385 (T <MIMOCERR UNKNOWN-LOCAL!-ERRORS .ITM>)>)
386 (<AND <OR <AND <OR <==? <SET PT <PRIMTYPE .ITM>> WORD> <==? .PT FIX>>
387 <OR <L? <ABS <CHTYPE .ITM FIX>> ,MAX-IMMEDIATE>
388 <0? <CHTYPE <ANDB .ITM 262143> FIX>>>>
389 <AND <==? <PRIMTYPE .ITM> LIST>
390 <EMPTY? <CHTYPE .ITM LIST>>>>
391 <OR <OR <==? .TYP FREE> <==? .TYP VALUE>>
392 <AND <==? .TYP BOTH> <MEMQ <TYPE .ITM> ,TYPE-WORDS>>>>
394 "Hacked by TAA to do immediate instructions when possible
395 even when loading BOTH. TAC is AC that will have value
396 word; type word (when BOTH) goes into LAC, TAC becomes NAC.
397 Otherwise, TAC becomes LAC."
398 <COND (<==? .TYP BOTH>
399 <LOAD-TYPE-IN-AC <AC-NAME .LAC> <TYPE .ITM>>
402 <COND (<==? <PRIMTYPE .ITM> LIST> <OCEMIT MOVEI .TAC 0>)
403 (<0? <CHTYPE <ANDB .ITM 262143> FIX>>
404 <OCEMIT MOVSI .TAC <CHTYPE <LSH .ITM -18> FIX>>)
405 (T ;<L? <ABS <SET ITM <CHTYPE .ITM FIX>>> ,MAX-IMMEDIATE
407 <COND (<L? <SET ITM <CHTYPE .ITM FIX>> 0>
408 <OCEMIT MOVNI .TAC <ABS .ITM>>)
409 (ELSE <OCEMIT MOVEI .TAC .ITM>)>)>)
411 <SET NUM <MVADD .ITM>>
412 <SET NUM <* <+ .NUM 1> 2>>
413 <COND (.BOTH <OCEMIT DMOVE .LAC .NUM '(M*)>)
414 (<==? .TYP VALUE> <OCEMIT MOVE .LAC 1 .NUM '(M*)>)
415 (<==? .TYP LENGTH> <OCEMIT HRRZ .LAC .NUM '(M*)>)
417 <LOAD-TYPE <AC-NAME <CHTYPE .LAC AC>> (.NUM '(M*))>)
418 (T <OCEMIT MOVE .LAC .NUM '(M*)>)>)>
419 <AC-NAME <CHTYPE .LAC AC>>)>>
421 <DEFINE LABEL-PREF (LBL VAR TYP "AUX" (LB <FIND-LABEL .LBL>) L)
422 #DECL ((LBL VAR TYP) ATOM (LB) <OR FALSE LAB>)
426 <OR <SET L <LAB-FINAL-STATE .LB>>
427 <AND <NOT <EMPTY? <LAB-STATE .LB>>>
428 <SET L <1 <LAB-STATE .LB>>>>>>
430 <FUNCTION (ACSP "AUX" (ACS <1 .ACSP>) NXT)
431 #DECL ((ACS) ACSTATE (NXT) <OR ACSTATE FALSE>)
432 <COND (<OR <AND <ACS-LOCAL .ACS>
433 <==? <LATM <ACS-LOCAL .ACS>> .VAR>
434 <OR <==? <ACS-CODE .ACS> .TYP>
436 <==? <ACS-CODE .ACS> TYPE>>>>
438 <NOT <EMPTY? <REST .ACSP>>>
439 <ACS-LOCAL <SET NXT <2 .ACSP>>>
440 <==? <LATM <ACS-LOCAL .NXT>> .VAR>
441 <==? <ACS-CODE .NXT> VALUE>>>
442 <MAPLEAVE <ACS-AC .ACS>>)>>
445 <DEFINE LOOK-AHEAD (L ITM TYP)
446 #DECL ((L) LIST (ITM TYP) ATOM)
447 <COND (<N==? .ITM STACK>
449 <COND (<EMPTY? .L> <RETURN <>>)>
450 <COND (<TYPE? <SET IT <1 .L>> ATOM>
451 <SET X <LABEL-PREF .IT .ITM .TYP>>
452 <COND (.X <RETURN .X>) (ELSE <RETURN <>>)>)
453 (<AND <TYPE? .IT FORM>
455 <COND (<SET Y <GETPROP <SET X <1 .IT>> LOOKA-AHEAD>>
456 <SPECIAL-PREF .Y .IT .ITM .TYP>)
458 <COND (<==? .ITM <2 .IT>>
459 <RETURN <COND (<==? .TYP VALUE>
464 <RETURN <COND (<==? .TYP VALUE>
469 (<SET Y <OR <MEMQ + .IT> <MEMQ - .IT>>>
470 <SET Y <LABEL-PREF <2 .Y> .ITM .TYP>>
471 <COND (.Y <RETURN .Y>)>)
472 (<AND <==? .X SET> <==? <2 .IT> .ITM>>
474 (<AND <SET Y <MEMQ = .IT>> <==? <2 .Y> .ITM>>
476 (<AND <==? .X DEAD> <MEMQ .ITM <REST .IT>>>
478 (<AND <==? .X RETURN> <==? <2 .IT> .ITM>>
479 <COND (<==? .TYP VALUE> <RETURN <GET-AC A2*>>)
480 (ELSE <RETURN <GET-AC A1*>>)>)
481 (<==? .X RETURN> <RETURN <>>)>)>
482 <SET L <REST .L>>>)>>
484 <DEFINE UPDATE-AC (AC
486 "AUX" (ITM <AC-ITEM .AC>) (TYP <AC-CODE .AC>) NAC NUM LCL
487 (T1 <AC-TIME .AC>) T2 (ACSTMP ,AC-STAMP))
488 #DECL ((NAC AC) AC (ITM) ANY (TYP) ATOM (NUM ACSTMP) FIX
489 (LCL) <OR ATOM FALSE LOCAL>)
490 <COND (<AND <TYPE? .ITM ATOM> <N==? .ITM STACK>>
491 <COND (<SET LCL <LMEMQ .ITM ,LOCALS>>
492 <COND (<AND <TYPE? .LCL LOCAL> <NOT <LUPD .LCL>>>
494 (<AND ,ICALL-FLAG <SET LCL <LMEMQ .ITM ,ICALL-TEMPS>>>
495 <COND (<AND <TYPE? .LCL LOCAL> <NOT <LUPD .LCL>>>
497 (T <MIMOCERR UNKNOWN-LOCAL!-ERRORS .ITM>)>
498 <SET ITM <LNAME <CHTYPE .LCL LOCAL>>>
499 <COND (<OR <AND <==? .TYP TYPE>
500 <SET NAC <GET-AC <NEXT-AC .AC>>>
501 <==? <AC-CODE .NAC> VALUE>
502 <==? <AC-ITEM .NAC> <LATM <CHTYPE .LCL LOCAL>>>
505 <AND <==? .TYP VALUE>
506 <SET NAC <GETPROP .AC AC-PAIR>>
507 <==? <AC-CODE .NAC> TYPE>
508 <==? <AC-ITEM .NAC> <LATM <CHTYPE .LCL LOCAL>>>
509 <SET T2 <AC-TIME .NAC>>
512 <SET T1 <AC-TIME .NAC>>
514 <SET NAC <GET-AC <NEXT-AC .AC>>>>>
515 <HACK-LAST-ACS .LCL TYPE>
516 <HACK-LAST-ACS .LCL VALUE>
517 <SET T2 <AC-TIME .NAC>>
518 <COND (<AND <MEMQ .LCL ,TYPED-LOCALS>
519 <N==? <LUPD .LCL> OARG>>
520 <OCEMIT MOVEM <AC-NAME .NAC> <- 1 ,STACK-DEPTH> .ITM
521 <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>>)
523 <OCEMIT DMOVEM <AC-NAME .AC> <- ,STACK-DEPTH> .ITM
524 <COND (,WINNING-VICTIM '(TP*))
526 <COND (.SAVE-TIME <AC-TIME .AC .T1> <AC-TIME .NAC .T2>)>
529 <HACK-LAST-ACS .LCL TYPE>
530 <COND (<NOT <MEMQ .LCL ,TYPED-LOCALS>>
531 <OCEMIT MOVEM <AC-NAME .AC> <- ,STACK-DEPTH> .ITM
532 <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>>
533 <COND (.SAVE-TIME <AC-TIME .AC .T1>)>)>)
535 <HACK-LAST-ACS .LCL VALUE>
536 <OCEMIT MOVEM <AC-NAME .AC> <- 1 ,STACK-DEPTH> .ITM
537 <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>>
540 <COND (<ASSIGNED? T2> <AC-TIME .NAC .T2>)>)>)>)>
541 <COND (.SAVE-TIME <SETG AC-STAMP .ACSTMP>)>>
543 <DEFINE HACK-LAST-ACS (LCL TYP "AUX" ACS)
544 #DECL ((LCL) LOCAL (TYP) ATOM (ACS) <OR ACSTATE FALSE>)
545 <COND (<AND <==? .TYP TYPE>
546 <SET ACS <LAST-ACST .LCL>>
547 <NOT <ACS-STORED .ACS>>>
548 <PUT .ACS ,ACS-STORED HACKED>
549 <PUT .LCL ,LAST-ACST <>>)
550 (<AND <==? .TYP VALUE>
551 <SET ACS <LAST-ACSV .LCL>>
552 <NOT <ACS-STORED .ACS>>>
553 <PUT .ACS ,ACS-STORED HACKED>
554 <PUT .LCL ,LAST-ACSV <>>)>>
556 <DEFINE UPDATE-ACS () <LABEL-UPDATE-ACS <> <>>>
558 <DEFINE LABEL-UPDATE-ACS (TAG UNCND
559 "OPT" (NO-TY <>) (A1 <>) (A2 <>)
560 "AUX" NXT LB (MIML .MIML))
561 #DECL ((TAG) <OR ATOM FALSE> (NXT) ANY (MIML) LIST)
562 <COND (<AND .TAG <SET LB <FIND-LABEL .TAG>>>)>
563 <COND (<OR <==? .TAG COMPERR> <==? .TAG UNWCONT>> ;"Don't bother"
564 <COND (.A1 <COND (.A2 (.A1 .A2)) (ELSE (.A1))>)>)
566 <COND (<AND .TAG <NOT <LAB-LOOP .LB>> <NOT .UNCND>>
568 <COND (<NOT <EMPTY? .MIML>>
569 <COND (<AND <TYPE? <SET NXT <2 .MIML>> FORM>
571 <DEAD!-MIMOC <REST .NXT> T .NO-TY>
572 <SET MIML <REST .MIML>>
575 <SET MIML <REST .MIML>>
578 <COND (<OR <NOT .TAG> ,NO-AC-FUNNYNESS>
582 <COND (<AC-UPDATE .AC>
584 <AC-UPDATE .AC <>>)>>
586 <COND (.A1 <COND (.A2 (.A1 .A2)) (ELSE (.A1))>)>)
588 <SAVE-BRANCH-STATE .LB .UNCND>
589 <COND (.A1 <COND (.A2 (.A1 .A2)) (ELSE (.A1))>)>)
590 (<NOT ,NO-AC-FUNNYNESS>
591 <ESTABLISH-BRANCH-STATE .LB .UNCND .A1 .A2>)>)>>
593 <DEFINE FLUSH-AC (AC "OPTIONAL" (BOTH <>) "AUX" RAC)
594 #DECL ((AC) ATOM (RAC) AC (BOTH) <OR ATOM FALSE>)
595 <COND (<AC-UPDATE <SET RAC <GET-AC .AC>>>
597 <COND (<AND .BOTH <AC-UPDATE <SET RAC <GET-AC <NEXT-AC .AC>>>>>
600 <DEFINE ALTER-AC (AC WHAT "AUX" RAC)
601 #DECL ((AC WHAT) ATOM (RAC) AC)
602 <COND (<AC-UPDATE <SET RAC <GET-AC .AC>>> <UPDATE-AC .RAC>)>
606 <COND (<AC-UPDATE <SET RAC <GET-AC <NEXT-AC .AC>>>> <UPDATE-AC .RAC>)>
619 <OR <==? <AC-NAME .AC> T*> <AC-TIME .AC 0>>>
622 <DEFINE REALLY-FREE-AC-PAIR ("AUX" OAC)
623 <COND (<OR <AND <==? <AC-CODE <GET-AC <SET OAC A1*>>> DUMMY>
624 <==? <AC-CODE <GET-AC A2*>> DUMMY>>
625 <AND <==? <AC-CODE <GET-AC <SET OAC B1*>>> DUMMY>
626 <==? <AC-CODE <GET-AC B2*>> DUMMY>>
627 <AND <==? <AC-CODE <GET-AC <SET OAC C1*>>> DUMMY>
628 <==? <AC-CODE <GET-AC C2*>> DUMMY>>>
631 <DEFINE MUNGED-AC (NAM "OPTIONAL" (NXT? <>) "AUX" AC)
632 #DECL ((NAM) ATOM (NXT?) <OR ATOM FALSE> (AC) AC)
633 <AC-ITEM <SET AC <GET-AC .NAM>> <>>
638 <AC-ITEM <SET AC <GET-AC <NEXT-AC .NAM>>> <>>
647 <DEFINE MVADD (ITM "AUX" P HC:FIX IDX:FIX BK:LIST)
649 <COND (<REPEAT ((ITM .ITM))
650 <COND (<AND <TYPE? .ITM FORM>
651 <==? <LENGTH .ITM> 2>
652 <==? <1 .ITM> QUOTE>>
653 <COND (<TYPE? <SET ITM <2 .ITM>> ATOM>
656 ; "This will strip off one level of quoting only when the
657 thing ultimately quoted is an atom; in other cases, all
658 levels need to remain."
660 <SET BK <NTH ,MV-TABLE
661 <SET IDX <+ <MOD <SET HC <HASH .ITM>>
665 <FUNCTION (MVB:MBUCK)
666 <COND (<AND <==? <MV-HASH .MVB> .HC>
667 <=? <MV-VAL .MVB> .ITM>>
674 (<SET FMV <CHTYPE [.ITM .HC <SETG MV-COUNT <+ ,MV-COUNT 1>>]
676 <SETG MV <REST <PUTREST ,MV (.ITM)>>>)>
679 <DEFINE POS (ITM LST "AUX" M)
680 #DECL ((ITM) ANY (LST) LIST (M) <OR FALSE LIST>)
681 <COND (<AND <TYPE? .ITM FORM>
682 <G? <LENGTH .ITM > 1>
684 <TYPE? <2 .ITM> ATOM>>
686 <COND (<AND ,ICALL-FLAG
688 <SET M <MEMQ .ITM ,ICALL-TEMPS>>>
690 (<SET M <MEMQ .ITM <REST .LST>>>
691 <- <LENGTH .LST> <LENGTH .M>>)>>
693 <DEFINE LMEMQ (ATM LST "AUX" ITM)
694 #DECL ((ATM) ATOM (LST) LIST (ITM) <OR ATOM LOCAL>)
696 <COND (<EMPTY? .LST> <RETURN <>>)
697 (<AND <TYPE? <SET ITM <1 .LST>> LOCAL>
698 <==? <LATM .ITM> .ATM>>
700 (<==? .ITM .ATM> <RETURN .ATM>)>
701 <SET LST <REST .LST>>>>
703 <DEFINE L-N-LMEMQ (LN LST "AUX" ITM)
704 #DECL ((LN) LOCAL-NAME (LST) LIST (ITM) <OR ATOM LOCAL>)
706 <COND (<EMPTY? .LST> <RETURN <>>)
707 (<AND <TYPE? <SET ITM <1 .LST>> LOCAL>
708 <==? <LNAME .ITM> .LN>>
710 (<==? .ITM .LN> <RETURN .LN>)>
711 <SET LST <REST .LST>>>>
713 <DEFINE LLOOKUP (ATM "AUX" M P)
714 #DECL ((ATM) ATOM (M) <OR LIST FALSE> (P) <OR FALSE FIX>)
715 <COND (<SET M <MEMQ .ATM ,ICALL-TEMPS>> <* <CHTYPE <2 .M> FIX> 2>)
716 (<SET P <POS .ATM ,LOCALS>> <* <CHTYPE .P FIX> 2>)
717 (<MIMOCERR UNKNOWN-LOCAL!-ERRORS .ATM>)>>
719 <DEFINE FIXUP-LOCALS (L
720 "AUX" (C ,TEMP-CC) (CFLG <>) (CNT 0) (LNUM 0) (TUP <>)
722 #DECL ((FL L C) LIST (CFLG) <OR ATOM FALSE> (CNT LNUM) FIX
723 (TUP) <OR FALSE INST>)
724 <COND (<AND <TYPE? <SET TMP <2 .C>> INST>
728 <SET C <REST .C 5>>)>
730 <FUNCTION (ITM "AUX" LU)
732 <COND (<NOT .CFLG> <SET CFLG T>)>
733 <COND (<SET LU <LUPD .ITM>>
734 <SET FL (<LNAME .ITM> <SET LNUM <+ .LNUM 2>> !.FL)>
735 <COND (<AND <N==? .LU ARG> <N==? .LU OARG>>
736 <SET C <REST .C 2>>)>)
738 <COND (,WINNING-VICTIM
739 <SETG WINNING-VICTIM <- ,WINNING-VICTIM 2>>)>
741 <PUTREST .C <REST .C 3>>
745 <- <CHTYPE <3 .TUP> FIX> 1>>)>)>>
747 <COND (,WINNING-VICTIM
748 <REPEAT ((WV ,WINNING-VICTIM) (L .FL))
749 #DECL ((L) <LIST [REST ANY FIX]> (WV) FIX)
750 <COND (<EMPTY? .L> <RETURN>)>
751 <PUT .L 2 <- <CHTYPE <2 .L> FIX> .WV -1>>
752 <SET L <REST .L 2>>>)>
753 <COND (<NOT <EMPTY? .FL>>
754 <PUTREST <REST .FL <- <LENGTH .FL> 1>> ,FINAL-LOCALS>
755 <SETG FINAL-LOCALS .FL>)>
756 <COND (<AND ,V1 <G? .CNT 0>>
759 <PRINC " flushed temporaries.">
762 <DEFINE OCEMIT ("TUPLE" T "AUX" (LABEL <>))
763 #DECL ((T) TUPLE (LABEL) <OR ATOM FALSE>)
764 <COND (<AND <1? <LENGTH .T>> <TYPE? <1 .T> ATOM>>
765 <AND ,V1 <NOT ,PASS1> <INDENT-TO 30>>
767 (<AND ,V1 <NOT ,PASS1>>
768 <COND (<G? <M-HPOS .OUTCHAN> 45> <CRLF>)>
771 <FUNCTION (Y "AUX" (X <1 .Y>) AC FOO AC1)
772 #DECL ((X) ANY (AC) <OR FALSE AC> (FOO) <OR FALSE ATOM>)
773 <COND (<AND <TYPE? .X LIST> <SET AC <IS-AC? <1 .X>>>>
774 <OR <==? .AC <GET-AC T*>>
775 <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>>
776 <COND (<SET FOO <AC-TYPE .AC>>
777 <LOAD-TYPE-IN-AC <AC-NAME .AC> .FOO>
779 <COND (<AND <SET AC1 <GETPROP .AC AC-PAIR>>
780 <==? <AC-ITEM .AC1> <AC-ITEM .AC>>>
781 <AC-TIME .AC1 ,AC-STAMP>)>)>
783 <COND (<AND <TYPE? .X ATOM>
785 <SET FOO <AC-TYPE .AC>>>
786 <LOAD-TYPE-IN-AC <AC-NAME .AC> .FOO>
789 <PUT .Y 1 <AC-NAME <SET AC .X>>>
790 <COND (<SET FOO <AC-TYPE .X>>
791 <LOAD-TYPE-IN-AC <AC-NAME .AC> .FOO>
794 <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
795 <COND (<AND <SET AC1 <GETPROP .AC AC-PAIR>>
796 <==? <AC-ITEM .AC> <AC-ITEM .AC1>>>
797 <AC-TIME .AC1 ,AC-STAMP>)>)>>
799 <COND (<AND ,V1 <NOT ,PASS1>>
802 <COND (<TYPE? .ITM ATOM> <PRINC .ITM>)
805 <COND (<TYPE? <1 .ITM> ATOM> <PRINC <1 .ITM>>)
806 (ELSE <PRIN1 <1 .ITM>>)>
810 <COND (<TYPE? <1 .ITM> ATOM> <PRINC <1 .ITM>>)
811 (ELSE <PRIN1 <1 .ITM>>)>
816 <COND (.LABEL <AND ,V1 <NOT ,PASS1> <PRINC ":">>)
819 <SETG CC <REST <PUTREST ,CC (<CHTYPE [!.T] INST>)>>>)>>
821 <DEFINE XEMIT ("TUPLE" T "AUX" M COD)
822 #DECL ((T) <TUPLE ATOM ATOM <OR FIX XTYPE-C REF>>
823 (COD) <OR FIX XTYPE-C REF> (M) <OR VECTOR FALSE>)
825 <COND (<AND <TYPE? <SET COD <3 .T>> FIX>
840 <2 .M>> FIX>>] INST>)>>>)
841 (T <SETG CC <REST <PUTREST ,CC (<CHTYPE [!.T] INST>)>>>)>
847 <COND (<TYPE? .ITM ATOM> <PRINC .ITM>)
850 <COND (<TYPE? <1 .ITM> ATOM>
852 (ELSE <PRIN1 <1 .ITM>>)>
856 <COND (<TYPE? <1 .ITM> ATOM>
858 (ELSE <PRIN1 <1 .ITM>>)>
866 <DEFINE CONST-LOC (ITM TYP "OPT" NEWV)
867 <COND (<==? .TYP TYPE>
868 <TYPE-WORD <TYPE .ITM>>)
870 <COND (<TYPE? .ITM CONST-W-LOCAL>
873 <CONST-ADD <SET ITM <CHTYPE .ITM CONSTANT>>>)>)>>
875 <DEFINE CONST-ADD (ITM "AUX" LBL (LS <+ ,CONSTSEQ 1>) HC BUCK INDX FCB)
876 #DECL ((INDX HC LS) FIX (ITM) <OR CONSTANT CONST-W-LOCAL>
877 (BUCK) <LIST [REST CONSTANT-BUCKET]> (FCB) CONSTANT-BUCKET)
878 <COND (<TYPE? .ITM CONSTANT> <SET HC <CHTYPE .ITM FIX>>)
879 (ELSE <SET HC <XORB <1 .ITM> <2 .ITM>>>)>
880 <SET BUCK <NTH ,CONSTANT-TABLE
881 <SET INDX <+ <MOD <SET HC <XORB .HC 3.141516>>
882 ,CONSTANT-TABLE-LENGTH> 1>>>>
884 <FUNCTION (CB:CONSTANT-BUCKET "AUX" TEM)
885 <COND (<AND <==? .HC <CB-HASH .CB>>
886 <OR <AND <TYPE? .ITM CONSTANT>
887 <==? .ITM <CB-VAL .CB>>>
888 <AND <TYPE? .ITM CONST-W-LOCAL>
889 <TYPE? <SET TEM <CB-VAL .CB>>
891 <==? <1 .TEM> <1 .ITM>>
892 <==? <2 .TEM> <2 .ITM>>>>>
897 <SET FCB <CHTYPE [.ITM .HC <CHTYPE <SETG CONSTSEQ .LS>
900 <SETG CONSTANT-VECTOR (.FCB !,CONSTANT-VECTOR)>
901 <PUT ,CONSTANT-TABLE .INDX (.FCB !.BUCK)>)>
902 (<CHTYPE [.FCB] REF>)>
904 <DEFINE CONST-ADD-FRM ("AUX" CB)
905 <SETG CONSTANT-VECTOR (<SET CB
906 <CHTYPE [FREE 0 <CHTYPE <SETG CONSTSEQ
911 <SETG FREE-CONSTS (.CB !,FREE-CONSTS)>>
913 <DEFINE OBJ-LOC (ITM OFF "AUX" IDX NUM LCL)
914 #DECL ((ITM) ANY (OFF NUM) FIX (IDX) <OR FALSE FIX>)
915 <COND (<TYPE? .ITM ATOM>
917 <OR <LMEMQ .ITM ,LOCALS>
918 <AND ,ICALL-FLAG <LMEMQ .ITM ,ICALL-TEMPS>>>>
919 (<- .OFF ,STACK-DEPTH> <LNAME <CHTYPE .LCL LOCAL>>
920 <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>))
922 <SET NUM <MVADD .ITM>>
923 <SET NUM <* <+ .NUM 1> 2>>
924 (<+ .OFF .NUM> '(M*)))>>
926 <DEFINE ALLOCATE-CONSTANTS (CV START)
927 #DECL ((CV CL) LIST (START) FIX)
929 <FUNCTION (CB:CONSTANT-BUCKET)
931 <SET START <+ .START 1>>>
934 <DEFINE FIXUP-CONSTANTS (C "AUX" (N 0))
937 <FUNCTION (CP "AUX" (IT <1 .CP>) R X)
938 <COND (<AND <TYPE? .IT INST>
940 <TYPE? <SET R <NTH .IT <LENGTH .IT>>> REF>>
941 <COND (<NOT <TYPE? <SET X <1 .R>> CONSTANT-BUCKET>>
942 <MIMOCERR BAD-REF-IN-CODE!-ERRORS .X>)
944 <SETG GREFS ((.N .X) !,GREFS)>
945 <PUT .CP 1 <CHTYPE [<1 .IT> <2 .IT> 0 '(R*)] INST>>)
949 <CHTYPE [<1 .IT> <2 .IT>
954 <DEFINE OBJ-VAL (ITM "OPTIONAL" (AC? T) "AUX" AC)
955 #DECL ((ITM) ANY (AC AC?) <OR FALSE ATOM>)
956 <COND (<AND .AC? <SET AC <IN-AC? .ITM VALUE>>> (.AC))
957 (<==? <PRIMTYPE .ITM> FIX>
958 <CONST-LOC <CHTYPE .ITM CONSTANT> VALUE>)
959 (<TYPE? .ITM CONST-W-LOCAL> <CONST-LOC .ITM VALUE>)
960 (T <OBJ-LOC .ITM 1>)>>
962 <DEFINE OBJ-TYP (ITM "AUX" AC)
963 #DECL ((ITM) ANY (AC) <OR FALSE ATOM>)
964 <COND (<SET AC <IN-AC? .ITM TYPE>> (.AC))
965 (<AND <==? <PRIMTYPE .ITM> FIX>
966 <MEMQ <TYPE .ITM> ,TYPE-WORDS>>
967 <CONST-LOC .ITM TYPE>)
968 (T <OBJ-LOC .ITM 0>)>>
970 <DEFINE XJUMP (TAG "AUX" X)
971 <COND (<AND <N==? <OBLIST? .TAG> ,LABEL-OBLIST>
972 <SET X <LOOKUP <SPNAME .TAG> ,LABEL-OBLIST>>>
976 <DEFINE DEAD!-MIMOC (LCLS "OPTIONAL" (PRED? <>) (NO-TY <>))
977 #DECL ((LCLS) <LIST [REST ATOM]> (PRED?) <OR FALSE ATOM>)
978 <COND (<NOT ,DEATH-TRQ> <SET NO-TY T>)>
980 <FUNCTION (AC "AUX" ITM FOO LCL)
981 #DECL ((AC) AC (FOO) <OR FALSE ATOM> (LCL) LOCAL)
982 <COND (<MEMQ <SET ITM <AC-ITEM .AC>> .LCLS>
984 <OR <LMEMQ <AC-ITEM .AC> ,LOCALS>
986 <LMEMQ <AC-ITEM .AC> ,ICALL-TEMPS>>>>
987 <PUT .LCL ,LAST-ACST <>>
988 <PUT .LCL ,LAST-ACSV <>>
989 <COND (<SET FOO <AC-TYPE .AC>>
991 <LOAD-TYPE-IN-AC <AC-NAME .AC> .FOO>
1000 <COND (<NOT <GASSIGNED? LBLSEQ>> <SETG CONSTSEQ <SETG LBLSEQ 0>>)>
1002 <DEFINE GENLBL (STR)
1003 #DECL ((STR) STRING)
1004 <SET STR <STRING .STR <UNPARSE <SETG LBLSEQ <+ ,LBLSEQ 1>>>>>
1005 <OR <LOOKUP .STR ,LABEL-OBLIST> <INSERT .STR ,LABEL-OBLIST>>>
1007 <DEFINE LABEL (NAM "OPT" (IND <>) (CP ()) "AUX" (LB <>))
1008 #DECL ((NAM) ATOM (IND) <OR FALSE FIX>)
1009 <SET LB <FIND-LABEL .NAM>>
1012 <SET LB <MAKE-LABEL .NAM .IND .CP>>)
1014 <LAB-IND .LB .IND>)>
1015 <PUT .LB ,LAB-LOOP ,NEXT-LOOP>
1017 (ELSE <SETG CC <REST <PUTREST ,CC (.NAM)>>> <OCEMIT .NAM> .LB)>>
1019 <DEFINE MAKE-LABEL (NAM IND CP "OPT" (NL <>) "AUX" LB)
1021 (<SET LB <CHTYPE [.NAM .IND .NL () <> 0 .CP ()] LAB>>
1026 <DEFINE LONG-FIND-LABEL (NAM LBLS) #DECL ((LBLS) <LIST [REST LAB]>)
1028 <FUNCTION (LB) #DECL ((LB) LAB)
1029 <COND (<==? <LAB-NAM .LB> .NAM> <MAPLEAVE .LB>)>>
1032 <DEFINE FIND-LABEL (NAM )
1034 <COND (<GASSIGNED? .NAM> ,.NAM)>>
1036 <DEFINE TYPE-CODE (TYP "OPT" (LS <>) "AUX" L)
1037 #DECL ((TYP) ATOM (L) <OR FALSE VECTOR>)
1038 <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
1039 <COND (.LS (<2 .L>)) (ELSE <2 .L>)>)
1041 <COND (.LS (@ !<OBJ-LOC <CHTYPE .TYP XTYPE-C> 1>))
1042 (ELSE <CHTYPE .TYP XTYPE-C>)>)
1043 (T <MIMOCERR UNDEFINED-TYPE!-ERRORS .TYP>)>>
1045 <DEFINE TYPE-WORD (TYP "AUX" L VAL M)
1046 #DECL ((TYP) ATOM (L M) <OR FALSE VECTOR> (VAL) CONSTANT)
1047 <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
1048 <SET VAL <CHTYPE <LSH <2 .L> 18> CONSTANT>>
1049 <COND (<SET M <MEMQ .TYP ,TYPE-LENGTHS>>
1050 <SET VAL <CHTYPE <ORB .VAL <2 .M>> CONSTANT>>)>
1052 <CONST-LOC .VAL VALUE>)
1053 (<VALID-TYPE? .TYP> <OBJ-LOC <CHTYPE .TYP XTYPE-W> 1>)
1054 (T <MIMOCERR CANT-TYPE-WORD!-ERRORS .TYP>)>>
1056 <DEFINE PUSHJ (NAM "OPTIONAL" (VAL <>) (TAG <>) (TYP <>) "AUX" AC
1058 #DECL ((NAM) ATOM (VAL) <OR ATOM FALSE> (AC) AC (OC) FIX)
1061 <OCEMIT PUSHJ P* @ .OC>)
1063 <OCEMIT JSP T* @ <- .OC>>)>
1064 <COND (.TAG <OCEMIT JRST <XJUMP .TAG>>)>
1065 <COND (.TYP <OCEMIT HRLI A1* !<TYPE-CODE .TYP T>>)>
1068 <DEFINE PUSHJ-VAL (VAL "AUX" AC)
1069 #DECL ((VAL) <OR FALSE ATOM> (AC) AC)
1070 <COND (<==? .VAL STACK>
1071 <OCEMIT PUSH TP* A1*>
1072 <OCEMIT PUSH TP* A2*>
1073 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1075 <SET AC <GET-AC A1*>>
1079 <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1080 <SET AC <GET-AC A2*>>
1084 <AC-TIME .AC ,AC-STAMP>)>>
1086 ;"Actual code for open-coding specific MIM instructions"
1088 <SETG MIMOC-OBLIST <MOBLIST MIMOC 51>>
1090 <SETG EVALABLES '[TYPE-CODE TYPE-WORD]>
1092 <GDECL (EVALABLES) VECTOR>
1094 <DEFINE OC (FRM OBLIST "AUX" ATM (EVF <>))
1095 #DECL ((FRM) FORM (ATM EVF) <OR FALSE ATOM> (OBLIST) <SPECIAL ANY>)
1096 <AND <NOT ,PASS1> ,V1 <PRINT .FRM>>
1098 <FUNCTION (L "AUX" (ITM <1 .L>))
1100 <COND (<AND <TYPE? .ITM FORM>
1102 <MEMQ <1 .ITM> ,EVALABLES>>
1103 <PUT .L 1 <EVAL .ITM>>
1104 <PUTPROP .L EVAL .ITM>
1107 <COND (<SET ATM <LOOKUP <SPNAME <1 .FRM>> ,MIMOC-OBLIST>>
1108 <APPLY ,.ATM <REST .FRM>>
1109 <COND (<AND .EVF <NOT ,PASS1>>
1110 <MAPR <> <FUNCTION (L) <PUTPROP .L EVAL>> .FRM>)>)
1111 (T <MIMOCERR CANT-OPEN-COMPILE!-ERRORS .FRM>)>>
1113 ;"Gross and disgusting hack for UNWINDage"
1115 <DEFINE LOCATION!-MIMOC (L "AUX" NAC)
1116 #DECL ((L) LIST (NAC) ATOM)
1117 <SET NAC <ASSIGN-AC <4 .L> BOTH>>
1118 <AC-TYPE <GET-AC .NAC> FIX>
1119 <COND (,GLUE-MODE <OCEMIT MOVEI <NEXT-AC .NAC> 0>)
1120 (ELSE <OCEMIT XMOVEI <NEXT-AC .NAC> 0 '(R*)>)>
1122 <SETG LOCATIONS (<1 ,CC> <2 .L> !,LOCATIONS)>)>
1123 <COND (<NOT ,GLUE-MODE> <OCEMIT SUB <NEXT-AC .NAC> R*>)>>
1125 <DEFINE LOCATION-CHECK ()
1126 <REPEAT ((O ,LOCATIONS))
1127 #DECL ((O) <LIST [REST INST ATOM]>)
1128 <COND (<EMPTY? .O> <RETURN>)
1129 (T <PUT <1 .O> 3 <LAB-IND <FIND-LABEL <2 .O>>>>)>
1130 <SET O <REST .O 2>>>>
1132 <DEFINE LOAD-TYPE-IN-AC (ACNAM TYP)
1133 <COND (<MEMQ .TYP ,TYPE-LENGTHS>
1134 <XEMIT MOVE .ACNAM !<TYPE-WORD .TYP>>)
1136 <XEMIT MOVSI .ACNAM !<TYPE-CODE .TYP T>>)>>
1139 <DEFINE SAVE-BRANCH-STATE (LB UNCND "AUX" NS (LS <LAB-STATE .LB>)
1140 (LOOP? <LAB-LOOP .LB>))
1141 #DECL ((LB) LAB (LS) LIST)
1145 <FUNCTION (AC NULL-STATE "AUX" LCL ACS)
1147 <COND (<AND <AC-ITEM .AC> <NOT <TYPE? <AC-ITEM .AC> LOSE>>>
1148 <OR <SET LCL <LMEMQ <AC-ITEM .AC> ,LOCALS>>
1151 <LMEMQ <AC-ITEM .AC> ,ICALL-TEMPS>>>>)
1152 (ELSE <SET LCL <>>)>
1153 <COND (<AND <AC-UPDATE .AC>
1155 <OR .UNCND <WILL-DIE? <AC-ITEM .AC>>>
1156 <WILL-DIE? <AC-ITEM .AC> <LAB-CODE-PNTR .LB>>>
1161 <COND (<AND <==? <AC-CODE .AC> TYPE>
1162 <SET ACS <LAST-ACST .LCL>>
1163 <NOT <ACS-STORED .ACS>>
1164 <OR <N==? <ACS-AC .ACS> .AC>
1165 <NOT <AC-UPDATE .AC>>>>
1166 <PUT .ACS ,ACS-STORED HACKED>)>
1167 <COND (<AND <==? <AC-CODE .AC> VALUE>
1168 <SET ACS <LAST-ACSV .LCL>>
1169 <NOT <ACS-STORED .ACS>>
1170 <OR <N==? <ACS-AC .ACS> .AC>
1171 <NOT <AC-UPDATE .AC>>>>
1172 <PUT .ACS ,ACS-STORED HACKED>)>
1173 <SET ACS <CHTYPE [.AC
1175 <NOT <AC-UPDATE .AC>>
1179 <COND (<==? <AC-CODE .AC> TYPE>
1180 <PUT .LCL ,LAST-ACST .ACS>)
1182 <PUT .LCL ,LAST-ACSV .ACS>)>
1184 (ELSE .NULL-STATE)>>
1188 <COND (<EMPTY? .LS> <PUT .LB ,LAB-STATE (.NS)>)
1189 (ELSE <PUTREST <REST .LS <- <LENGTH .LS> 1>> (.NS)>)>
1190 <COND (<LAB-LOOP .LB>
1191 <COND (<LAB-FINAL-STATE .LB>
1192 <MERGE-TWO-FORCE .NS <LAB-FINAL-STATE .LB>>)>
1193 <LOGICAL-ESTABLISH .NS>)
1195 <COND (<LAB-FINAL-STATE .LB>
1196 <MERGE-TWO .NS <LAB-FINAL-STATE .LB>>)>
1197 <ESTABLISH-UPDATE .NS>)>
1198 <COND (.UNCND <FLUSH-ACS>) (ELSE <MUNGED-AC T*> <MUNGED-AC O*>)>>
1200 <DEFINE SAVE-LABEL-STATE (LB "AUX" NS)
1206 <FUNCTION (AC NULL-STATE "AUX" LCL (ITM <AC-ITEM .AC>) ACS)
1208 <COND (<AND .ITM <NOT <TYPE? .ITM LOSE>>>
1209 <OR <SET LCL <LMEMQ .ITM ,LOCALS>>
1211 <SET LCL <LMEMQ .ITM ,ICALL-TEMPS>>>>)
1212 (ELSE <SET LCL <>>)>
1214 <COND (<AND <==? <AC-CODE .AC> TYPE>
1215 <SET ACS <LAST-ACST .LCL>>
1216 <NOT <ACS-STORED .ACS>>
1217 <OR <N==? <ACS-AC .ACS> .AC>
1218 <NOT <AC-UPDATE .AC>>>>
1219 <PUT .ACS ,ACS-STORED HACKED>)>
1220 <COND (<AND <==? <AC-CODE .AC> VALUE>
1221 <SET ACS <LAST-ACSV .LCL>>
1222 <NOT <ACS-STORED .ACS>>
1223 <OR <N==? <ACS-AC .ACS> .AC>
1224 <NOT <AC-UPDATE .AC>>>>
1225 <PUT .ACS ,ACS-STORED HACKED>)>
1226 <SET ACS <CHTYPE [.AC
1228 <NOT <AC-UPDATE .AC>>
1232 <COND (<==? <AC-CODE .AC> TYPE>
1233 <PUT .LCL ,LAST-ACST .ACS>)
1235 <PUT .LCL ,LAST-ACSV .ACS>)>
1237 (ELSE .NULL-STATE)>>
1241 <PUT .LB ,LAB-STATE (.NS !<LAB-STATE .LB>)>
1242 <COND (<NOT <LAB-LOOP .LB>> <KILL-DEAD-ACS .LB>)>
1243 <COND (<NOT <LAB-FINAL-STATE .LB>>
1244 <PUT .LB ,LAB-FINAL-STATE .NS>)>
1245 <MERGE-TWO <1 <LAB-STATE .LB>> <LAB-FINAL-STATE .LB>>
1246 <ESTABLISH-LABEL-STATE .LB <1 <LAB-STATE .LB>>>
1249 <COND (<NOT <LAB-LOOP .LB>> <KILL-DEAD-ACS .LB>)>
1250 <COND (<AND <NOT <LAB-FINAL-STATE .LB>> <NOT <EMPTY? <LAB-STATE .LB>>>>
1251 <PUT .LB ,LAB-FINAL-STATE <1 <LAB-STATE .LB>>>)>
1252 <COND (<LAB-FINAL-STATE .LB> <ESTABLISH-LABEL-STATE .LB>)>)>>
1254 <DEFINE KILL-DEAD-ACS (LB)
1256 <COND (<LAB-FINAL-STATE .LB> <KILL-ONE-STATE <LAB-FINAL-STATE .LB>>)>
1257 <MAPF <> ,KILL-ONE-STATE <LAB-STATE .LB>>>
1259 <DEFINE KILL-ONE-STATE (LSTATE)
1260 #DECL ((LSTATE) LABSTATE)
1262 <FUNCTION (ACST "AUX" LCL)
1263 #DECL ((ACST) ACSTATE (LCL) LOCAL)
1264 <COND (<AND <ACS-LOCAL .ACST>
1265 <WILL-DIE? <LATM <SET LCL <ACS-LOCAL .ACST>>>>>
1266 <PUT .LCL ,LAST-ACST <>>
1267 <PUT .LCL ,LAST-ACSV <>>
1268 <PUT .ACST ,ACS-LOCAL
1269 <CHTYPE (<ACS-LOCAL .ACST>) FALSE>>
1270 <PUT .ACST ,ACS-STORED DEAD>)>>
1273 <DEFINE ESTABLISH-BRANCH-STATE (LB UNCND
1274 "OPT" (AC-P1 <>) (AC-P2 <>)
1275 (LS <LAB-FINAL-STATE .LB>)
1276 "AUX" (LOOP? <LAB-LOOP .LB>) (MOVES-TO ())
1277 SAVED? (MOVES-FROM ()))
1278 #DECL ((LB) LAB (LS) LABSTATE)
1281 "AUX" LCL1 (AC <ACS-AC .STAT>) (LCL2 <AC-ITEM .AC>)
1283 #DECL ((STAT) ACSTATE (AC) AC)
1284 <COND (<TYPE? .LCL2 LOSE> <SET LCL2 <>>)>
1285 <COND (<AND <AC-UPDATE .AC>
1288 <OR .UNCND <WILL-DIE? .LCL2>>
1289 <WILL-DIE? .LCL2 <LAB-CODE-PNTR .LB>>
1290 <COND (<ASSIGNED? DISP-L>
1293 <COND (<WILL-DIE? .LCL2
1297 (ELSE <MAPLEAVE <>>)>>
1304 (<OR <AND <SET LCL1 <ACS-LOCAL .STAT>> <==? <LATM .LCL1> .LCL2>>
1305 <AND <NOT .LCL1> <NOT .LOOP?>>>
1306 <COND (<AND <AC-UPDATE .AC>
1307 <OR <AND <NOT .LCL1> <EMPTY? .LCL1>>
1308 <AND <ACS-STORED .STAT>
1310 <AND <NOT <EMPTY? .LCL1>>
1311 <N==? <LATM <1 .LCL1>> .LCL2>>>>>>
1313 <AC-UPDATE .AC <>>)>)
1316 <OR <NOT .LCL2> <N==? <LATM .LCL1> .LCL2>>
1317 <SET NEW-AC? <FIND-AC .LCL1 <ACS-CODE .STAT>>>>
1318 <COND (<NOT <AND <ACS-TYPE .STAT>
1319 <OR <NOT <ACS-STORED .STAT>>
1321 <==? <ACS-TYPE .STAT> <AC-TYPE .NEW-AC?>>>>>
1322 <SET MOVES-TO (.AC !.MOVES-TO)>
1323 <SET MOVES-FROM (.NEW-AC? !.MOVES-FROM)>)>)
1324 (<AND .LCL1 .LOOP? <NOT .NEW-AC?>> <ERROR AC-SCREW-UP!-ERRORS>)>
1327 <NOT <FIND-LOCAL .LCL2 <AC-CODE .AC> .LS T>>
1330 <AC-UPDATE .AC <>>)>>
1332 <COND (<AND .AC-P1 <SET AC-P1 <GET-AC .AC-P1>> <MEMQ .AC-P1 .MOVES-TO>>
1333 <COND (<SET SAVED? <MEMQ .AC-P1 .MOVES-FROM>>
1336 <- <LENGTH .MOVES-FROM> <LENGTH .SAVED?> -1>>>)
1338 <SET MOVES-FROM (.AC-P1 !.MOVES-FROM)>
1340 (<SET AC-P1 <FIND-FREE-TO .MOVES-TO .MOVES-FROM>>
1342 <COND (<AND .AC-P2 <SET AC-P2 <GET-AC .AC-P2>> <MEMQ .AC-P2 .MOVES-TO>>
1343 <COND (<SET SAVED? <MEMQ .AC-P2 .MOVES-FROM>>
1346 <- <LENGTH .MOVES-FROM> <LENGTH .SAVED?> -1>>>)
1348 <SET MOVES-FROM (.AC-P2 !.MOVES-FROM)>
1350 (<SET AC-P2 <FIND-FREE-TO .MOVES-TO .MOVES-FROM>>
1353 (<NOT <EMPTY? .MOVES-FROM>>
1354 <REPEAT ((WIN T) GOT-ONE)
1358 "AUX" (AC-TO? <1 .PT>) PAT1 PAT2 AT1 AT2 AF P-TO? P-FROM)
1359 #DECL ((AT1 AT2 PAT1 PAT2) FIX (AF P-FROM) AC
1360 (PT PF) <LIST <OR AC FALSE>> (AC-TO? P-TO?) <OR AC FALSE>)
1362 (<==? .AC-TO? <1 .PF>> <PUT .PF 1 <>> <PUT .PT 1 <>>)
1365 <COND (<NOT <MEMQ .AC-TO? .MOVES-FROM>>
1366 <SET AT1 <AC-TIME .AC-TO?>>
1367 <SET AT2 <AC-TIME <SET AF <1 .PF>>>>
1369 <COND (<AND <NOT <EMPTY? <REST .PT>>>
1371 <==? <NEXT-AC <AC-NAME .P-TO?>>
1373 <SET P-FROM <2 .PF>>
1374 <==? <NEXT-AC <AC-NAME .P-FROM>> <AC-NAME .AF>>
1375 <NOT <MEMQ .P-TO? .MOVES-FROM>>>
1376 <SET PAT1 <AC-TIME .P-TO?>>
1377 <SET PAT2 <AC-TIME .P-FROM>>
1378 <OCEMIT DMOVE <AC-NAME .P-TO?> <AC-NAME .P-FROM>>
1379 <AC-TIME .P-TO? .PAT1>
1380 <AC-TIME .P-FROM .PAT2>
1384 <LOAD-TYPE-IN-AC <AC-NAME .AC-TO?> <AC-TYPE .AF>>)
1385 (ELSE <OCEMIT MOVE <AC-NAME .AC-TO?> <AC-NAME .AF>>)>
1386 <AC-TIME .AC-TO? .AT1>
1392 <COND (.WIN <RETURN>)>
1397 "AUX" (AC-TO? <1 .PT>) (AC-FROM <1 .PF>) PP1 PP2 AT1 AT2)
1398 #DECL ((AT1 AT2) FIX (PT PF) <LIST <OR AC FALSE>>
1399 (AC-TO? AC-FROM) <OR AC FALSE>)
1400 <COND (<AND .AC-TO? .AC-FROM>
1401 <SET AT1 <AC-TIME .AC-TO?>>
1402 <SET AT2 <AC-TIME .AC-FROM>>
1403 <OCEMIT EXCH <AC-NAME .AC-TO?> <AC-NAME .AC-FROM>>
1404 <AC-TIME .AC-TO? .AT1>
1405 <AC-TIME .AC-FROM .AT2>
1408 <COND (<SET PP1 <MEMQ .AC-TO? .MOVES-FROM>>
1409 <PUT .PP1 1 .AC-FROM>)>
1410 <COND (<AND <SET PP2 <MEMQ .AC-FROM .MOVES-FROM>>
1412 <PUT .PP2 1 .AC-TO?>)>
1417 <COND (.UNCND <FLUSH-ACS>) (.LOOP? <LOGICAL-ESTABLISH .LS>)>
1419 <COND (.AC-P2 (<AC-NAME .AC-P1> <AC-NAME .AC-P2>))
1420 (ELSE (<AC-NAME .AC-P1>))>)>>
1422 <DEFINE FIND-FREE-TO (L1 L2 "AUX" (BEST <>))
1423 #DECL ((L1 L2) <LIST [REST AC]>)
1425 <FUNCTION (AC) #DECL ((AC) AC)
1426 <COND (<NOT <MEMQ .AC .L1>>
1427 <COND (<MEMQ .AC .L2>
1430 (<NOT .BEST> <SET BEST .AC>)>)>>
1434 <DEFINE LOGICAL-ESTABLISH (LS)
1435 #DECL ((LS) LABSTATE)
1437 <FUNCTION (STAT "AUX" (AC <ACS-AC .STAT>))
1438 #DECL ((STAT) ACSTATE (AC) AC)
1439 <COND (<ACS-LOCAL .STAT>
1440 <AC-CODE <AC-ITEM .AC <LATM <ACS-LOCAL .STAT>>>
1442 <AC-TYPE <AC-UPDATE .AC <NOT <ACS-STORED .STAT>>>
1444 (<FIND-LOCAL <AC-ITEM .AC> <AC-CODE .AC> .LS>
1445 <AC-TIME <AC-ITEM <AC-CODE <AC-TYPE .AC <>> DUMMY> <>> 0>)
1446 (<OR <==? <AC-CODE .AC> TYPE> <==? <AC-CODE .AC> VALUE>>
1447 <AC-UPDATE .AC <>>)>>
1450 <DEFINE ESTABLISH-UPDATE (LS)
1451 #DECL ((LS) LABSTATE)
1453 <FUNCTION (STAT "AUX" (AC <ACS-AC .STAT>))
1454 #DECL ((STAT) ACSTATE (AC) AC)
1455 <COND (<OR <AND <ACS-LOCAL .STAT> <ACS-STORED .STAT>>
1456 <NOT <ACS-LOCAL .STAT>>>
1457 <AC-UPDATE .AC <>>)>>
1460 <DEFINE FIND-LOCAL (ATM COD LS "OPT" (STORE-CHECK <>))
1461 #DECL ((LS) LABSTATE)
1464 #DECL ((STAT) ACSTATE)
1465 <COND (<AND <ACS-LOCAL .STAT>
1466 <==? <LATM <ACS-LOCAL .STAT>> .ATM>
1467 <==? .COD <ACS-CODE .STAT>>
1468 <NOT <AND .STORE-CHECK <ACS-STORED .STAT>>>>
1472 <DEFINE FIND-AC (LCL COD "AUX" (ATM <LATM .LCL>))
1477 <COND (<AND <==? <AC-ITEM .AC> .ATM>
1478 <==? <AC-CODE .AC> .COD>>
1482 <DEFINE ESTABLISH-LABEL-STATE (LB "OPT" (LS <LAB-FINAL-STATE .LB>))
1483 #DECL ((LB) LAB (LS) <OR FALSE LABSTATE>)
1487 <FUNCTION (STAT "AUX" AC ACL)
1488 #DECL ((STAT) ACSTATE (AC) AC)
1489 <SET AC <ACS-AC .STAT>>
1490 <COND (<AND <NOT ,LAST-UNCON>
1491 <OR <SET ACL <ACS-LOCAL .STAT>>
1493 <N==? <LATM <1 .ACL>> <AC-ITEM .AC>>>
1495 <AND <ACS-STORED .STAT>
1496 <OR <NOT <ACS-TYPE .STAT>>
1497 <NOT <LDECL .ACL>>>>>
1500 <COND (<NOT <ACS-LOCAL .STAT>>
1503 <AC-CODE .AC DUMMY>)
1505 <AC-CODE .AC <ACS-CODE .STAT>>
1506 <AC-ITEM .AC <LATM <ACS-LOCAL .STAT>>>
1507 <AC-UPDATE .AC <NOT <ACS-STORED .STAT>>>
1508 <AC-TYPE .AC <ACS-TYPE .STAT>>)>>
1517 <DEFINE PLS (LAB "AUX" (N 0))
1518 <COND (<TYPE? .LAB ATOM> <SET LAB <FIND-LABEL .LAB>>)>
1520 <PRINC "States for label: ">
1521 <PRIN1 <LAB-NAM .LAB>>
1522 <COND (<LAB-LOOP .LAB> <PRINC " (loop)">)>
1525 <COND (<LAB-FINAL-STATE .LAB>
1526 <PRINC "Current final state">
1528 <PSTATE <LAB-FINAL-STATE .LAB>>)>
1529 <COND (<NOT <EMPTY? <LAB-STATE .LAB>>>
1533 <PRIN1 <SET N <+ .N 1>>>
1537 <LAB-STATE .LAB>>)>>
1539 <DEFINE PSTATE (LS) #DECL ((LS) LABSTATE)
1541 <FUNCTION (ACS) #DECL ((ACS) ACSTATE)
1542 <COND (<ACS-LOCAL .ACS>
1543 <PRIN1 <AC-NAME <ACS-AC .ACS>>>
1545 <PRIN1 <LATM <ACS-LOCAL .ACS>>>
1546 <PRINC <COND (<ACS-STORED .ACS> " stored ")
1547 (ELSE " not stored ")>>
1548 <COND (<ACS-TYPE .ACS>
1550 <PRIN1 <ACS-TYPE .ACS>>)>
1552 (<==? <ACS-STORED .ACS> DEAD>
1553 <PRIN1 <AC-NAME <ACS-AC .ACS>>>
1555 <PRIN1 <LATM <1 <ACS-LOCAL .ACS>>>>
1560 <DEFINE MERGE-LABEL-STATES ()
1562 <FUNCTION (LAB "AUX" (LS <LAB-STATE .LAB>) TEM)
1564 <COND (<SET TEM <LAB-FINAL-STATE .LAB>>)
1567 <SET LS <REST .LS>>)>
1568 <COND (<NOT <EMPTY? .LS>> <MERGE-ONE-SET .TEM .LS .LAB>)
1570 <PUT .LAB ,LAB-STATE ()>
1571 <PUT .LAB ,LAB-FINAL-STATE .TEM>)>>
1574 <DEFINE MERGE-ONE-SET (FIRST RESTP LAB)
1575 #DECL ((RESTP) <LIST LABSTATE [REST LABSTATE]> (FIRST) LABSTATE
1578 <FUNCTION (NEXT "AUX" CH)
1579 #DECL ((NEXT) LABSTATE)
1581 <COND (<LAB-LOOP .LAB>
1582 <MERGE-TWO-FORCE .FIRST .NEXT>)
1583 (ELSE <MERGE-TWO .FIRST .NEXT>)>>
1584 <COND (.CH <SETG CHANGED .CH>)>>
1586 <PUT .LAB ,LAB-FINAL-STATE .FIRST>
1587 <PUT .LAB ,LAB-STATE ()>>
1589 <DEFINE MERGE-TWO (ONE TWO "AUX" (CHANGED <>))
1590 #DECL ((ONE TWO) LABSTATE)
1592 <FUNCTION (AP1 AP2 NSP
1593 "AUX" (ACST1 <1 .AP1>) (ACST2 <1 .AP2>) (NULL-STATE <1 .NSP>)
1595 #DECL ((ACST1 ACST2 NULL-STATE) ACSTATE)
1596 <COND (<AND <ACS-LOCAL .ACST1>
1598 <==? <LATM <ACS-LOCAL .ACST1>> <LATM <ACS-LOCAL .ACST2>>>
1599 <==? <ACS-CODE .ACST1> <ACS-CODE .ACST2>>
1600 <OR <==? <ACS-TYPE .ACST1> <ACS-TYPE .ACST2>>
1601 <AND <SET LD <LDECL <ACS-LOCAL .ACST1>>>
1602 <ACS-TYPE <ACS-STORED .ACST1 T> .LD>
1603 <ACS-TYPE <ACS-STORED .ACST2 T> .LD>
1604 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>>>>
1605 <COND (<N==? <NOT <ACS-STORED .ACST2>> <NOT <ACS-STORED .ACST1>>>
1606 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1607 <COND (<AND <ACS-TYPE .ACST1> <LDECL <ACS-LOCAL .ACST1>>>
1608 <ACS-STORED .ACST1 T>)
1609 (<OR <==? <ACS-STORED .ACST1> HACKED>
1610 <==? <ACS-STORED .ACST2> HACKED>>
1611 <ACS-STORED .ACST1 HACKED>)
1612 (ELSE <ACS-STORED .ACST1 <>>)>)>)
1614 <COND (<==? .ACST1 .NULL-STATE>
1616 <PUT .AP2 1 <SET ACST2 .ACST1>>
1617 <SET ACST1 <1 .AP1>>)>
1618 <COND (<AND <ACS-LOCAL .ACST1>
1619 <OR <ACS-LOCAL .ACST2>
1620 <EMPTY? <ACS-LOCAL .ACST2>>
1621 <N==? <LATM <ACS-LOCAL .ACST1>>
1622 <LATM <1 <ACS-LOCAL .ACST2>>>>>>
1623 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1624 <LUPD <ACS-LOCAL .ACST1> T>
1625 <ACS-STORED <ACS-LOCAL .ACST1 <>> <>>)>)>>
1631 <DEFINE MERGE-TWO-FORCE (ONE TWO "AUX" (CHANGED <>) (WINNERS 0))
1632 #DECL ((ONE TWO) LABSTATE (WINNERS) FIX)
1635 #DECL ((ACST1) ACSTATE)
1639 <SET WINNERS <+ .WINNERS 1>>
1641 <FUNCTION (ACST2 "AUX" LCL)
1642 #DECL ((ACST2) ACSTATE)
1644 (<AND <SET LCL <ACS-LOCAL .ACST2>>
1645 <==? <LATM <ACS-LOCAL .ACST1>> <LATM <ACS-LOCAL .ACST2>>>
1646 <==? <ACS-CODE .ACST1> <ACS-CODE .ACST2>>
1647 <OR <AND <NOT <ACS-TYPE .ACST1>> <NOT <ACS-TYPE .ACST2>>>
1648 <AND <==? <ACS-TYPE .ACST1> <ACS-TYPE .ACST2>>
1649 <OR <==? <NOT <ACS-STORED .ACST1>>
1650 <NOT <ACS-STORED .ACST2>>>
1652 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1653 <ACS-STORED .ACST1 T>
1654 <ACS-STORED .ACST2 T>>
1655 <AND <OR <==? <ACS-STORED .ACST1> HACKED>
1656 <==? <ACS-STORED .ACST2> HACKED>>
1657 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1658 <ACS-STORED .ACST1 HACKED>
1659 <ACS-STORED .ACST2 HACKED>>
1660 <AND <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1661 <ACS-STORED .ACST1 <>>
1662 <ACS-STORED .ACST2 <>>>>>
1664 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1665 <ACS-STORED <ACS-TYPE .ACST1 <LDECL .LCL>> T>
1666 <ACS-STORED <ACS-TYPE .ACST2 <LDECL .LCL>> T>>>>
1667 <COND (<N==? <NOT <ACS-STORED .ACST1>>
1668 <NOT <ACS-STORED .ACST2>>>
1669 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1670 <COND (<OR <==? <ACS-STORED .ACST1> HACKED>
1671 <==? <ACS-STORED .ACST2> HACKED>>
1672 <ACS-STORED .ACST1 HACKED>
1673 <ACS-STORED .ACST2 HACKED>)
1675 <ACS-STORED .ACST1 <>>
1676 <ACS-STORED .ACST2 <>>)>)>
1680 <COND (<ACS-LOCAL .ACST1>
1681 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1682 <LUPD <ACS-LOCAL .ACST1> T>)>
1683 <ACS-STORED <ACS-LOCAL .ACST1 <>> <>>)>>
1687 #DECL ((ACST1) ACSTATE)
1688 <COND (<ACS-LOCAL .ACST1>
1689 <COND (<L? <SET WINNERS <- .WINNERS 1>> 0>
1690 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1695 <DEFINE PLOCAL-NAME (LN "AUX" LCL) #DECL ((LN) LOCAL-NAME)
1696 <OR <SET LCL <L-N-LMEMQ .LN ,LOCALS>>
1699 <L-N-LMEMQ .LN ,ICALL-TEMPS>>>>
1700 <COND (.LCL <PRINC <LATM .LCL>>)
1701 (ELSE <PRINC "#LOC "><PRIN1 <CHTYPE .LN FIX>>)>>
1704 <DEFINE PCONST-LABEL (CL "AUX" TEM)
1705 #DECL ((CL) CONSTANT-LABEL)
1706 <COND (<SET TEM <MEMQ .CL ,CONSTANT-VECTOR>>
1708 <COND (<TYPE? .TEM CONSTANT> <PRIN1 <CHTYPE .TEM FIX>>)
1709 (ELSE <PRIN1 <CHTYPE .TEM LIST>>)>)
1710 (ELSE <PRINC "#CL "> <PRIN1 <CHTYPE .CL FIX>>)>>
1712 <DEFINE PCONST-BUCK (CB:CONSTANT-BUCKET "AUX" (TEM <CB-VAL .CB>))
1713 <COND (<TYPE? .TEM CONSTANT> <PRIN1 <CHTYPE .TEM FIX>>)
1714 (ELSE <PRIN1 <CHTYPE .TEM LIST>>)>>
1716 <COND (<GASSIGNED? PCONST-BUCK> <PRINTTYPE CONSTANT-BUCKET ,PCONST-BUCK>)>
1718 <COND (<GASSIGNED? PLOCAL-NAME> <PRINTTYPE LOCAL-NAME ,PLOCAL-NAME>)>
1720 <COND (<GASSIGNED? PCONST-LABEL> <PRINTTYPE CONSTANT-LABEL ,PCONST-LABEL>)>