2 <COND (<NOT <GASSIGNED? WIDTH-MUNG>> <FLOAD "MIMOC20DEFS.MUD">)>
6 <NEWTYPE LOCAL-NAME FIX>
16 <MANIFEST PRIM-LIST PRIM-FIX>
20 <DEFINE TYPE!-MIMOC (L "AUX" (ARG <1 .L>) AC NAC)
21 #DECL ((L) LIST (ARG) ANY (AC) ATOM (NAC) <OR FALSE ATOM>)
22 <COND (<==? <3 .L> STACK>
23 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
24 <LOAD-TYPE O* <OBJ-TYP .ARG>>
26 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>
29 <SET AC <ASSIGN-AC <3 .L> BOTH>>
30 <AC-TYPE <GET-AC .AC> FIX>
31 <LOAD-TYPE <NEXT-AC .AC> <OBJ-TYP .ARG>>)>>
33 <DEFINE TYPE?!-MIMOC (L
34 "AUX" (ARG <1 .L>) (TYP <2 .L>) (CAM CAMN) (CAI CAIN)
36 #DECL ((L) LIST (ARG) ANY (TYP) <OR ATOM FIX XTYPE-C>
37 (CAM CAI JMP) ATOM (AC) <OR FALSE ATOM>)
38 <COND (<==? <3 .L> -> <SET CAM CAME> <SET CAI CAIE> <SET JMP JUMPN>)>
39 <COND (<SET AC <IN-AC? .ARG TYPE>> <LOAD-TYPE O* (.AC)> <MUNGED-AC O*>)
40 (T <SET AC <SMASH-AC O* .ARG TYPECODE>>)>
41 <LABEL-UPDATE-ACS <4 .L> <>>
42 <COND (,GC-MODE <OCEMIT TRZ O* 56>)>
43 <COND (<TYPE? .TYP FIX>
44 <COND (<==? .TYP 0> <OCEMIT .JMP O* <XJUMP <4 .L>>>)
45 (ELSE <OCEMIT .CAI O* .TYP>)>)
46 (T <OCEMIT .CAM O* !<OBJ-VAL .TYP>>)>
47 <COND (<N==? .TYP 0> <OCEMIT JRST <XJUMP <4 .L>>>)>>
49 <DEFINE CHTYPE!-MIMOC (L
50 "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (VAL <4 .L>) AC PCOD
53 <OR <LMEMQ .VAL ,LOCALS>
55 <LMEMQ .VAL ,ICALL-TEMPS>>>))
56 #DECL ((L) LIST (AC VAL) ATOM (ARG1 ARG2) ANY
57 (TYFRM) <OR FALSE <FORM ATOM ATOM>>)
60 <MEMQ .LV ,TYPED-LOCALS>
61 <SET VTYP <LDECL .LV>>
62 <OR <MEMQ <TYPEPRIM .VTYP> '[WORD FIX LIST]>
63 <MEMQ .VTYP ,TYPE-LENGTHS>>>
64 <SET AC <LOAD-AC .ARG1 BOTH>>
65 <COND (<AND <N==? .VAL .ARG1> <NOT <WILL-DIE? .ARG1>>>
66 <COND (<AC-UPDATE <GET-AC .AC>>
67 <UPDATE-AC <GET-AC .AC>>
68 <UPDATE-AC <GET-AC <NEXT-AC .AC>>>)>)>
70 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC <NEXT-AC .AC>> T> .VAL> VALUE>
71 <AC-TYPE <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC .AC> T> .VAL> TYPE> .VTYP>)
73 <COND (<AND <SET TYFRM <GETPROP <REST .L> EVAL>>
74 <OR <==? <SET PCOD <CHTYPE <ANDB .ARG2 7> FIX>> ,PRIM-FIX>
75 <==? .PCOD ,PRIM-LIST>
76 <MEMQ <2 .TYFRM> ,TYPE-LENGTHS>>>
77 <COND (<==? .VAL STACK>
78 <OCEMIT PUSH TP* !<TYPE-WORD <2 .TYFRM>>>
79 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
80 <OCEMIT PUSH TP* !<OBJ-VAL .ARG1>>
81 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
83 <SET AC <LOAD-AC .ARG1 BOTH>>
84 <COND (<WILL-DIE? .ARG1>
85 <AC-UPDATE <GET-AC .AC> <>>
86 <AC-UPDATE <GET-AC <NEXT-AC .AC>> <>>
87 <AC-TYPE <GET-AC .AC> <>>)>
88 <COND (<N==? .ARG1 .VAL> <CLEAN-ACS .VAL> <ALTER-AC .AC .VAL>)>
89 <AC-TYPE <GET-AC .AC> <2 .TYFRM>>
90 <AC-UPDATE <GET-AC .AC> T>)>)
92 <SET AC <LOAD-AC .ARG1 BOTH>>
93 <COND (<WILL-DIE? .ARG1>
94 <AC-UPDATE <GET-AC .AC> <>>
95 <AC-UPDATE <GET-AC <NEXT-AC .AC>> <>>
96 <AC-TYPE <GET-AC .AC> <>>)>
97 <COND (<N==? .ARG1 .VAL> <CLEAN-ACS .VAL> <ALTER-AC .AC .VAL>)>
98 <AC-TYPE <GET-AC .AC> <>>
99 <OCEMIT HRLI .AC .ARG2>
100 <AC-UPDATE <GET-AC .AC> T>
101 <COND (<==? .VAL STACK>
102 <OCEMIT PUSH TP* .AC>
103 <OCEMIT PUSH TP* <NEXT-AC .AC>>
104 <COND (,WINNING-VICTIM
105 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)>)
107 <SET AC <LOAD-AC .ARG1 BOTH>>
108 <SET ACT <AC-TYPE <GET-AC .AC>>>
109 <COND (<N==? .ARG1 .VAL>
110 <COND (<WILL-DIE? .ARG1>
111 <AC-UPDATE <GET-AC .AC> <>>
112 <AC-UPDATE <GET-AC <NEXT-AC .AC>> <>>)>
115 <AC-TYPE <GET-AC .AC> <>>
116 <COND (<AND <TYPE? .ARG2 FORM>
117 <==? <LENGTH .ARG2> 2>
119 <TYPE? <2 .ARG2> ATOM>>
121 <MEMQ .ACT ,TYPE-LENGTHS>>
122 <LOAD-TYPE-IN-AC .AC .ACT>)>
123 <OCEMIT HLL .AC !<OBJ-TYP <2 .ARG2>>>)
125 <COND (<MEMQ .ACT ,TYPE-LENGTHS>
126 <OCEMIT MOVE .AC !<OBJ-VAL <CHTYPE .ARG2 XTYPE-W>>>)
127 (ELSE <OCEMIT HRLZ .AC !<OBJ-VAL .ARG2>>)>)
128 (ELSE <OCEMIT HRL .AC !<OBJ-VAL .ARG2>>)>
129 <COND (<AND <N==? .VAL STACK> <N==? .VAL .ARG1>>
131 <ALTER-AC .AC .VAL>)>
132 <AC-UPDATE <GET-AC .AC> T>
133 <COND (<==? .VAL STACK>
134 <OCEMIT PUSH TP* .AC>
135 <OCEMIT PUSH TP* <NEXT-AC .AC>>
136 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)>>
138 <DEFINE NEWTYPE!-MIMOC (L)
141 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
142 <PUSHJ NEWTYPE <3 .L>>>
147 <DEFINE VALUE!-MIMOC (L "AUX" (IT <1 .L>) (VAL <3 .L>) AC)
148 #DECL ((L) LIST (VAL) ATOM)
149 <COND (<==? .VAL STACK>
150 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
151 <OCEMIT PUSH TP* !<OBJ-VAL .IT>>
152 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
153 (<AND <OR <==? .IT .VAL> <WILL-DIE? .IT>>
154 <OR <SET AC <IN-AC? .IT BOTH>>
155 <AND <SET AC <IN-AC? .IT VALUE>>
156 <SET AC <GETPROP .AC AC-PAIR>>>>>
157 <COND (<N==? .IT .VAL> <CLEAN-ACS .VAL>)>
159 <AC-TYPE <GET-AC .AC> FIX>)
161 <SET AC <ASSIGN-AC .VAL BOTH>>
162 <AC-TYPE <GET-AC .AC> FIX>
163 <OCEMIT MOVE <NEXT-AC .AC> !<OBJ-VAL <1 .L>>>)>>
165 <DEFINE ON-STACK?!-MIMOC (L "AUX" (IT <1 .L>) (VAL <3 .L>) AC NAC)
166 #DECL ((L) LIST (VAL) ATOM)
167 <COND (<==? .VAL STACK>
168 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
169 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
170 <COND (<AND <WILL-DIE? .IT> <SET AC <IN-AC? .IT VALUE>>>)
171 (ELSE <OCEMIT MOVE <SET AC O1*> !<OBJ-VAL .IT>>)>
174 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
175 (<AND <==? .IT .VAL> <SET AC <IN-AC? .IT VALUE>>>
177 <AC-TIME <GET-AC .AC> ,AC-STAMP>
179 <DO-ON-STACK .AC <NEXT-AC <SET NAC <ASSIGN-AC .VAL BOTH>>>>
180 <AC-TYPE <GET-AC .NAC> FIX>)
182 <COND (<AND <SET NAC <IN-AC? .IT VALUE>>
185 <AC-TIME <GET-AC .NAC> ,AC-STAMP>)
187 <OCEMIT MOVE <SET NAC O1*> !<OBJ-VAL .IT>>)>
188 <DO-ON-STACK .NAC <NEXT-AC <SET AC <ASSIGN-AC .VAL BOTH>>>>
189 <AC-TYPE <GET-AC .AC> FIX>)>>
191 <DEFINE DO-ON-STACK (ARG DEST "AUX" (LBL <GENLBL "DOS">))
192 <OCEMIT MOVEI .DEST 0>
193 <OCEMIT TLZ .ARG *770000*>
194 <OCEMIT CAMLE .ARG !<OBJ-VAL *3000000*>> ;"Border btwn stk + gc"
195 <OCEMIT JRST <XJUMP .LBL>>
196 <OCEMIT MOVNI .DEST 1> ;"Assume legal"
197 <OCEMIT HRRZ .ARG .ARG>
198 <OCEMIT CAILE .ARG 0 '(TP*)> ;"Skip if legal"
199 <OCEMIT MOVEI .DEST 1> ;"Not legal"
202 <DEFINE OBJECT!-MIMOC (L "AUX" (TY <1 .L>) (CNT <2 .L>) (VAL <3 .L>)
203 (V-DONE <>) (RES <5 .L>) (AC <>) (TAC <>) (CAC <>))
204 #DECL ((L) <LIST [5 <OR ATOM FIX>]>)
205 <COND (<==? .RES STACK>
206 <COND (<AND <TYPE? .TY FIX> <TYPE? .CNT FIX>>
208 !<OBJ-VAL <CHTYPE <ORB <LSH .TY 18> .CNT>
211 <SMASH-AC O* .CNT VALUE>
212 <COND (<TYPE? .TY FIX>
213 <OCEMIT HRLI O* .TY>)
215 <OCEMIT HRL O* !<OBJ-VAL .TY>>)>
216 <OCEMIT PUSH TP* O*>)>
217 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
218 <OCEMIT PUSH TP* !<OBJ-VAL .VAL>>
219 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
221 <COND (<AND <TYPE? .TY ATOM>
222 <OR <==? .RES .TY> <WILL-DIE? .TY>>>
223 <COND (<SET TAC <IN-AC? .TY BOTH>>
225 <SET TAC <NEXT-AC .TAC>>)
226 (<SET TAC <IN-AC? .TY VALUE>>
228 <DEAD!-MIMOC (.TY) T>)>
229 <COND (<AND <TYPE? .CNT ATOM>
230 <OR <==? .RES .CNT> <WILL-DIE? .CNT>>>
231 <COND (<SET CAC <IN-AC? .CNT BOTH>>
233 <SET CAC <NEXT-AC .CAC>>)
234 (<SET CAC <IN-AC? .CNT VALUE>>
236 <DEAD!-MIMOC (.CNT) T>)>
237 <COND (<AND <TYPE? .VAL ATOM>
238 <OR <==? .RES .VAL> <WILL-DIE? .VAL>>>
239 <DEAD!-MIMOC (.VAL) T>
240 <COND (<SET AC <IN-AC? .VAL BOTH>>
243 (<SET AC <IN-AC? .VAL VALUE>>
244 <SET AC <GETPROP .AC AC-PAIR>>
248 <SET AC <ASSIGN-AC .RES BOTH>>)>
249 <COND (<AND <TYPE? .TY FIX> <TYPE? .CNT FIX>>
251 <OCEMIT MOVSI .AC .TY>)
254 !<OBJ-VAL <CHTYPE <ORB <LSH .TY 18> .CNT>
258 <COND (.CAC <OCEMIT HRRZ .AC .CAC>)
259 (ELSE <OCEMIT HRRZ .AC !<OBJ-VAL .CNT>>)>)
261 <OCEMIT MOVSI .AC .TY>
262 <COND (.CAC <OCEMIT HRR .AC .CAC>)
263 (ELSE <OCEMIT HRR .AC !<OBJ-VAL .CNT>>)>)>)
266 <COND (.TAC <OCEMIT HRLZ .AC .TAC>)
267 (ELSE <OCEMIT HRLZ .AC !<OBJ-VAL .TY>>)>)
269 <OCEMIT MOVEI .AC .CNT>
270 <COND (.TAC <OCEMIT HRL .AC .TAC>)
271 (ELSE <OCEMIT HRL .AC !<OBJ-VAL .TY>>)>)>)
273 <COND (.CAC <OCEMIT MOVE .AC .CAC>)
274 (ELSE <OCEMIT MOVE .AC !<OBJ-VAL .CNT>>)>
275 <COND (.TAC <OCEMIT HRL .AC .TAC>)
276 (ELSE <OCEMIT HRL .AC !<OBJ-VAL .TY>>)>)>
278 <OCEMIT MOVE <NEXT-AC .AC> !<OBJ-VAL .VAL>>)
280 <ALTER-AC .AC .RES>)>)>>
285 <DEFINE OPEN!-MIMOC (L)
288 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
289 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>
290 <OCEMIT DMOVE B1* !<OBJ-TYP <3 .L>>>
293 <DEFINE CLOSE!-MIMOC (L)
296 <OCEMIT MOVE A1* !<OBJ-VAL <1 .L>>>
297 <PUSHJ CLOSE <COND (<G? <LENGTH .L> 2> <3 .L>)>>>
299 <DEFINE RESET!-MIMOC (L)
302 <OCEMIT MOVE A1* !<OBJ-VAL <1 .L> >>
305 <DEFINE READ!-MIMOC (L "AUX" (LL <LENGTH .L>) (TL <MEMQ = .L>)
306 (NARGS <- <LENGTH .L> <LENGTH .TL>>))
309 <SMASH-AC A1* <1 .L> VALUE>
310 <SMASH-AC A2* <2 .L> VALUE>
311 <SMASH-AC B1* <3 .L> VALUE>
312 <SMASH-AC B2* <4 .L> VALUE>
313 <COND (<G=? .NARGS 5>
314 <SMASH-AC C1* <5 .L> VALUE>)
315 (<SMASH-AC C1* 0 VALUE>)>
316 <COND (<G=? .NARGS 6>
317 <SMASH-AC C2* <6 .L> VALUE>)
318 (<SMASH-AC C2* 0 VALUE>)>
319 <PUSHJ READ <COND (.TL <2 .TL>)>>>
321 <DEFINE PRINT!-MIMOC (L)
324 <SMASH-AC A1* <1 .L> VALUE>
325 <SMASH-AC A2* <2 .L> VALUE>
326 <SMASH-AC B1* <3 .L> VALUE>
330 ;"Stack, variable hacking"
333 <DEFINE SET!-MIMOC (L
334 "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (VT <VAR-TYPED? .ARG1>)
335 (STK? <VAR-STACKED? .ARG1>) AC NAC ITM FARG2 LV TAC
337 #DECL ((L MIML) LIST (AC ARG1) ATOM (ARG2 ITM) ANY (NAC) <OR FALSE ATOM>
340 (<AND <TYPE? .ARG2 ATOM> <SET ITM <WILL-DIE? .ARG2>>>
342 <DEAD!-MIMOC (.ARG2) T>
343 <COND (<AND <TYPE? <2 .MIML> FORM>
344 <NOT <EMPTY? <2 .MIML>>>
345 <==? <1 <2 .MIML>> RETURN>>
346 <GET-INTO-ACS .ARG2 BOTH <SET AC A1*>>)
347 (<SET NAC <IN-AC? .ARG2 BOTH>> <SET AC .NAC>)
348 (<AND .VT <SET NAC <IN-AC? .ARG2 VALUE>>>
350 <AC-TYPE <GET-AC <SET AC <GETPROP .AC AC-PAIR>>> .VT>)
351 (T <SET AC <LOAD-AC .ARG2 BOTH>>)>
352 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC .AC> <NOT .VT>> .ARG1> TYPE>
353 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC <NEXT-AC .AC>> T> .ARG1> VALUE>)
354 (<AND <NOT <TYPE? .ARG2 ATOM>>
355 <NOT <EMPTY? <SET LL <REST .MIML>>>>
356 <TYPE? <SET LL <1 .LL>> FORM>
357 <==? <1 .LL> RETURN>>
359 <GET-INTO-ACS .ARG2 BOTH <SET AC A1*>>
360 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC .AC> <NOT .VT>> .ARG1> TYPE>
361 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC <NEXT-AC .AC>> T> .ARG1> VALUE>)
363 <COND (<AND <TYPE? .ARG2 ATOM>
364 <SET NAC <OR <IN-AC? .ARG2 BOTH> <IN-AC? .ARG2 VALUE>>>
365 <AC-UPDATE <GET-AC .NAC>>>
366 <AC-TIME <GET-AC .NAC> ,AC-STAMP>)>
367 <SET AC <ASSIGN-AC .ARG1 BOTH>>
368 <AC-TYPE <GET-AC .AC> <>>
369 <COND (<AND <SET NAC <IN-AC? .ARG2 BOTH>> <NOT <AC-TYPE <GET-AC .NAC>>>>
370 <OCEMIT DMOVE .AC .NAC>)
371 (<AND <MEMQ <PRIMTYPE .ARG2> '[WORD FIX]>
372 <MEMQ <TYPE .ARG2> ,TYPE-WORDS>>
373 <COND (<==? <CHTYPE .ARG2 FIX> 0>
374 <COND (<AND .STK? .VT>
375 <OCEMIT SETZB <NEXT-AC .AC> !<OBJ-VAL .ARG1 <>>>
376 <AC-UPDATE <GET-AC <NEXT-AC .AC>> <>>)
377 (ELSE <OCEMIT MOVEI <NEXT-AC .AC> 0>)>)
378 (<==? <CHTYPE .ARG2 FIX> -1>
379 <COND (<AND .STK? .VT>
380 <OCEMIT SETOB <NEXT-AC .AC> !<OBJ-VAL .ARG1 <>>>
381 <AC-UPDATE <GET-AC <NEXT-AC .AC>> <>>)
382 (ELSE <OCEMIT MOVNI <NEXT-AC .AC> 1>)>)
383 (<==? <CHTYPE <ANDB .ARG2 262143> FIX> 0>
384 <OCEMIT MOVSI <NEXT-AC .AC> <CHTYPE <LSH .ARG2 -18> FIX>>)
385 (<L=? <ABS <SET FARG2 <CHTYPE .ARG2 FIX>>> ,MAX-IMMEDIATE>
386 <COND (<G=? .FARG2 0> <OCEMIT MOVEI <NEXT-AC .AC> .FARG2>)
387 (ELSE <OCEMIT MOVNI <NEXT-AC .AC> <ABS .FARG2>>)>)
388 (ELSE <OCEMIT MOVE <NEXT-AC .AC> !<OBJ-VAL .FARG2>>)>
389 <AC-TYPE <GET-AC .AC> <TYPE .ARG2>>
390 <COND (<VAR-TYPED? .ARG1> <AC-UPDATE <GET-AC .AC> <>>)
391 (ELSE <AC-UPDATE <GET-AC .AC> T>)>)
392 (<AND <==? <PRIMTYPE .ARG2> LIST>
393 <EMPTY? <CHTYPE .ARG2 LIST>>
394 <MEMQ <TYPE .ARG2> ,TYPE-WORDS>>
395 <COND (<AND .STK? .VT>
396 <OCEMIT SETZB <NEXT-AC .AC> !<OBJ-VAL .ARG1 <>>>
397 <AC-UPDATE <GET-AC <NEXT-AC .AC>> <>>)
398 (ELSE <OCEMIT MOVEI <NEXT-AC .AC> 0>)>
399 <AC-TYPE <GET-AC .AC> <TYPE .ARG2>>
400 <COND (<VAR-TYPED? .ARG1> <AC-UPDATE <GET-AC .AC> <>>)>)
401 (<AND <SET LV <VAR-TYPED? .ARG1>> <SET NAC <IN-AC? .ARG2 VALUE>>>
402 <OCEMIT MOVE <NEXT-AC .AC> .NAC>
403 <AC-TYPE <AC-UPDATE <GET-AC .AC> <>> .LV>)
404 (<AND <SET NAC <IN-AC? .ARG2 VALUE>>
406 <OR <VAR-TYPED? .ARG2>
407 <AND <SET TAC <IN-AC? .ARG2 TYPE>>
408 <AC-TYPE <GET-AC .TAC>>>>>>
409 <OCEMIT MOVE <NEXT-AC .AC> .NAC>
410 <AC-TYPE <GET-AC .AC> .LV>)
411 (<AND <SET NAC <IN-AC? .ARG2 VALUE>> <AC-UPDATE <GET-AC .NAC>>>
412 <OCEMIT MOVE .AC !<OBJ-TYP .ARG2>>
413 <OCEMIT MOVE <NEXT-AC .AC> .NAC>)
414 (<AND <SET NAC <IN-AC? .ARG2 TYPE>> <AC-UPDATE <GET-AC .NAC>>>
415 <OCEMIT MOVE .AC .NAC>
416 <OCEMIT MOVE <NEXT-AC .AC> !<OBJ-VAL .ARG2>>)
417 (T <OCEMIT DMOVE .AC !<OBJ-LOC .ARG2 0>>)>)>>
419 <DEFINE VAR-TYPED? (ARG1 "AUX" LV)
421 <AND <SET LV <OR <LMEMQ .ARG1 ,LOCALS>
423 <LMEMQ .ARG1 ,ICALL-TEMPS>>>>
424 <N==? <LUPD .LV> OARG>
426 <OR <MEMQ <TYPEPRIM .LV> '[WORD FIX LIST]>
427 <MEMQ .LV ,TYPE-LENGTHS>>
430 <DEFINE VAR-STACKED? (ARG1 "AUX" LV)
432 <AND <SET LV <OR <LMEMQ .ARG1 ,LOCALS>
434 <LMEMQ .ARG1 ,ICALL-TEMPS>>>>
437 <SETG SIMPLE-DEATH <>>
439 <NEWTYPE DEAD-VAR ATOM>
441 <DEFINE WILL-DIE? (ARG "OPT" (MIML .MIML)
442 (VISIT <SETG VISIT-COUNT <+ ,VISIT-COUNT 1>>)
444 #DECL ((ARG) ANY (MIML) LIST (VISIT) FIX)
445 <PROG LEAVE (NXT ITM (SIMPLE ,SIMPLE-DEATH) LAB)
446 #DECL ((NXT) <OR ATOM FORM LIST>)
448 (<NOT <TYPE? .ARG ATOM>> <RETURN T>)
449 (<L=? <LENGTH .MIML> 1> <RETURN T>)
450 (<TYPE? <SET NXT <2 .MIML>> FORM>
451 <OR <AND <==? <SET ITM <1 .NXT>> DEAD>
452 <OR <MEMQ .ARG <REST .NXT>>
453 <AND .SIMPLE <RETURN <>>>
454 <AND <SET MIML <REST .MIML>> <AGAIN>>>>
455 <AND <==? .ITM RETURN> <RETURN <N==? <2 .NXT> .ARG>>>
456 <AND <==? .ITM DISPATCH> <RETURN <>>>
459 <COND (<==? <2 .NXT> .ARG>)
460 (<OR <==? <3 .NXT> .ARG> .SIMPLE> <RETURN <>>)
461 (ELSE <SET MIML <REST .MIML>> <AGAIN>)>>
462 <AND <N==? .ITM ICALL>
464 <FUNCTION (XP "AUX" (X <1 .XP>))
466 <COND (<==? <SET X <2 .XP>> .ARG>
468 (ELSE <MAPLEAVE <>>)>)
469 (<==? .X .ARG> <RETURN <> .LEAVE>)>>
471 <AND .SIMPLE <RETURN <>>>
472 <AND <OR <SET FOO <MEMQ + <SET NXT <REST .NXT>>>>
473 <SET FOO <MEMQ - .NXT>>
475 <TYPE? <SET ITM <NTH .NXT <LENGTH .NXT>>> LIST>
476 <==? <1 .ITM> BRANCH-FALSE>
477 <SET FOO <REST .ITM>>>
478 <AND <==? .ITM ICALL> <SET FOO <2 .MIML>>>>
479 <COND (<AND <SET LB <FIND-LABEL <SET LAB <2 .FOO>>>>
480 <LAB-WILL-DIE .LB .ARG .VISIT
481 <COND (<AND <==? .ITM ICALL>
482 <G? <LENGTH .FOO> 1>>
484 <SET MIML <REST .MIML>>
485 <COND (<==? .ITM JUMP> <RETURN T>)
487 (<OR <==? .LAB COMPERR>
490 <COND (<==? .ITM JUMP> <RETURN T>)
493 <AND <NOT <EMPTY? ,THE-BIG-LABELS>>
494 <OR <==? .ITM CALL> <==? .ITM ACALL> <==? .ITM SCALL>>
497 <COND (<LAB-WILL-DIE <FIND-LABEL .NAM> .ARG .VISIT
503 <NOT <SET MIML <REST .MIML>>>
505 (ELSE <SET MIML <REST .MIML>> <AGAIN>)>>>
507 <DEFINE LAB-WILL-DIE (LB:LAB ARG:ATOM VISIT:FIX ICALL-VAR:<OR ATOM FALSE>)
509 <COND (<==? .ICALL-VAR .ARG> <RETURN T>)>
510 <AND <OR <AND <GASSIGNED? DO-LOOPS> ,DO-LOOPS>
511 <NOT <LAB-LOOP .LB>>>
514 <COND (<==? <CHTYPE .X ATOM> .ARG>
515 <COND (<TYPE? .X ATOM>
520 <==? <LAB-VISIT-MARK .LB> .VISIT>
521 <AND <PUT .LB ,LAB-VISIT-MARK .VISIT> <>>
522 <COND (<WILL-DIE? .ARG <LAB-CODE-PNTR .LB> .VISIT>
523 <PUT .LB ,LAB-DEAD-VARS
524 (<CHTYPE .ARG DEAD-VAR>
525 !<LAB-DEAD-VARS .LB>)>)
527 <PUT .LB ,LAB-DEAD-VARS
528 (.ARG !<LAB-DEAD-VARS .LB>)>
530 <NEWTYPE T$UNBOUND FIX>
532 <DEFINE PUSH!-MIMOC (L "AUX" (ARG <1 .L>) AC TY)
533 #DECL ((L) LIST (ARG) ANY)
534 <COND (<TYPE? .ARG T$UNBOUND>
535 <OCEMIT PUSH TP* !<OBJ-VAL 0>>
536 <OCEMIT PUSH TP* !<OBJ-VAL 0>>
537 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
539 <COND (<AND <TYPE? .ARG ATOM>
540 <SET AC <IN-AC? .ARG TYPE>>
541 <SET TY <AC-TYPE <GET-AC .AC>>>>
542 <OCEMIT PUSH TP* !<TYPE-WORD .TY>>)
544 <OCEMIT PUSH TP* !<OBJ-TYP .ARG>>)>
545 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
546 <OCEMIT PUSH TP* !<OBJ-VAL .ARG>>
547 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)>>
549 <DEFINE POP!-MIMOC (L "AUX" AC)
550 #DECL ((L) LIST (AC) ATOM)
551 <SET AC <ASSIGN-AC <2 .L> BOTH>>
552 <OCEMIT DMOVE .AC -1 '(TP*)>
553 <OCEMIT ADJSP TP* -2>
554 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <- ,STACK-DEPTH 2>>)>>
556 <DEFINE ADJ!-MIMOC (L "AUX" (ARG <1 .L>))
557 #DECL ((L) LIST (ARG) ANY)
558 <COND (<TYPE? .ARG FIX>
559 <OCEMIT ADJSP TP* .ARG>
560 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH
563 <SMASH-AC T* .ARG VALUE>
564 <OCEMIT ADJSP TP* '(T*)>)>>
566 <DEFINE GETS!-MIMOC (L "AUX" (ARG1 <1 .L>) (VAL <3 .L>) (VAR <2 .ARG1>)
568 #DECL ((L) LIST (ARG1) <FORM ATOM ATOM> (VAR VAL AC) ATOM)
569 <COND (<==? .VAR ARGS>
570 <COND (<==? .VAL STACK>
571 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
572 <OCEMIT HLRZ O* -2 '(F*)>
575 <COND (,WINNING-VICTIM
576 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
578 <SET AC <ASSIGN-AC .VAL BOTH T>>
579 <AC-TYPE <GET-AC .AC> FIX>
580 <OCEMIT HLRZ <NEXT-AC .AC> -2 '(F*)>)>)
582 <COND (<==? .VAL STACK>
585 <OCEMIT MOVE T* *144*>
586 <OCEMIT PUSH TP* '(T*)>
587 <OCEMIT PUSH TP* 1 '(T*)>
588 <COND (,WINNING-VICTIM
589 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
591 <SET AC <ASSIGN-AC .VAL BOTH T>>
592 <OCEMIT DMOVE .AC @ *144*>)>)
594 <COND (<==? .VAL STACK>
595 <OCEMIT PUSH TP* !<TYPE-WORD T$LBIND>>
596 <OCEMIT PUSH TP* SP*>
597 <COND (,WINNING-VICTIM
598 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
600 <SET AC <ASSIGN-AC .VAL BOTH T>>
601 <AC-TYPE <GET-AC .AC> T$LBIND>
602 <OCEMIT MOVE <NEXT-AC .AC> SP*>)>)
604 <COND (<==? .VAL STACK>
607 <OCEMIT MOVE T* *145*>
608 <OCEMIT PUSH TP* '(T*)>
609 <OCEMIT PUSH TP* 1 '(T*)>
610 <COND (,WINNING-VICTIM
611 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>
612 <OCEMIT SKIPN '(TP*)>
613 <OCEMIT SETZM -1 '(TP*)>)
615 <SET AC <ASSIGN-AC .VAL BOTH T>>
616 <OCEMIT DMOVE .AC @ *145*>
617 <OCEMIT SKIPN O* <NEXT-AC .AC>>
618 <OCEMIT MOVEI .AC 0>)>)
620 <COND (<==? .VAL STACK>
621 <OCEMIT PUSH TP* !<TYPE-WORD T$MINF>>
622 <OCEMIT PUSH TP* @ *143*>
623 <COND (,WINNING-VICTIM
624 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>
625 <OCEMIT SKIPN '(TP*)>
626 <OCEMIT SETZM -1 '(TP*)>)
628 <SET AC <ASSIGN-AC .VAL BOTH T>>
629 <OCEMIT MOVE .AC !<TYPE-WORD T$MINF>>
630 <OCEMIT SKIPN <NEXT-AC .AC> @ *143*>
631 <OCEMIT MOVEI .AC 0>)>)
632 (<SET TEMP <MEMQ .VAR '[ICALL ECALL NCALL UWATM MAPPER
633 PURVEC DBVEC TBIND]>>
634 <SET TEMP <LENGTH .TEMP>>
635 <COND (<==? .VAL STACK>
636 <COND (<==? .VAR TBIND>
637 <OCEMIT PUSH TP* !<TYPE-WORD T$LBIND>>)
638 (<MEMQ .VAR '[PURVEC DBVEC]>
639 <OCEMIT PUSH TP* !<TYPE-WORD LIST>>)
640 (<OCEMIT PUSH TP* !<TYPE-WORD T$ATOM>>)>
641 <OCEMIT PUSH TP* @ <NTH '![*136* *142* *141*
642 *140* *146* *151* *150* *147*]
644 <COND (,WINNING-VICTIM
645 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>
646 <OCEMIT SKIPN '(TP*)>
647 <OCEMIT SETZM -1 '(TP*)>)
649 <SET AC <ASSIGN-AC .VAL BOTH T>>
650 <COND (<==? .VAR TBIND>
651 <OCEMIT MOVE .AC !<TYPE-WORD T$LBIND>>)
652 (<MEMQ .VAR '[PURVEC DBVEC]>
653 <OCEMIT MOVE .AC !<TYPE-WORD LIST>>)
654 (<OCEMIT MOVE .AC !<TYPE-WORD T$ATOM>>)>
655 <OCEMIT SKIPN <NEXT-AC .AC> @
656 <NTH '![*136* *142* *141*
657 *140* *146* *151* *150* *147*] .TEMP>>
658 <OCEMIT MOVEI .AC 0>)>)
659 (<MEMQ .VAR '[ENVIR ARGV]>
660 <COND (<==? .VAL STACK>
661 <OCEMIT PUSH TP* !<TYPE-WORD FALSE>>
662 <OCEMIT PUSH TP* !<OBJ-VAL 0>>
663 <COND (,WINNING-VICTIM
664 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
666 <SET AC <ASSIGN-AC .VAL BOTH T>>
667 <OCEMIT MOVE .AC !<TYPE-WORD FALSE>>
668 <OCEMIT MOVEI <NEXT-AC .AC> 0>)>)
669 (<OR <==? .VAR BINDID> <==? .VAR INGC>>
670 <COND (<==? .VAL STACK>
671 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
672 <OCEMIT PUSH TP* @ <COND (<==? .VAR BINDID> *137*)
674 <COND (,WINNING-VICTIM
675 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
677 <SET AC <ASSIGN-AC .VAL BOTH T>>
678 <OCEMIT MOVSI .AC !<TYPE-CODE FIX T>>
679 <OCEMIT MOVE <NEXT-AC .AC> @ <COND (<==? .VAR BINDID> *137*)
681 (T <MIMOCERR UNKNOWN-SPECIAL-VARIABLE!-ERRORS .VAR>)>>
683 <DEFINE ATIC!-MIMOC (L "AUX")
686 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
689 <DEFINE SETS!-MIMOC (L "AUX" (ARG <1 .L>) (VAR <2 .ARG>) (VAL <2 .L>) AC)
690 #DECL ((L) LIST (ARG) <FORM ATOM ATOM> (VAR) ATOM
691 (VAL) <OR ATOM <FORM ATOM ATOM>>)
692 <COND (<MEMQ = .L> <ERROR CANT-ASSIGN-RESULT-OF-SETS!-ERRORS .L>)>
693 <COND (<==? .VAR BIND>
694 <OCEMIT MOVE SP* !<OBJ-VAL .VAL>>)
696 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
697 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
698 <OCEMIT MOVEM .AC @ *147*>)
700 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
701 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
702 <OCEMIT MOVEM .AC @ *161*>)
704 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
705 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
706 <OCEMIT MOVEM .AC @ *150*>)
708 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
709 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
710 <OCEMIT MOVEM .AC @ *151*>)
713 <OCEMIT MOVE O1* !<OBJ-VAL .VAL>>
716 <OCEMIT MOVE O1* !<OBJ-VAL .VAL>>
719 <COND (<NOT <SET AC <IN-AC? .VAL BOTH>>>
720 <GET-INTO-ACS .VAL BOTH <SET AC O1*>>)>
721 <OCEMIT DMOVEM .AC @ *145*>)
723 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
724 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
725 <OCEMIT MOVEM .AC @ *143*>)
727 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
728 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
729 <OCEMIT MOVEM .AC @ *140*>)
731 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
732 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
733 <OCEMIT MOVEM .AC @ *141*>)
735 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
736 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
737 <OCEMIT MOVEM .AC @ *142*>)
739 <COND (<NOT <SET AC <IN-AC? .VAL BOTH>>>
740 <GET-INTO-ACS .VAL BOTH <SET AC O1*>>)>
741 <OCEMIT DMOVEM .AC @ *144*>)
743 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
744 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
745 <OCEMIT MOVEM .AC @ *136*>)
747 <COND (<NOT <SET AC <IN-AC? .VAL VALUE>>>
748 <GET-INTO-ACS .VAL VALUE <SET AC O1*>>)>
749 <OCEMIT MOVEM .AC @ *137*>)
750 (T <MIMOCERR UNKNOWN-SPECIAL-VARIABLE!-ERRORS .VAR>)>>
754 <DEFINE JUMP!-MIMOC (L)
756 <LABEL-UPDATE-ACS <2 .L> T>
758 <OCEMIT JRST <XJUMP <2 .L>>>>
766 <SETG GLUE-FRAME 100>
768 <DEFINE SFRAME!-MIMOC (L) <FRAME!-MIMOC .L T>>
770 <DEFINE FRAME!-MIMOC (L "OPT" (SEG <>) "AUX" PN NM CN)
772 <COND (<AND ,GLUE-MODE <NOT <EMPTY? .L>> <NOT <TYPE? <1 .L> FORM>>>
773 <COND (<AND ,SURVIVOR-MODE
774 <SET PN <FIND-CALL <SET NM <2 .L>> ,PRE-NAMES>>
775 <NOT <GETPROP .PN NDFRM>>
776 <NOT <FIND-OPT .NM ,PRE-OPTS>>
777 <NOT <SURVIVOR? .NM>>>
778 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
779 <COND (.SEG <OCEMIT <CHTYPE <1 .L> SGFRM> T>)
780 (ELSE <OCEMIT <CHTYPE <1 .L> GFRM> T>)>
781 <COND (<NOT ,PASS1> <CONST-ADD-FRM>)>
782 <COND (,WINNING-VICTIM
783 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
787 <OCEMIT SKIPL T* -1 '(F*)>
788 <OCEMIT HRROI T* '(F*)>
790 <COND (.SEG <OCEMIT <CHTYPE <1 .L> SGFRM> T>)
791 (ELSE <OCEMIT <CHTYPE <1 .L> GFRM> T>)>
792 <COND (<NOT ,PASS1> <CONST-ADD-FRM>)>
794 <COND (,WINNING-VICTIM
795 <SETG STACK-DEPTH <+ ,STACK-DEPTH 3>>)>)>)
796 (<AND <NOT <EMPTY? .L>>
797 <NOT <TYPE? <SET NM <1 .L>> FORM>>
801 <OCEMIT <CHTYPE .NM SBFRM> T>
802 <COND (<NOT ,PASS1> <CONST-ADD-FRM>)>
803 <OCEMIT JSP T* @ <- <OPCODE SBRFRAM>>>
804 <COND (,WINNING-VICTIM
805 <SETG STACK-DEPTH <+ ,STACK-DEPTH 7>>)>)
808 <PUSHJ <COND (.SEG SFRAME) (ELSE FRAME)>>
809 <COND (,WINNING-VICTIM
810 <SETG STACK-DEPTH <+ ,STACK-DEPTH 7>>)>)>>
812 <DEFINE VFRAME!-MIMOC (L)
815 <PUSHJ FRAME <2 .L>>>
817 <DEFINE CFRAME!-MIMOC (L "AUX" (VAL <2 .L>) AC)
818 #DECL ((L) LIST (VAL AC) ATOM)
819 <COND (<==? .VAL STACK>
820 <OCEMIT PUSH TP* !<TYPE-WORD FRAME>>
821 <OCEMIT XMOVEI O* -4 '(F*)>
823 <COND (,WINNING-VICTIM
824 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
826 <SET AC <ASSIGN-AC .VAL BOTH>>
827 <AC-TYPE <GET-AC .AC> FRAME>
828 <OCEMIT XMOVEI <NEXT-AC .AC> -4 '(F*)>)>>
830 <DEFINE PFRAME!-MIMOC (L "AUX" (VAL <3 .L>) AC NAC RNAC TAG)
831 #DECL ((L) LIST (VAL AC NAC RNAC TAG) ATOM)
832 <SET AC <LOAD-AC <1 .L> VALUE>>
833 <SET NAC <ASSIGN-AC .VAL BOTH T>>
834 <AC-TYPE <GET-AC .NAC> FRAME>
835 <OCEMIT MOVE <SET RNAC <NEXT-AC .NAC>> 3 (.AC)>
836 <OCEMIT SKIPL (.RNAC)>
837 <OCEMIT JRST <XJUMP <SET TAG <GENLBL "END">>>>
838 <OCEMIT HRR .RNAC -1 (.RNAC)>
839 <OCEMIT SUBI .RNAC 4>
841 <OCEMIT HLL .RNAC F*>
842 <COND (<==? .VAL STACK>
843 <OCEMIT PUSH TP* .NAC>
844 <OCEMIT PUSH TP* .RNAC>
845 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>>
847 <DEFINE RFRAME!-MIMOC (L)
849 <RETURN!-MIMOC .L <2 .L>>>
851 <DEFINE RTUPLE!-MIMOC (L)
854 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
855 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>
856 <OCEMIT JRST @ <OPCODE RTUPLE>>>
858 <DEFINE MRETURN!-MIMOC (L)
861 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
862 <COND (<==? <2 .L> 0>
863 <OCEMIT MOVEI O2* 0>)
865 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>)>
866 <OCEMIT JRST @ <OPCODE MRETURN>>>
868 <DEFINE ICALL!-MIMOC (L "AUX" (END <GENLBL "ICALL">))
870 <COND (,ICALL-FLAG <SETG ICALL-FLAG <+ ,ICALL-FLAG 1>>)
871 (ELSE <SETG ICALL-FLAG 1>)>
874 <OCEMIT JSP T* @ <- <OPCODE ICALL>>>
875 <OCEMIT JRST <XJUMP .END>>
876 <SETG ICALL-TAGS (<1 .L> .END <COND (<G=? <LENGTH .L> 3>
878 (ELSE <>)> !,ICALL-TAGS)>>
880 <DEFINE SCALL!-MIMOC (L) <CALL!-MIMOC .L T>>
882 <DEFINE CALL!-MIMOC (L
884 "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) C AC PN OP-INF TAG COUNT
885 (XTAG <GENLBL "SC">) (SBYFINF <>))
886 #DECL ((L) LIST (ARG1) <OR ATOM <FORM ATOM ATOM>> (C) ATOM
888 (OP-INF) <OR !<FALSE> <LIST <OR <FORM ANY FIX> !<FALSE>>>>)
889 <COND (<AND .SEG <G? <LENGTH .L> 5>>
892 <COND (<AND <TYPE? .ARG1 FORM>
894 <SET PN <FIND-CALL <2 .ARG1> ,PRE-NAMES>>>
895 <SET SBYFINF <SUBRIFY? <2 .ARG1>>>>>
897 <COND (<NOT <TYPE? .ARG2 FIX>>
898 <OCEMIT MOVE O2* !<OBJ-VAL .ARG2>>)
899 (<NOT <KNOWN-ARGS .SBYFINF>>
900 <OCEMIT MOVEI O2* .ARG2>)>)
901 (<SET OP-INF <FIND-OPT <2 .ARG1> ,PRE-OPTS>>
902 <COND (<NOT <TYPE? .ARG2 FIX>>
903 <OCEMIT MOVE O2* !<OBJ-VAL .ARG2>>)
904 (<NOT <1 .OP-INF>> <OCEMIT MOVEI O2* .ARG2>)>)
905 (<AND <TYPE? .ARG2 ATOM> <NOT <IN-AC? .ARG2 VALUE>>>
906 <OCEMIT MOVE O2* !<OBJ-VAL .ARG2>>)>
907 <COND (<AND <TYPE? .ARG2 FIX>
909 <NOT <GETPROP .PN NDFRM>>
911 <NOT <SURVIVOR? <2 .ARG1>>>>
913 <COND (,WINNING-VICTIM
915 <- ,STACK-DEPTH <+ <* .ARG2 2> 2>>>)>)
918 <OCEMIT XMOVEI F* <- <+ <* .ARG2 2> 1>> (TP*)>
919 <COND (,WINNING-VICTIM
921 <- ,STACK-DEPTH <+ <* .ARG2 2> 3>>>)>)
923 <COND (<AND <TYPE? .ARG2 ATOM>
924 <OR <WILL-DIE? .ARG2>
926 <COND (<G? <LENGTH .L> 3> <4 .L>)>>>>
927 <DEAD!-MIMOC (.ARG2) T>)>
929 <OCEMIT XMOVEI F* -1 '(TP*)>
930 <COND (<SET AC <IN-AC? .ARG2 VALUE>>
935 <OCEMIT SUB F* O2*>)>)>
937 <OCEMIT DMOVE A1* !<OBJ-TYP .SBYFINF>>
938 <OCEMIT DMOVEM A1* -3 '(F*)>
939 <OCEMIT MOVE M* 1 '(A2*)>
940 <OCEMIT XCT 3 '(A2*)>
941 <OCEMIT JRST @ 5 '(A2*)>)
943 <OCEMIT <CHTYPE <2 .ARG1> GCAL>
945 <COND (<AND .OP-INF <1 .OP-INF> <TYPE? .ARG2 FIX>>
948 <CHTYPE <2 <1 .OP-INF>> FIX>
950 <LABEL <NTH .L <LENGTH .L>> 0>
952 <COND (<AND .SEG <ASSIGNED? TAG>>
953 <COND (<N==? .TAG <2 .MIML>>
954 <OCEMIT JRST <XJUMP .XTAG>>)
956 <OCEMIT JFCL O* O*>)>
957 <COND (<NOT <WILL-DIE? .COUNT>>
959 <OCEMIT ADDB A2* !<OBJ-VAL .COUNT>>
960 <SET AC <GET-AC A1*>>
964 <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
965 <SET AC <GET-AC A2*>>
969 <AC-TIME .AC ,AC-STAMP>)>
970 <COND (<N==? .TAG <2 .MIML>>
971 <LABEL-UPDATE-ACS .TAG <>>
972 <OCEMIT JRST <XJUMP .TAG>>
974 <SET AC <GET-AC A1*>>
979 <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
980 <SET AC <GET-AC A2*>>
984 <AC-TIME .AC ,AC-STAMP>)>)
986 <COND (<G? <LENGTH .L> 3> <PUSHJ-VAL <4 .L>>)>)>)
988 <OCEMIT MOVE O1* !<OBJ-VAL .ARG1>>
989 <COND (<TYPE? .ARG2 FIX>
990 <OCEMIT MOVEI O2* .ARG2>)
991 (T <OCEMIT MOVE O2* !<OBJ-VAL .ARG2>>)>
992 <COND (<AND <TYPE? .ARG1 ATOM>
993 <OR <WILL-DIE? .ARG1>
994 <==? .ARG1 <COND (<G? <LENGTH .L> 3> <4 .L>)>>>>
995 <DEAD!-MIMOC (.ARG1)>)>
996 <COND (<AND <TYPE? .ARG2 ATOM>
997 <OR <WILL-DIE? .ARG2>
998 <==? .ARG2 <COND (<G? <LENGTH .L> 3> <4 .L>)>>>>
999 <DEAD!-MIMOC (.ARG2)>)>
1001 <COND (<AND ,WINNING-VICTIM <TYPE? .ARG2 FIX>>
1003 <- ,STACK-DEPTH <* .ARG2 2> 7>>)>
1004 <COND (<AND .SEG <ASSIGNED? TAG>>
1006 <COND (<N==? .TAG <2 .MIML>>
1007 <OCEMIT JRST <XJUMP .XTAG>>)
1009 <OCEMIT JFCL O* O*>)>
1010 <COND (<NOT <WILL-DIE? .COUNT>>
1011 <SET AC <GET-AC A1*>>
1013 <OCEMIT ADDB A2* !<OBJ-VAL .COUNT>>
1014 <AC-ITEM .AC .COUNT>
1017 <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1018 <SET AC <GET-AC A2*>>
1019 <AC-ITEM .AC .COUNT>
1022 <AC-TIME .AC ,AC-STAMP>)>
1023 <COND (<N==? .TAG <2 .MIML>>
1024 <LABEL-UPDATE-ACS .TAG <>>
1025 <OCEMIT JRST <XJUMP .TAG>>
1027 <SET AC <GET-AC A1*>>
1029 <AC-ITEM .AC <4 .L>>
1032 <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1033 <SET AC <GET-AC A2*>>
1034 <AC-ITEM .AC <4 .L>>
1037 <AC-TIME .AC ,AC-STAMP>)>)
1039 <COND (<L=? <LENGTH .L> 3> <PUSHJ CALL>)
1040 (T <PUSHJ CALL <4 .L>>)>
1041 <COND (.SEG <OCEMIT JFCL O* O*>)>)>)>>
1043 <DEFINE ACALL!-MIMOC (L "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) C (VAL <>))
1044 #DECL ((L) LIST (ARG1) <OR ATOM <FORM ATOM ATOM>> (C) ATOM
1045 (ARG2) <OR FIX ATOM>)
1046 <COND (<G? <LENGTH .L> 3> <SET VAL <4 .L>>)>
1047 <COND (<OR <==? .ARG1 .VAL> <WILL-DIE? .ARG1>>
1048 <DEAD!-MIMOC (.ARG1) T>)>
1049 <COND (<OR <==? .ARG2 .VAL> <WILL-DIE? .ARG2>>
1050 <DEAD!-MIMOC (.ARG2) T>)>
1052 <GET-INTO-ACS .ARG1 BOTH A1* .ARG2 VALUE O2*>
1053 <COND (<AND <TYPE? .ARG2 FIX>
1055 <SETG STACK-DEPTH <- ,STACK-DEPTH
1057 <COND (<NOT .VAL> <PUSHJ ACALL>) (T <PUSHJ ACALL .VAL>)>>
1059 <DEFINE SETLR!-MIMOC (L "AUX" AC LCL)
1060 #DECL ((L) LIST (AC) ATOM (P) <OR FALSE FIX>)
1061 <SET AC <ASSIGN-AC <1 .L> BOTH>>
1062 <OCEMIT MOVE T* !<OBJ-VAL <2 .L>>>
1063 <SET LCL <OR <LMEMQ <3 .L> ,LOCALS>
1064 <LMEMQ <3 .L> ,ICALL-TEMPS>>>
1065 <OCEMIT DMOVE .AC <LNAME .LCL> '(T*)>>
1067 <DEFINE SETRL!-MIMOC (L "AUX" AC LCL)
1068 #DECL ((L) LIST (AC) ATOM (P) <OR FALSE FIX>)
1069 <SET AC <LOAD-AC <3 .L> BOTH>>
1070 <OCEMIT MOVE T* !<OBJ-VAL <1 .L>>>
1071 <COND (<OR <SET LCL <LMEMQ <2 .L> ,LOCALS>>
1072 <SET LCL <LMEMQ <2 .L> ,ICALL-TEMPS>>>
1073 <COND (<NOT <LUPD .LCL>> <LUPD .LCL TEMP>)>)>
1074 <OCEMIT DMOVEM .AC <LNAME .LCL> '(T*)>>
1076 <DEFINE RETURN!-MIMOC (L "OPTIONAL" (FRM <>) "AUX" TYP)
1077 #DECL ((L) LIST (TYP FRM) <OR FALSE ATOM>)
1078 <COND (.FRM <GET-INTO-ACS <1 .L> BOTH A1* .FRM VALUE T*>)
1079 (ELSE <GET-INTO-ACS <1 .L> BOTH A1*>)>
1080 <COND (<SET TYP <AC-TYPE <GET-AC A1*>>>
1081 <XEMIT MOVSI A1* !<TYPE-CODE .TYP T>>)>
1083 <OCEMIT XMOVEI F* 4 '(T*)>
1084 <OCEMIT SKIPGE '(F*)>
1085 <OCEMIT HRR F* -1 '(F*)>
1086 <OCEMIT JRST @ <OPCODE RETURN>>)
1088 <OCEMIT MOVE O* '(TP*) '<- 2 ,WINNING-VICTIM>>
1089 <OCEMIT SUBI TP* ',WINNING-VICTIM>
1091 (T <OCEMIT JRST @ <OPCODE RETURN>>)>
1095 <DEFINE BIND!-MIMOC (L)
1098 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 9>>)>
1099 <PUSHJ BIND <2 .L>>>
1101 <DEFINE ACTIVATION!-MIMOC (L)
1106 <DEFINE AGAIN!-MIMOC (L)
1109 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
1110 <OCEMIT JRST @ <OPCODE AGAIN>>
1113 <DEFINE RETRY!-MIMOC (L)
1116 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
1117 <OCEMIT JRST @ <OPCODE RETRY>>
1120 <DEFINE FIXBIND!-MIMOC (L)
1125 <DEFINE UNBIND!-MIMOC (L)
1128 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
1131 <DEFINE ARGS!-MIMOC (L)
1134 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
1135 <PUSHJ ARGS <3 .L>>>
1137 <DEFINE TUPLE!-MIMOC (L)
1140 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
1141 <PUSHJ TUPLE <3 .L>>>
1143 <DEFINE ARGNUM!-MIMOC (L)
1146 <OCEMIT MOVEI O1* <1 .L>>
1150 ;"General Predicates"
1152 <DEFINE EQUAL?!-MIMOC (L "OPT" (ADDR1 <>) (ADDR2 <>) (OFF <>)
1153 "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (AC1 <>) (AC2 <>)
1154 (AC-T1 <>) (AC-T2 <>) NEW (TY1 <>) (TY2 <>))
1155 #DECL ((NEW L) LIST (ARG1 ARG2) ANY (AC1 AC2) <OR ATOM FALSE>)
1156 <COND (<AND <NOT .ADDR1>
1157 <SET AC1 <IN-AC? .ARG1 BOTH>>
1158 <NOT <SET TY1 <AC-TYPE <GET-AC .AC1>>>>>
1159 <AND <SET AC2 <IN-AC? .ARG2 BOTH>>
1160 <SET TY2 <AC-TYPE <GET-AC .AC2>>>>)
1162 <SET AC2 <IN-AC? .ARG2 BOTH>>
1163 <NOT <SET TY2 <AC-TYPE <GET-AC .AC2>>>>>
1169 <SET ADDR1 <SET TY1 <>>>
1170 <SET AC2 <IN-AC? .ADDR2 BOTH>>)
1172 <AND <SET AC2 <IN-AC? .ARG2 BOTH>>
1173 <SET TY2 <AC-TYPE <GET-AC .AC2>>>>)
1180 <SET ADDR1 <SET TY1 <>>>
1183 <SET AC1 <LOAD-AC .ARG1 BOTH>>)>
1184 <SET NEW <LABEL-UPDATE-ACS <4 .L> <> <> .AC1 .AC2>>
1185 <COND (<N==? .AC1 <1 .NEW>>
1186 <SET AC-T1 <AC-TIME <GET-AC <SET AC1 <1 .NEW>>>>>)>
1187 <COND (<AND .AC2 <N==? .AC2 <2 .NEW>>>
1188 <SET AC-T2 <AC-TIME <GET-AC <SET AC2 <2 .NEW>>>>>)>
1189 <OCEMIT CAMN .AC1 !<COND (.ADDR2 (.OFF (.ADDR2)))
1190 (.TY2 <TYPE-WORD .TY2>)
1192 (ELSE <OBJ-TYP .ARG2>)>>
1193 <OCEMIT CAME <NEXT-AC .AC1>
1194 !<COND (.AC2 (<NEXT-AC .AC2>))
1195 (.ADDR2 (<+ .OFF 1> (.ADDR2)))
1196 (ELSE <OBJ-VAL .ARG2>)>>
1197 <COND (<==? <3 .L> +> <OCEMIT CAIA O* O*>)>
1198 <OCEMIT JRST <XJUMP <4 .L>>>
1200 <AC-TIME <GET-AC .AC1> .AC-T1>
1201 <AC-TIME <GET-AC <NEXT-AC .AC1>> .AC-T1>)>
1203 <AC-TIME <GET-AC .AC2> .AC-T2>
1204 <AC-TIME <GET-AC <NEXT-AC .AC2>> .AC-T2>)>>
1206 <DEFINE VEQUAL?!-MIMOC (L
1207 "OPTIONAL" (ADDR1 <>) (ADDR2 <>) (OFF <>) (TY <>)
1209 (CAM CAMN) (JUMP JUMPE) (CAIX CAIE) (CAMX CAME)
1210 (JUMPX JUMPN) (SOJ SOJE) (SOJX SOJN)
1211 (SKIP SKIPN) (SKIPX SKIPE)
1212 "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (TAG <4 .L>) AC1 NEW
1213 (AC-T1 <>) (AC-T2 <>) AC2 TEM (DIR <3 .L>)
1214 BP (KL <>) TMP (SWAPPED? <>))
1215 #DECL ((L) LIST (ARG1 ARG2) ANY (KL) <OR FALSE ATOM>
1216 (AC1 CAI CAM JUMP CAIX CAMX JUMPX TAG SKIP SKIPX) ATOM)
1217 <COND (<TYPE? .ARG2 FLOAT WORD LOSE CHARACTER>
1218 <SET ARG2 <CHTYPE .ARG2 FIX>>)
1219 (<AND <==? <PRIMTYPE .ARG2> LIST> <EMPTY? .ARG2>> <SET ARG2 0>)>
1222 (<IN-AC? .ARG1 VALUE>)
1224 (<AND <TYPE? .ARG2 ATOM>
1225 <OR <IN-AC? .ARG2 VALUE> <NOT <TYPE? .ARG1 ATOM>>>>
1226 <COND (<==? .CAI CAIGE> ;"LESS?"
1228 <COND (<==? .DIR +> <SET CAI CAILE> <SET CAM CAMLE>)
1229 (T <SET CAI CAIG> <SET CAM CAMG>)>)
1230 (<==? .CAI CAILE> ;"GRTR?"
1232 <COND (<==? .DIR +> <SET CAI CAIGE> <SET CAM CAMGE>)
1233 (T <SET CAI CAIL> <SET CAM CAML>)>)>
1238 <COND (<IN-AC? .ARG1 VALUE>)
1239 (ELSE <NEXT-AC <LOAD-AC .ARG1 BOTH>>)>)
1240 (T <NEXT-AC <LOAD-AC .ARG1 BOTH>>)>>
1243 (<AND <TYPE? .ARG2 ATOM> <IN-AC? .ARG2 VALUE>>)
1244 (<AND .ADDR1 <TYPE? .ARG2 ATOM>> <LOAD-AC .ARG2 VALUE>)
1246 <COND (<AND <==? .ARG2 1> <NOT <AC-UPDATE <GET-AC .AC1>>>>
1247 <COND (<SET TMP <IN-AC? .ARG1 BOTH>>
1249 (ELSE <MUNGED-AC .AC1>)>)
1253 <LABEL-UPDATE-ACS .TAG
1256 <COND (<AND <N==? .AC1 X*> <N==? .AC1 O*>> .AC1)>
1257 <COND (<AND <N==? .AC2 X*> <N==? .AC2 O*>> .AC2)>>>
1258 <COND (<AND <N==? .AC1 X*> <N==? .AC1 O*> <N==? .AC1 <1 .NEW>>>
1259 <SET AC-T1 <AC-TIME <GET-AC <SET AC1 <1 .NEW>>>>>)>
1260 <COND (<AND <N==? .AC2 X*> <N==? .AC2 O*> <N==? .AC2 <2 .NEW>>>
1261 <SET AC-T2 <AC-TIME <GET-AC <SET AC2 <2 .NEW>>>>>)>
1262 <COND (<AND <NOT .KL> <==? .DIR ->>
1266 <COND (.SOJ <SET SOJ .SOJX>)>
1268 <COND (<AND .OFF .TY>
1269 <SET BP <+ <CHTYPE <ORB 19595788288
1270 <LSH <2 <CHTYPE <MEMQ .AC1 ,ACS> VECTOR>>
1274 <CONST-LOC .BP VALUE>
1275 <OCEMIT LDB O* !<OBJ-VAL .BP>>
1276 <OCEMIT CAIN O* .TY>
1280 <COND (<==? .ARG2 0>
1282 <COND (<TYPE? .OFF FIX>
1283 <OCEMIT .SKIP O* .OFF (.AC1)>)
1285 <OCEMIT .SKIP O* !.OFF>)>
1286 <COND (.TY <OCEMIT CAIA O* O*>)>
1287 <OCEMIT JRST <XJUMP .TAG>>)
1289 <OCEMIT .SKIP !<OBJ-VAL .ARG1>>
1290 <OCEMIT JRST <XJUMP .TAG>>)
1291 (T <OCEMIT .JUMP .AC1 <XJUMP .TAG>>)>)
1292 (<AND <==? .ARG2 1> <NOT <AC-UPDATE <GET-AC .AC1>>> .SOJ>
1293 <OCEMIT .SOJ .AC1 <XJUMP .TAG>>)
1294 (<AND <TYPE? .ARG2 FIX> <G=? .ARG2 0> <L=? .ARG2 ,MAX-IMMEDIATE>>
1295 <OCEMIT .CAI .AC1 .ARG2>
1296 <OCEMIT JRST <XJUMP .TAG>>)
1299 <COND (<TYPE? .OFF FIX>
1300 <OCEMIT .CAM .AC1 .OFF (.AC2)>)
1302 <OCEMIT .CAM .AC1 !.OFF>)>)
1304 <OCEMIT .CAM .AC2 .OFF (.AC1)>)
1306 <OCEMIT .CAM .AC2 !.OFF>)>
1307 <COND (.TY <OCEMIT CAIA O* O*>)>
1308 <OCEMIT JRST <XJUMP .TAG>>)
1310 <COND (<==? .AC2 X*> <OCEMIT .CAM .AC1 !<OBJ-VAL .ARG2>>)
1311 (ELSE <OCEMIT .CAM .AC1 .AC2>)>
1312 <OCEMIT JRST <XJUMP .TAG>>)>
1313 <COND (.AC-T1 <AC-TIME <GET-AC .AC1> .AC-T1>)>
1314 <COND (.AC-T2 <AC-TIME <GET-AC .AC2> .AC-T2>)>>
1316 <DEFINE LESS?!-MIMOC (L)
1318 <VEQUAL?!-MIMOC .L <> <> <> <> CAIGE CAMGE JUMPL CAIL CAML JUMPGE SOJL
1319 SOJGE SKIPGE SKIPL>>
1321 <DEFINE GRTR?!-MIMOC (L)
1323 <VEQUAL?!-MIMOC .L <> <> <> <> CAILE CAMLE JUMPG CAIG CAMG JUMPLE SOJG
1324 SOJLE SKIPLE SKIPG>>
1326 <SETG COMPARERS [VEQUAL!-MIMOC LESS?!-MIMOC GRTR?!-MIMOC]>
1330 <DEFINE MUL!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L IMUL IMULI <> IMULB>>
1331 <DEFINE MULF!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L FMPR FMPRI <> FMPRB
1334 <DEFINE SUB!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L SUB SUBI SOS SUBB>>
1335 <DEFINE SUBF!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L FSBR FSBRI <> FSBRB
1338 <DEFINE DIV!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L IDIV IDIVI <> IDIVB>>
1339 <DEFINE DIVF!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L FDVR FDVRI <> FDVRB
1342 <DEFINE ADD!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L>>
1343 <DEFINE ADDF!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L FADR FADRI <> FADRB
1346 <DEFINE MOD!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L IDIV IDIVI MOD <>>>
1347 <DEFINE XOR!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L XOR XORI TLC XORB>>
1349 <DEFINE EQV!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L EQV EQVI '(TLC TRC) EQVB>>
1350 <DEFINE OR!-MIMOC (L) #DECL ((L) LIST) <ARITH!-MIMOC .L IOR IORI TLO IORB>>
1352 <DEFINE ARITH!-MIMOC (L
1353 "OPTIONAL" (NORM ADD) (IMMED ADDI) (HACK AOS) (BO ADDB)
1355 "AUX" AC OAC (ARG1 <1 .L>) (ARG2 <2 .L>) (VAL <4 .L>)
1356 HACK2 (TEM .ARG1) (IMM-OK <>) (NEG-FIRST <>))
1357 #DECL ((L) LIST (NORM IMMED VAL) ATOM (HACK) <OR ATOM LIST FALSE>
1358 (ARG1 ARG2) <OR ATOM FIX FLOAT> (AC) <OR FALSE ATOM>)
1359 <COND (<AND <==? .ARG1 1> <==? .NORM ADD>> <SET ARG1 .ARG2> <SET ARG2 1>)>
1360 <COND (<AND <OR <AND <==? .ARG2 .VAL>
1361 <NOT <AND <IN-AC? .ARG1 VALUE> <WILL-DIE? .ARG1>>>>
1362 <COND (<SET AC <IN-AC? .ARG2 VALUE>>
1363 <OR <NOT <SET OAC <IN-AC? .ARG1 VALUE>>>
1364 <AND <N==? .ARG1 .VAL>
1365 <OR <NOT <AC-UPDATE <GET-AC .OAC>>>
1367 <AC-UPDATE <GET-AC .AC>>
1368 <NOT <WILL-DIE? .ARG1>>>>)>>
1371 <OR <MEMQ .NORM '[ADD MUL IOR XOR AND EQV]>
1372 <AND <==? .NORM SUB>
1377 <AND <==? .NORM FSBR>
1384 (<AND <OR <==? <PRIMTYPE .ARG2> WORD> <==? <PRIMTYPE .ARG2> FIX>>
1385 <OR <==? .NORM ADD> <==? .NORM SUB>>
1386 <L? <CHTYPE .ARG2 FIX> 0>
1387 <L? <ABS <CHTYPE .ARG2 FIX>> ,MAX-IMMEDIATE>>
1388 <SET ARG2 <- .ARG2>>
1389 <COND (<==? .NORM ADD> <SET NORM SUB> <SET IMMED SUBI>)
1390 (ELSE <SET NORM ADD> <SET IMMED ADDI>)>)>
1392 (<AND <OR <==? <PRIMTYPE .ARG2> WORD> <==? <PRIMTYPE .ARG2> FIX>>
1393 <OR <AND <L=? <SET ARG2 <CHTYPE .ARG2 FIX>> ,MAX-IMMEDIATE>
1395 <AND <==? <CHTYPE <ANDB .ARG2 262143> FIX> 0>
1396 <OR <AND <OR <==? .NORM IOR> <==? .NORM XOR>>
1397 <SET ARG2 <CHTYPE <LSH .ARG2 -18> FIX>>
1399 <COND (<AND <==? .HACK TLO> <==? .ARG2 262143>>
1404 <AND <MEMQ .NORM '[FADR FSBR FDVR FMPR]>
1405 <SET ARG2 <CHTYPE <LSH .ARG2 -18> FIX>>>>>
1406 <AND <OR <==? .NORM AND> <==? .NORM EQV>>
1407 <OR <AND <==? <CHTYPE <ANDB .ARG2 262143> FIX> 262143>
1408 <SET ARG2 <CHTYPE <LSH <XORB .ARG2 -1> -18> FIX>>
1409 <SET IMMED <1 <CHTYPE .HACK LIST>>>>
1410 <AND <==? <CHTYPE <ANDB <LSH .ARG2 -18> 262143> FIX>
1413 <CHTYPE <ANDB <XORB .ARG2 -1> 262143> FIX>>
1414 <SET IMMED <2 <CHTYPE .HACK LIST>>>
1415 <COND (<AND <==? .ARG2 262143> <==? .IMMED TRZ>>
1420 <OR <==? .ARG1 .VAL>
1421 <AND <WILL-DIE? .ARG1>
1423 <PROG () <DEAD!-MIMOC (.ARG1) T> 1>>
1424 <AND <NOT <IN-AC? .ARG1 VALUE>>
1425 <OR <==? .HACK HRROS>
1427 <AND <==? .IMMED ANDI> <==? .ARG2 262143>>>>>>
1428 <COND (<SET AC <IN-AC? .ARG1 VALUE>>
1429 <COND (<AND <N==? .VAL STACK> <N==? .ARG1 .VAL>>
1431 <AC-CODE <AC-ITEM <GET-AC .AC> .VAL> VALUE>
1432 <PROG ((X <GET-AC <GETPROP .AC AC-PAIR>>) Y)
1434 <COND (<OR <==? <AC-ITEM .X> .ARG1>
1435 <AND <SET Y <VAR-TYPED? .ARG1>>
1436 <AC-TYPE .X .RESTYP>>>
1437 <AC-UPDATE <AC-CODE <AC-ITEM .X .VAL> TYPE>
1439 <COND (<OR <AND <AC-TYPE .X>
1440 <N==? <AC-TYPE .X> .RESTYP>>
1441 <AND <NOT <AC-TYPE .X>>
1444 <==? .Y .RESTYP>>>>>
1445 <AC-TYPE .X .RESTYP>)>)>>)>
1446 <COND (.NEG-FIRST <OCEMIT MOVNS O* .AC>)>
1447 <COND (<AND <OR <==? .NORM IDIV> <==? .NORM FDVR>>
1448 <NOT <AC-TYPE <GET-AC <NEXT-AC .AC>>>>>
1449 <FLUSH-AC <NEXT-AC .AC>>
1450 <MUNGED-AC <NEXT-AC .AC>>)>
1451 <OCEMIT .IMMED .AC .ARG2>
1452 <AC-UPDATE <GET-AC .AC> T>
1453 <COND (<==? .HACK MOD>
1454 <PROG ((X <GET-AC <NEXT-AC .AC>>) (Y <AC-TYPE .X>))
1457 <OCEMIT SKIPGE .AC <NEXT-AC .AC>>
1458 <OCEMIT ADDI .AC .ARG2>
1461 <COND (<AND <1? .ARG2> <MEMQ .NORM '[ADD SUB]>>
1462 <SET AC <ASSIGN-AC .VAL BOTH>>
1463 <AC-UPDATE <GET-AC <NEXT-AC .AC>> <N==? .ARG1 .VAL>>
1464 <AC-UPDATE <GET-AC .AC> <N==? .ARG1 .VAL>>
1465 <OCEMIT .HACK <NEXT-AC .AC> !<OBJ-VAL .ARG1>>
1466 <AC-ITEM <GET-AC <NEXT-AC .AC>> .VAL>
1467 <AC-CODE <GET-AC <NEXT-AC .AC>> VALUE>
1468 <AC-TYPE <GET-AC .AC> FIX>)
1469 (<OR <==? .HACK HRROS>
1471 <AND <==? .IMMED ANDI>
1475 <COND (<N==? .VAL STACK>
1476 <SET AC <ASSIGN-AC .VAL BOTH>>
1477 <AC-UPDATE <GET-AC <NEXT-AC .AC>> <N==? .VAL .ARG1>>
1478 <AC-UPDATE <GET-AC .AC> <N==? .VAL .ARG1>>
1479 <OCEMIT <COND (<==? .VAL .ARG1> .HACK)
1481 <NEXT-AC .AC> !<OBJ-VAL .ARG1>>
1482 <AC-ITEM <GET-AC <NEXT-AC .AC>> .VAL>
1483 <AC-CODE <GET-AC <NEXT-AC .AC>> VALUE>
1484 <AC-TYPE <GET-AC .AC> FIX>)
1486 <OCEMIT .HACK2 O* !<OBJ-VAL .ARG1>>
1487 <OCEMIT PUSH TP* !<TYPE-WORD .RESTYP>>
1488 <OCEMIT PUSH TP* O*>
1489 <COND (,WINNING-VICTIM
1490 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)
1492 <SET AC <ASSIGN-AC .VAL BOTH T>>
1493 <OCEMIT MOVE .AC !<OBJ-VAL .ARG1>>
1494 <OCEMIT IDIVI .AC .ARG2>
1495 <OCEMIT SKIPGE O* <NEXT-AC .AC>>
1496 <OCEMIT ADDI <NEXT-AC .AC> .ARG2>
1497 <AC-TYPE <GET-AC .AC> FIX>
1498 <AC-ITEM <GET-AC <NEXT-AC .AC>> .VAL>
1499 <AC-CODE <GET-AC <NEXT-AC .AC>> VALUE>
1500 <AC-UPDATE <GET-AC <NEXT-AC .AC>> T>)
1503 <SET AC <ASSIGN-AC .ARG1 BOTH>>
1504 <OCEMIT MOVN <NEXT-AC .AC> !<OBJ-VAL .ARG1>>
1505 <AC-TYPE <GET-AC .AC> .RESTYP>)
1507 <SET AC <LOAD-AC .ARG1 BOTH T>>)>
1508 <COND (<N==? .ARG1 .VAL>
1509 <DEAD!-MIMOC (.ARG1) T>
1510 <PROG ((X <GET-AC .AC>) Y)
1511 <COND (<OR <AND <AC-TYPE .X>
1512 <N==? <AC-TYPE .X> .RESTYP>>
1513 <AND <NOT <AC-TYPE .X>>
1516 <==? .Y .RESTYP>>>>>
1517 <AC-TYPE .X .RESTYP>)>>
1519 <ALTER-AC .AC .VAL>)>
1520 <SET AC <NEXT-AC .AC>>
1521 <COND (<OR <==? .NORM IDIV> <==? .NORM FDVR>>
1522 <FLUSH-AC <NEXT-AC .AC>>
1523 <MUNGED-AC <NEXT-AC .AC>>)>
1524 <OCEMIT .IMMED .AC .ARG2>)>)>)
1525 (<AND <OR <==? .ARG1 0> <==? .ARG1 0.0000000>>
1526 <OR <==? .NORM SUB> <==? .NORM FSBR>>>
1527 <COND (<SET AC <IN-AC? .ARG2 VALUE>>
1528 <COND (<==? .ARG2 .VAL>
1529 <AC-UPDATE <GET-AC .AC> T>
1530 <OCEMIT MOVNS O* .AC>)
1532 <OCEMIT MOVN O* .AC>
1533 <OCEMIT PUSH TP* !<TYPE-WORD .RESTYP>>
1534 <OCEMIT PUSH TP* O*>
1535 <COND (,WINNING-VICTIM
1536 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1539 <SET AC <ASSIGN-AC .VAL BOTH T>>
1540 <AC-TYPE <GET-AC .AC> .RESTYP>
1541 <AC-ITEM <GET-AC <NEXT-AC .AC>> .VAL>
1542 <OCEMIT MOVN <NEXT-AC .AC> .OAC>)>)
1543 (<==? .ARG2 .VAL> <OCEMIT MOVNS O* !<OBJ-VAL .ARG2>>)
1545 <OCEMIT MOVN O* !<OBJ-VAL .ARG2>>
1546 <OCEMIT PUSH TP* !<TYPE-WORD .RESTYP>>
1547 <OCEMIT PUSH TP* O*>
1548 <COND (,WINNING-VICTIM
1549 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1551 <SET AC <ASSIGN-AC .VAL BOTH T>>
1552 <AC-TYPE <GET-AC .AC> .RESTYP>
1553 <OCEMIT MOVN <NEXT-AC .AC> !<OBJ-VAL .ARG2>>)>)
1554 (<AND <==? .HACK MOD> <==? .ARG1 .VAL>>
1555 <SET AC <ASSIGN-AC .ARG1 BOTH T>>
1556 <OCEMIT MOVE .AC !<OBJ-VAL .ARG1>>
1557 <OCEMIT IDIV .AC !<OBJ-VAL .ARG2>>
1558 <OCEMIT SKIPGE O* <NEXT-AC .AC>>
1559 <OCEMIT ADD <NEXT-AC .AC> !<OBJ-VAL .ARG2>>
1560 <AC-TYPE <GET-AC .AC> FIX>
1561 <AC-ITEM <GET-AC <NEXT-AC .AC>> .ARG1>
1562 <AC-CODE <GET-AC <NEXT-AC .AC>> VALUE>
1563 <AC-UPDATE <GET-AC <NEXT-AC .AC>> T>)
1565 <SET AC <NEXT-AC <LOAD-AC .ARG1 BOTH>>>
1566 <COND (.NEG-FIRST <OCEMIT MOVNS O* .AC>)>
1567 <COND (<OR <==? .NORM IDIV> <==? .NORM FDVR>>
1568 <FLUSH-AC <NEXT-AC .AC>>
1569 <MUNGED-AC <NEXT-AC .AC>>)>
1570 <OCEMIT .NORM .AC !<OBJ-VAL .ARG2>>
1571 <AC-UPDATE <GET-AC .AC> T>)
1573 <COND (<==? .ARG2 .VAL> <SMASH-AC T* .ARG2 VALUE>)>
1575 <SET AC <ASSIGN-AC .VAL BOTH T>>
1576 <OCEMIT MOVE .AC !<OBJ-VAL .ARG1>>
1577 <COND (<TYPE? .ARG2 FIX>
1578 <OCEMIT IDIVI .AC .ARG2>
1579 <OCEMIT SKIPGE O* <NEXT-AC .AC>>
1580 <OCEMIT ADDI <NEXT-AC .AC> .ARG2>)
1582 <OCEMIT IDIV .AC !<OBJ-VAL .ARG2>>
1583 <OCEMIT SKIPGE O* <NEXT-AC .AC>>
1584 <OCEMIT ADD <NEXT-AC .AC> !<OBJ-VAL .ARG2>>)>
1585 <COND (<==? .VAL STACK>
1586 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
1587 <OCEMIT PUSH TP* <NEXT-AC .AC>>
1588 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>
1591 <AC-TYPE <GET-AC .AC> FIX>
1592 <AC-ITEM <GET-AC <NEXT-AC .AC>> .ARG1>
1593 <AC-CODE <GET-AC <NEXT-AC .AC>> VALUE>
1594 <AC-UPDATE <GET-AC <NEXT-AC .AC>> T>)>)
1597 <COND (<AND <==? .ARG2 .VAL>
1598 <OR <AND <SET TEM <IN-AC? .ARG2 BOTH>>
1601 <SET TEM <NEXT-AC .TEM>>
1603 <AND <SET TEM <IN-AC? .ARG2 VALUE>> <MUNGED-AC .TEM>>>>)>
1604 <COND (<SET AC <IN-AC? .ARG1 BOTH>>
1605 <COND (<WILL-DIE? .ARG1> <DEAD!-MIMOC (.ARG1) T>)
1606 (<AND <AC-UPDATE <GET-AC <NEXT-AC .AC>>>
1607 <SET OAC <REALLY-FREE-AC-PAIR>>
1608 <N==? <NEXT-AC .OAC> .TEM>>
1610 <OCEMIT MOVN <NEXT-AC .OAC> <NEXT-AC .AC>>
1613 <OCEMIT MOVE <NEXT-AC .OAC> <NEXT-AC .AC>>)>
1615 <AC-TYPE <GET-AC .AC> .RESTYP>)>
1616 <PROG ((TY <AC-TYPE <GET-AC .AC>>))
1619 <AC-TYPE <GET-AC .AC> .TY>>
1620 <COND (.NEG-FIRST <OCEMIT MOVNS O* <NEXT-AC .AC>>)>)
1622 <SET AC <ASSIGN-AC .VAL BOTH T>>
1623 <COND (<==? .TEM <NEXT-AC .AC>>
1624 <OCEMIT MOVE T* .TEM>
1626 <AC-TYPE <GET-AC .AC> .RESTYP>
1627 <COND (<TYPE? .ARG1 ATOM>
1628 <OCEMIT <COND (.NEG-FIRST MOVN)
1629 (ELSE MOVE)> <NEXT-AC .AC> !<OBJ-VAL .ARG1>>)
1630 (ELSE <LOAD-AC .ARG1 VALUE <> <> <GET-AC <NEXT-AC .AC>>>)>)>
1631 <COND (<AND <OR <==? .NORM IDIV> <==? .NORM FDVR>>
1632 <N==? <NEXT-AC <NEXT-AC .AC>> T*>>
1633 <FLUSH-AC <NEXT-AC <NEXT-AC .AC>>>
1634 <MUNGED-AC <NEXT-AC <NEXT-AC .AC>>>)>
1635 <COND (.IMM-OK <OCEMIT .IMMED <NEXT-AC .AC> .ARG2>)
1636 (.TEM <OCEMIT .NORM <NEXT-AC .AC> .TEM>)
1637 (<AND .BO <==? .ARG2 .VAL>>
1638 <OCEMIT .BO <NEXT-AC .AC> !<OBJ-VAL .ARG2>>)
1639 (T <OCEMIT .NORM <NEXT-AC .AC> !<OBJ-VAL .ARG2>>)>
1641 <AC-CODE <AC-ITEM <GET-AC .AC> .VAL> TYPE>
1642 <AC-UPDATE <GET-AC .AC> T>
1643 <AC-CODE <AC-ITEM <GET-AC <SET AC <NEXT-AC .AC>>> .VAL> VALUE>
1644 <AC-UPDATE <GET-AC .AC> <NOT <AND .BO <==? .ARG2 .VAL> <NOT .TEM>>>>
1645 <COND (<==? .VAL STACK>
1646 <OCEMIT PUSH TP* !<TYPE-WORD .RESTYP>>
1647 <OCEMIT PUSH TP* .AC>
1648 <COND (,WINNING-VICTIM
1649 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)>>
1651 <DEFINE AND!-MIMOC (L "AUX" (ARG1 <1 .L>)
1654 NEXTLINE AFTERNEXTLINE
1658 TAC TEMP AC (MIML .MIML))
1659 #DECL ((TRN MIML L) LIST (ARG1 ARG2 TEMP) ANY
1660 (VAL DIR DESTINATION) ATOM
1661 (NEXTLINE AFTERNEXTLINE) <OR ATOM LIST FORM>)
1662 <COND (<AND <G=? <LENGTH .MIML> 3>
1663 <OR <AND <==? <PRIMTYPE .ARG1> FIX>
1667 <SET ARG2 <CHTYPE .TEMP FIX>>>
1668 <AND <TYPE? .ARG1 ATOM>
1669 <==? <PRIMTYPE .ARG2> FIX>
1670 <SET ARG2 <CHTYPE .ARG2 FIX>>>
1671 <AND <TYPE? .ARG1 ATOM>
1673 <NOT <WILL-DIE? .ARG1>>
1674 <NOT <WILL-DIE? .ARG2>>
1678 <COND (<AND <IN-AC? .ARG2 VALUE>
1679 <NOT <IN-AC? .ARG1 VALUE>>>
1684 <TYPE? <SET NEXTLINE <2 .MIML>> FORM>
1685 <=? <SPNAME <1 .NEXTLINE>> "VEQUAL?">
1686 <OR <AND <==? <2 .NEXTLINE> .VAL>
1687 <==? <3 .NEXTLINE> 0>>
1688 <AND <==? <2 .NEXTLINE> 0>
1689 <==? <3 .NEXTLINE> .VAL>>>
1690 <WILL-DIE? .VAL <REST .MIML>>
1691 <WILL-DIE? .VAL <LAB-CODE-PNTR <FIND-LABEL <5 .NEXTLINE>>>>>
1692 <SET DIR <4 .NEXTLINE>>
1693 <SET DESTINATION <5 .NEXTLINE>>
1694 <COND (<SET TAC <IN-AC? .ARG1 BOTH>>
1695 <SET AC <NEXT-AC .TAC>>)
1696 (<SET AC <IN-AC? .ARG1 VALUE>>)
1697 (ELSE <SET AC <NEXT-AC <SET TAC <LOAD-AC .ARG1 BOTH>>>>)>
1698 <LABEL-UPDATE-ACS .DESTINATION <>>
1699 <COND (<TYPE? .ARG2 ATOM> <SET CONST T>)
1700 (<L=? .ARG2 *777777*> <SET TRN '(TRNN TRNE)>)
1701 (<==? <CHTYPE <ANDB .ARG2 *777777*> FIX> 0>
1702 <SET ARG2 <CHTYPE <LSH .ARG2 -18> FIX>>
1703 <SET TRN '(TLNN TLNE)>)
1704 (ELSE <SET CONST T>)>
1706 <COND (.CONST <OCEMIT TDNE .AC !<OBJ-VAL .ARG2>>)
1707 (ELSE <OCEMIT <2 .TRN> .AC .ARG2>)>)
1708 (<AND <TYPE? .ARG2 FIX>
1709 <==? .ARG2 <CHTYPE <ANDB .ARG2 <- .ARG2>> FIX>>>
1710 ;"Only one bit, can be TRNN..."
1711 <COND (.CONST <OCEMIT TDNN .AC !<OBJ-VAL .ARG2>>)
1712 (ELSE <OCEMIT <1 .TRN> .AC .ARG2>)>)
1714 <OCEMIT TDNE .AC !<OBJ-VAL .ARG2>>
1715 <OCEMIT CAIA O* O*>)
1717 <OCEMIT <2 .TRN> .AC .ARG2>
1718 <OCEMIT CAIA O* O*>)>
1719 <OCEMIT JRST <XJUMP .DESTINATION>>
1720 <SETG NEXT-FLUSH 1>)
1721 (ELSE <ARITH!-MIMOC .L AND ANDI '(TLZ TRZ) ANDB>)>>
1723 <DEFINE FLOAT!-MIMOC (L "AUX" (VAL <3 .L>) NAC)
1724 #DECL ((L) LIST (VAL NAC) ATOM)
1725 <COND (<==? .VAL STACK>
1726 <OCEMIT PUSH TP* !<TYPE-WORD FLOAT>>
1727 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
1728 <OCEMIT FLTR O* !<OBJ-VAL <1 .L>>>
1729 <OCEMIT PUSH TP* O*>
1730 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
1732 <SET NAC <ASSIGN-AC <3 .L> BOTH>>
1733 <AC-TYPE <GET-AC .NAC> FLOAT>
1734 <OCEMIT FLTR <NEXT-AC .NAC> !<OBJ-VAL <1 .L>>>)>>
1736 <DEFINE FIX!-MIMOC (L "AUX" (VAL <3 .L>) NAC)
1737 #DECL ((L) LIST (VAL NAC) ATOM)
1738 <COND (<==? .VAL STACK>
1739 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
1740 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
1741 <OCEMIT FIX O* !<OBJ-VAL <1 .L>>>
1742 <OCEMIT PUSH TP* O*>
1743 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
1745 <SET NAC <ASSIGN-AC <3 .L> BOTH>>
1746 <AC-TYPE <GET-AC .NAC> FIX>
1747 <OCEMIT FIX <NEXT-AC .NAC> !<OBJ-VAL <1 .L>>>)>>
1749 <DEFINE LSH!-MIMOC (L
1750 "OPTIONAL" (INS LSH)
1751 "AUX" TAC (AC <>) (ARG <1 .L>) (AMT <2 .L>) (VAL <4 .L>)
1753 #DECL ((L) LIST (VAL INS NAC) ATOM (AMT) <OR FIX ATOM> (AC) <OR ATOM FALSE>)
1755 (<AND <==? .INS LSH> <OR <==? .AMT 18> <==? .AMT -18>>>
1756 <DO-HWRD-INS .ARG .VAL .AMT>)
1758 <COND (<TYPE? .ARG ATOM> <SET AC <NEXT-AC <SET TAC <LOAD-AC .ARG BOTH>>>>)>
1759 <COND (<SET AMT-AC <IN-AC? .AMT BOTH>>
1761 <COND (<OR <==? .AMT .VAL> <WILL-DIE? .AMT>>
1763 <SET FAC <REALLY-FREE-AC-PAIR>>>
1764 <MUNGED-AC .AMT-AC T>)
1766 <OCEMIT MOVE <SET FAC T*> <NEXT-AC .AMT-AC>>
1768 <COND (<N==? .AMT-AC T*>
1769 <AC-TIME <GET-AC .AMT-AC> ,AC-STAMP>
1770 <AC-TIME <GET-AC <NEXT-AC .AMT-AC>> ,AC-STAMP>
1771 <SET AMT-AC <NEXT-AC .AMT-AC>>)>)>
1772 <COND (<AND <N==? .ARG .VAL>
1774 <NOT <WILL-DIE? .ARG>>
1775 <NOT <AND <NOT <AC-UPDATE <GET-AC .AC>>>
1780 <SET NAC <ASSIGN-AC .VAL BOTH T>>
1781 <AC-TYPE <GET-AC .NAC> FIX>
1782 <OCEMIT MOVE <SET NAC <NEXT-AC .NAC>> .AC>)
1784 <AC-TIME <GET-AC .TAC> ,AC-STAMP>
1785 <AC-TIME <GET-AC <SET NAC .AC>> ,AC-STAMP>)
1787 <AC-TYPE <GET-AC <SET NAC <ASSIGN-AC .VAL BOTH T>>> FIX>
1788 <SET NAC <NEXT-AC .NAC>>)>
1789 <COND (<TYPE? .AMT FIX>
1790 <COND (<NOT <TYPE? .ARG ATOM>>
1791 <LOAD-NUM-INTO-AC .ARG .NAC>)>
1792 <OCEMIT .INS .NAC .AMT>)
1794 <COND (<==? .AMT-AC .NAC>
1795 <OCEMIT MOVE T* .AMT-AC>
1797 <COND (<NOT <TYPE? .ARG ATOM>>
1798 <LOAD-NUM-INTO-AC .ARG .NAC>)>
1799 <OCEMIT .INS .NAC (.AMT-AC)>)
1801 <GET-INTO-ACS .AMT VALUE T*>
1802 <COND (<NOT <TYPE? .ARG ATOM>>
1803 <LOAD-NUM-INTO-AC .ARG .NAC>)>
1804 <OCEMIT .INS .NAC '(T*)>)
1806 <AC-TIME <GET-AC .NAC> ,AC-STAMP>
1807 <AC-TIME <GET-AC <GETPROP .NAC AC-PAIR>> ,AC-STAMP>
1808 <COND (<NOT <TYPE? .ARG ATOM>>
1809 <LOAD-NUM-INTO-AC .ARG .NAC>)>
1810 <SET AMT-AC <LOAD-AC .AMT BOTH>>
1811 <OCEMIT .INS .NAC (<NEXT-AC .AMT-AC>)>)>
1815 <AC-CODE <AC-ITEM <AC-TYPE <AC-UPDATE <GET-AC .TAC> T> FIX> .VAL> TYPE>
1817 <AC-ITEM <AC-TYPE <AC-UPDATE <GET-AC .AC> T> <>> .VAL>
1819 <COND (<==? .VAL STACK>
1820 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
1821 <OCEMIT PUSH TP* .NAC>
1822 <COND (,WINNING-VICTIM
1823 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)>>
1825 <DEFINE LOAD-NUM-INTO-AC (V AC) #DECL ((V) FIX (AC) ATOM)
1826 <COND (<AND <G=? .V 0> <L=? .V ,MAX-IMMEDIATE>>
1827 <OCEMIT MOVEI .AC .V>)
1828 (<AND <L? .V 0> <L=? <ABS .V> ,MAX-IMMEDIATE>>
1829 <OCEMIT MOVNI .AC <- .V>>)
1830 (<0? <CHTYPE <ANDB .V 262143> FIX>>
1831 <OCEMIT MOVSI .AC <CHTYPE <LSH .V -18> FIX>>)
1832 (ELSE <OCEMIT MOVE .AC !<OBJ-LOC .V 1>>)>>
1834 <DEFINE DO-HWRD-INS (SRC VAL AMT "AUX" AC)
1836 <COND (<==? .VAL STACK>
1837 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
1838 <COND (,WINNING-VICTIM
1839 <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
1840 <OCEMIT <COND (<==? .AMT 18> HRLZ)
1843 <OCEMIT PUSH TP* O*>
1844 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
1846 <COND (<SET AC <IN-AC? .SRC VALUE>>
1847 <COND (<==? .AMT 18> <OCEMIT HRLZS O* .AC>)
1848 (ELSE <OCEMIT HLRZS O* .AC>)>
1849 <AC-UPDATE <GET-AC .AC> T>)
1851 <OCEMIT HRLZS !<OBJ-VAL .SRC>>)
1853 <OCEMIT HLRZS !<OBJ-VAL .SRC>>)>)
1855 <SET AC <ASSIGN-AC .VAL BOTH>>
1856 <AC-TYPE <GET-AC .AC> FIX>
1857 <COND (<==? .AMT 18>
1858 <OCEMIT HRLZ <NEXT-AC .AC> !<OBJ-VAL .SRC>>)
1859 (ELSE <OCEMIT HLRZ <NEXT-AC .AC> !<OBJ-VAL .SRC>>)>)>>
1861 <DEFINE ROT!-MIMOC (L) #DECL ((L) LIST) <LSH!-MIMOC .L ROT>>
1863 <DEFINE RANDOM!-MIMOC (L)
1866 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
1867 <PUSHJ RANDOM <3 .L>>>
1869 ;"Random user RECORD stuff"
1871 <DEFINE TEMPLATE-TABLE!-MIMOC (L)
1874 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
1875 <SMASH-AC A1* <2 .L> BOTH>
1876 <PUSHJ TEMPLATE-TABLE>>
1878 <DEFINE IRECORD!-MIMOC (L)
1881 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
1882 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>
1883 <OCEMIT MOVE C1* !<OBJ-VAL <3 .L>>>
1884 <PUSHJ IRECORD <5 .L>>>
1888 <DEFINE MARKL!-MIMOC (L "AUX" AC)
1889 #DECL ((L) LIST (AC) ATOM)
1890 <SET AC <LOAD-AC <1 .L> BOTH>>
1892 <OCEMIT MOVSI O* *200000*>
1893 <OCEMIT <COND (<==? <2 .L> 0> ANDCAM) (T IORM)> O* 1 (<NEXT-AC .AC>)>>
1895 <DEFINE MARK-JOIN (NUM "AUX" NAC)
1897 <OCEMIT MOVSI O* *200000*>
1898 <COND (<TYPE? .NUM FIX>
1899 <OCEMIT <COND (<0? .NUM> ANDCAM) (T IORM)> O* '(T*)>)
1901 <OCEMIT IORM O* '(T*)>
1902 <COND (<SET NAC <IN-AC? .NUM VALUE>>)
1904 <SMASH-AC O* .NUM VALUE>
1906 <OCEMIT MOVEM .NAC 1 '(T*)>)>>
1908 <DEFINE MARKR!-MIMOC (L "AUX" AC (END <GENLBL "END">))
1909 #DECL ((L) LIST (AC END) ATOM)
1912 <SET AC <LOAD-AC <1 .L> BOTH>>
1913 <OCEMIT XMOVEI O* '(TP*)>
1914 <OCEMIT CAMG <NEXT-AC .AC> O*>
1915 <OCEMIT JRST <XJUMP .END>>
1916 <OCEMIT HRRZ T* .AC>
1918 <OCEMIT ADD T* <NEXT-AC .AC>>
1922 <DEFINE MARKU!-MIMOC (L)
1924 <MARK!-MIMOC MARKU <1 .L> <2 .L>>>
1926 <DEFINE MARKUS!-MIMOC (L "AUX" AC)
1927 #DECL ((L) LIST (AC) ATOM)
1930 <SET AC <LOAD-AC <1 .L> BOTH>>
1931 <OCEMIT MOVEI T* 5 (.AC)>
1932 <OCEMIT ADJBP T* <NEXT-AC .AC>>
1933 <OCEMIT TLZ T* *770000*>
1936 <DEFINE MARKUB!-MIMOC (L "AUX" AC)
1937 #DECL ((L) LIST (AC) ATOM)
1940 <SET AC <LOAD-AC <1 .L> BOTH>>
1941 <OCEMIT MOVEI T* 4 (.AC)>
1942 <OCEMIT ADJBP T* <NEXT-AC .AC>>
1943 <OCEMIT TLZ T* *770000*>
1946 <DEFINE MARKUV!-MIMOC (L "AUX" AC)
1947 #DECL ((L) LIST (AC) ATOM)
1950 <SET AC <LOAD-AC <1 .L> BOTH>>
1951 <OCEMIT HRRZ T* .AC>
1953 <OCEMIT ADD T* <NEXT-AC .AC>>
1956 <DEFINE MARKUU!-MIMOC (L "AUX" AC)
1957 #DECL ((L) LIST (AC) ATOM)
1960 <SET AC <LOAD-AC <1 .L> BOTH>>
1961 <OCEMIT HRRZ T* .AC>
1962 <OCEMIT ADD T* <NEXT-AC .AC>>
1965 <DEFINE MARK!-MIMOC (NAM OBJ VAL)
1966 #DECL ((NAM) ATOM (OBJ) ANY (VAL) FIX)
1968 <SMASH-AC A1* .OBJ BOTH>
1969 <COND (<0? .VAL> <OCEMIT MOVEI B1* 0>)
1970 (T <OCEMIT MOVSI B1* *200000*>)>
1973 <DEFINE MARKL?!-MIMOC (L "AUX" AC NAC)
1974 #DECL ((L) LIST (AC NAC) ATOM)
1975 <SET AC <LOAD-AC <1 .L> VALUE>>
1976 <SET NAC <ASSIGN-AC <3 .L> BOTH T>>
1977 <AC-TYPE <GET-AC .NAC> FIX>
1981 <CHTYPE <ORB <LSH <+ *420100* <2 <CHTYPE <MEMQ .AC ,ACS>
1984 <COND-PUSH <3 .L> .NAC>>
1986 <DEFINE MARKR?!-MIMOC (L "AUX" AC NAC (END <GENLBL "END">) RES (REL <>))
1987 #DECL ((L) LIST (AC NAC END) ATOM)
1988 <COND (<==? <LENGTH .L> 4>
1995 <SET AC <LOAD-AC <1 .L> BOTH>>
1996 <SET NAC <ASSIGN-AC .RES BOTH T>>
1997 <OCEMIT MOVEI <NEXT-AC .NAC> 1>
1998 <COND (.REL <OCEMIT MOVE .NAC !<TYPE-WORD FIX>>)>
1999 <OCEMIT XMOVEI O* '(TP*)>
2000 <OCEMIT CAMG <NEXT-AC .AC> O*>
2001 <OCEMIT JRST <XJUMP .END>>
2002 <OCEMIT HRRZ T* .AC>
2004 <MARK?-JOIN .AC .NAC .REL <> .REL>
2006 <COND-PUSH .RES .NAC>>
2008 <DEFINE MARKU?!-MIMOC (L)
2011 <SMASH-AC A1* <1 .L> BOTH>
2012 <PUSHJ MARKU? <3 .L>>>
2014 <DEFINE MARKUS?!-MIMOC (L "AUX" AC NAC RES (REL <>))
2015 #DECL ((L) LIST (AC NAC) ATOM)
2016 <COND (<==? <LENGTH .L> 4>
2023 <SET AC <LOAD-AC <1 .L> BOTH>>
2024 <SET NAC <ASSIGN-AC .RES BOTH T>>
2025 <OCEMIT MOVEI T* 5 (.AC)>
2026 <MARK?-JOIN .AC .NAC .REL T>
2027 <COND-PUSH .RES .NAC>>
2029 <DEFINE MARKUB?!-MIMOC (L "AUX" AC NAC RES (REL <>))
2030 #DECL ((L) LIST (AC NAC) ATOM)
2031 <COND (<==? <LENGTH .L> 4>
2038 <SET AC <LOAD-AC <1 .L> BOTH>>
2039 <SET NAC <ASSIGN-AC .RES BOTH T>>
2040 <OCEMIT MOVEI T* 4 (.AC)>
2041 <MARK?-JOIN .AC .NAC .REL T>
2042 <COND-PUSH .RES .NAC>>
2044 <DEFINE MARKUU?!-MIMOC (L "AUX" AC NAC RES (REL <>))
2045 #DECL ((L) LIST (AC NAC) ATOM)
2046 <COND (<==? <LENGTH .L> 4>
2053 <SET AC <LOAD-AC <1 .L> BOTH>>
2054 <SET NAC <ASSIGN-AC .RES BOTH T>>
2055 <OCEMIT HRRZ T* .AC>
2056 <MARK?-JOIN .AC .NAC .REL>
2057 <COND-PUSH .RES .NAC>>
2059 <DEFINE MARKUV?!-MIMOC (L "AUX" AC NAC RES (REL <>))
2060 #DECL ((L) LIST (AC NAC) ATOM)
2061 <COND (<==? <LENGTH .L> 4>
2068 <SET AC <LOAD-AC <1 .L> BOTH>>
2069 <SET NAC <ASSIGN-AC .RES BOTH T>>
2070 <OCEMIT HRRZ T* .AC>
2072 <MARK?-JOIN .AC .NAC .REL>
2073 <COND-PUSH .RES .NAC>>
2075 <DEFINE COND-PUSH (ITM AC)
2076 #DECL ((ITM AC) ATOM)
2077 <COND (<==? .ITM STACK>
2078 <OCEMIT PUSH TP* .AC>
2079 <OCEMIT PUSH TP* <NEXT-AC .AC>>
2080 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>>
2082 <DEFINE MARK?-JOIN (AC NAC REL "OPT" (DIV <>) (NO-LOAD-TYPE <>)
2083 "AUX" (L1 <GENLBL "L1">) (L2 <GENLBL "L2">))
2084 #DECL ((AC NAC L1 L2) ATOM)
2086 <OCEMIT ADJBP T* <NEXT-AC .AC>>
2087 <OCEMIT TLZ T* *770000*>)
2089 <OCEMIT ADD T* <NEXT-AC .AC>>)>
2091 <AC-TYPE <GET-AC .NAC> FIX>)>
2092 <OCEMIT LDB <NEXT-AC .NAC> !<OBJ-VAL ,LDB-PAREN-T>>
2094 <OCEMIT JUMPE <NEXT-AC .NAC> <XJUMP .L1>>
2095 <OCEMIT MOVE .NAC .AC>
2096 <OCEMIT MOVE <NEXT-AC .NAC> 1 '(T*)>
2097 <OCEMIT JRST <XJUMP .L2>>
2099 <COND (<NOT .NO-LOAD-TYPE>
2100 <OCEMIT MOVE .NAC !<TYPE-WORD FIX>>)>
2101 <OCEMIT MOVEI <NEXT-AC .NAC> 0>
2106 <SETG LDB-PAREN-T -32193642496>
2108 <MANIFEST LDB-PAREN-T>
2110 <DEFINE SWNEXT!-MIMOC (L)
2113 <OCEMIT DMOVE O1* !<OBJ-TYP <1 .L>>>
2114 <OCEMIT MOVE A1* !<OBJ-VAL <2 .L>>>
2115 <PUSHJ SWNEXT <4 .L>>>
2117 <DEFINE NEXTS!-MIMOC (L)
2120 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
2121 <PUSHJ NEXTS <3 .L>>>
2123 <DEFINE CONTENTS!-MIMOC (L "AUX" AC)
2124 #DECL ((L) LIST (AC) ATOM)
2125 <SMASH-AC T* <1 .L> VALUE>
2126 <SET AC <ASSIGN-AC <3 .L> BOTH T>>
2127 <OCEMIT DMOVE .AC '(T*)>
2128 <OCEMIT TLZE .AC *40*>
2129 <OCEMIT XMOVEI <NEXT-AC .AC> 1 '(T*)>
2130 <COND (<==? <3 .L> STACK>
2131 <OCEMIT PUSH TP* .AC>
2132 <OCEMIT PUSH TP* <NEXT-AC .AC>>
2133 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>>
2135 <DEFINE PUTS!-MIMOC (L "AUX" AC)
2136 #DECL ((L) LIST (AC) ATOM)
2137 <SET AC <LOAD-AC <2 .L> BOTH>>
2138 <SMASH-AC T* <1 .L> VALUE>
2141 <OCEMIT MOVE O* '(T*)>
2142 <OCEMIT TLNN O* *40*>
2143 <OCEMIT DMOVEM .AC '(T*)>>
2145 <DEFINE ALLOCL!-MIMOC (L "AUX" (AC <ASSIGN-AC <3 .L> BOTH T>))
2146 #DECL ((L) LIST (AC) ATOM)
2147 <OCEMIT MOVE .AC !<TYPE-WORD LIST>>
2148 <OCEMIT MOVE <NEXT-AC .AC> !<OBJ-VAL <1 .L>>>
2149 <COND (<==? <3 .L> STACK>
2150 <OCEMIT PUSH TP* .AC>
2151 <OCEMIT PUSH TP* <NEXT-AC .AC>>
2152 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>>
2154 <DEFINE ALLOCUV!-MIMOC (L)
2156 <ALLOC-JOIN <1 .L> <2 .L> <4 .L> VECTOR>>
2158 <DEFINE ALLOCUU!-MIMOC (L)
2160 <ALLOC-JOIN <1 .L> <2 .L> <4 .L> UVECTOR>>
2162 <DEFINE ALLOCUS!-MIMOC (L "OPTIONAL" (BYTES? <>) "AUX" AC)
2164 <SET AC <ASSIGN-AC <4 .L> BOTH T>>
2165 <OCEMIT MOVE <NEXT-AC .AC> !<OBJ-VAL <1 .L>>>
2166 <OCEMIT ADD <NEXT-AC .AC> !<OBJ-VAL <COND (.BYTES? *577777777777*)
2167 (T *657777777777*)>>>
2168 <OCEMIT MOVE .AC !<OBJ-TYP <2 .L>>>
2169 <COND (<==? <4 .L> STACK>
2170 <OCEMIT PUSH TP* .AC>
2171 <OCEMIT PUSH TP* <NEXT-AC .AC>>
2172 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>>
2174 <DEFINE ALLOCUB!-MIMOC (L)
2175 <ALLOCUS!-MIMOC .L T>>
2177 <DEFINE ALLOCR!-MIMOC (L) #DECL ((L) LIST)
2178 <ALLOC-JOIN <1 .L> <2 .L> <4 .L> RECORD>>
2180 <DEFINE ALLOC-JOIN (WHERE OLD NEW TYP "AUX" AC)
2181 <COND (<==? .NEW STACK>
2182 <OCEMIT PUSH TP* !<OBJ-TYP .OLD>>
2183 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
2184 <OCEMIT PUSH TP* !<OBJ-VAL .WHERE>>
2185 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
2187 <SET AC <ASSIGN-AC .NEW BOTH T>>
2188 <OCEMIT MOVE .AC !<OBJ-TYP .OLD>>
2189 <OCEMIT MOVE <NEXT-AC .AC> !<OBJ-VAL .WHERE>>)>>
2191 <DEFINE BLT!-MIMOC (L)
2195 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
2196 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>
2197 <OCEMIT MOVE T* !<OBJ-VAL <3 .L>>>
2198 <OCEMIT XBLT T* !<OBJ-VAL *020000000000*>>>
2200 <DEFINE RELL!-MIMOC (L)
2203 <SMASH-AC A1* <1 .L> BOTH>
2206 <DEFINE RELU!-MIMOC (L)
2209 <SMASH-AC A1* <1 .L> BOTH>
2212 <DEFINE RELR!-MIMOC (L)
2215 <SMASH-AC A1* <1 .L> BOTH>
2218 <DEFINE LOOP!-MIMOC (L "AUX" VARS (LBNM <2 .MIML>) LB LFS)
2219 #DECL ((L VARS MIML) LIST (LB) LAB (LFS) <OR FALSE LABSTATE>)
2223 <SET LFS <LAB-FINAL-STATE .LB>>
2225 <SETG LOOPTAGS (<2 .MIML> !,LOOPTAGS)>
2227 (<AND <GASSIGNED? DO-LOOPS> ,DO-LOOPS>
2228 <SET VARS <MAPF ,LIST 1 .L>>
2230 <FUNCTION (LL "AUX" (ITM <1 .LL>) NEED)
2233 (<MEMQ VALUE <SET LL <REST .LL>>>
2234 <COND (<NOT <EMPTY? <REST .LL>>> <SET NEED BOTH>)
2235 (ELSE <SET NEED VALUE>)>)
2236 (ELSE <SET NEED TYPE>)>
2238 (<NOT <IN-AC? .ITM .NEED>>
2241 <REPEAT ((ACS <REST ,AC-TABLE>) A1 A2 IT)
2242 #DECL ((ACS) VECTOR (A1 A2) AC)
2243 <COND (<==? <AC-NAME <SET A1 <1 .ACS>>> X*>
2246 (<AND <OR <==? .NEED VALUE>
2247 <NOT <SET IT <AC-ITEM .A1>>>
2249 <AND <NOT <AC-UPDATE .A1>>
2250 <NOT <MEMQ .IT .VARS>>>>
2251 <OR <==? .NEED TYPE>
2252 <NOT <SET IT <AC-ITEM <SET A2
2255 <AND <NOT <AC-UPDATE .A2>>
2256 <NOT <MEMQ .IT .VARS>>>>>
2257 <COND (<==? .NEED VALUE>
2258 <LOAD-AC .ITM VALUE <> <> .A2>)
2260 <LOAD-AC .ITM TYPE <> <> .A1>)
2262 <LOAD-AC .ITM BOTH <> <> .A1 .A2>)>
2264 <SET ACS <REST .ACS 2>>>)
2266 <REPEAT ((V <CHTYPE .LFS VECTOR>) ACS1 ACS2 ONE)
2267 #DECL ((V) VECTOR (ACS1 ACS2) ACSTATE)
2268 <COND (<EMPTY? .V> <RETURN>)>
2271 <==? <LATM <ACS-LOCAL <SET ACS1 <1 .V>>>>
2273 <==? <LATM <ACS-LOCAL <SET ACS2 <2 .V>>>> .ITM>>
2277 <COND (<==? <LATM <ACS-LOCAL
2280 <OR <NOT <ACS-STORED .ACS2>>
2281 <NOT <ACS-STORED .ACS1>>>)
2283 <NOT <ACS-STORED .ACS1>>)>
2284 <> <ACS-AC .ACS1> <ACS-AC .ACS2>>)
2288 <NOT <ACS-STORED .ACS2>>
2289 <> <ACS-AC .ACS2>>)>
2291 <SET V <REST .V 2>>>)>)>>
2294 <DEFINE INTGO!-MIMOC (L) T>
2296 <DEFINE SAVE!-MIMOC (L)
2299 <SMASH-AC A1* <1 .L> VALUE>
2300 <SMASH-AC A2* <2 .L> VALUE>
2301 <SMASH-AC B1* <3 .L> VALUE>
2302 <PUSHJ SAVE <5 .L>>>
2304 <DEFINE RESTORE!-MIMOC (L)
2306 <SMASH-AC A1* <1 .L> VALUE>
2307 <PUSHJ RESTORE <3 .L>>>
2309 <DEFINE QUIT!-MIMOC (L)
2311 <COND (<NOT <EMPTY? .L>>
2312 ; "Stuff the return value into B, with authentication in A"
2313 <SMASH-AC A2* <1 .L> VALUE>
2314 <SMASH-AC A1* *777777000003* VALUE>)>
2317 <DEFINE SETSIZ!-MIMOC (L)
2320 <SMASH-AC A1* <1 .L> BOTH>
2321 <PUSHJ SETSIZ <3 .L>>>
2323 <DEFINE RNTIME!-MIMOC (L)
2329 <PUSHJ RNTIME <2 .L>>)>>
2331 "Instructions for seedup of NTH,REST,EMPTY? and MONAD? of unknown type"
2333 <DEFINE NTH1!-MIMOC (L)
2334 <NEW-FUNNY-CALL *154* .L>
2335 <ALTER-AC A1* <3 .L>>
2338 <DEFINE REST1!-MIMOC (L)
2339 <NEW-FUNNY-CALL *155* .L>
2340 <ALTER-AC A1* <3 .L>>
2343 <DEFINE EMPTY?!-MIMOC (L)
2344 <FUNNY-PRED *153* .L>>
2346 <DEFINE MONAD?!-MIMOC (L)
2347 <FUNNY-PRED *156* .L>>
2349 <DEFINE FUNNY-PRED (LOC L "AUX" (FLAG <2 .L>) (TAG <3 .L>))
2351 <NEW-FUNNY-CALL .LOC .L .TAG>
2352 <COND (<==? .FLAG +> <OCEMIT CAIA O* O*>)>
2353 <OCEMIT JRST <XJUMP .TAG>>>
2355 <DEFINE NEW-FUNNY-CALL (LOC L "OPT" (TAG <>) "AUX" AC)
2357 <COND (<N==? <SET AC <IN-AC? <1 .L> BOTH>> A1*>
2361 <OCEMIT DMOVE A1* .AC>
2363 <ALTER-AC A1* <1 .L>>)
2365 <SMASH-AC A1* <1 .L> BOTH>)>)>
2366 <COND (.TAG <LABEL-UPDATE-ACS .TAG <>>)
2368 <COND (<N==? <1 .L> <3 .L>>
2370 <COND (<NOT <WILL-DIE? <1 .L>>>
2371 <FLUSH-AC A1* T>)>)>
2373 <OCEMIT JSP T* @ .LOC>>
2375 <DEFINE LEGAL?!-MIMOC (L)
2378 <SMASH-AC A1* <1 .L> BOTH>
2379 <PUSHJ LEGAL? <3 .L>>>
2382 <DEFINE SETZONE!-MIMOC (L)
2384 <SMASH-AC A1* <1 .L> BOTH>
2385 <COND (<==? <LENGTH .L> 3>
2386 <PUSHJ SETZONE <3 .L>>)
2390 <DEFINE TYPEW!-MIMOC (L) #DECL ((L) LIST)
2391 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>
2392 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>
2393 <PUSHJ TYPEW <4 .L>>>
2395 <DEFINE TYPEWC!-MIMOC (L "AUX" AC) #DECL ((L) LIST)
2396 <SET AC <ASSIGN-AC <3 .L> BOTH>>
2397 <OCEMIT HLRZ <NEXT-AC .AC> !<OBJ-VAL <1 .L>>>
2398 <AC-TYPE <GET-AC .AC> TYPE-C>>
2401 <DEFINE FATAL!-MIMOC (L) #DECL ((L) LIST)
2402 <SMASH-AC A1* <1 .L> BOTH>
2403 <COND (<EMPTY? <REST .L>> <PUSHJ FATAL>)
2404 (ELSE <PUSHJ FATAL <3 .L>>)>>
2408 <DEFINE GETBITS!-MIMOC (L
2409 "AUX" (WD <1 .L>) (WL <2 .L>) (SHL <3 .L>) (DST <5 .L>)
2410 (TAC? <IN-AC? .WD BOTH>) AN BP
2411 (AC? <IN-AC? .WD VALUE>) (OL <>) AC (W 0) (SH 0)
2413 #DECL ((L) LIST (OL) <OR FALSE LIST>)
2414 <COND (<TYPE? .WL FIX> <SET W .WL>)>
2415 <COND (<TYPE? .SHL FIX> <SET SH .SHL>)>
2416 <COND (<TYPE? .WD ATOM> <SET OL <OBJ-LOC .WD 1>>)>
2417 <SET BP <CHTYPE <ORB <LSH .SH 30> <LSH .W 24>> FIX>>
2418 <COND (.AC? <SET AN <2 <CHTYPE <MEMQ .AC? ,ACS> VECTOR>>>)>
2419 <COND (.AC? <SET BP <CHTYPE <ORB .BP .AN> CONSTANT>>)
2423 <+ <CHTYPE <LSH <2 <MEMQ <1 <CHTYPE <3 .OL> LIST>>
2425 <CHTYPE <1 .OL> FIX>
2429 (<AND <TYPE? .WL FIX> <TYPE? .SHL FIX>>
2430 <SET AC <ASSIGN-AC .DST BOTH T>>
2431 <CONST-LOC .BP VALUE>
2432 <OCEMIT LDB <NEXT-AC .AC> !<OBJ-VAL .BP>>
2433 <AC-TYPE <GET-AC .AC> FIX>)
2435 <COND (<NOT <AND .AC? <OR <==? .DST .WD>
2436 <AND <WILL-DIE? .WD>
2437 <PROG () <DEAD!-MIMOC (.WD) T> 1>>>>>
2439 <ASSIGN-AC <COND (<AND <==? .SHL .DST> <IN-AC? .SHL VALUE>>
2444 <AC-TYPE <GET-AC .AC> FIX>
2445 <SET AC <NEXT-AC .AC>>
2446 <OCEMIT MOVE .AC !<OBJ-VAL .WD>>)
2448 <AC-TYPE <GET-AC .TAC?> FIX>
2450 <ALTER-AC .TAC? .DST>)
2452 <SET AC <ASSIGN-AC .DST BOTH T>>
2453 <AC-TYPE <GET-AC .AC> FIX>
2454 <OCEMIT MOVE <SET AC <NEXT-AC .AC>> .AC?>)>
2457 <OCEMIT MOVN T* !<OBJ-VAL .SHL>>
2461 <COND (<L=? <SET W <CHTYPE <XORB <LSH -1 .W> -1> FIX>> 262143>
2462 <OCEMIT ANDI .AC .W>)
2463 (ELSE <OCEMIT TLZ .AC <CHTYPE <LSH <XORB .W -1> -18> FIX>>)>
2464 <COND (<==? .DST .SHL>
2466 <ALTER-AC <GETPROP .AC AC-PAIR> .DST>
2467 <SETG ACA-AC <SETG ACA-BOTH <SETG ACA-ITEM <>>>>
2468 <AC-TYPE <GET-AC <GETPROP .AC AC-PAIR>> FIX>)>)
2470 <COND (<AND .TAC? <OR <==? .WD .DST> <WILL-DIE? .WD>>> <SET AC O*>)
2472 <COND (<==? .WL .DST>
2473 <COND (<SET AC <IN-AC? .WL BOTH>>
2474 <SET IX <NEXT-AC .AC>>
2476 <AC-TIME <GET-AC .AC> ,AC-STAMP>
2477 <AC-TIME <GET-AC <NEXT-AC .AC>> ,AC-STAMP>)
2478 (<SET AC <IN-AC? .WL VALUE>>
2480 <AC-TIME <GET-AC .AC> ,AC-STAMP>
2482 <AC-TYPE <GET-AC <SET AC <ASSIGN-AC .DST BOTH T>>> FIX>
2483 <SET AC <NEXT-AC .AC>>)>
2484 <SET MSK <CHTYPE <LSH -1 .SH> FIX>>
2485 <COND (<==? <CHTYPE <ANDB .MSK 262143> FIX> 0>
2486 <OCEMIT MOVSI .AC <CHTYPE <LSH .MSK -18> FIX>>)
2487 (ELSE <OCEMIT HRROI .AC <CHTYPE <ANDB .MSK 262143> FIX>>)>
2490 !<COND (.IX ((.IX)))
2491 (<AND <N==? .WL .DST> <SET IX <IN-AC? .WL VALUE>>>
2493 (ELSE (@ !<OBJ-VAL .WL>))>>
2496 <OCEMIT ANDCA .AC? O*>
2497 <OCEMIT LSH .AC? <- .SH>>
2499 <AC-UPDATE <AC-ITEM <AC-CODE <AC-TYPE <GET-AC .TAC?> FIX> TYPE> .DST> T>
2500 <AC-CODE <AC-TYPE <AC-ITEM <AC-UPDATE <GET-AC <SET AC .AC?>> T> .DST>
2504 <OCEMIT ANDCA .AC !<COND (.AC? (.AC?)) (ELSE <OBJ-VAL .WD>)>>
2505 <OCEMIT LSH .AC <- .SH>>)>)
2507 <COND (.AC? <OCEMIT MOVEI O* .AC?>)
2508 (ELSE <CONST-LOC .BP VALUE> <OCEMIT MOVE O* !<OBJ-VAL .BP>>)>
2510 <COND (<IN-AC? .SHL VALUE>) (ELSE <NEXT-AC <LOAD-AC .SHL BOTH>>)>
2511 !<OBJ-VAL <SET BP <CHTYPE 32312918016 CONSTANT>>>>
2512 <CONST-LOC .BP VALUE>
2514 <COND (<IN-AC? .WL VALUE>) (ELSE <NEXT-AC <LOAD-AC .WL BOTH>>)>
2515 !<OBJ-VAL <SET BP <CHTYPE 25870467072 CONSTANT>>>>
2516 <CONST-LOC .BP VALUE>
2517 <SET AC <ASSIGN-AC .DST BOTH T>>
2518 <OCEMIT LDB <NEXT-AC .AC> O*>
2519 <AC-TYPE <GET-AC .AC> FIX>)>
2520 <COND (<==? .DST STACK>
2521 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
2522 <OCEMIT PUSH TP* <NEXT-AC .AC>>
2523 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>>
2525 <DEFINE PUTBITS!-MIMOC (L "AUX" (WL <2 .L>) (SHL <3 .L>) (NEW <4 .L>) (OLD <1 .L>)
2526 AC? TAC? NAC (DST <6 .L>) (FLIP <>))
2528 <COND (<AND <==? .WL 18> <OR <==? .SHL 0> <==? .SHL 18>>>
2529 <COND (<OR <==? .OLD 0>
2532 <OR <AND <NOT <IN-AC? .OLD VALUE>>
2533 <IN-AC? .NEW VALUE>>
2538 <COND (<OR <AND <SET TAC? <IN-AC? .OLD BOTH>>
2539 <SET AC? <NEXT-AC .TAC?>>>
2540 <AND <SET AC? <IN-AC? .OLD VALUE>>
2541 <SET TAC? <GETPROP .AC? AC-PAIR>>>
2542 <AND <N==? .OLD .DST>
2545 <SET AC? <NEXT-AC <SET TAC? <LOAD-AC .OLD BOTH>>>>>>
2546 <COND (<N==? .OLD .DST>
2547 <COND (<WILL-DIE? .OLD> <DEAD!-MIMOC (.OLD) T>)>
2550 <MUNGED-AC .TAC? T>)
2553 <MUNGED-AC .AC?>)>)>
2555 <AC-TIME <GET-AC .TAC?> <SETG AC-STAMP <+ ,AC-STAMP 1>>>
2556 <AC-UPDATE <AC-TIME <GET-AC .AC?>
2557 <SETG AC-STAMP <+ ,AC-STAMP 1>>> T>)>
2558 <COND (<AND <NOT .AC?>
2559 <NOT <SET NAC <IN-AC? .NEW VALUE>>>
2562 <COND (<AND <TYPE? .NEW ATOM> <NOT <WILL-DIE? .NEW>>>
2563 <SET NAC <NEXT-AC <LOAD-AC .NEW BOTH>>>)
2565 <GET-INTO-ACS .NEW VALUE <SET NAC T*>>)>)>
2566 <COND (<AND .FLIP <N==? .SHL 0>>
2567 <COND (<==? .DST STACK>
2569 <OCEMIT <COND (<==? .NEW 0> HRLZ)
2574 <OCEMIT <COND (<==? .NEW 0> HRLZ)
2578 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
2579 <OCEMIT PUSH TP* O*>
2580 <COND (,WINNING-VICTIM
2581 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
2583 <COND (<==? .NEW 0> <OCEMIT HRLZS O* .AC?>)
2584 (ELSE <OCEMIT HRLOS O* .AC?>)>
2585 <COND (<N==? .DST .OLD>
2587 <ALTER-AC .TAC? .DST>
2588 <AC-TYPE <GET-AC .TAC?> FIX>)>)
2590 <SET AC? <ASSIGN-AC .DST BOTH>>
2592 <OCEMIT HRLZ <NEXT-AC .AC?> !<OBJ-VAL .OLD>>)
2594 <OCEMIT HRLO <NEXT-AC .AC?> !<OBJ-VAL .OLD>>)>
2595 <AC-TYPE <GET-AC .AC?> FIX>)
2596 (<==? .NEW 0> <OCEMIT HRLZS O* !<OBJ-VAL .OLD>>)
2597 (ELSE <OCEMIT HRLOS O* !<OBJ-VAL .OLD>>)>)
2599 <OCEMIT <COND (<TYPE? .NEW ATOM>
2601 <COND (.FLIP HLL) (ELSE HRR)>)
2604 <COND (.FLIP HRLI) (ELS HRRI)>)
2607 !<COND (<TYPE? .NEW ATOM> <OBJ-VAL .NEW>)
2608 (.FLIP (<LSH .NEW -18>))
2609 (ELSE (<CHTYPE <ANDB .NEW *777777*> FIX>))>>
2610 <COND (<==? .DST STACK>
2611 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
2612 <OCEMIT PUSH TP* .AC?>
2613 <COND (,WINNING-VICTIM
2614 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
2617 <ALTER-AC .TAC? .DST>
2618 <AC-TYPE <GET-AC .TAC?> FIX>)>)
2620 <COND (<==? .DST .OLD>
2621 <OCEMIT <COND (<==? .NEW -1>
2628 <COND (.FLIP HRRZS) (ELSE HLLZS)>)
2630 (ELSE HRRZS)> O* !<OBJ-VAL .OLD>>)
2632 <COND (<N==? .DST STACK>
2633 <SET NAC <ASSIGN-AC .DST BOTH>>)>
2634 <OCEMIT <COND (<==? .NEW -1>
2641 <COND (.FLIP HRRZ) (ELSE HLLZ)>)
2644 <COND (<==? .DST STACK> O*)
2645 (ELSE <NEXT-AC .NAC>)>
2647 <COND(<==? .DST STACK>
2648 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
2649 <OCEMIT PUSH TP* O*>
2650 <COND (,WINNING-VICTIM
2652 <+ ,STACK-DEPTH 2>>)>)
2654 <AC-TYPE <GET-AC .NAC> FIX>)>)>)
2656 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
2657 <OCEMIT PUSH TP* !<OBJ-VAL .OLD>>
2658 <OCEMIT <COND (<==? .SHL 0>
2659 <COND (.FLIP HLLM) (ELSE HRRM)>)
2663 <COND (,WINNING-VICTIM
2664 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
2666 <OCEMIT <COND (<==? .SHL 0>
2667 <COND (.FLIP HLLM) (ELSE HRRM)>)
2675 <ALTER-AC .TAC? .DST>)>)
2676 (ELSE <RPUTBITS .L>)>>
2678 <DEFINE RPUTBITS (L "AUX" (WD <1 .L>) (WL <2 .L>) (SHL <3 .L>) (NEW <4 .L>)
2679 (DST <6 .L>) (TAC? <>) (AC? <>) AN BP (OL <>) (AC <>)
2680 (W 0) (SH 0) IX (VT <>) (WAS-TYPED <>)
2682 #DECL ((L) LIST (OL) <OR FALSE LIST>)
2683 <COND (<TYPE? .WL FIX> <SET W .WL>)>
2684 <COND (<TYPE? .SHL FIX> <SET SH .SHL>)>
2685 <COND (<TYPE? .WD ATOM>
2686 <SET OL <OBJ-LOC .WD 1>>
2687 <SET TAC? <IN-AC? .WD BOTH>>
2688 <SET AC? <IN-AC? .WD VALUE>>
2689 <SET VT <VAR-TYPED? .WD>>)
2690 (<N==? <PRIMTYPE .WD> FIX>
2691 <MIMOCERR BAD-ARG-TO-PUTBITS .WD>)
2693 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
2694 <OCEMIT PUSH TP* !<OBJ-VAL <CHTYPE .WD CONSTANT>>>
2695 <CONST-LOC <CHTYPE .WD CONSTANT> VALUE>
2696 <COND (,WINNING-VICTIM
2697 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
2699 <COND (<OR <==? .DST .NEW> <==? .DST SHL> <==? .DST .WL>>
2701 <OCEMIT MOVE O1* !<OBJ-VAL .DST>>)>
2702 <SET AC? <NEXT-AC <SET TAC? <ASSIGN-AC .DST BOTH>>>>
2703 <LOAD-AC .WD VALUE <> <> <GET-AC .AC?>>
2705 <ALTER-AC .TAC? .DST>
2707 <SET BP <CHTYPE <ORB <LSH .SH 30> <LSH .W 24>> FIX>>
2708 <COND (<AND <TYPE? .WD ATOM>
2709 <OR <N==? .WD .DST> <AND <NOT .VT> <NOT .AC?>>>>
2710 <SET TAC? <LOAD-AC .WD BOTH>>
2711 <SET AC? <NEXT-AC .TAC?>>
2712 <COND (<AND <N==? .WD .DST>
2713 <NOT <WILL-DIE? .WD>>>
2714 <FLUSH-AC .TAC? T>)>)>
2715 <COND (<N==? .WD .DST>
2717 <SET WAS-TYPED <AC-TYPE <GET-AC .TAC?>>>
2718 <MUNGED-AC .TAC? T>)
2719 (.AC? <MUNGED-AC .AC?>)>)>
2720 <COND (.AC? <SET AN <2 <CHTYPE <MEMQ .AC? ,ACS> VECTOR>>>)>
2721 <COND (<AND <TYPE? .WD FIX> <==? .DST STACK>>
2722 <SET BP <CHTYPE <ORB .BP <LSH ,TP* 18>> CONSTANT>>)
2723 (.AC? <SET BP <CHTYPE <ORB .BP .AN> CONSTANT>>)
2727 <+ <CHTYPE <LSH <2 <MEMQ <1 <CHTYPE <3 .OL> LIST>>
2731 <CHTYPE <1 .OL> FIX>
2732 .BP>) CONST-W-LOCAL>>)>
2733 <COND (<AND <TYPE? .WL FIX> <TYPE? .SHL FIX>>
2734 <COND (<OR <NOT <TYPE? .NEW ATOM>>
2735 <AND <WILL-DIE? .NEW>
2736 <NOT <SET AC <IN-AC? .NEW VALUE>>>>>
2737 <GET-INTO-ACS .NEW VALUE <SET AC T*>>)
2738 (<AND .DST-IN-O1 <==? .NEW .DST>> <SET AC O1*>)
2740 <SET AC <NEXT-AC <LOAD-AC .NEW BOTH>>>)>
2741 <CONST-LOC .BP VALUE>
2742 <OCEMIT DPB .AC !<OBJ-VAL .BP>>)
2744 <COND (.AC? <OCEMIT MOVEI O* .AC?>)
2746 <CONST-LOC .BP VALUE>
2747 <OCEMIT MOVE O* !<OBJ-VAL .BP>>)>
2748 <COND (<NOT <TYPE? .SHL FIX>>
2749 <OCEMIT DPB <COND (<IN-AC? .SHL VALUE>)
2750 (<AND <==? .SHL .DST> .DST-IN-O1>
2752 (ELSE <NEXT-AC <LOAD-AC .SHL BOTH>>)>
2753 !<OBJ-VAL <SET BP <CHTYPE *360600000000*
2755 <CONST-LOC .BP VALUE>)>
2756 <COND (<NOT <TYPE? .WL FIX>>
2757 <OCEMIT DPB <COND (<IN-AC? .WL VALUE>)
2758 (<AND <==? .WL .DST> .DST-IN-O1>
2760 (ELSE <NEXT-AC <LOAD-AC .WL BOTH>>)>
2761 !<OBJ-VAL <SET BP <CHTYPE *300600000000*
2763 <CONST-LOC .BP VALUE>)>
2765 <AC-TIME <GET-AC .AC?>
2766 <SETG AC-STAMP <+ ,AC-STAMP 1>>>
2767 <COND (.TAC? <AC-TIME <GET-AC .TAC?> ,AC-STAMP>)>)>
2768 <COND (<AND <==? .NEW .DST> .DST-IN-O1>
2769 <OCEMIT DPB O1* O*>)
2771 <SET AC <LOAD-AC .NEW BOTH>>
2772 <OCEMIT DPB <NEXT-AC .AC> O*>)>)>
2773 <COND (<==? .DST STACK>
2774 <COND (<TYPE? .WD ATOM>
2775 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
2776 <OCEMIT PUSH TP* .AC?>
2777 <COND (,WINNING-VICTIM
2778 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)
2781 <AC-UPDATE <AC-ITEM <AC-CODE <GET-AC .TAC?> TYPE>
2783 <COND (.WAS-TYPED <AC-TYPE <GET-AC .TAC?> FIX>)>
2787 <AC-UPDATE <GET-AC <SET AC .AC?>> T> .DST> <>> VALUE>)
2790 <SET TAC? <GETPROP .AC? AC-PAIR>>
2791 <AC-UPDATE <AC-ITEM <AC-CODE <GET-AC .TAC?> TYPE>
2793 <AC-UPDATE <GET-AC .AC?> T>
2794 <COND (<NOT .VT> <AC-TYPE <GET-AC .TAC?> FIX>)>)>>
2796 <DEFINE DISPATCH!-MIMOC (L
2797 "AUX" (VAR <1 .L>) (BASE <2 .L>) DELBL AC (DF <>)
2798 (DLBL <GENLBL "DISP">) RLBLS (LL .MIML) NEW AC-T
2799 TAC (NV <- <LENGTH .L> 2>) (DISP-L ()))
2800 #DECL ((LL MIML L) LIST (BASE NV) FIX (DISP-L) <SPECIAL LIST>)
2803 <FUNCTION (LBL "AUX" LB LBX)
2804 <COND (<AND <SET LB <FIND-LABEL .LBL>>
2806 <COND (<NOT <FIND-LABEL
2807 <SET LBX <GENLBL "LOOPD">>>>
2808 <MAKE-LABEL .LBX <> ()>)>
2810 (ELSE (.LBL .LBL))>>
2812 <SET DISP-L <MAPF ,LIST <FUNCTION (L:LIST) <2 .L>> .RLBLS>>
2814 <COND (<OR <EMPTY? <SET LL <REST .LL>>>
2815 <AND <TYPE? <SET ITM <1 .LL>> FORM>
2816 <OR <EMPTY? .ITM> <N==? <1 .ITM> DEAD>>>>
2822 <COND (<SET AC <IN-AC? .VAR BOTH>> <SET AC <NEXT-AC <SET TAC .AC>>>)
2823 (<SET AC <IN-AC? .VAR VALUE>>)
2824 (ELSE <SET AC <NEXT-AC <SET TAC <LOAD-AC .VAR BOTH>>>>)>
2826 <SET DELBL <GENLBL "DEFAULT">>
2827 <COND (<NOT <FIND-LABEL .DELBL>>
2828 <MAKE-LABEL .DELBL <> ()>)>)>
2829 <LABEL-UPDATE-ACS .DELBL <>>
2830 <COND (<AND <G=? .BASE 0> <L=? .BASE 1>>
2831 <OCEMIT <COND (<==? .BASE 0> JUMPL) (ELSE JUMPLE)>
2834 <OCEMIT CAILE .AC <+ .NV .BASE -1>>
2835 <OCEMIT JRST O* <XJUMP .DELBL>>)
2837 <COND (<G? .BASE 0> <OCEMIT CAIL .AC .BASE>)
2838 (ELSE <OCEMIT CAML .AC !<OBJ-VAL .BASE>>)>
2839 <COND (<G? <SET NV <+ .NV .BASE -1>> 0> <OCEMIT CAILE .AC .NV>)
2840 (ELSE <OCEMIT CAMLE .AC !<OBJ-CAL .NV>>)>
2841 <OCEMIT JRST O* <XJUMP .DELBL>>)>
2842 <OCEMIT XMOVEI O1* <XJUMP .DLBL>>
2843 <OCEMIT ADD O1* .AC>
2844 <MAPF <> <FUNCTION (LBL) <LABEL-UPDATE-ACS <2 .LBL> <>>> .RLBLS>
2846 <OCEMIT JRST @ <- .BASE> '(O1*)>
2848 <MAPF <> <FUNCTION (LBL) <OCEMIT SETZ O* <XJUMP <2 .LBL>>>> .RLBLS>
2851 <COND (<N==? <1 .LBL> <2 .LBL>>
2853 <JUMP!-MIMOC <1 .LBL>>)>>
2856 <COND (,PASS1 <SET LB <LABEL .DELBL>> <SAVE-LABEL-STATE .LB>)
2857 (,NO-AC-FUNNYNESS <SAVE-ACS> <SET LB <LABEL .DELBL>>)
2859 <SET LB <FIND-LABEL .DELBL>>
2860 <ESTABLISH-LABEL-STATE .LB>
2864 <DEFINE CHANNEL-OP!-MIMOC (L "AUX" (CTYP <1 .L>) (OPER <2 .L>) (EQSN <>) RES
2865 (GC <>) (NUM 2) RTN OC)
2866 #DECL ((L) LIST (CTYP OPER) <FORM ATOM ATOM>)
2868 <COND (<AND <SET OC <GETPROP <2 .CTYP> OC-INDICATOR>>
2869 <SET OC <APPLY .OC <2 .OPER> <REST .L 2>>>>
2871 <SET RTN <CT-QUERY <2 .CTYP> <2 .OPER>>>
2873 <COND (<AND ,GLUE-MODE <MEMQ .RTN ,PRE-NAMES>>
2874 <FRAME!-MIMOC (<SET GC <GENLBL "?FRM">> .RTN)>
2875 <SET RTN <FORM QUOTE .RTN>>)
2877 <FRAME!-MIMOC (<SET GC <GENLBL "?FRM">> .RTN)>
2878 <SET RTN <FORM QUOTE .RTN>>)
2880 <SET RTN <FORM QUOTE .RTN>>
2881 <FRAME!-MIMOC (.RTN)>)>)
2882 (ELSE <FRAME!-MIMOC ()>)>
2883 <PUSH!-MIMOC (<3 .L>)>
2884 <PUSH!-MIMOC (.OPER)>
2887 <COND (.EQSN <SET RES .ARG> <MAPLEAVE>)
2888 (<==? .ARG => <SET EQSN T>)
2890 <PUSH!-MIMOC (.ARG)>
2891 <SET NUM <+ .NUM 1>>)>>
2894 <CALL!-MIMOC (.RTN .NUM !<COND (.EQSN (= .RES)) (ELSE ())>
2895 !<COND (.GC (.GC)) (ELSE ())>)>)
2897 <OCEMIT MOVE O1* !<OBJ-VAL <CHTYPE (.CTYP .OPER) CHANNEL-ROUTINE>>>
2898 <OCEMIT MOVE O1* 2 (O1*)>
2899 <OCEMIT MOVEI O2* .NUM>
2900 <COND (,WINNING-VICTIM
2901 <SETG STACK-DEPTH <- ,STACK-DEPTH <* .NUM 2> 7>>)>
2903 <COND (<ASSIGNED? RES> <PUSHJ CALL .RES>)
2904 (ELSE <PUSHJ CALL>)>)>>>
2906 <DEFINE CHANNEL-ROUTINE-PRINT (L) #DECL ((L) CHANNEL-ROUTINE)
2907 <PRINC "%<CHANNEL-OPERATION ">
2913 <PRINTTYPE CHANNEL-ROUTINE ,CHANNEL-ROUTINE-PRINT>
2915 <SETG BIND-DW *1442000000*>
2917 <DEFINE BBIND!-MIMOC (L "AUX" (ATM <1 .L>) (DCL <2 .L>) (FXB <3 .L>) VAL AC)
2918 #DECL ((L) LIST (ATM) <OR ATOM <FORM ATOM ATOM>>)
2919 <OCEMIT PUSH TP* !<OBJ-VAL ,BIND-DW>>
2920 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
2921 <COND (<==? <LENGTH .L> 4>
2922 <OCEMIT PUSH TP* !<OBJ-TYP <SET VAL <4 .L>>>>
2923 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
2924 <OCEMIT PUSH TP* !<OBJ-VAL .VAL>>
2925 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
2927 <OCEMIT PUSH TP* !<OBJ-VAL 0>>
2928 <OCEMIT PUSH TP* !<OBJ-VAL 0>>
2929 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>
2930 <COND (<SET AC <IN-AC? .ATM VALUE>>)
2932 <SET AC <NEXT-AC <LOAD-AC .ATM BOTH>>>)
2934 <OCEMIT MOVE <SET AC O1*> !<OBJ-VAL .ATM>>)>
2935 <OCEMIT PUSH TP* .AC>
2936 <OCEMIT PUSH TP* !<OBJ-TYP .DCL>>
2937 <OCEMIT PUSH TP* !<OBJ-VAL .DCL>>
2938 <OCEMIT PUSH TP* SP*>
2939 <OCEMIT PUSH TP* 1 (.AC)>
2940 <OCEMIT PUSH TP* @ *137*>
2941 <OCEMIT XMOVEI SP* -7 '(TP*)>
2942 <COND (.FXB <OCEMIT MOVEM SP* 1 (.AC)>)>
2943 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 6>>)>>
2945 <DEFINE GEN-LVAL!-MIMOC (L "AUX" (ATM <1 .L>) (VAL <3 .L>))
2947 <OCEMIT MOVE O1* !<OBJ-VAL .ATM>>
2951 <DEFINE GEN-ASSIGNED?!-MIMOC (L "AUX" (ATM <1 .L>) (DIR <2 .L>) (TG <3 .L>))
2953 <OCEMIT MOVE O1* !<OBJ-VAL .ATM>>
2954 <LABEL-UPDATE-ACS .TG <>>
2955 <OCEMIT JSP T* @ <- <OPCODE IASS>>>
2956 <COND (<==? .DIR +> <OCEMIT CAIA O* O*>)>
2957 <OCEMIT JRST <XJUMP .TG>>>
2959 <DEFINE GEN-SET!-MIMOC (L "AUX" (ATM <1 .L>) (NVAL <2 .L>))
2961 <COND (<WILL-DIE? .NVAL> <DEAD!-MIMOC (.NVAL) T>)>
2962 <COND (<AND <TYPE? .ATM ATOM> <WILL-DIE? .ATM>> <DEAD!-MIMOC (.ATM) T>)>
2964 <GET-INTO-ACS .NVAL BOTH A1* .ATM VALUE O1*>