2 <COND (<NOT <GASSIGNED? WIDTH-MUNG>> <FLOAD "MIMOC20DEFS.MUD">)>
6 <NEWTYPE LOCAL-NAME FIX>
16 <MANIFEST PRIM-LIST PRIM-FIX>
20 <DEFINE NTHL!-MIMOC (L
21 "OPT" (AOS <>) (NOT-DEAD? T) LEN-VAR
22 "AUX" (LST <1 .L>) (AMT <2 .L>) (VAL <4 .L>)
23 (LOOP <GENLBL "LOOP">) (END <GENLBL "END">) (TAC <>)
24 CNT-AC (AHEAD <>) AC NAC (RES-TYP <EXTRAMEM TYPE .L>))
25 #DECL ((LST) <OR LIST ATOM> (AMT) <OR FIX ATOM> (NAC LOOP END) ATOM
26 (AC) <OR AC ATOM FALSE> (MIML L) LIST (AHEAD) <OR AC FALSE>)
27 <COND (<AND <NOT .AOS> <NTH-PUT-LOOK-AHEAD .L "PUTL" .LST .AMT .VAL>>)
29 <COND (<AND <ASSIGNED? LEN-VAR> .NOT-DEAD?> <SET VAL .LEN-VAR>)>
30 <COND (<AND <NOT <AND <SET TAC <IN-AC? .LST BOTH>>
31 <SET AC <NEXT-AC .TAC>>>>
32 <NOT <SET AC <IN-AC? .LST VALUE>>>>
33 <COND (<AND <OR <NOT .AOS> .NOT-DEAD?>
36 <LOOK-AHEAD <REST .MIML> .VAL BOTH>>>
37 <AC-TIME .AHEAD <SETG AC-STAMP <+ ,AC-STAMP 1>>>
38 <AC-TIME <GET-AC <NEXT-AC .AHEAD>> ,AC-STAMP>)>
39 <SET AC <NEXT-AC <SET TAC <LOAD-AC .LST BOTH>>>>)>
40 <COND (<AND <NOT <WILL-DIE? .LST>>
43 <COND (.TAC <FLUSH-AC .TAC T>) (ELSE <FLUSH-AC .AC>)>)>
44 <COND (<AND <==? .AMT .VAL>
46 <OR <IN-AC? .VAL BOTH> <IN-AC? .VAL VALUE>>>>
48 <COND (<AND <OR <NOT .AOS> .NOT-DEAD?> <N==? .VAL STACK>>
49 <SET NAC <LOAD-AC .VAL BOTH T T .AHEAD>>
50 ;"Really an ASSIGN-AC"
51 <COND (<AND <==? .NAC .TAC> <==? .LST .VAL>>
52 <AC-TYPE <GET-AC .NAC> <>>)>)>
56 (<AND <TYPE? .AMT ATOM>
57 <OR <AND <SET CNT-AC <IN-AC? .AMT BOTH>>
58 <OR <AND <WILL-DIE? .AMT>
59 <DEAD!-MIMOC (.AMT) T>>
61 <GET-AC <NEXT-AC .CNT-AC>>>>>
64 <SET CNT-AC <NEXT-AC .CNT-AC>>>>
65 <AND <SET CNT-AC <IN-AC? .AMT VALUE>>
66 <OR <AND <WILL-DIE? .AMT>
67 <DEAD!-MIMOC (.AMT) T>>
68 <NOT <AC-UPDATE <GET-AC .CNT-AC>>>>
70 <MUNGED-AC .CNT-AC T>>>>>)
72 <OCEMIT MOVE <SET CNT-AC O*> !<OBJ-VAL .AMT>>)>
73 <SETG LOOPTAGS (.LOOP !,LOOPTAGS)>
75 <OCEMIT SOJE .CNT-AC <XJUMP .END>>
76 <OCEMIT MOVE .AC (.AC)>
77 <OCEMIT JRST <XJUMP .LOOP>>
79 <COND (<N==? .LST .VAL>
80 <COND (.TAC <MUNGED-AC .TAC T>)
81 (ELSE <MUNGED-AC .AC>)>)>)>
83 <COND (<==? .VAL STACK>
86 <COND (<==? .AOS HRRZ> 1) (ELSE 2)>
88 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
90 <COND (,WINNING-VICTIM
91 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
95 <COND (<==? .AOS HRRZ> 1) (ELSE 2)>
97 <AC-TYPE <GET-AC .NAC> FIX>)
99 <COND (<=? <SPNAME <1 .AOS>> "VEQUAL?">
100 <VEQUAL?!-MIMOC <REST .AOS> .AC <> 2>)
101 (<=? <SPNAME <1 .AOS>> "TYPE?">
102 <VEQUAL?!-MIMOC <REST .AOS 3> .AC <> 2
105 <EQUAL?!-MIMOC <REST .AOS> .AC <> 1>)>)
108 <COND (<==? .AOS HRRZ> 1) (ELSE 2)>
111 <OCEMIT PUSH TP* 1 (.AC)>
112 <OCEMIT PUSH TP* 2 (.AC)>
113 <COND (,WINNING-VICTIM
114 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
115 (T <OCEMIT DMOVE .NAC 1 (.AC)>)>)>>
117 <DEFINE RESTL!-MIMOC (L
118 "AUX" (LST <1 .L>) (AMT <2 .L>) (VAL <4 .L>) AC NAC
119 (TAC <>) (END <GENLBL "END">)
120 (LOOP <GENLBL "LOOP">)
122 <OR <LMEMQ .VAL ,LOCALS>
123 <AND ,ICALL-FLAG <LMEMQ .VAL ,ICALL-TEMPS>>>)
124 (VD <COND (.LV <LDECL .LV>)>))
125 #DECL ((LST) <OR LIST ATOM> (AMT) <OR FIX ATOM> (NAC END LOOP) ATOM
126 (AC) <OR ATOM FALSE> (L) LIST)
127 <COND (<OR <==? .AMT 1> <==? .AMT 2>>
128 <OR <AND <SET TAC <IN-AC? .LST BOTH>> <SET AC <NEXT-AC .TAC>>>
129 <SET AC <IN-AC? .LST VALUE>>>)
130 (<AND <NOT <AND <SET AC <IN-AC? .LST BOTH>>
132 <SET AC <NEXT-AC .AC>>>>
133 <NOT <SET AC <IN-AC? .LST VALUE>>>>
134 <SET AC <NEXT-AC <SET TAC <LOAD-AC .LST BOTH>>>>)>
135 <COND (<AND <==? .AMT .VAL> <SET NAC <IN-AC? .AMT BOTH>>>
137 <COND (<N==? .VAL .LST> <CLEAN-ACS .VAL>)>
138 <COND (<AND .TAC <OR <==? .LST .VAL> <WILL-DIE? .LST>>> <SET NAC .TAC>)
140 <OR <==? .LST .VAL> <WILL-DIE? .LST>>
141 <SET TAC <GET-AC <GETPROP .AC AC-PAIR>>>
142 <==? <NEXT-AC <AC-NAME .TAC>> .AC>>
143 <SET NAC <AC-NAME .TAC>>
148 (ELSE <SET NAC <ASSIGN-AC .VAL BOTH T>>)>
150 <COND (.AC <OCEMIT MOVE <NEXT-AC .NAC> (.AC)>)
151 (ELSE <OCEMIT MOVE <NEXT-AC .NAC> @ !<OBJ-VAL .LST>>)>)
153 <COND (.AC <OCEMIT MOVE <NEXT-AC .NAC> @ (.AC)>)
155 <OCEMIT MOVE <NEXT-AC .NAC> @ !<OBJ-VAL .LST>>
156 <OCEMIT MOVE <NEXT-AC .NAC> (<NEXT-AC .NAC>)>)>)
159 <OCEMIT MOVE <NEXT-AC .NAC> @ (.AC)>
160 <OCEMIT MOVE <NEXT-AC .NAC> (<NEXT-AC .NAC>)>)
162 <OCEMIT MOVE <NEXT-AC .NAC> @ !<OBJ-VAL .LST>>
163 <OCEMIT MOVE <NEXT-AC .NAC> @ (<NEXT-AC .NAC>)>)>)
166 <OCEMIT MOVE <NEXT-AC .NAC> @ (.AC)>
167 <OCEMIT MOVE <NEXT-AC .NAC> @ (<NEXT-AC .NAC>)>)
169 <OCEMIT MOVE <NEXT-AC .NAC> @ !<OBJ-VAL .LST>>
170 <OCEMIT MOVE <NEXT-AC .NAC> @ (<NEXT-AC .NAC>)>
171 <OCEMIT MOVE <NEXT-AC .NAC> (<NEXT-AC .NAC>)>)>)
173 <COND (<N==? .AC <NEXT-AC .NAC>>
174 <OCEMIT MOVE <NEXT-AC .NAC> .AC>)>
175 <SMASH-AC O* .AMT VALUE <N==? .AMT .VAL>>
178 <COND (<TYPE? .AMT ATOM> <OCEMIT JUMPE O* <XJUMP .END>>)>
179 <SETG LOOPTAGS (.LOOP !,LOOPTAGS)>
181 <OCEMIT MOVE <NEXT-AC .NAC> (<NEXT-AC .NAC>)>
182 <OCEMIT SOJN O* <XJUMP .LOOP>>
184 <AC-ITEM <GET-AC O*> 0>)>)>
185 <COND (<AND <==? .AC <NEXT-AC .NAC>>
186 <N==? .VAL .LST> <N==? .VAL STACK>>
187 <AC-CODE <AC-ITEM <GET-AC .NAC> .VAL> TYPE>
188 <AC-CODE <AC-ITEM <GET-AC <NEXT-AC .NAC>> .VAL> VALUE>)>
189 <COND (.VD <AC-UPDATE <GET-AC .NAC> <>>)
190 (ELSE <AC-UPDATE <GET-AC .NAC> T>)>
191 <AC-UPDATE <GET-AC <NEXT-AC .NAC>> T>
192 <COND (<==? .VAL STACK>
193 <OCEMIT PUSH TP* !<TYPE-WORD LIST>>
194 <OCEMIT PUSH TP* <NEXT-AC .NAC>>
195 <COND (,WINNING-VICTIM
196 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
198 <COND (<N==? .NAC .TAC> <AC-TYPE <GET-AC .NAC> LIST>)>
199 <COND (.VD <AC-UPDATE <GET-AC .NAC> <>>)
200 (ELSE <AC-UPDATE <GET-AC .NAC> T>)>)>>
202 <DEFINE EMPL?!-MIMOC (L
203 "AUX" (LST <1 .L>) (FLAG <2 .L>) (TAG <3 .L>)
204 (JUMP JUMPE) (SKIP SKIPN) AC NEW (AC-T <>)
206 <OR <LMEMQ .LST ,LOCALS>
207 <AND ,ICALL-FLAG <LMEMQ .LST ,ICALL-TEMPS>>>)
210 <COND (.LV <LDECL .LV>)
211 (ELSE <EXTRAMEM TYPE .L>)>))
212 #DECL ((LST) <OR LIST ATOM> (FLAG TAG SKIP JUMP) ATOM
213 (AC) <OR FALSE ATOM> (L) LIST)
214 <COND (<==? .FLAG -> <SET JUMP JUMPN> <SET SKIP SKIPE>)>
215 <COND (<OR <AND <SET TAC <IN-AC? .LST BOTH>>
216 <SET AC <NEXT-AC .TAC>>
218 <LABEL-UPDATE-ACS .TAG <> T .TAC .AC>>>
219 <AND <SET AC <IN-AC? .LST VALUE>>
221 <LABEL-UPDATE-ACS .TAG <> T .AC>>>>
223 <SET AC-T-2 <AC-TIME <GET-AC <SET TAC <1 .NEW>>>>>
224 <COND (<N==? .AC <2 .NEW>>
226 <AC-TIME <GET-AC <SET AC <2 .NEW>>>>>)>)
228 <SET AC-T <AC-TIME <GET-AC <SET AC <1 .NEW>>>>>)>
229 <OCEMIT .JUMP .AC <XJUMP .TAG>>
230 <COND (.AC-T <AC-TIME <GET-AC .AC> .AC-T>)>
231 <COND (.AC-T-2 <AC-TIME <GET-AC .TAC> .AC-T-2>)>)
233 <COND (<OR <AND <SET TAC <LABEL-PREF .TAG .LST BOTH>>
234 <SET AC <NEXT-AC <SET TAC <AC-NAME .TAC>>>>>
235 <AND <SET TAC <LABEL-PREF .TAG .LST VALUE>>
236 <SET AC <AC-NAME .TAC>>
237 <SET TAC <GETPROP .TAC AC-PAIR>>>>
238 <LOAD-AC .LST BOTH T T <GET-AC .TAC> <GET-AC .AC>>)
240 <SET AC <NEXT-AC <SET TAC <ASSIGN-AC .LST BOTH>>>>)>
241 <AC-UPDATE <GET-AC .AC> <>>
242 <AC-ITEM <GET-AC .AC> .LST>
243 <AC-CODE <GET-AC .AC> VALUE>
246 <LABEL-UPDATE-ACS .TAG <>>
247 <OCEMIT .SKIP .AC !<OBJ-LOC .LST 1>>
248 <OCEMIT JRST <XJUMP .TAG>>)>>
250 <DEFINE PUTREST!-MIMOC (L "AUX" (L1 <1 .L>) (L2 <2 .L>) AC NAC)
251 #DECL ((L) LIST (L1 L2) <OR LIST ATOM> (AC NAC) <OR FALSE ATOM>)
252 <COND (<SET AC <IN-AC? .L1 VALUE>>
254 <AC-TIME <GET-AC .AC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>)>
256 <COND (.AC <OCEMIT SETZM 0 (.AC)>)
257 (ELSE <OCEMIT SETZM @ !<OBJ-VAL .L1>>)>)
259 <COND (<SET NAC <IN-AC? .L2 VALUE>>)
260 (<AND <TYPE? .L2 ATOM> <NOT <WILL-DIE? .L2>>>
261 <SET NAC <NEXT-AC <LOAD-AC .L2 BOTH>>>)
262 (T <SMASH-AC O* .L2 VALUE> <SET NAC O*>)>
263 <COND (.AC <OCEMIT MOVEM .NAC (.AC)>)
264 (ELSE <OCEMIT MOVEM .NAC @ !<OBJ-VAL .L1>>)>)>>
266 <DEFINE CONS!-MIMOC (L "AUX" (L1 <1 .L>) (L2 <2 .L>) (VAL <4 .L>))
267 #DECL ((L) LIST (L1) ANY (L1) <OR LIST ATOM> (VAL) ATOM)
268 <COND (<OR <==? .L1 .VAL> <AND <TYPE? .L1 ATOM> <WILL-DIE? .L1>>>
269 <DEAD!-MIMOC (.L1) T>)>
270 <COND (<OR <==? .L2 .VAL> <AND <TYPE? .L2 ATOM> <WILL-DIE? .L2>>>
271 <DEAD!-MIMOC (.L2) T>)>
273 <GET-INTO-ACS .L1 BOTH B1* .L2 VALUE C1*>
276 <DEFINE GET-INTO-ACS ("TUPLE" PTRNS "AUX" (FIRSTS ()) (LASTS ()) (OTHERS ()))
277 #DECL ((PTRNS) TUPLE (FIRSTS LASTS OTHERS) LIST)
278 <REPEAT ((P .PTRNS) (WIN T) (CHANGE <>) AC ITM DAC KIND RAC)
279 <COND (<AND <EMPTY? .P> .WIN> <RETURN>)>
287 #DECL ((ONE) !<LIST [3 ATOM] TUPLE>)
288 <COND (<AND <OR <AND <NOT .BOTH> <N==? <2 .ONE> BOTH>>
289 <AND .BOTH <==? <2 .ONE> BOTH>>>
290 <N==? <1 .ONE> <3 .ONE>>>
291 <OCEMIT EXCH <1 .ONE> <3 .ONE>>
292 <FIXUP-ACS .FIRSTS <1 .ONE> <3 .ONE> .ONE <2 .ONE>>
293 <COND (<==? <2 .ONE> BOTH>
295 <NEXT-AC-FUNNY <1 .ONE>>
296 <NEXT-AC-FUNNY <3 .ONE>>>)>
298 (<==? <1 .ONE> <3 .ONE>> <PUT <4 .ONE> 2 <>>)>>
300 <COND (.BOTH <SET BOTH <>> <AGAIN>)>>
306 (<NOT <TYPE? <SET ITM <1 .P>> ATOM>>
307 <SET LASTS ((.ITM <2 .P> <3 .P>) !.LASTS)>
309 (<SET AC <IN-AC? .ITM <SET KIND <2 .P>>>>
310 <COND (<==? .AC <SET DAC <3 .P>>>
311 <COND (<AND <N==? .KIND VALUE>
312 <SET RAC <GETPROP .DAC AC>>
314 <LOAD-TYPE-IN-AC .DAC <AC-TYPE .RAC>>
316 (<OR <AND <==? .KIND BOTH>
317 <OR <AC-MEMQ .DAC .PTRNS>
318 <AC-MEMQ <NEXT-AC-FUNNY .DAC> .PTRNS>>>
319 <AND <N==? .KIND BOTH> <AC-MEMQ .DAC .PTRNS>>>
321 <SET FIRSTS ((.AC .KIND .DAC .P) !.FIRSTS)>)
325 <COND (<GETPROP .DAC AC>
326 <AC-TYPE <GET-AC .DAC> <>>
327 <COND (<==? .KIND BOTH>
328 <AC-TYPE <GET-AC <NEXT-AC .DAC>> <>>)>)>
329 <COND (<==? .KIND BOTH>
330 <OCEMIT DMOVE .DAC .AC>)
331 (ELSE <OCEMIT MOVE .DAC .AC>)>
336 <SET OTHERS ((.ITM .KIND <3 .P>) !.OTHERS)>)>
340 #DECL ((ONE) !<LIST ATOM ATOM ATOM>)
341 <COND (<GETPROP <3 .ONE> AC>
342 <AC-TYPE <GET-AC <3 .ONE>> <>>
343 <COND (<==? <2 .ONE> BOTH>
344 <AC-TYPE <GET-AC <NEXT-AC <3 .ONE>>> <>>)>)>
345 <COND (<==? <2 .ONE> BOTH>
346 <OCEMIT DMOVE <3 .ONE> !<OBJ-LOC <1 .ONE> 0>>)
347 (<==? <2 .ONE> VALUE>
348 <OCEMIT MOVE <3 .ONE> !<OBJ-LOC <1 .ONE> 1>>)
349 (ELSE <OCEMIT MOVE <3 .ONE> !<OBJ-LOC <1 .ONE> 0>>)>>
352 <FUNCTION (ONE "AUX" (AC <3 .ONE>) (TYP <2 .ONE>) (V <1 .ONE>))
353 #DECL ((ONE) !<LIST ANY ATOM ATOM>)
354 <COND (<GETPROP .AC AC> <MUNGED-AC .AC <==? .TYP BOTH>>)>
355 <COND (<AND <N==? .TYP TYPE>
356 <OR <MEMQ <PRIMTYPE .V> '[WORD FIX]>
357 <AND <==? <PRIMTYPE .V> LIST>
358 <EMPTY? <CHTYPE .V LIST>>>>>
359 <COND (<==? .TYP BOTH>
360 <OCEMIT MOVSI .AC !<TYPE-CODE <TYPE .V> T>>
361 <SET AC <NEXT-AC-FUNNY .AC>>)>
362 <COND (<==? <PRIMTYPE .V> LIST> <SET V 0>)
363 (ELSE <SET V <CHTYPE .V FIX>>)>
364 <COND (<AND <G=? .V 0> <L=? .V ,MAX-IMMEDIATE>>
365 <OCEMIT MOVEI .AC .V>)
366 (<0? <ANDB .V 262143>>
367 <OCEMIT MOVSI .AC <LSH .V -18>>)
368 (<AND <L? .V 0> <L=? <ABS .V> ,MAX-IMMEDIATE>>
369 <OCEMIT MOVNI .AC <- .V>>)
370 (ELSE <OCEMIT MOVE .AC !<OBJ-LOC .V 1>>)>)
371 (<==? .TYP BOTH> <OCEMIT DMOVE .AC !<OBJ-LOC .V 0>>)
372 (<==? .TYP VALUE> <OCEMIT MOVE .AC !<OBJ-LOC .V 1>>)
373 (ELSE <OCEMIT MOVE .AC !<OBJ-LOC .V 0>>)>>
376 <DEFINE AC-MEMQ (AC P)
377 #DECL ((AC) ATOM (P) <PRIMTYPE VECTOR>)
379 <COND (<EMPTY? .P> <RETURN <>>)>
381 <OR <==? <IN-AC? <1 .P> <2 .P>> .AC>
382 <AND <==? <2 .P> BOTH>
383 <OR <==? <IN-AC? <1 .P> TYPE> .AC>
384 <==? <IN-AC? <1 .P> VALUE> .AC>>>>>
386 <SET P <REST .P 3>>>>
388 <DEFINE NEXT-AC-FUNNY (AC:ATOM)
390 <AND <==? .AC O1*> O2*>
391 <AND <==? .AC O*> A1*>
392 <ERROR NEXT-AC-LOSSAGE!-ERRORS>>>
394 <DEFINE FIXUP-ACS (L ACA ACB NOT-ME KIND "AUX" AC2A AC2B)
396 <SET AC2B <COND (<==? .KIND BOTH> <NEXT-AC-FUNNY .ACB>)>>
397 <SET AC2A <COND (<==? .KIND BOTH> <NEXT-AC-FUNNY .ACA>)>>
399 <FUNCTION (LL "AUX" TAC)
400 #DECL ((LL) !<LIST ATOM ATOM ATOM TUPLE>)
401 <COND (<AND <N==? .LL .NOT-ME>
402 <OR <AND <==? .ACB <SET TAC <1 .LL>>>
404 <AND <==? .ACA .TAC> <SET TAC .ACB>>
405 <AND <==? .AC2A .TAC> <SET TAC .AC2B>>
406 <AND <==? .AC2B .TAC> <SET TAC .AC2A>>>>
410 <DEFINE PUTL!-MIMOC (L "AUX" (LST <1 .L>) (AMT <2 .L>) (VAL <3 .L>)
411 (LOOP <GENLBL "LOOP">) (END <GENLBL "END">)
412 (TAC <>) AC NAC (PUT-TYP <EXTRAMEM TYPE .L>)
414 #DECL ((LST) <OR LIST ATOM>
416 (LOOP) ATOM (NAC AC TAC) <OR ATOM FALSE>
418 <COND (<AND <NOT <AND <SET AC <IN-AC? .LST BOTH>>
420 <SET AC <NEXT-AC .AC>>>>
421 <NOT <SET AC <IN-AC? .LST VALUE>>>>
422 <SET AC <NEXT-AC <SET TAC <LOAD-AC .LST BOTH>>>>)
425 <AC-TIME <GET-AC .AC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>)>
428 <COND (.TAC <FLUSH-AC .TAC T>)
429 (ELSE <FLUSH-AC .AC>)>
430 <COND (<L? <SET AMT <- .AMT 1>> 3>
432 <OCEMIT MOVE .AC (.AC)>
433 <COND (<0? <SET AMT <- .AMT 1>>> <RETURN>)>>)
435 <SMASH-AC O* .AMT VALUE>
436 <SETG LOOPTAGS (.LOOP !,LOOPTAGS)>
438 <OCEMIT MOVE .AC (.AC)>
439 <OCEMIT SOJN O* <XJUMP .LOOP>>)>)
441 <COND (.TAC <FLUSH-AC .TAC T>)
442 (ELSE <FLUSH-AC .AC>)>
443 <COND (<OR <AND <SET CNT-AC <IN-AC? .AMT BOTH>>
444 <OR <AND <WILL-DIE? .AMT> <DEAD!-MIMOC (.AMT) T>>
445 <NOT <AC-UPDATE <GET-AC <NEXT-AC .CNT-AC>>>>>
447 <MUNGED-AC .CNT-AC T>
448 <SET CNT-AC <NEXT-AC .CNT-AC>>>>
449 <AND <SET CNT-AC <IN-AC? .AMT VALUE>>
450 <OR <AND <WILL-DIE? .AMT> <DEAD!-MIMOC (.AMT) T>>
451 <NOT <AC-UPDATE <GET-AC .CNT-AC>>>>
453 <MUNGED-AC .CNT-AC T>>>>)
455 <OCEMIT MOVE <SET CNT-AC O*> !<OBJ-VAL .AMT>>)>
456 <OCEMIT SOJE .CNT-AC <XJUMP .END>>
457 <SETG LOOPTAGS (.LOOP !,LOOPTAGS)>
459 <OCEMIT MOVE .AC (.AC)>
460 <OCEMIT SOJN .CNT-AC <XJUMP .LOOP>>
462 <DO-PUT .PUT-TYP .AC .VAL 1>
464 <COND (.TAC <MUNGED-AC .TAC T>)
465 (ELSE <MUNGED-AC .AC>)>)>>
467 <DEFINE DO-PUT (PUT-TYP AC VAL OFFS "AUX" NAC)
469 <COND (.PUT-TYP <SET PUT-TYP <DECL-HACK <COND (<TYPE? .PUT-TYP LIST>
473 <OR <NOT <TYPE? .VAL ATOM>> <SET NAC <IN-AC? .VAL VALUE>>>>
474 <COND (<TYPE? .VAL ATOM> <OCEMIT MOVEM .NAC <+ .OFFS 1> (.AC)>)
475 (<OR <AND <==? <PRIMTYPE .VAL> LIST> <EMPTY? .VAL>>
476 <AND <==? <PRIMTYPE .VAL> FIX>
477 <==? <CHTYPE .VAL FIX> 0>>>
478 <OCEMIT SETZM <+ .OFFS 1> (.AC)>)
479 (<AND <==? <PRIMTYPE .VAL> FIX>
480 <==? <CHTYPE .VAL FIX> -1>>
481 <OCEMIT SETOM <+ .OFFS 1> (.AC)>)
485 <GET-INTO-ACS .VAL VALUE O*>
486 <OCEMIT MOVEM O* <+ .OFFS 1> (.AC)>)>)
488 <COND (<SET NAC <IN-AC? .VAL VALUE>>)
489 (<OR <NOT <TYPE? .VAL ATOM>> <WILL-DIE? .VAL>>
490 <GET-INTO-ACS .VAL VALUE <SET NAC O*>>)
492 <SET NAC <NEXT-AC <LOAD-AC .VAL BOTH>>>)>
493 <OCEMIT MOVEM .NAC <+ .OFFS 1> (.AC)>)
495 <COND (<SET NAC <IN-AC? .VAL BOTH>>)
496 (<OR <NOT <TYPE? .VAL ATOM>> <WILL-DIE? .VAL>>
497 <GET-INTO-ACS .VAL BOTH <SET NAC O1*>>)
499 <SET NAC <LOAD-AC .VAL BOTH>>)>
500 <OCEMIT DMOVEM .NAC .OFFS (.AC)>)>>
502 <DEFINE LENL!-MIMOC (L
503 "AUX" (LST <1 .L>) (VAL <3 .L>) NAC AC TAC
504 (END <GENLBL "END">) (LOOP <GENLBL "LOOP">))
505 #DECL ((L) LIST (VAL AC NAC END LOOP) ATOM)
508 <COND (<SET TAC <IN-AC? .LST VALUE>>
510 <AC-TIME <GET-AC .TAC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>
511 <OCEMIT MOVEI T* .TAC>)
512 (ELSE <OCEMIT XMOVEI T* !<OBJ-VAL .LST>>)>
513 <SET NAC <NEXT-AC <SET AC <ASSIGN-AC .VAL BOTH>>>>
514 <COND (<==? .VAL STACK> <SET NAC O*>)
515 (<==? .LST .VAL> <SET NAC O*> <AC-TYPE <GET-AC .AC> FIX>)
516 (T <AC-TYPE <GET-AC .AC> FIX>)>
517 <OCEMIT MOVSI .NAC 131072>
518 <SETG LOOPTAGS (.LOOP !,LOOPTAGS)>
520 <OCEMIT SKIPE T* '(T*)>
521 <OCEMIT AOBJN .NAC <XJUMP .LOOP>>
523 <COND (<==? .VAL STACK>
524 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
525 <OCEMIT ANDI O* *777777*>
527 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
528 (<==? .VAL .LST> <OCEMIT HRRZ <NEXT-AC .AC> O*>)
529 (ELSE <OCEMIT MOVEI .NAC (.NAC)>)>>
533 ;"UBLOCK manipulation"
535 <DEFINE NTHU!-MIMOC (L "AUX" (L1 <1 .L>))
536 #DECL ((L) LIST (L1) ANY)
538 <SMASH-AC A1* .L1 TYPE>
539 <OCEMIT MOVE O1* !<OBJ-VAL .L1>>
540 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>
543 <DEFINE RESTU!-MIMOC (L)
546 <SMASH-AC A1* <1 .L> BOTH>
547 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>
548 <PUSHJ RESTU <4 .L>>>
550 <DEFINE BACKU!-MIMOC (L)
553 <SMASH-AC A1* <1 .L> BOTH>
554 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>
555 <PUSHJ BACKU <4 .L>>>
557 <DEFINE TOPU!-MIMOC (L)
560 <SMASH-AC A1* <1 .L> BOTH>
563 <SETG TOPUV!-MIMOC ,TOPU!-MIMOC>
565 <SETG TOPUS!-MIMOC ,TOPU!-MIMOC>
567 <SETG TOPUB!-MIMOC ,TOPU!-MIMOC>
569 <DEFINE PUTU!-MIMOC (L)
572 <SMASH-AC A1* <1 .L> BOTH>
573 <SMASH-AC B1* <3 .L> BOTH>
574 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>
577 ;"VECTOR manipulation"
579 <DEFINE NTHUU!-MIMOC (L) #DECL ((L) LIST)
583 <DEFINE NTHUV!-MIMOC (L
584 "OPT" (UV? <>) (AOS <>) (NOT-DEAD? T) LEN-VAR
585 "AUX" (V <1 .L>) (AMT <2 .L>) AM-AC (TAC <>) (VAL <4 .L>)
586 AC NAC NUM (AHEAD <>))
587 #DECL ((L) LIST (V) <OR VECTOR ATOM> (AMT) <OR FIX ATOM> (VAL NAC) ATOM
588 (NUM) FIX (AC TAC) <OR ATOM FALSE>)
591 <NTH-PUT-LOOK-AHEAD .L
592 <COND (.UV? "PUTUU") ("PUTUV")>
597 <COND (<AND <ASSIGNED? LEN-VAR> .NOT-DEAD?> <SET VAL .LEN-VAR>)>
598 <COND (<AND <NOT <AND <SET TAC <IN-AC? .V BOTH>> <SET AC <NEXT-AC .TAC>>>>
599 <NOT <SET AC <IN-AC? .V VALUE>>>
601 <AND <OR .AOS <==? .VAL STACK>> <NOT .UV?> <N==? .AOS HRRZ>>>
603 <COND (<AND <NOT .AOS>
605 <SET AHEAD <LOOK-AHEAD <REST .MIML> .VAL BOTH>>>
606 <AC-TIME .AHEAD <SETG AC-STAMP <+ ,AC-STAMP 1>>>
607 <AC-TIME <GET-AC <NEXT-AC .AHEAD>> ,AC-STAMP>)>
608 <SET AC <NEXT-AC <SET TAC <LOAD-AC .V BOTH>>>>)
611 <AC-TIME <GET-AC .AC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>)>
614 <COND (<AND .NOT-DEAD? <N==? .VAL STACK>>
615 <SET NAC <LOAD-AC .VAL BOTH T T .AHEAD>> ;"Really an ASSIGN-AC")>
616 <COND (.UV? <SET NUM <- .AMT 1>>) (ELSE <SET NUM <* <- .AMT 1> 2>>)>
617 <COND (<==? .AOS HRRZ>
619 <COND (<OR <NOT .NOT-DEAD?> <==? .VAL STACK>> O*)
620 (ELSE <AC-TYPE <GET-AC .NAC> FIX> <NEXT-AC .NAC>)>
621 !<COND (.AC (.NUM (.AC))) (ELSE (@ !<OBJ-VAL .V>))>>
622 <COND (<==? .VAL STACK>
623 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
625 <COND (,WINNING-VICTIM
626 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)
628 <COND (<=? <SPNAME <1 .AOS>> "VEQUAL?">
629 <VEQUAL?!-MIMOC <REST .AOS>
630 .AC <> <COND (<NOT .UV?> <+ .NUM 1>)
632 (ELSE (@ !<OBJ-VAL .V>))>>)
633 (<=? <SPNAME <1 .AOS>> "TYPE?">
634 <VEQUAL?!-MIMOC <REST .AOS 3>
635 .AC <> <COND (<NOT .UV?> <+ .NUM 1>)
637 (ELSE (@ !<OBJ-VAL .V>))>
640 <EQUAL?!-MIMOC <REST .AOS> .AC <> .NUM>)>)
643 <COND (.NOT-DEAD? <NEXT-AC .NAC>) (ELSE O*)>
644 !<COND (<NOT .UV?> (<+ .NUM 1> (.AC)))
646 (ELSE (@ !<OBJ-VAL .V>))>>
647 <COND (.NOT-DEAD? <AC-TYPE <GET-AC .NAC> FIX>)>)
648 (<AND <==? .VAL STACK> <NOT .UV?>>
649 <OCEMIT PUSH TP* .NUM (.AC)>
650 <OCEMIT PUSH TP* <+ .NUM 1> (.AC)>
651 <COND (,WINNING-VICTIM
652 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
654 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
655 <COND (,WINNING-VICTIM
656 <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
657 <COND (.AC <OCEMIT PUSH TP* .NUM (.AC)>)
658 (ELSE <OCEMIT PUSH TP* @ !<OBJ-VAL .V>>)>
659 <COND (,WINNING-VICTIM
660 <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
663 <OCEMIT MOVE <NEXT-AC .NAC> @ !<OBJ-VAL .V>>
664 <AC-TYPE <GET-AC .NAC> FIX>)
665 (ELSE <OCEMIT DMOVE .NAC @ !<OBJ-VAL .V>>)>)
667 <OCEMIT MOVE <NEXT-AC .NAC> .NUM (.AC)>
668 <AC-TYPE <GET-AC .NAC> FIX>)
669 (T <OCEMIT DMOVE .NAC .NUM (.AC)>)>)
672 (<OR <AND <SET AM-AC <IN-AC? .AMT VALUE>>
673 <OR <NOT <AC-UPDATE <GET-AC .AM-AC>>> <WILL-DIE? .AMT>>>
677 <SET NAC <LOAD-AC .VAL BOTH T T .AHEAD>>>>>>
680 <OCEMIT MOVE <SET AM-AC <NEXT-AC .NAC>> !<OBJ-VAL .AMT>>)
681 (<AND <MEMQ .AM-AC '[A2* B2* C2*]> <N==? .VAL STACK>>
682 <SET NAC <GETPROP .AM-AC AC-PAIR>>
684 <AC-CODE <AC-ITEM <AC-UPDATE <AC-TYPE <GET-AC .NAC> <>> T> .VAL>
686 <AC-CODE <AC-ITEM <AC-UPDATE <AC-TYPE <GET-AC .AM-AC> <>> T> .VAL>
689 <COND (<N==? .AMT .VAL> <MUNGED-AC .AM-AC>)>
691 <COND (.NOT-DEAD? <SET NAC <LOAD-AC .VAL BOTH T T .AHEAD>>)>)>)
693 <COND (.AM-AC <OCEMIT MOVE T* .AM-AC> <SET AM-AC T*>)
694 (ELSE <SMASH-AC <SET AM-AC T*> .AMT VALUE>)>
695 <COND (.NOT-DEAD? <SET NAC <LOAD-AC .VAL BOTH T T .AHEAD>>)>)>
696 <COND (<AND <N==? .VAL STACK> <ASSIGNED? NAC>>
697 <AC-TYPE <GET-AC .NAC> <>>)>
698 <COND (<NOT .UV?> <OCEMIT LSH .AM-AC 1>)>
699 <COND (.AC <OCEMIT ADD .AM-AC .AC>)
700 (ELSE <OCEMIT ADD .AM-AC !<OBJ-LOC .V 1>>)>
701 <COND (<==? .AOS HRRZ>
703 <COND (<OR <NOT .NOT-DEAD?> <==? .VAL STACK>> O*)
704 (ELSE <AC-TYPE <GET-AC .NAC> FIX> <NEXT-AC .NAC>)>
707 <COND (<==? .VAL STACK>
708 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
709 <OCEMIT PUSH TP* O*>)>)
711 <COND (<=? <SPNAME <1 .AOS>> "VEQUAL?">
712 <VEQUAL?!-MIMOC <REST .AOS> .AM-AC <> -1>)
713 (<=? <SPNAME <1 .AOS>> "TYPE?">
714 <VEQUAL?!-MIMOC <REST .AOS 3> .AM-AC <> -2 <2 .AOS>>)
716 <EQUAL?!-MIMOC <REST .AOS> .AM-AC <> -2>)>)
720 <AC-TYPE <GET-AC .NAC> FIX>
725 (<AND <==? .VAL STACK> <NOT .UV?>>
726 <OCEMIT PUSH TP* -2 (.AM-AC)>
727 <OCEMIT PUSH TP* -1 (.AM-AC)>
728 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
730 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
731 <OCEMIT PUSH TP* -1 (.AM-AC)>
732 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
734 <OCEMIT MOVE <NEXT-AC .NAC> -1 (.AM-AC)>
735 <AC-TYPE <GET-AC .NAC> FIX>)
736 (T <OCEMIT DMOVE .NAC -2 (.AM-AC)>)>
737 <AC-CODE <GET-AC T*> DUMMY>)>)>>
739 <DEFINE PUTUU!-MIMOC (L) #DECL ((L) LIST)
742 <DEFINE PUTUV!-MIMOC (L
744 "AUX" (V <1 .L>) (AMT <2 .L>) (TAC <>) (VAL <3 .L>) AC
745 AMT-AC NAC (PUT-TYP <EXTRAMEM TYPE .L>))
746 #DECL ((L) LIST (V) <OR VECTOR ATOM> (AMT) <OR FIX ATOM> (NAC) ATOM
747 (VAL) ANY (AC TAC) <OR ATOM FALSE>)
748 <COND (<AND <NOT <AND <SET TAC <IN-AC? .V BOTH>>
749 <SET AC <NEXT-AC .TAC>>>>
750 <NOT <SET AC <IN-AC? .V VALUE>>>
753 <SET AC <NEXT-AC <SET TAC <LOAD-AC .V BOTH>>>>)
756 <AC-TIME <GET-AC .AC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>)>
757 <COND (<AND <TYPE? .AMT FIX> .UV?>
758 <COND (.AC <DO-PUT FIX .AC .VAL <- .AMT 2>>)
759 (<OR <AND <==? <PRIMTYPE .VAL> LIST> <EMPTY? .VAL>>
760 <AND <==? <PRIMTYPE .VAL> WORD>
761 <==? <CHTYPE .VAL FIX> 0>>>
762 <OCEMIT SETZM @ !<OBJ-VAL .V>>)
763 (<AND <==? <PRIMTYPE .VAL> WORD>
764 <==? <CHTYPE .VAL FIX> -1>>
765 <OCEMIT SETOM @ !<OBJ-VAL .V>>)
767 <SET NAC <NEXT-AC <LOAD-AC .VAL BOTH>>>
768 <OCEMIT MOVEM .NAC @ !<OBJ-VAL .V>>)
770 <GET-INTO-ACS .VAL VALUE O*>
771 <OCEMIT MOVEM O* @ !<OBJ-VAL .V>>)>)
773 <COND (.AC <DO-PUT .PUT-TYP .AC .VAL <* <- .AMT 1> 2>>)
775 <SET NAC <LOAD-AC .VAL BOTH>>
776 <OCEMIT DMOVEM .NAC @ !<OBJ-VAL .V>>)>)
778 <COND (<AND <SET AMT-AC <IN-AC? .AMT VALUE>>
781 <DEAD!-MIMOC (.AMT) T>
782 <AC-TIME <GET-AC .AMT-AC> ,AC-STAMP>
783 <AC-TIME <GET-AC <GETPROP .AMT-AC AC-PAIR>> ,AC-STAMP>)
785 <GET-INTO-ACS .AMT VALUE <SET AMT-AC T*>>)>
786 <COND (<NOT .UV?> <OCEMIT LSH .AMT-AC 1>)>
787 <COND (.AC <OCEMIT ADD .AMT-AC .AC>)
788 (ELSE <OCEMIT ADD .AMT-AC !<OBJ-VAL .V>>)>
789 <COND (.UV? <DO-PUT FIX .AMT-AC .VAL -2>)
790 (ELSE <DO-PUT .PUT-TYP .AMT-AC .VAL -2>)>
791 <AC-CODE <GET-AC .AMT-AC> DUMMY>)>>
793 <DEFINE RESTUU!-MIMOC (L) #DECL ((L) LIST)
794 <RESTUV!-MIMOC .L T>>
796 <DEFINE RESTUV!-MIMOC (L
798 "AUX" (V <1 .L>) (AMT <2 .L>) (VAL <4 .L>) AC NAC
799 (RES-TYP <EXTRAMEM TYPE .L>))
800 #DECL ((L) LIST (V) <OR VECTOR ATOM> (AMT) <OR ATOM FIX> (VAL) ATOM
801 (AC NAC) <OR ATOM FALSE>)
802 <COND (<TYPE? .AMT FIX>
803 <COND (<AND <==? .AMT 1> <==? .V .VAL>>
804 <SET AC <IN-AC? .V BOTH>>)
805 (ELSE <SET AC <LOAD-AC .V BOTH>>)>
807 <COND (<AND <N==? .V .VAL>
809 <AC-UPDATE <GET-AC .AC>>>
811 <SET NAC <ASSIGN-AC .VAL BOTH T>>
812 <OCEMIT DMOVE .NAC .AC>)
815 <COND (<N==? .VAL STACK> <ALTER-AC .AC .VAL>)
816 (ELSE <MUNGED-AC .AC T>)>
820 <COND (.UV? .AMT) (T <* .AMT 2>)>>
821 <OCEMIT SUBI .NAC .AMT>)
823 <SET NAC <ASSIGN-AC .VAL BOTH T>>
824 <OCEMIT SOS .NAC !<OBJ-LOC .V 0>>
825 <COND (.UV? <OCEMIT AOS <NEXT-AC .NAC> !<OBJ-LOC .V 1>>)
827 <OCEMIT MOVEI <NEXT-AC .NAC> 2>
828 <OCEMIT ADDB <NEXT-AC .NAC> !<OBJ-LOC .V 1>>)>
829 <AC-UPDATE <GET-AC .NAC> <>>
830 <AC-UPDATE <GET-AC <NEXT-AC .NAC>> <>>
831 <AC-ITEM <GET-AC .NAC> .V>
832 <AC-ITEM <GET-AC <NEXT-AC .NAC>> .V>
833 <AC-CODE <GET-AC .NAC> TYPE>
834 <AC-CODE <GET-AC <NEXT-AC .NAC>> VALUE>)>)
836 <SET NAC <LOAD-AC .V BOTH>>
837 <COND (<AND <SET AC <IN-AC? .AMT VALUE>>
838 <OR <AND <WILL-DIE? .AMT> <DEAD!-MIMOC (.AMT) T>>
839 <NOT <AC-UPDATE <GET-AC .AC>>>>>)
841 <OCEMIT SUB .NAC !<COND (.AC (.AC)) (ELSE <OBJ-VAL .AMT>)>>
842 <COND (<AND <NOT .UV?> .AC> <OCEMIT LSH .AC 1>)
846 !<COND (.AC (.AC)) (ELSE <OBJ-VAL .AMT>)>>)>
849 !<COND (.AC (.AC)) (ELSE <OBJ-VAL .AMT>)>>
850 <AC-UPDATE <GET-AC .NAC> T>
851 <AC-UPDATE <GET-AC <NEXT-AC .NAC>> T>)
853 <SET AC <IN-AC? .AMT VALUE>>
855 <SET NAC <LOAD-AC .V BOTH>>
859 <OCEMIT SUB .NAC !<COND (.AC (.AC)) (ELSE <OBJ-VAL .AMT>)>>
860 <COND (<AND <NOT .UV?> .AC> <OCEMIT LSH .AC 1>)
864 !<COND (.AC (.AC)) (ELSE <OBJ-VAL .AMT>)>>)>
867 !<COND (.AC (.AC)) (ELSE <OBJ-VAL .AMT>)>>
868 <ALTER-AC .NAC .VAL>)
870 <SET NAC <LOAD-AC .V BOTH>>
873 <COND (<AND <SET AC <IN-AC? .AMT VALUE>>
874 <OR <AND <WILL-DIE? .AMT> <DEAD!-MIMOC (.AMT) T>>
875 <NOT <AC-UPDATE <GET-AC .AC>>>
878 <OCEMIT SUB .NAC !<COND (.AC (.AC)) (ELSE <OBJ-VAL .AMT>)>>
879 <COND (<AND <NOT .UV?> .AC> <OCEMIT LSH .AC 1>)
883 !<COND (.AC (.AC)) (ELSE <OBJ-VAL .AMT>)>>)>
886 !<COND (.AC (.AC)) (ELSE <OBJ-VAL .AMT>)>>
887 <COND (<N==? .VAL STACK> <ALTER-AC .NAC .VAL>)>)>
888 <COND (<==? .VAL STACK>
889 <OCEMIT PUSH TP* .NAC>
890 <OCEMIT PUSH TP* <NEXT-AC .NAC>>
891 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>>
893 <DEFINE EMPUV?!-MIMOC (L "AUX" (V <1 .L>) (TAG <3 .L>) (JUMP JUMPE)
895 #DECL ((L) LIST (V) <OR VECTOR ATOM> (JUMP TRN TAG) ATOM
896 (AC) <OR FALSE ATOM>)
897 <COND (<==? <2 .L> -> <SET JUMP JUMPN> <SET TRN TRNE>)>
898 <LABEL-UPDATE-ACS .TAG <>>
899 <COND (<SET AC <IN-AC? .V TYPE>>
900 <OCEMIT .TRN .AC *777777*>
901 <OCEMIT JRST <XJUMP .TAG>>)
903 <OCEMIT HRRZ O* !<OBJ-TYP .V>>
904 <OCEMIT .JUMP O* <XJUMP .TAG>>)>>
906 <DEFINE LENUV!-MIMOC (L "AUX" (V <1 .L>) (VAL <3 .L>) AC)
907 #DECL ((L) LIST (V) <OR VECTOR ATOM> (VAL AC) ATOM)
908 <COND (<==? .VAL STACK>
909 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
910 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
911 <OCEMIT HRRZ O* !<OBJ-TYP .V>>
913 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>)
915 <SET AC <ASSIGN-AC .VAL BOTH>>
916 <OCEMIT HRRZ <NEXT-AC .AC> !<OBJ-TYP .V>>
917 <AC-TYPE <GET-AC .AC> FIX>)>>
920 ;"STRING and BYTES manipulation"
922 <DEFINE NTHUB!-MIMOC (L)
925 <DEFINE NTHUS!-MIMOC (L
926 "OPTIONAL" (BYTES? <>)
927 "AUX" (V <1 .L>) (AMT <2 .L>) (VAL <4 .L>) AC NUM
928 (NAC <PUTPROP .L DONE>))
929 #DECL ((L) LIST (V) <OR BYTES STRING ATOM> (AMT) <OR FIX ATOM>
930 (VAL) ATOM (NUM) FIX (AC BYTES?) <OR ATOM FALSE>)
931 <SETG DIE-LATER <SETG REMEMBER-STRING <>>>
932 <COND (<AND <NOT .NAC> <N==? .VAL .V> <TYPE? .AMT FIX>>
933 <SET NAC <STRING-PUT-NTH-LOOK-AHEAD .V NTH .VAL .BYTES? .AMT>>)>
935 <COND (<SET AC <IN-AC? .V FUNNY-VALUE>>
936 <AC-CODE <GET-AC .AC> VALUE>
939 <AC-TIME <GET-AC .AC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>)
940 (<AND <N==? .AMT 1> <N==? .AMT 2>>
941 <SET AC <LOAD-AC .AMT VALUE>>
944 <OCEMIT <COND (,ADJBP-HACK MADJBP)
947 (<AND <SET AC <IN-AC? .V VALUE>>
949 <NOT <AC-UPDATE <GET-AC .AC>>>
954 <AC-TIME <GET-AC .AC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>)
959 <AC-TIME <GET-AC .AC>
960 <SETG AC-STAMP <+ ,AC-STAMP 1>>>)
963 <SET AC <NEXT-AC <LOAD-AC .V BOTH>>>)>
966 <COND (<==? .VAL STACK>
967 <COND (.BYTES? <OCEMIT PUSH TP* !<TYPE-WORD FIX>>)
968 (T <OCEMIT PUSH TP* !<TYPE-WORD CHARACTER>>)>
969 <COND (,WINNING-VICTIM
970 <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
972 <OCEMIT MOVE O* !<OBJ-VAL .V>>
976 <COND (,WINNING-VICTIM
977 <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
978 <AC-CODE <GET-AC .AC> DUMMY>)
980 <SET NAC <ASSIGN-AC .VAL BOTH>>
983 <SET AC <NEXT-AC .NAC>>
985 <DNTH <NEXT-AC .NAC> .AC .AMT>
986 <COND (.BYTES? <AC-TYPE <GET-AC .NAC> FIX>)
987 (T <AC-TYPE <GET-AC .NAC> CHARACTER>)>)>
991 <N==? .AC <NEXT-AC .NAC>>>>>
992 <COND (,REMEMBER-STRING
993 <AC-UPDATE <AC-CODE <AC-ITEM <GET-AC .AC> .V>
996 <AC-CODE <GET-AC .AC> DUMMY>)>)>)>>
998 <DEFINE DNTH (AC1 AC2 AMT)
999 #DECL ((AC1 AC2) ATOM (AMT) <OR ATOM FIX>)
1000 <COND (<OR <==? .AMT 1><==? .AMT 2>>
1002 <OCEMIT IBP O* .AC2>)>
1003 <OCEMIT ILDB .AC1 .AC2>)
1005 <OCEMIT LDB .AC1 .AC2>)>>
1007 <DEFINE PUTUS!-MIMOC (L
1009 "AUX" (V <1 .L>) (AMT <2 .L>) (VAL <3 .L>) (AC <>) NAC
1010 (DONE <PUTPROP .L DONE>) TAC)
1011 #DECL ((L) LIST (V) <OR BYTES STRING ATOM> (AMT) <OR FIX ATOM>
1012 (NAC) <OR ATOM FALSE> (VAL) ANY (TAC AC) <OR ATOM FALSE>)
1013 <SETG DIE-LATER <SETG REMEMBER-STRING <>>>
1014 <COND (<AND <NOT .DONE> <TYPE? .AMT FIX>>
1015 <SET DONE <STRING-PUT-NTH-LOOK-AHEAD
1016 .V PUT .VAL .BYTES? .AMT>>)>
1018 <COND (<OR <SET AC <IN-AC? .V FUNNY-VALUE>>
1022 <AC-CODE <GET-AC .AC> VALUE>
1025 <AC-TIME <GET-AC .AC>
1026 <SETG AC-STAMP <+ ,AC-STAMP 1>>>)
1027 (<AND <SET AC <IN-AC? .V VALUE>>
1028 <OR <WILL-DIE? .V> ,DIE-LATER>>
1030 <AC-TIME <GET-AC .AC>
1031 <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1036 <SET AC <NEXT-AC <SET TAC <LOAD-AC .V BOTH>>>>
1037 <COND (<NOT <OR ,DIE-LATER <WILL-DIE? .V>>>
1041 <OCEMIT MOVE <SET AC O*> !<OBJ-VAL .V>>)>
1043 <OCEMIT IBP O* .AC>)>
1044 <COND (<SET NAC <IN-AC? .VAL VALUE>>)
1045 (<AND <TYPE? .VAL ATOM>
1046 <NOT <WILL-DIE? .VAL>>>
1047 <SET NAC <NEXT-AC <LOAD-AC .VAL BOTH>>>)
1049 <GET-INTO-ACS .VAL VALUE <SET NAC O1*>>)>
1050 <OCEMIT IDPB .NAC .AC>
1051 <COND (,REMEMBER-STRING
1052 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC .AC> <>>
1055 <AC-CODE <GET-AC .AC> DUMMY>)>)
1057 <COND (<OR <AND <SET TAC <IN-AC? .AMT BOTH>>
1058 <SET AC <NEXT-AC .TAC>>>
1059 <SET AC <IN-AC? .AMT VALUE>>>
1061 <COND (<WILL-DIE? .AMT>
1062 <DEAD!-MIMOC (.AMT) T>)
1063 (<AC-UPDATE <GET-AC .AC>>
1064 <OCEMIT MOVE O1* .AC>
1066 <COND (<N==? .AC O1*>
1068 <AC-TIME <GET-AC .TAC>
1071 (ELSE <FLUSH-AC .AC>)>
1072 <AC-TIME <GET-AC .AC> ,AC-STAMP>)>)
1074 <SET AC <LOAD-AC .AMT VALUE>>)
1076 <GET-INTO-ACS .AMT VALUE <SET AC O1*>>)>
1077 <OCEMIT <COND (,ADJBP-HACK MADJBP)
1078 (T ADJBP)> .AC !<OBJ-VAL .V>>
1079 <COND (<AND <TYPE? .VAL ATOM>
1080 <NOT <WILL-DIE? .VAL>>>
1081 <SET NAC <NEXT-AC <LOAD-AC .VAL BOTH>>>)
1083 <GET-INTO-ACS .VAL VALUE <SET NAC O*>>)>
1084 <OCEMIT DPB .NAC .AC>
1085 <COND (<N==? .AC O1*>
1086 <COND (.TAC <MUNGED-AC .TAC T>)
1087 (ELSE <MUNGED-AC .AC>)>
1088 <COND (,REMEMBER-STRING
1089 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC .AC>
1091 FUNNY-VALUE>)>)>)>)>>
1093 <DEFINE PUTUB!-MIMOC (L) <PUTUS!-MIMOC .L T>>
1095 <DEFINE RESTUS!-MIMOC (L
1096 "OPTIONAL" (BYTES? <>) (OTH-VAL <>) OP DEAD?
1097 "AUX" (STR <1 .L>) (AMT <2 .L>) (VAL <4 .L>) AC
1098 (OTH-AC <>) (NAC <PUTPROP .L DONE>))
1099 #DECL ((L) LIST (STR) ATOM (AMT) <OR FIX ATOM> (VAL) ATOM
1100 (AC NAC) <OR ATOM FALSE> (BYTES?) <OR ATOM FALSE>)
1102 (<AND <NOT .NAC> <==? .AMT 1> <N==? .STR .VAL> <NOT .OTH-VAL>>
1103 <SET NAC <STRING-REST-LOOK-AHEAD .L .STR .VAL .BYTES?>>)
1105 <COND (<==? .OP PUT>
1106 <COND (<SET OTH-AC <IN-AC? .OTH-VAL BOTH>>
1107 <AC-TIME <GET-AC .OTH-AC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1108 <AC-TIME <GET-AC <SET OTH-AC <NEXT-AC .OTH-AC>>> ,AC-STAMP>)
1109 (<SET OTH-AC <IN-AC? .OTH-VAL VALUE>>
1110 <AC-TIME <GET-AC .OTH-AC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>)
1111 (<TYPE? .OTH-VAL ATOM>
1112 <OCEMIT MOVE <SET OTH-AC O*> !<OBJ-VAL .OTH-VAL>>)
1114 <OCEMIT MOVEI <SET OTH-AC O*> <CHTYPE .OTH-VAL FIX>>)>)>)>
1117 (<AND <==? .AMT 1> <NOT <IN-AC? .STR BOTH>> <==? .STR .VAL>>
1118 <COND (<AND <SET NAC <IN-AC? .STR TYPE>> <NOT <AC-UPDATE <GET-AC .NAC>>>>
1120 <COND (<AND <SET NAC <IN-AC? .STR VALUE>> <NOT <AC-UPDATE <GET-AC .NAC>>>>
1122 <OCEMIT SOS O* !<OBJ-TYP .STR>>
1124 <COND (<==? .OP PUT> <OCEMIT IDPB .OTH-AC !<OBJ-VAL .STR>>)
1125 (<==? .OTH-VAL STACK>
1126 <OCEMIT ILDB O* !<OBJ-VAL .STR>>
1129 !<TYPE-WORD <COND (.BYTES? FIX) (ELSE CHARACTER)>>>
1130 <OCEMIT PUSH TP* O*>
1131 <COND (,WINNING-VICTIM
1132 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1134 <SET OTH-AC <ASSIGN-AC .OTH-VAL BOTH>>
1135 <AC-TYPE <GET-AC .OTH-AC>
1136 <COND (.BYTES? FIX) (ELSE CHARACTER)>>
1137 <OCEMIT ILDB <NEXT-AC .OTH-AC> !<OBJ-VAL .STR>>)>)
1138 (ELSE <OCEMIT IBP O* !<OBJ-VAL .STR>>)>)
1141 <SET NAC <LOAD-AC .STR BOTH>>
1142 <COND (<OR <NOT .OTH-VAL> <==? .OP PUT> <==? .OTH-VAL STACK>>
1143 <COND (<NOT <OR <AND <ASSIGNED? DEAD?> .DEAD?>
1144 <AND <NOT <ASSIGNED? DEAD?>>
1148 <MUNGED-AC .NAC T>)>)
1150 <SET NAC <LOAD-AC .STR TYPE>>
1151 <COND (<NOT <WILL-DIE? .STR>> <FLUSH-AC .NAC>)>
1153 <OCEMIT SUBI .NAC .AMT>
1157 <COND (<==? .OP PUT> <OCEMIT IDPB .OTH-AC <NEXT-AC .NAC>>)
1158 (<==? .OTH-VAL STACK>
1159 <OCEMIT ILDB O* <NEXT-AC .NAC>>
1162 !<TYPE-WORD <COND (.BYTES? FIX)
1164 <OCEMIT PUSH TP* O*>
1165 <COND (,WINNING-VICTIM
1166 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1168 <COND (<NOT <OR <AND <ASSIGNED? DEAD?> .DEAD?>
1169 <AND <NOT <ASSIGNED? DEAD?>>
1174 <SET OTH-AC <ASSIGN-AC .OTH-VAL BOTH>>
1175 <AC-TYPE <GET-AC .OTH-AC>
1176 <COND (.BYTES? FIX) (ELSE CHARACTER)>>
1177 <OCEMIT ILDB <NEXT-AC .OTH-AC> <NEXT-AC .NAC>>)>)
1178 (ELSE <OCEMIT IBP O* <NEXT-AC .NAC>>)>)
1179 (<AND <==? <IN-AC? .STR VALUE> <NEXT-AC .NAC>>
1180 <AC-UPDATE <GET-AC <NEXT-AC .NAC>>>>
1181 <SMASH-AC O* .STR VALUE>
1183 <OCEMIT MOVEI <NEXT-AC .NAC> .AMT>
1184 <OCEMIT <COND (,ADJBP-HACK MADJBP)
1185 (T ADJBP)> <NEXT-AC .NAC> O*>)
1187 <FLUSH-AC <NEXT-AC .NAC>>
1188 <MUNGED-AC <NEXT-AC .NAC>>
1189 <OCEMIT MOVEI <NEXT-AC .NAC> .AMT>
1190 <OCEMIT <COND (,ADJBP-HACK MADJBP)
1191 (T ADJBP)> <NEXT-AC .NAC> !<OBJ-VAL .STR>>)>
1193 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC .NAC> T> .VAL> TYPE>
1194 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC <NEXT-AC .NAC>> T> .VAL> VALUE>)
1196 <COND (<SET AC <IN-AC? .AMT VALUE>>) (ELSE <SET AC <LOAD-AC .AMT VALUE>>)>
1197 <SET NAC <GETPROP .AC AC-PAIR>>
1198 <OCEMIT MOVE .NAC !<OBJ-TYP .STR>>
1199 <OCEMIT SUB .NAC !<OBJ-VAL .AMT>>
1200 <OCEMIT <COND (,ADJBP-HACK MADJBP)
1201 (T ADJBP)> .AC !<OBJ-VAL .STR>>
1202 <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC .NAC> T> .VAL> TYPE>
1203 <AC-ITEM <AC-UPDATE <GET-AC .AC> T> .VAL>)
1205 <SET NAC <LOAD-AC .STR TYPE>>
1206 <OCEMIT SUB .NAC !<OBJ-VAL .AMT>>
1207 <FLUSH-AC <NEXT-AC .NAC>>
1208 <MUNGED-AC <NEXT-AC .NAC>>
1209 <OCEMIT MOVE <NEXT-AC .NAC> !<OBJ-VAL .AMT>>
1210 <OCEMIT <COND (,ADJBP-HACK MADJBP)
1211 (T ADJBP)> <NEXT-AC .NAC> !<OBJ-VAL .STR>>
1212 <AC-ITEM <AC-UPDATE <GET-AC .NAC> T> .VAL>
1213 <AC-TIME <AC-CODE <AC-ITEM <AC-UPDATE <GET-AC <NEXT-AC .NAC>> T> .VAL>
1217 <SET NAC <ASSIGN-AC .VAL BOTH T>>
1218 <COND (<N==? <IN-AC? .STR TYPE> .NAC>
1219 <OCEMIT MOVE .NAC !<OBJ-TYP .STR>>)>
1220 <OCEMIT SUB .NAC !<OBJ-VAL .AMT>>
1221 <OCEMIT MOVE <NEXT-AC .NAC> !<OBJ-VAL .AMT>>
1222 <OCEMIT <COND (,ADJBP-HACK MADJBP)
1223 (T ADJBP)> <NEXT-AC .NAC> !<OBJ-VAL .STR>>)>
1224 <COND (<==? .VAL STACK>
1225 <OCEMIT PUSH TP* .NAC>
1226 <OCEMIT PUSH TP* <NEXT-AC .NAC>>
1227 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>>
1229 <DEFINE RESTUB!-MIMOC (L)
1230 <RESTUS!-MIMOC .L T>>
1232 <SETG LENU!-MIMOC ,LENUV!-MIMOC>
1234 <SETG LENUS!-MIMOC ,LENUV!-MIMOC>
1236 <SETG LENUB!-MIMOC ,LENUV!-MIMOC>
1238 <SETG LENUU!-MIMOC ,LENUV!-MIMOC>
1240 <SETG EMPU?!-MIMOC ,EMPUV?!-MIMOC>
1242 <SETG EMPUU?!-MIMOC ,EMPUV?!-MIMOC>
1244 <SETG EMPUS?!-MIMOC ,EMPUV?!-MIMOC>
1246 <SETG EMPUB?!-MIMOC ,EMPUV?!-MIMOC>
1248 <SETG LENR!-MIMOC ,LENUV!-MIMOC>
1250 <DEFINE EMPR?!-MIMOC (L) T ;"NO CODE">
1253 ;"RECORD manipulation"
1255 <DEFINE GVAL!-MIMOC (L "AUX" (ATM <1 .L>) (VAL <3 .L>) AC NAC (XGL <>)
1257 #DECL ((L) LIST (ATM) <OR ATOM <FORM ATOM ATOM>> (VAL AC) ATOM)
1258 <COND (<TYPE? .ATM FORM>
1259 <SET XGL <CHTYPE <2 .ATM> XGLOC>>
1260 <SET RATM <1 .ATM>>)>
1261 <COND (<AND ,GVAL-CAREFUL <N=? <SPNAME .RATM> "M$$BINDID">>
1264 <OCEMIT SKIPN @ !<OBJ-VAL .XGL>>
1265 <OCEMIT GVERR !<OBJ-VAL .XGL>>
1266 <OCEMIT DMOVE A1* @ !<OBJ-VAL .XGL>>)
1267 (<SET NAC <IN-AC? .ATM VALUE>>
1268 <COND (<OR <==? .VAL .ATM> <WILL-DIE? .ATM>>
1269 <DEAD!-MIMOC (.ATM) T>)>
1271 <OCEMIT SKIPE (.NAC)>
1272 <OCEMIT SKIPN @ (.NAC)>
1274 <OCEMIT DMOVE A1* @ (.NAC)>)
1277 <OCEMIT SKIPE T* @ !<OBJ-VAL .ATM>>
1278 <OCEMIT SKIPN '(T*)>
1279 <OCEMIT GVERR !<OBJ-VAL .ATM>>
1280 <OCEMIT DMOVE A1* '(T*)>)>
1283 <COND (<AND .XGL <NOT ,BOOT-MODE>>
1284 <SMASH-AC <SET NAC T*> .XGL VALUE>)
1285 (<SET NAC <IN-AC? .ATM VALUE>>)
1287 <SET NAC <NEXT-AC <LOAD-AC .ATM BOTH>>>)>
1288 <COND (<OR ,BOOT-MODE <NOT .XGL>>
1289 <OCEMIT MOVE T* (.NAC)>
1291 <OCEMIT PUSH TP* '(T*)>
1292 <OCEMIT PUSH TP* 1 '(T*)>
1293 <COND (,WINNING-VICTIM
1294 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1297 <SMASH-AC T* .ATM VALUE>
1298 <SET AC <ASSIGN-AC .VAL BOTH>>
1299 <OCEMIT DMOVE .AC @ '(T*)>
1300 <AC-CODE <GET-AC T*> DUMMY>)
1302 <SET AC <ASSIGN-AC .VAL BOTH>>
1303 <OCEMIT DMOVE .AC @ !<OBJ-VAL .XGL>>)
1305 <SET NAC <OR <IN-AC? .ATM VALUE>
1306 <NEXT-AC <LOAD-AC .ATM BOTH>>>>
1307 <SET AC <ASSIGN-AC .VAL BOTH>>
1308 <OCEMIT DMOVE .AC @ (.NAC)>)>)>>
1310 <DEFINE SETG!-MIMOC (L "AUX" (ATM <1 .L>) (VAL <2 .L>) AC)
1311 #DECL ((L) LIST (ATM) <FORM ATOM ATOM> (AC) ATOM (VAL) ANY)
1312 <SET AC <LOAD-AC .VAL BOTH>>
1314 <SMASH-AC T* .ATM VALUE>
1315 <OCEMIT DMOVEM .AC @ '(T*)>
1316 <AC-CODE <GET-AC T*> DUMMY>)
1318 <OCEMIT DMOVEM .AC @ !<OBJ-VAL <CHTYPE <2 .ATM> XGLOC>>>)>>
1320 <GDECL (NTHR-TABLE PUTR-TABLE) <VECTOR [REST ATOM]>>
1374 <DEFINE FRAME-PUT (L "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (VAL <3 .L>) AC NAC)
1376 <COND (<N==? .ARG2 1>
1379 <SET NAC <COND (<IN-AC? .ARG1 VALUE>)
1380 (<NOT <WILL-DIE? .ARG1>>
1381 <NEXT-AC <LOAD-AC .ARG1 BOTH>>)
1382 (T <SMASH-AC T* .ARG1 VALUE>)>>
1383 <SET AC <COND (<IN-AC? .VAL VALUE>)
1384 (<OR <WILL-DIE? .VAL>
1385 <NOT <TYPE? .VAL ATOM>>>
1386 <SMASH-AC O* .VAL VALUE>)
1389 <AC-TIME <GET-AC .NAC>
1390 <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1391 <NEXT-AC <LOAD-AC .VAL BOTH>>)>>
1392 <OCEMIT MOVEM .AC 0 (.NAC)>
1393 <COND (<==? .NAC T*> <AC-CODE <GET-AC T*> DUMMY>)>)>>
1395 <DEFINE FRAME-NTH (L "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (VAL <4 .L>) AC NAC XAC)
1396 #DECL ((L) LIST (ARG1) ANY (ARG2) FIX (AC NAC VAL) ATOM
1397 (XAC) <OR FALSE ATOM> (EX) <OR FALSE <LIST ATOM ATOM ATOM>>)
1398 <COND (<AND <N==? .ARG2 1> <N==? .ARG2 5> <N==? .ARG2 7>>
1401 <SET NAC <COND (<AND <SET XAC <IN-AC? .ARG1 VALUE>>
1403 <AC-TIME <GET-AC .XAC>
1404 <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1407 (<NOT <WILL-DIE? .ARG1>>
1408 <NEXT-AC <LOAD-AC .ARG1 BOTH>>)
1409 (T <SMASH-AC T* .ARG1 VALUE>)>>
1410 <SET AC <ASSIGN-AC .VAL BOTH T>>
1411 <COND (<==? .ARG2 1> ;"The frames MSUBR"
1412 <AC-TYPE <GET-AC .AC> MSUBR>
1413 <OCEMIT MOVE <NEXT-AC .AC> 0 (.NAC)>)
1414 (<==? .ARG2 5> ;"The previous 'frame'"
1415 <AC-TYPE <GET-AC .AC> FRAME>
1416 <OCEMIT MOVE <NEXT-AC .AC> 3 (.NAC)>
1417 <OCEMIT SKIPL (<NEXT-AC .AC>)>
1418 <OCEMIT ADDI <NEXT-AC .AC> 4>)
1420 <AC-TYPE <GET-AC .AC> LBIND>
1421 <OCEMIT HRRZ <NEXT-AC .AC> 4 (.NAC)>
1422 <OCEMIT HLLI <NEXT-AC .AC> (.NAC)>)>
1423 <COND (<==? .NAC T*> <AC-CODE <GET-AC T*> DUMMY>)>
1424 <COND (<==? .VAL STACK>
1425 <OCEMIT PUSH TP* !<TYPE-WORD <AC-TYPE <GET-AC .AC>>>>
1426 <OCEMIT PUSH TP* <NEXT-AC .AC>>
1427 <COND (,WINNING-VICTIM
1428 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)>>
1430 <DEFINE LBIND-NTH (L
1431 "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (VAL <4 .L>) AC NAC XAC
1433 #DECL ((L) LIST (ARG1) ANY (ARG2) FIX (AC VAL) ATOM
1434 (XAC) <OR FALSE ATOM> (EX) <OR FALSE <LIST ATOM ATOM ATOM>>)
1435 <COND (<OR <G? .ARG2 6> <L? .ARG2 1>>
1436 <MIMOCERR OUT-OF-BOUNDS!-ERRORS NTHR LBIND .ARG2>)
1439 <COND (<AND <SET XAC <IN-AC? .ARG1 VALUE>>
1441 <AC-TIME <GET-AC .XAC>
1442 <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1445 (<AND <==? .ARG2 1> <N==? .VAL STACK>> <>)
1446 (<NOT <WILL-DIE? .ARG1>>
1447 <NEXT-AC <LOAD-AC .ARG1 BOTH>>)
1449 <SMASH-AC T* .ARG1 VALUE>
1453 <COND (<N==? .VAL STACK>
1454 <SET AC <ASSIGN-AC .VAL BOTH T>>
1455 <COND (<AND <==? <NEXT-AC .AC> .NAC>
1457 <AC-TYPE <GET-AC .AC> <>>)>)>
1458 <COND (<==? .ARG2 1>
1459 <COND (<==? .VAL STACK>
1460 <OCEMIT PUSH TP* (.NAC)>
1461 <OCEMIT PUSH TP* 1 (.NAC)>
1462 <COND (,WINNING-VICTIM
1463 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1464 (.NAC <OCEMIT DMOVE .AC (.NAC)>)
1465 (ELSE <OCEMIT DMOVE .AC @ !<OBJ-VAL .ARG1>>)>)
1467 <COND (<==? .VAL STACK>
1468 <OCEMIT PUSH TP* 3 (.NAC)>
1469 <OCEMIT PUSH TP* 4 (.NAC)>
1470 <COND (,WINNING-VICTIM
1471 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1472 (ELSE <OCEMIT DMOVE .AC 3 (.NAC)>)>)
1473 (<MEMQ .ARG2 '[2 6]>
1474 <COND (<==? .VAL STACK>
1477 !<TYPE-WORD <NTH '[#FALSE ()
1494 <COND (,WINNING-VICTIM
1495 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1497 <AC-TYPE <GET-AC .AC>
1516 <COND (<==? .VAL STACK>
1517 <SET AC <ASSIGN-AC .VAL BOTH T>>)>
1518 <COND (<SET EX <EXTRAMEM BRANCH-FALSE .L>>
1519 <LABEL-UPDATE-ACS <3 .EX> <>>)>
1520 <OCEMIT MOVE .AC !<TYPE-WORD T$LBIND>>
1522 <OCEMIT <COND (<==? <2 .EX> +> SKIPN) (T SKIPE)>
1532 <OCEMIT JRST <XJUMP <3 .EX>>>
1533 <SETG NEXT-FLUSH 1>)
1545 <OCEMIT MOVE .AC !<TYPE-WORD FALSE>>)>
1546 <COND (<==? .VAL STACK>
1547 <OCEMIT PUSH TP* .AC>
1548 <OCEMIT PUSH TP* <NEXT-AC .AC>>
1549 <COND (,WINNING-VICTIM
1550 <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)>)>>
1552 <DEFINE LBIND-PUT (L "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (VAL <3 .L>) AC NAC XAC)
1553 #DECL ((L) LIST (ARG1 VAL) ANY (ARG2) FIX (AC) ATOM)
1554 <COND (<OR <G? .ARG2 6> <L? .ARG2 1>>
1555 <MIMOCERR OUT-OF-BOUNDS!-ERRORS NTHR LBIND .ARG2>)
1557 <SET AC <COND (<MEMQ .ARG2 '[1 3]>
1558 <LOAD-AC .VAL BOTH>)
1559 (<SET XAC <IN-AC? .VAL VALUE>>
1560 <AC-TIME <GET-AC .XAC>
1561 <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1564 (<OR <NOT <TYPE? .VAL ATOM>>
1566 <SMASH-AC O* .VAL VALUE>)
1567 (ELSE <NEXT-AC <LOAD-AC .VAL BOTH>>)>>
1568 <SET NAC <COND (<IN-AC? .ARG1 VALUE>)
1571 <SMASH-AC T* .ARG1 VALUE>
1572 <AC-CODE <GET-AC T*> DUMMY>
1574 <COND (<==? .ARG2 1>
1575 <COND (.NAC <OCEMIT DMOVEM .AC (.NAC)>)
1576 (ELSE <DMOVEM .AC @ !<OBJ-VAL .ARG1>>)>)
1578 <OCEMIT DMOVEM .AC 3 (.NAC)>)
1582 <NTH '[%<> 2 %<> 5 6 7] .ARG2>
1586 "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (VAL <4 .L>) AC NAC XAC EX
1587 (LAB <>) TY LBL (TEX <>) (WD <>) TG (AC-T1 <>)
1588 NEW (WD1 <>) (AC-T2 <>))
1589 #DECL ((L) LIST (ARG1) ANY (ARG2) FIX (NAC VAL SKIP) ATOM
1590 (AC-T1 AC-T2) <OR FALSE FIX>
1591 (AC XAC) <OR FALSE ATOM> (EX) <OR FALSE <LIST ATOM ATOM ATOM>>)
1593 (<OR <G? .ARG2 5> <L? .ARG2 1>>
1594 <MIMOCERR OUT-OF-BOUNDS!-ERRORS NTHR ATOM .ARG2>)
1597 <COND (<AND <SET XAC <IN-AC? .ARG1 VALUE>>
1599 <AC-TIME <GET-AC .XAC> <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1602 (<NOT <WILL-DIE? .ARG1>>
1603 <NEXT-AC <LOAD-AC .ARG1 BOTH>>)
1605 <SMASH-AC T* .ARG1 VALUE>
1611 <COND (<==? .VAL STACK>
1612 <OCEMIT PUSH TP* 2 (.NAC)>
1613 <SMASH-AC O* <TYPE-CODE STRING> VALUE>
1614 <OCEMIT HRLM O* '(TP*)>
1615 <OCEMIT PUSH TP* 3 (.NAC)>
1616 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1618 <SET AC <ASSIGN-AC .VAL BOTH T>>
1619 <OCEMIT DMOVE .AC 2 (.NAC)>
1620 <OCEMIT HRLI .AC <TYPE-CODE STRING>>)>)
1622 <COND (<SET EX <EXTRAMEM BRANCH-FALSE .L>>
1624 <SET WD <AND <SET WD1 <WILL-DIE? .VAL <REST .MIML>>>
1625 <WILL-DIE? .VAL <LAB-CODE-PNTR ,.LAB>>>>)>
1626 <SET TEX <EXTRAMEM TYPE .L>>
1628 <SET AC <ASSIGN-AC .VAL BOTH T>>)
1630 <COND (<AND <NOT .WD> <==? .ARG2 5>>
1632 <OCEMIT MOVSI .AC <TYPE-CODE TYPE-C>>)>)
1633 (<AND <NOT .WD> <NOT .EX> <NOT .TEX>>
1636 !<TYPE-WORD <NTH '[GBIND LBIND #FALSE () OBLIST]
1638 <COND (<AND .EX <OR .WD <N==? .ARG2 5> <==? <2 .EX> +>>>
1639 <SET NEW <LABEL-UPDATE-ACS .LAB <> <> .NAC>>
1640 <AC-UPDATE <GET-AC .AC> T>
1641 <AC-UPDATE <GET-AC <NEXT-AC .AC>> T>
1642 <COND (<N==? .NAC <1 .NEW>>
1643 <SET AC-T1 <AC-TIME <GET-AC <SET NAC <1 .NEW>>>>>)>
1644 <OCEMIT <COND (<==? <2 .EX> +>
1645 <COND (<==? .ARG2 5> SKIPGE) (ELSE SKIPN)>)
1646 (<==? .ARG2 5> SKIPL)
1648 <COND (.WD O*) (ELSE <NEXT-AC .AC>)>
1649 <NTH '[0 1 #FALSE () 4 2] .ARG2>
1651 <COND (<==? .ARG2 5>
1652 <OCEMIT JRST <XJUMP .LAB>>
1654 <COND (<==? <2 .EX> +>
1655 <OCEMIT HLRZS O* <NEXT-AC .AC>>)>)>)
1656 (ELSE <OCEMIT JRST <XJUMP .LAB>>)>
1658 <AC-TIME <GET-AC .NAC> .AC-T1>)>
1660 <COND (<==? <2 .EX> +>
1661 <AC-TYPE <GET-AC .AC>
1662 <NTH '[GBIND LBIND T OBLIST TYPE-C]
1665 <AC-TYPE <GET-AC .AC> FALSE>)>)>
1666 <SETG NEXT-FLUSH 1>)
1668 <OCEMIT HLRE <NEXT-AC .AC> 2 (.NAC)>
1670 <AC-ITEM <GET-AC .AC> .VAL>
1671 <AC-ITEM <GET-AC <NEXT-AC .AC>> .VAL>
1672 <COND (.WD1 <AC-TYPE <GET-AC .AC> TYPE-C>)
1673 (ELSE <OCEMIT MOVSI .AC <TYPE-CODE TYPE-C>>)>
1674 <SET NEW <LABEL-UPDATE-ACS .LAB <> <> .NAC .AC>>
1675 <COND (<N==? .NAC <1 .NEW>>
1676 <SET AC-T1 <AC-TIME <GET-AC <SET NAC <1 .NEW>>>>>)>
1677 <COND (<N==? .AC <2 .NEW>>
1678 <SET AC-T2 <AC-TIME <GET-AC <SET AC <2 .NEW>>>>>)>
1679 <SETG NEXT-FLUSH 1>)>
1683 <XJUMP <COND (.EX .LAB)
1684 (ELSE <SET LBL <GENLBL "FOO">>)>>>
1686 <OCEMIT MOVEI <NEXT-AC .AC> 0>
1687 <OCEMIT MOVSI .AC <TYPE-CODE FALSE>>)>
1688 <COND (<NOT .EX> <LABEL .LBL>)>)>
1690 <AC-TIME <GET-AC .NAC> .AC-T1>)>
1692 <AC-TIME <GET-AC .AC> .AC-T2>
1693 <AC-TIME <GET-AC <NEXT-AC .AC>> .AC-T2>)>)
1695 <OCEMIT MOVE <NEXT-AC .AC> <NTH '[0 1 #FALSE () 4] .ARG2>
1697 <AC-TYPE <GET-AC .AC> <2 .TEX>>)
1701 <NTH '[0 1 #FALSE () 4] .ARG2>
1703 <OCEMIT MOVSI .AC <TYPE-CODE FALSE>>)>
1704 <COND (<==? .VAL STACK>
1705 <OCEMIT PUSH TP* .AC>
1706 <OCEMIT PUSH TP* <NEXT-AC .AC>>
1707 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)>)>)>>
1709 <DEFINE EXTRAMEM (NAM LST)
1710 #DECL ((NAM) ATOM (LST) LIST)
1714 <COND (<AND <TYPE? .ITM LIST>
1715 <G? <LENGTH .ITM> 1>
1716 <==? <1 .ITM> .NAM>>
1720 <DEFINE ATOM-PUT (L "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) (V <3 .L>) AC NAC AC1)
1721 #DECL ((L) LIST (ARG1) ANY (ARG2) FIX (AC NAC) ATOM
1722 (AC1) <OR ATOM FALSE>)
1723 <COND (<OR <G? .ARG2 5> <L? .ARG2 1>>
1724 <MIMOCERR OUT-OF-BOUNDS!-ERRORS NTHR LBIND .ARG2>)
1726 <SET NAC <COND (<SET AC1 <IN-AC? .ARG1 VALUE>>
1727 <AC-TIME <GET-AC .AC1>
1728 <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1732 <SMASH-AC T* .ARG1 VALUE>
1736 <COND (<==? .ARG2 3>
1737 <SET AC <LOAD-AC .V BOTH>>
1738 <OCEMIT HRRM .AC 2 (.NAC)>
1739 <OCEMIT MOVEM <NEXT-AC .AC> 3 (.NAC)>)
1741 <COND (<OR <==? <PRIMTYPE .V> WORD>
1742 <==? <PRIMTYPE .V> FIX>>
1743 <SET AC <COND (<IN-AC? .V VALUE>)
1744 (T <SMASH-AC O* .V VALUE>)>>
1745 <OCEMIT HRLM .AC 2 (.NAC)>)
1747 <OCEMIT HRROS O* 2 (.NAC)>)
1749 <SET AC <COND (<IN-AC? .V VALUE>)
1750 (T <SMASH-AC O* .V VALUE>)>>
1751 <OCEMIT HRLM .AC 2 (.NAC)>
1752 <COND (<SET AC1 <IN-AC? .V TYPE>>
1753 <LOAD-TYPE O* (.AC1)>
1755 (T <SMASH-AC O* .V TYPECODE>)>
1756 <OCEMIT CAIN O* <TYPE-CODE FALSE>>
1757 <OCEMIT HRROS O* 2 (.NAC)>)>)
1759 <SET AC <COND (<IN-AC? .V VALUE>)
1760 (<OR <NOT <TYPE? .V ATOM>>
1762 <SMASH-AC O* .V VALUE>)
1765 <AC-TIME <GET-AC .NAC>
1766 <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1767 <NEXT-AC <LOAD-AC .V BOTH>>)>>
1770 <NTH '[0 1 %<> 4] .ARG2>
1773 <DEFINE NTHR!-MIMOC (L "OPT" (NOGP <>) "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) T M)
1774 #DECL ((L) LIST (ARG1 T) ANY (M) <OR FALSE VECTOR>
1775 (ARG2) <OR ATOM FIX>)
1776 <COND (<AND <NOT .NOGP>
1779 <TYPE? <SET T <5 .L>> LIST>
1780 <==? <1 .T> RECORD-TYPE>
1781 <SET M <MEMQ <2 .T> ,NTHR-TABLE>>>
1785 <OCEMIT MOVE O1* !<OBJ-VAL .ARG1>>
1786 <OCEMIT MOVE O2* !<OBJ-VAL .ARG2>>
1787 <OCEMIT HLRZ A1* !<OBJ-TYP .ARG1>>
1788 <OCEMIT ANDI A1* *177777*>
1790 <PUSHJ NTHR <4 .L>>)>>
1792 <DEFINE PUTR!-MIMOC (L "OPT" (NOGP <>) "AUX" (ARG1 <1 .L>) (ARG2 <2 .L>) T M)
1793 #DECL ((L) LIST (ARG1 T) ANY (M) <OR FALSE VECTOR>
1794 (ARG2) <OR ATOM FIX>)
1795 <COND (<AND <NOT .NOGP>
1798 <TYPE? <SET T <4 .L>> LIST>
1799 <==? <1 .T> RECORD-TYPE>
1800 <SET M <MEMQ <2 .T> ,PUTR-TABLE>>>
1804 <SMASH-AC C1* <3 .L> BOTH>
1805 <OCEMIT MOVE O1* !<OBJ-VAL .ARG1>>
1806 <OCEMIT MOVE O2* !<OBJ-VAL .ARG2>>
1807 <OCEMIT HLRZ A1* !<OBJ-TYP .ARG1>>
1808 <OCEMIT ANDI A1* *177777*>
1810 <OCEMIT MOVEI B2* C1*>
1814 ;"Structure creation"
1816 <DEFINE LIST!-MIMOC (L)
1817 #DECL ((L) <LIST ANY ANY ANY>)
1819 <COND (<AND <TYPE? <1 .L> FIX> <L=? <1 .L> *777777*>>
1820 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <- ,STACK-DEPTH
1822 <OCEMIT MOVEI O1* <1 .L>>)
1824 <OCEMIT MOVE O1* !<OBJ-VAL <1 .L>>>)>
1825 <PUSHJ LIST <3 .L>>>
1827 <DEFINE UBLOCK!-MIMOC (L) <DO-UBLOCK UBLOCK .L <> T>>
1829 <DEFINE UUBLOCK!-MIMOC (L) <DO-UBLOCK UUBLOCK .L <> <>>>
1831 <DEFINE SBLOCK!-MIMOC (L) <DO-UBLOCK SBLOCK .L T T>>
1833 <DEFINE USBLOCK!-MIMOC (L) <DO-UBLOCK USBLOCK .L T <>>>
1835 <DEFINE DO-UBLOCK (NAM L STACK? INIT? "AUX" ATM NITMS NWRDS)
1836 #DECL ((L) LIST (NITMS NWRDS) FIX)
1838 <COND (<AND <TYPE? <SET ATM <1 .L>> FIX> <L=? .ATM *777777*>>
1839 <OCEMIT MOVEI O1* .ATM>)
1840 (<OR <TYPE? .ATM ATOM>
1841 <AND <TYPE? .ATM FORM>
1843 <==? <1 .ATM> QUOTE>
1844 <TYPE? <SET ATM <2 .ATM>> ATOM>>>
1845 <OCEMIT MOVEI O1* !<TYPE-CODE .ATM T>>)
1847 <OCEMIT MOVE O1* !<OBJ-VAL .ATM>>)>
1848 <COND (<AND <TYPE? <2 .L> FIX> <L=? <SET NITMS <2 .L>> *777777*>>
1849 <COND (<TYPE? .ATM ATOM> <SET ATM <CHTYPE <TYPE-C .ATM> FIX>>)>
1850 <SET ATM <ANDB .ATM 7>> ;"Get SAT"
1851 <COND (<==? .ATM 4> ;"BYTES"
1852 <SET NWRDS </ <+ .NITMS 3> 4>>)
1853 (<==? .ATM 5> ;"STRING"
1854 <SET NWRDS </ <+ .NITMS 4> 5>>)
1857 (ELSE <SET NWRDS <* .NITMS 2>>)>
1858 <COND (,WINNING-VICTIM
1859 <COND (<AND <NOT .STACK?> .INIT?>
1860 <SETG STACK-DEPTH <- ,STACK-DEPTH
1862 (<AND .STACK? <NOT .INIT?>>
1863 <SETG STACK-DEPTH <+ ,STACK-DEPTH
1867 <SETG STACK-DEPTH <+ ,STACK-DEPTH
1871 <OCEMIT MOVEI O2* .NITMS>)
1873 <OCEMIT MOVE O2* !<OBJ-VAL <2 .L>>>)>
1874 <PUSHJ .NAM <4 .L>>>
1876 <DEFINE RECORD!-MIMOC (L "AUX" (TYP <1 .L>) TYP1)
1877 #DECL ((L) LIST (TYP) ANY)
1880 <COND (<AND <TYPE? .TYP FORM>
1881 <G? <LENGTH .TYP> 1>
1882 <==? <1 .TYP> QUOTE>>
1883 <COND (<OR <==? <SET TYP1 <2 .TYP>> ATOM>
1886 <EXPLICIT-MAKE-RECORD .TYP1 .L>
1888 <OCEMIT MOVEI O1* !<TYPE-CODE <2 .TYP> T>>)
1889 (<AND <TYPE? .TYP FIX> <L=? .TYP *777777*>>
1890 <OCEMIT MOVEI O1* .TYP>)
1892 <OCEMIT MOVE O1* !<OBJ-VAL .TYP>>)>
1893 <REPEAT ((LL <REST .L>) (CNT 0) ITM (WV ,WINNING-VICTIM)
1894 (SD <AND .WV ,STACK-DEPTH>))
1895 #DECL ((LL) LIST (CNT SD) FIX (ITM) ANY (SD WV) <OR FALSE FIX>)
1896 <COND (<==? <SET ITM <1 .LL>> =>
1897 <OCEMIT MOVEI O2* .CNT>
1898 <SETG STACK-DEPTH .SD>
1901 <OCEMIT PUSH TP* !<OBJ-TYP .ITM>>
1902 <COND (.WV <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
1903 <OCEMIT PUSH TP* !<OBJ-VAL .ITM>>
1904 <COND (.WV <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
1905 <SET CNT <+ .CNT 1>>
1906 <SET LL <REST .LL>>)>>
1907 <PUSHJ RECORD <NTH .L <LENGTH .L>>>>>
1909 <DEFINE EXPLICIT-MAKE-RECORD (TYP L)
1910 <COND (<==? .TYP ATOM>
1911 <OCEMIT MOVEI O1* !<TYPE-CODE ATOM T>>
1912 <OCEMIT MOVEI O2* 5> ;"Length of atom in words"
1913 <OCEMIT MOVEI C1* 10> ;"LH of atom pointer"
1915 <PUT-ELEMENTS .L 0 1 '(2 3) 4 -2>)
1917 <OCEMIT MOVEI O1* !<TYPE-CODE GBIND T>>
1918 <OCEMIT MOVEI O2* 5> ;"Length of GBIND in words"
1919 <OCEMIT MOVEI C1* 10> ;"LH of GBIND pointer"
1921 <PUT-ELEMENTS .L '(0 1) 2 '(3 4)>)
1923 <OCEMIT MOVEI O1* !<TYPE-CODE LBIND T>>
1924 <OCEMIT MOVEI O2* 8> ;"Length of LBIND in words"
1925 <OCEMIT MOVEI C1* 16> ;"LH of LBIND pointer"
1927 <PUT-ELEMENTS .L '(0 1) 2 '(3 4) 5 6 7>)>>
1929 <DEFINE PUT-ELEMENTS (L "TUPLE" TUP "AUX" (VAL <NTH .L <LENGTH .L>>)
1930 (B-USED <>) (C-USED <>))
1931 #DECL ((L) LIST (TUP) <TUPLE [REST <OR FIX <LIST FIX FIX>>]>)
1933 <FUNCTION (ITM OFFS "AUX" ACS)
1934 <COND (<TYPE? .ITM ATOM>
1935 <COND (<AND <NOT <OR <==? .ITM .VAL> <WILL-DIE? .ITM>>>
1936 <OR <AND <NOT .B-USED> <SET B-USED T>>
1937 <AND <NOT .C-USED> <SET C-USED T>>>>
1939 <LOAD-AC .ITM BOTH <> <>
1940 <GET-AC <SET ACS C1*>>
1943 <LOAD-AC .ITM BOTH <> <>
1944 <GET-AC <SET ACS B1*>>
1946 <COND (<TYPE? .OFFS FIX>
1948 <OCEMIT HRLM <NEXT-AC .ACS>
1953 <OCEMIT HRROS <- .OFFS> '(A2*)>)
1955 <OCEMIT MOVEM <NEXT-AC .ACS>
1959 <OCEMIT SETZM .OFFS '(A2*)>)>)
1961 <OCEMIT DMOVEM .ACS <1 .OFFS>
1964 <OCEMIT DMOVE O1* !<OBJ-TYP .ITM>>
1966 <OCEMIT HRLM O2* <- .OFFS> '(A2*)>
1969 <OCEMIT HRROS <- .OFFS> '(A2*)>)
1971 <OCEMIT MOVEM O2* .OFFS '(A2*)>
1974 <OCEMIT SETZM .OFFS '(A2*)>)>)
1976 <OCEMIT DMOVE O1* !<OBJ-TYP .ITM>>
1977 <OCEMIT DMOVEM O1* <1 .OFFS> '(A2*)>)>)
1981 <OCEMIT HRROS <- .OFFS> '(A2*)>)
1983 <OCEMIT SETZM .OFFS '(A2*)>)>)
1985 <GET-INTO-ACS .ITM VALUE O*>
1987 <OCEMIT HRLM O* <- .OFFS> '(A2*)>)
1989 <OCEMIT MOVEM O* .OFFS '(A2*)>)>)>)
1991 <OCEMIT DMOVE O1* !<OBJ-TYP .ITM>>
1992 <OCEMIT DMOVEM O1* <1 .OFFS> '(A2*)>)>>
1996 <DEFINE NTH-PUT-LOOK-AHEAD (OL INS STRUC AMT VAL
1997 "AUX" (AC <>) (L <REST .MIML>) NXT INS-A (DEAD? <>)
1998 THE-TY ITM FOO INSC NXT2 LBL)
1999 #DECL ((INS) STRING (L MIML OL) LIST)
2000 <COND (<AND <G=? <LENGTH .L> 4>
2001 <TYPE? <SET NXT <1 .L>> FORM>
2002 <G=? <LENGTH .NXT> 5>
2003 <OR <=? <SET INS-A <SPNAME <1 .NXT>>> "ADD"> <=? .INS-A "SUB">>
2007 <TYPE? <SET NXT <2 .L>> FORM>
2008 <G=? <LENGTH .NXT> 4>
2009 <=? <SPNAME <1 .NXT>> .INS>
2010 <==? <2 .NXT> .STRUC>
2012 <==? <4 .NXT> .VAL>>
2014 <COND (<AND <TYPE? <SET NXT <3 .L>> FORM>
2015 <G=? <LENGTH .NXT> 2>
2016 <=? <SPNAME <1 .NXT>> "DEAD">
2017 <MEMQ .VAL <REST .NXT>>>
2019 <COND (<=? .INS "PUTL">
2021 <COND (<=? .INS-A "ADD"> AOS) (ELSE SOS)>
2026 <COND (<=? .INS-A "ADD"> AOS) (ELSE SOS)>
2029 (<AND <G=? <LENGTH .L> 4>
2030 <TYPE? <SET NXT <1 .L>> FORM>
2031 <G=? <LENGTH .NXT> 4>
2032 <OR <AND <==? <LENGTH <SET INS-A <SPNAME <1 .NXT>>>> 5>
2033 <MEMBER "LENU" .INS-A>
2035 <OR <==? <4 .NXT> .VAL> <WILL-DIE? .VAL .L>>
2036 <COND (<AND <TYPE? <SET FOO <2 .L>> FORM>
2037 <G=? <LENGTH .FOO> 5>
2038 <MEMQ <LOOKUP <SPNAME <1 .FOO>>
2041 <MEMQ <4 .NXT> <REST .FOO>>
2042 <WILL-DIE? <4 .NXT> <REST .L>>
2043 ;"Check for death at branch"
2047 ,<MAPR <> ;"Find label"
2048 <FUNCTION (FOOL:LIST "AUX" X)
2050 (<OR <==? <SET X <1 .FOOL>> +>
2052 <MAPLEAVE <2 .FOOL>>)
2053 (<EMPTY? <REST .FOOL>>
2054 <ERROR HUH?!-ERRORS>)>>
2057 <COND (<=? .INS "PUTL">
2058 <NTHL!-MIMOC .OL HRRZ <>>
2059 <SETG NEXT-FLUSH 1>)
2061 <NTHUV!-MIMOC .OL <> HRRZ <>>
2062 <SETG NEXT-FLUSH 1>)>
2063 <AC-ITEM <AC-CODE <GET-AC O*> VALUE> <4 .NXT>>)
2065 <COND (<=? .INS "PUTL">
2066 <NTHL!-MIMOC .OL HRRZ T <4 .NXT>>
2067 <SETG NEXT-FLUSH 1>)
2069 <NTHUV!-MIMOC .OL <> HRRZ T <4 .NXT>>
2070 <SETG NEXT-FLUSH 1>)>)>>
2071 <AND <==? <LENGTH .INS-A> 6>
2072 <MEMBER "EMPU" .INS-A>
2075 <OR <==? <4 .NXT> COMPERR>
2076 <AND <SET FOO <MEMQ <4 .NXT> <REST .L>>>
2077 <WILL-DIE? .VAL .FOO>>>
2079 <COND (<=? .INS "PUTL">
2080 <NTHL!-MIMOC .OL HRRZ <>>
2081 <SETG NEXT-FLUSH 1>)
2083 <NTHUV!-MIMOC .OL <> HRRZ <>>
2084 <SETG NEXT-FLUSH 1>)>
2085 <LABEL-UPDATE-ACS <4 .NXT> <>>
2086 <OCEMIT <COND (<==? <3 .NXT> +> JUMPE)
2092 (<AND <G=? <LENGTH .L> 4>
2093 <TYPE? <SET NXT <1 .L>> FORM>
2094 <G=? <LENGTH .NXT> 5>
2095 <OR <=? <SET INS-A <SPNAME <1 .NXT>>> "VEQUAL?">
2096 <=? .INS-A "EQUAL?">>
2097 <OR <==? <2 .NXT> .VAL>
2098 <AND <==? <3 .NXT> .VAL>
2099 <SET NXT <FORM <1 .NXT> .VAL <2 .NXT> !<REST .NXT 3>>>>>
2100 <PROG () <SET ITM <3 .NXT>> <SET DIR <4 .NXT>> T>
2101 <OR <AND <COND (<=? .INS-A "VEQUAL?">
2102 <SET AC <IN-AC? .ITM VALUE>>)
2104 <SET AC <IN-AC? .ITM BOTH>>)>>
2105 <AND <=? .INS-A "VEQUAL?">
2106 <OR <AND <==? <PRIMTYPE .ITM> FIX>
2107 <==? <CHTYPE .ITM FIX> 0>>
2108 <AND <==? <PRIMTYPE .ITM> LIST>
2109 <EMPTY? <CHTYPE .ITM LIST>>>>>>
2111 <WILL-DIE? .VAL <LAB-CODE-PNTR <FIND-LABEL <5 .NXT>>>>>
2112 <COND (<=? .INS "PUTL">
2113 <NTHL!-MIMOC .OL .NXT <>>
2114 <SETG NEXT-FLUSH 1>)
2116 <NTHUV!-MIMOC .OL <=? .INS "PUTUU"> .NXT <>>
2117 <SETG NEXT-FLUSH 1>)>
2119 (<AND <G=? <LENGTH .L> 4>
2120 <TYPE? <SET NXT <1 .L>> FORM>
2121 <G=? <LENGTH .NXT> 5>
2122 <=? <SPNAME <1 .NXT>> "TYPE?">
2124 <TYPE? <SET THE-TY <3 .NXT>> FIX>
2127 <TYPE? <SET NXT <2 .L>> FORM>
2128 <G=? <LENGTH .NXT> 5>
2129 <=? <SPNAME <1 .NXT>> "VEQUAL?">
2130 <OR <==? <2 .NXT> .VAL>
2131 <AND <==? <3 .NXT> .VAL>
2132 <SET NXT <FORM <1 .NXT> .VAL <2 .NXT> !<REST .NXT 3>>>>>
2133 <PROG () <SET ITM <3 .NXT>> <==? <4 .NXT> +>>
2134 <OR <AND <TYPE? .ITM ATOM>
2136 <WILL-DIE? .VAL <REST .L>>
2137 <WILL-DIE? .VAL <LAB-CODE-PNTR <FIND-LABEL <5 .NXT>>>>>
2138 <AND <OR <AND <==? <PRIMTYPE .ITM> FIX>
2139 <==? <CHTYPE .ITM FIX> 0>>
2140 <AND <==? <PRIMTYPE .ITM> LIST>
2141 <EMPTY? <CHTYPE .ITM LIST>>>>>>
2142 <OR <==? <3 .L> .LBL>
2143 <AND <TYPE? <3 .L> FORM>
2144 <=? <SPNAME <1 <3 .L>>> "DEAD">
2145 <==? <4 .L> .LBL>>>>
2147 <SET NXT <CHTYPE (TYPE? .THE-TY !.NXT) FORM>>
2148 <COND (<=? .INS "PUTL">
2149 <NTHL!-MIMOC .OL .NXT <>>)
2151 <NTHUV!-MIMOC .OL <=? .INS "PUTUU"> .NXT <>>)>
2154 <DEFINE STRING-PUT-NTH-LOOK-AHEAD (STR PUT-OR-NTH VAL BYTES? AMT
2155 "AUX" (STACK-OK? T) (L <REST .MIML>))
2156 #DECL ((STR PUT-OR-NTH) ATOM (L MIML) LIST (AMT) FIX)
2158 <FUNCTION (LL "AUX" (INS <1 .LL>) NM X)
2159 #DECL ((INS) <OR ATOM <FORM ANY>> (NM) STRING)
2160 <COND (<TYPE? .INS ATOM> <MAPLEAVE <>>)>
2161 <COND (<OR <=? <SET NM <SPNAME <1 .INS>>> "CALL">
2168 <SET STACK-OK? <>>)>
2169 <COND (<AND <OR <AND <=? <SET NM <SPNAME <1 .INS>>> "RESTUS">
2171 <AND .BYTES? <=? .NM "RESTUB">>>
2175 <COND (<AND <NOT .STACK-OK?>
2178 <RESTUS!-MIMOC <REST .INS> .BYTES? .VAL .PUT-OR-NTH
2179 <WILL-DIE? .STR .LL>>
2180 <PUTPROP <REST .INS> DONE T>
2182 (<AND <=? .NM <OR <AND <==? .PUT-OR-NTH PUT>
2183 <OR <AND .BYTES? "PUTUB">
2185 <AND .BYTES? "NTHUB">
2188 <==? <3 .INS> <+ .AMT 1>>>
2189 <COND (<AND <NOT .STACK-OK?>
2192 <SETG REMEMBER-STRING T>
2193 <COND (<WILL-DIE? .STR .LL>
2194 <SETG DIE-LATER T>)>
2196 (<OR <MEMQ .STR .INS>
2199 <AND <TYPE? <SET X <NTH .INS <LENGTH .INS>>> LIST>
2200 <OR <MEMQ + .X> <MEMQ - .X>>>>
2203 <SET STACK-OK? <>>)>>
2206 <DEFINE STRING-REST-LOOK-AHEAD (RINS STR VAL BYTES?
2207 "AUX" (L <REST .MIML>) (PUT? <>))
2208 #DECL ((STR) ATOM (L MIML) LIST)
2210 <FUNCTION (LL "AUX" (INS <1 .LL>) NM X DST)
2211 #DECL ((INS) <OR ATOM <FORM ANY>> (NM) STRING)
2212 <COND (<TYPE? .INS ATOM> <MAPLEAVE <>>)>
2213 <COND (<AND <OR <=? <SET NM <SPNAME <1 .INS>>> "NTHUS">
2214 <AND <=? .NM "PUTUS"> <SET PUT? T>>>
2218 <SET DST <COND (.PUT? <4 .INS>)
2221 <FUNCTION (I) #DECL ((I) FORM)
2222 <COND (<==? .I .INS>
2224 <COND (<MEMQ .DST <REST .I>>
2227 <RESTUS!-MIMOC .RINS
2230 <COND (<=? .NM "PUTUS"> PUT) (NTH)>
2231 <WILL-DIE? .STR .LL>>
2232 <PUTPROP <REST .INS> DONE T>
2234 (<OR <MEMQ .STR .INS>
2237 <AND <TYPE? <SET X <NTH .INS <LENGTH .INS>>> LIST>
2238 <OR <MEMQ + .X> <MEMQ - .X>>>>