2 <DEFINE INIT-VAR-LIST () <SETG VAR-LIST ()>>
4 <DEFINE CREATE-VAR (NAME TEMP "OPTIONAL" (HACK? <>) "AUX" VAR CMOD)
5 #DECL ((NAME) <OR ATOM VARTBL> (TEMP) BOOLEAN)
6 <COND (<TYPE? .NAME ATOM>
8 <CHTYPE <VECTOR .NAME <> <> <> <> .TEMP <> <>> VARTBL>>)
11 <AND <GASSIGNED? CURRENT-MODEL>
12 <SET CMOD ,CURRENT-MODEL>
13 <PUT .CMOD ,SM-VARS (.VAR !<SM-VARS .CMOD>)>>
14 <COND (<NOT .TEMP> <GEN-LOC .VAR 0>)>)>
15 <COND (<TYPE? .NAME ATOM> <SETG VAR-LIST (.VAR !,VAR-LIST)>)>
18 <DEFINE FIND-VAR (NAME "AUX" (VAR? <>))
19 #DECL ((NAME) ATOM (VALUE) <OR VARTBL FALSE>)
22 <COND (<==? <VARTBL-NAME .VAR> .NAME>
28 <DEFINE INDICATE-VAR-DECL (VAR DCL)
29 #DECL ((VAR) VARTBL (DCL) <OR ATOM FALSE>)
30 <PUT .VAR ,VARTBL-RDECL .DCL>>
32 <DEFINE INDICATE-VAR-INIT (VAR VAL)
33 #DECL ((VAR) VARTBL (VAL) ANY)
34 <COND (<TYPE? .VAL FALSE> <SET VAL <CHTYPE .VAL SPEC-FALSE>>)>
35 <PUT .VAR ,VARTBL-INIT .VAL>
38 <DEFINE INDICATE-VAR-TEMP-DECL (VAR DCL)
39 #DECL ((VAR) VARTBL (DCL) <OR FALSE ATOM>)
40 <PUT .VAR ,VARTBL-TDECL .DCL>>
42 <DEFINE FLUSH-VAR-TEMP-DECLS ()
43 <MAPF <> <FCN (VAR) <INDICATE-VAR-TEMP-DECL .VAR <>>> ,VAR-LIST>>
45 <DEFINE VARTBL-DECL (VAR "AUX" (LVAR <FIND-CACHE-VAR .VAR>))
47 <OR <VARTBL-RDECL .VAR>
49 <AND .LVAR <LINKVAR-DECL .LVAR>>>>
51 <DEFINE ADDR-VAR-VALUE (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 4>>
53 <DEFINE ADDR-VAR-CHAR-VALUE (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 4>>
55 <DEFINE ADDR-VAR-COUNT (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 2>>
57 <DEFINE ADDR-VAR-TYPE (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 0>>
59 <DEFINE ADDR-VAR-TYPE-VALUE (VAR) #DECL ((VAR) VARTBL) <GEN-LOC .VAR 0>>
61 <DEFINE CREATE-MODEL () <CHTYPE <VECTOR 0 () () <> 0 ()> STK-MODEL>>
63 <DEFINE INIT-STACK-MODEL ("AUX" MOD)
64 <SET MOD <CREATE-MODEL>>
65 <SETG CURRENT-MODEL .MOD>
67 <SETG STACK-LEVELS (.MOD)>>
69 <DEFINE INDICATE-TEMP-PATCH (NUM)
71 <PUT ,CURRENT-MODEL ,SM-PATCHLOC .NUM>>
73 <DEFINE NEW-MODEL (MODEL)
74 #DECL ((MODEL) STK-MODEL)
75 <PUT ,CURRENT-MODEL ,SM-KIDS (.MODEL !<SM-KIDS ,CURRENT-MODEL>)>
76 <PUT .MODEL ,SM-PARENT ,CURRENT-MODEL>
77 <SETG CURRENT-MODEL .MODEL>>
80 <COND (<NOT <SM-PARENT ,CURRENT-MODEL>>
81 <ERROR "TOPLEVEL MODEL" POP-MODEL>)>
82 <SETG CURRENT-MODEL <SM-PARENT ,CURRENT-MODEL>>>
84 <DEFINE GEN-LOC (VAR IOFF "OPT" (DEF? <>)
85 "AUX" (OFF <VARTBL-LOC .VAR>) (CMOD ,CURRENT-MODEL) VARS)
86 #DECL ((VAR) VARTBL (IOFF) FIX)
88 <COND (<MEMQ .VAR <SM-VARS .CMOD>> <RETURN>)
89 (<SET CMOD <SM-PARENT .CMOD>>)
90 (<ERROR "VARIABLE NOT FOUND" GEN-LOC>)>>
92 <SET OFF <SM-SAVED-VAR-POINTER .CMOD>>
93 <PUT .CMOD ,SM-SAVED-VAR-POINTER <+ .OFF 8>>
94 <PUT .VAR ,VARTBL-LOC .OFF>
95 <COND (<EMPTY? <SET VARS <SM-VARLIST .CMOD>>>
96 <PUT .CMOD ,SM-VARLIST (.VAR)>)
97 (<PUTREST <REST .VARS <- <LENGTH .VARS> 1>> (.VAR)>)>)>
98 <SET OFF <+ .OFF .IOFF>>
99 <COND (.DEF? <MA-DEF-DISP ,AC-F .OFF>)
100 (<0? .OFF> <MA-REGD ,AC-F>)
101 (T <MA-DISP ,AC-F .OFF>)>>
103 <DEFINE EMIT-STORE-AC (AC DEST "OPTIONAL" (MODE LONG))
104 #DECL ((AC) AC (DEST) EFF-ADDR (MODE) ATOM)
105 <COND (<AND <NOT <AC-USE .AC>>
107 <NOT <==? .MODE BYTE>>
109 <NOT <G=? <LENGTH <AC-VARS .AC>> 2>>>
110 <RE-EMIT-MOVE <AC-LLOAD .AC> <AC-LLOAD-EA .AC> .DEST .MODE>
111 <CLEAR-VARS-FROM-AC .AC>)
112 (ELSE <USE-AC .AC> <EMIT-MOVE <MA-REG .AC> .DEST .MODE>)>>
114 <DEFINE EMIT-STORE-PAIR-AC (AC AC2 DEST "OPT" (MODE LONG))
115 #DECL ((AC AC2) AC (DEST) EFF-ADDR (MODE) ATOM)
116 <COND (<AND <NOT <AC-USE .AC>>
118 <NOT <==? .MODE BYTE>>
120 <NOT <G=? <LENGTH <AC-VARS .AC>> 2>>>
121 <RE-EMIT-MOVE <AC-LLOAD .AC> <AC-LLOAD-EA .AC> .DEST DOUBLE>
122 <CLEAR-VARS-FROM-AC .AC>)
126 <EMIT-MOVE <MA-REG .AC> .DEST DOUBLE>)>>
128 <DEFINE ISTORE-VAR (LVAR
129 "OPTIONAL" (XREF <>) (WILL-DIE-LIES? <>)
130 "AUX" DADDR (VAR <LINKVAR-VAR .LVAR>) VAC TAC (STOREV <>)
131 (STORET <>) (STOREC <>) SVEC KIND)
132 #DECL ((LVAR) LINKVAR (XREF) <OR FALSE XREF-INFO> (SVEC) CODEVEC)
133 <COND (<OR <VARTBL-DEAD? .VAR>
134 <AND <LINKVAR-VALUE-STORED .LVAR>
135 <LINKVAR-TYPE-STORED .LVAR>
136 <LINKVAR-COUNT-STORED .LVAR>>
137 <AND <NOT .WILL-DIE-LIES?> <WILL-DIE? .VAR>>>)
140 <COND (<AND <NOT <LINKVAR-VALUE-STORED .LVAR>>
141 <OR <NOT <LINKVAR-COUNT-STORED .LVAR>>
142 <NOT <LINKVAR-TYPE-STORED .LVAR>>>
143 <==? <LINKVAR-TYPE-WORD-AC .LVAR>
144 <SET VAC <PREV-AC <LINKVAR-VALUE-AC .LVAR>>>>
146 <SET DADDR <ADDR-VAR-TYPE-VALUE .VAR>>
147 <EMIT-STORE-PAIR-AC .VAC <LINKVAR-VALUE-AC .LVAR> .DADDR>
148 <SET STOREV <SET STORET <SET STOREC T>>>
149 <PUT .LVAR ,LINKVAR-VALUE-STORED T>
150 <PUT .LVAR ,LINKVAR-TYPE-STORED T>
151 <PUT .LVAR ,LINKVAR-COUNT-STORED T>)
152 (<NOT <LINKVAR-VALUE-STORED .LVAR>>
153 <COND (<NOT <SET VAC <LINKVAR-VALUE-AC .LVAR>>>
154 <ERROR "VARIABLE NOT IN AC" ISTORE-VAR>)>
155 <SET DADDR <ADDR-VAR-VALUE .VAR>>
156 <EMIT-STORE-AC .VAC .DADDR LONG>
158 <PUT .LVAR ,LINKVAR-VALUE-STORED T>)>
159 <SET STORET <SCHECK-TYPE-STORED .LVAR>>
160 <COND (<NOT <LINKVAR-COUNT-STORED .LVAR>>
161 <PUT .LVAR ,LINKVAR-COUNT-STORED T>
163 <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
164 <SET DADDR <ADDR-VAR-TYPE .VAR>>
165 <EMIT-STORE-AC .TAC .DADDR LONG>)
166 (<SET TAC <LINKVAR-COUNT-AC .LVAR>>
167 <SET DADDR <ADDR-VAR-COUNT .VAR>>
168 <EMIT-STORE-AC .TAC .DADDR WORD>)>)>
169 <COND (<NOT <EMPTY? <SET SVEC <END-CODE-INSERT>>>>
170 <SET KIND <COMPUTE-KIND .STOREV .STORET .STOREC>>
171 <EMIT-POTENTIAL-STORE .SVEC .KIND .LVAR>
172 <AND .XREF <KILL-STORES .XREF .KIND .VAR>>)>)>>
174 <DEFINE COMPUTE-KIND (STOREV STORET STOREC)
175 #DECL ((STOREV STOREC) BOOLEAN (STORET) <OR FALSE ATOM>)
176 <COND (<==? .STORET TYPE>
177 <COND (<AND .STOREV .STOREC> COUNT-VALUE)
181 (<==? .STORET TYPE-COUNT>
182 <COND (.STOREV TYPE-COUNT-VALUE) (TYPE-COUNT)>)
184 <COND (<AND .STOREV .STOREC> COUNT-VALUE)
188 <DEFINE SCHECK-TYPE-STORED (LVAR
189 "AUX" DADDR TAC (KIND TYPE) DCL
190 (VAR <LINKVAR-VAR .LVAR>))
191 #DECL ((LVAR) LINKVAR)
192 <COND (<NOT <LINKVAR-TYPE-STORED .LVAR>>
194 (<AND <SET DCL <VARTBL-RDECL <LINKVAR-VAR .LVAR>>>
195 <OR <MEMQ .DCL ,TYPE-LENGTHS>
196 <NOT <COUNT-NEEDED? .DCL>>>>
197 <LINKVAR-COUNT-STORED .LVAR T>)
199 <SET DADDR <ADDR-VAR-TYPE .VAR>>
200 <PUT .LVAR ,LINKVAR-TYPE-STORED T>
201 <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
202 <EMIT-STORE-AC .TAC .DADDR LONG>
203 <PUT .LVAR ,LINKVAR-COUNT-STORED T>
204 <SET KIND TYPE-COUNT>)
205 (<SET TAC <LINKVAR-TYPE-AC .LVAR>>
206 <EMIT-STORE-AC .TAC .DADDR WORD>)
207 (<SET DCL <LINKVAR-DECL .LVAR>> <STORE-TYPE .DCL .DADDR>)
208 (<ERROR "VARIABLE NOT IN AC" ISTORE-ADDR>)>)>)>
211 <DEFINE STORE-TYPE (DCL ADDR "OPT" (EXTRA <>))
212 #DECL ((DCL) ATOM (ADDR) EFF-ADDR)
213 <COND (<MEMQ .DCL ,TYPE-LENGTHS>
214 <EMIT-MOVE <TYPE-WORD .DCL> .ADDR LONG .EXTRA>)
215 (<AND <NOT <COUNT-NEEDED? .DCL>>
216 <NOT <MEMQ <TYPEPRIM .DCL> ,TYPE-LENGTHS>>>
217 <EMIT-MOVE <TYPE-CODE .DCL WORD> .ADDR LONG .EXTRA>)
218 (ELSE <EMIT-MOVE <TYPE-CODE .DCL WORD> .ADDR WORD>)>>
220 <DEFINE LOAD-AC-PAIR (VAR RES "OPTIONAL" (AC <GET-AC DOUBLE <>>)
222 <COND (<NOT <TYPE? .VAR VARTBL>>
224 <STORE-AC <NEXT-AC .AC> T>
225 <COND (<NOT <MEMQ <PRIMTYPE .VAR> '[WORD FIX]>>
226 <EMIT ,INST-MOVQ <ADDR-TYPE-M <ADD-MVEC .VAR>>
229 <MOVE-VALUE .VAR <NEXT-AC .AC>>
230 <EMIT-MOVE <TYPE-WORD <TYPE .VAR>> <MA-REG .AC> LONG>
231 <LOAD-AC .AC <TYPE-WORD <TYPE .VAR>>>)>)
232 (<NOT <SET LVAR <FIND-CACHE-VAR .VAR>>>
234 <STORE-AC <NEXT-AC .AC> T>
235 <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .AC T>)
236 (<AND <SET VAC <LINKVAR-VALUE-AC .LVAR>>
237 <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
238 <==? <NEXT-AC .TAC> .VAC>>
239 <COND (<==? .TAC .AC>
241 <MUNG-AC <NEXT-AC .AC>>)
243 <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .AC T <> .TAC>)>)
245 <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
246 <COND (<OR <AND <NOT .VAC> <NOT .TAC>>
247 <AND <LINKVAR-VALUE-STORED .LVAR>
248 <LINKVAR-TYPE-STORED .LVAR>
249 <LINKVAR-COUNT-STORED .LVAR>>>
250 <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .AC T <> <>>)
252 <LOAD-VAR .VAR JUST-VALUE T <NEXT-AC .AC>>
253 <LOAD-VAR .VAR TYPE-WORD T .AC>)>)>
255 <DEST-PAIR <NEXT-AC .AC> .AC .RES>)>
258 <DEFINE LOAD-VAR (VAR IMODE MODIFY? AC-TYPE
259 "OPTIONAL" (DCL? <>) (USE? T)
260 "AUX" LVAR NOAC? TAC VAC TAC1 TAC2 (MODE .IMODE))
261 #DECL ((VAR) VARTBL (MODE) ATOM (MODIFY?) BOOLEAN (AC-TYPE) AC-CHOICES
262 (DCL?) <OR ATOM FALSE> (USE?) BOOLEAN)
263 <COND (<==? .IMODE JUST-VALUE> <SET MODE VALUE>)>
264 <OR .DCL? <SET DCL? <VARTBL-DECL .VAR>>>
266 (<NOT <SET LVAR <FIND-CACHE-VAR .VAR>>> <SET NOAC? <>>)
268 <COND (<AND <N==? .IMODE JUST-VALUE>
269 <SET VAC <LINKVAR-VALUE-AC .LVAR>>
270 <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
271 <==? <NEXT-AC .TAC> .VAC>
272 <N==? .AC-TYPE ,AC-0>>
273 <COND (<AND <TYPE? .AC-TYPE AC> <N==? .AC-TYPE .VAC>>
274 <COND (<TYPE? .AC-TYPE AC>
275 <SET TAC1 <PREV-AC .AC-TYPE>>)
276 (<SET TAC1 <GET-AC DOUBLE T>>)>
277 <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .TAC1 .MODIFY?
279 <SET NOAC? .AC-TYPE>)
282 <COND (.MODIFY? <MUNG-AC .VAC> <MUNG-AC .TAC>)>)>)
283 (<SET VAC <LINKVAR-VALUE-AC .LVAR>>
285 <MOVE-VAR-BETWEEN-ACS .VAC .VAR .AC-TYPE .MODIFY?>>)
286 (ELSE <SET NOAC? <>>)>)
288 <COND (<SET TAC <LINKVAR-TYPE-AC .LVAR>>
290 <MOVE-VAR-BETWEEN-ACS .TAC .VAR .AC-TYPE .MODIFY?>>)
291 (<AND <NOT <LINKVAR-TYPE-STORED .LVAR>>
292 <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
293 <NOT <VARTBL-DECL .VAR>>>
295 <MOVE-TYPE-FROM-TYPEWORD .VAR .TAC .AC-TYPE .MODIFY?>>)
296 (ELSE <SET NOAC? <>>)>)
298 <COND (<LINKVAR-COUNT-STORED .LVAR> <SET NOAC? <>>)
299 (<SET TAC <LINKVAR-COUNT-AC .LVAR>>
301 <MOVE-VAR-BETWEEN-ACS .TAC .VAR .AC-TYPE .MODIFY?>>)
302 (<SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
304 <MOVE-COUNT-FROM-TYPEWORD .VAR .TAC .AC-TYPE .MODIFY?>>)
305 (ELSE <SET NOAC? <>>)>)
306 (<==? .MODE TYPE-WORD>
307 <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>
309 <MOVE-VAR-BETWEEN-ACS .TAC .VAR .AC-TYPE .MODIFY?>>)
310 (<NOT <SAFE-TYPE-WORD? .VAR>>
311 <COND (<AND <SET TAC1 <LINKVAR-COUNT-AC .LVAR>>
312 <NOT <LINKVAR-COUNT-STORED .LVAR>>>
313 <EMIT-MOVE <MA-REG .TAC1> <ADDR-VAR-COUNT .VAR> WORD>
314 <PUT .LVAR ,LINKVAR-COUNT-STORED T>
315 <BREAK-LINK .TAC1 .VAR>)>
316 <COND (<AND <SET TAC2 <LINKVAR-TYPE-AC .LVAR>>
317 <NOT <LINKVAR-TYPE-STORED .LVAR>>>
318 <EMIT-MOVE <MA-REG .TAC2> <ADDR-VAR-TYPE .VAR> WORD>
319 <PUT .LVAR ,LINKVAR-TYPE-STORED T>
320 <BREAK-LINK .TAC2 .VAR>)>
321 <COND (<AND <NOT <SAFE-TYPE-WORD? .VAR>>
322 <SET DCL? <LINKVAR-DECL .LVAR>>>
323 <EMIT-MOVE <TYPE-CODE .DCL? WORD>
326 <PUT .LVAR ,LINKVAR-TYPE-STORED T>)>
328 (ELSE <SET NOAC? <>>)>)
329 (<ERROR "BAD-MODE" LOAD-VAR>)>
330 <COND (<AND <NOT .NOAC?>
333 <AND <NOT <LINKVAR-TYPE-AC .LVAR>>
334 <NOT <LINKVAR-TYPE-WORD-AC .LVAR>>
335 <NOT <LINKVAR-COUNT-AC .LVAR>>>>
336 <N==? .AC-TYPE ,AC-0>
337 <COND (<TYPE? .AC-TYPE AC>
338 <SET TAC <GET-AC <PREV-AC .AC-TYPE>>>
340 (ELSE <SET TAC <GET-AC DOUBLE>>)>>
341 <LOAD-VAR-INTO-AC .VAR TYPE-VALUE-PAIR .TAC .MODIFY? <>>
342 <AND .DCL? <INDICATE-CACHED-VARIABLE-DECL .VAR .DCL?>>
343 <SET TAC <NEXT-AC .TAC>>
344 <AND .USE? <USE-AC .TAC>>
347 <SET TAC <GET-AC .AC-TYPE>>
348 <LOAD-VAR-INTO-AC .VAR .MODE .TAC .MODIFY?>
350 <AND .DCL? <INDICATE-CACHED-VARIABLE-DECL .VAR .DCL?>>
351 <AND .USE? <USE-AC .TAC>>
354 <AND .DCL? <INDICATE-CACHED-VARIABLE-DECL .VAR .DCL?>>
355 <AND .USE? <USE-AC .NOAC?>>
358 <DEFINE MOVE-VAR-BETWEEN-ACS (VAC VAR AC-MODE MODIFY? "AUX" FAC)
359 #DECL ((VAC) AC (AC-MODE) AC-CHOICES (MODIFY?) BOOLEAN)
361 <COND (<MATCH-AC? .VAC .AC-MODE>
363 <COND (<AVAILABLE? .VAC> <CLEAR-VARS-FROM-AC .VAC> .VAC)
364 (<SET FAC <CHECK-FREE-AC? .AC-MODE>>
365 <IMOVE-AC .VAC .FAC <>>
367 (ELSE <STORE-AC .VAC T> .VAC)>)
371 <SET FAC <GET-AC .AC-MODE>>
372 <IMOVE-AC .VAC .FAC T>
374 (ELSE <PLACE-ALTERNATE-AC .VAC .AC-MODE>)>)>>
376 <DEFINE CHECK-FREE-AC? (MODE)
377 #DECL ((MODE) AC-CHOICES)
378 <COND (<TYPE? .MODE AC> <AND <AVAILABLE? .MODE> .MODE>)
380 <OR <FIND-FREE-PAIR NOVARS> <FIND-FREE-PAIR STORED>>)
381 (ELSE <OR <FREE-AC? .MODE NOVARS> <FREE-AC? .MODE STORED>>)>>
383 <DEFINE AVAILABLE? (AC)
387 <COND (<NOT <VARTBL-DEAD? <LINKVAR-VAR .LVAR>>>
388 <COND (<AND <==? .AC <LINKVAR-VALUE-AC .LVAR>>
389 <NOT <LINKVAR-VALUE-STORED .LVAR>>>
391 (<AND <==? .AC <LINKVAR-TYPE-AC .LVAR>>
392 <NOT <LINKVAR-TYPE-STORED .LVAR>>>
394 (<AND <==? .AC <LINKVAR-COUNT-AC .LVAR>>
395 <NOT <LINKVAR-COUNT-STORED .LVAR>>>
397 (<AND <==? .AC <LINKVAR-TYPE-WORD-AC .LVAR>>
398 <NOT <LINKVAR-TYPE-STORED .LVAR>>>
403 <DEFINE GET-AC ("OPT" (AC-MODE ANY-AC) (MUNG? <>) "AUX" PAC)
404 #DECL ((AC-MODE) AC-CHOICES)
405 <COND (<==? .AC-MODE ANY-AC> <SET AC-MODE NONE>)>
406 <COND (<TYPE? .AC-MODE AC> <STORE-AC .AC-MODE> <SET PAC .AC-MODE>)
407 (<SET PAC <CHECK-FREE-AC? .AC-MODE>>)
408 (<SET PAC <PICK-BEST-AC .AC-MODE>>
410 <COND (<==? .AC-MODE DOUBLE> <STORE-AC <NEXT-AC .PAC>>)>
412 (<ERROR "CANT GET AC" GET-AC>)>
415 <COND (<==? .AC-MODE DOUBLE> <MUNG-AC <NEXT-AC .PAC>>)>)>
418 <DEFINE PICK-BEST-AC (MODE)
419 #DECL ((MODE) ATOM (VALUE) AC)
420 <PICK-FROM ,ALL-ACS .MODE>>
422 <DEFINE PICK-FROM (ACS MODE "AUX" (BEST-AC <>) BEST-AC2)
423 #DECL ((ACS) <VECTOR [REST AC]>)
425 <COND (<OR <EMPTY? .ACS>
426 <AND <EMPTY? <REST .ACS>>
430 <COND (<==? .MODE DOUBLE> <SET AC2 <2 .ACS>>)>
431 <SET ACS <REST .ACS <COND (<==? .MODE DOUBLE> 2) (ELSE 1)>>>
433 <COND (<OR <AC-PROT .AC>
434 <AND <==? .MODE DOUBLE>
437 <COND (<NOT .BEST-AC>
439 <COND (<==? .MODE DOUBLE> <SET BEST-AC2 .AC2>)>
441 <COND (<AND <L? <LENGTH <AC-VARS .AC>>
442 <LENGTH <AC-VARS .BEST-AC>>>
443 <OR <N==? .MODE DOUBLE>
444 <L? <LENGTH <AC-VARS .AC2>>
445 <LENGTH <AC-VARS .BEST-AC2>>>>>
447 <COND (<==? .MODE DOUBLE> <SET BEST-AC2 .AC2>)>
449 <COND (<AND <G? <AC-AGE .AC> <AC-AGE .BEST-AC>>
450 <OR <N==? .MODE DOUBLE>
451 <G? <AC-AGE .AC2> <AC-AGE .BEST-AC2>>>>
453 <SET BEST-AC2 .AC2>)>>>
454 <COND (<NOT .BEST-AC> <ERROR "AC NOT FOUND" PICK-FROM>)>
457 <DEFINE IMOVE-AC (SOURCE-AC DEST-AC MODIFY?)
458 #DECL ((SOURCE-AC DEST-AC) AC)
460 <STORE-AC .DEST-AC T>
461 <EMIT-MOVE <MA-REG .SOURCE-AC> <MA-REG .DEST-AC> LONG>
462 <LOAD-AC .DEST-AC <MA-REG .SOURCE-AC>>
463 <OR .MODIFY? <MOVE-AC .SOURCE-AC .DEST-AC>>
464 <SET-STATUS-AC .DEST-AC>
465 <SET-AC-AGE .DEST-AC>>
467 <DEFINE STORE-AC (AC "OPTIONAL" (FLUSH <>) (SAVE? <>))
468 #DECL ((AC) AC (FLUSH) BOOLEAN (SAVE?) <OR LINKVAR FALSE>)
471 <COND (<N==? .X .SAVE?>
475 <CLEAR-VARS-FROM-AC .AC .SAVE? T>)>>
477 <DEFINE PLACE-ALTERNATE-AC (AC MODE "AUX" FAC)
478 #DECL ((MODE) AC-CHOICES (AC) AC)
479 <SET FAC <GET-AC .MODE>>
480 <COND (<ALL-DEAD? .FAC>
481 <EMIT-MOVE <MA-REG .AC> <MA-REG .FAC> LONG>
483 (ELSE <EMIT-EXCH .AC .FAC> <EXCH-AC .AC .FAC>)>
486 <DEFINE EMIT-EXCH (AC1 AC2 "AUX" TAC)
488 <COND (<SET TAC <FREE-AC? NONE NOVARS>>
489 <EMIT ,INST-MOVL <MA-REG .AC1> <MA-REG .TAC>>
490 <EMIT ,INST-MOVL <MA-REG .AC2> <MA-REG .AC1>>
491 <EMIT ,INST-MOVL <MA-REG .TAC> <MA-REG .AC2>>)
493 <EMIT ,INST-PUSHL <MA-REG .AC1>>
494 <EMIT ,INST-MOVL <MA-REG .AC2> <MA-REG .AC1>>
495 <EMIT ,INST-MOVL <MA-AINC ,AC-P> <MA-REG .AC2>>)>>
497 <DEFINE LOAD-VAR-INTO-AC (VAR MODE AC MODIFY?
498 "OPT" (VTMOD <>) (ALREADY? <>)
499 "AUX" (LVAR <FIND-CACHE-VAR .VAR>) TAC FAC DCL CAC
500 (SAFE? <SAFE-TYPE-WORD? .VAR>) (RLVAR <>)
502 <AND .LVAR <LINKVAR-TYPE-STORED .LVAR>>)
503 (CLEAR-TYPE? <>) (CLEAR-COUNT? <>))
504 #DECL ((VAR) VARTBL (AC) AC (MODE) ATOM (MODIFY?) BOOLEAN)
505 <COND (<==? .MODE TYPE-VALUE-PAIR>
506 <COND (<AND <OR <ALL-DEAD? .AC> <ALL-STORED? .AC>>
507 <OR <ALL-DEAD? <NEXT-AC .AC>>
508 <ALL-STORED? <NEXT-AC .AC>>>>
510 <MUNG-AC <NEXT-AC .AC>>)
511 (ELSE <STORE-AC .AC T> <STORE-AC <NEXT-AC .AC> T>)>)
512 (<OR <ALL-DEAD? .AC> <ALL-STORED? .AC>> <MUNG-AC .AC>)
513 (<SET FAC <FREE-AC? .MODE NOVARS>>
514 <IMOVE-AC .AC .FAC <>>
515 <CLEAR-VARS-FROM-AC .AC>)
519 (<==? .MODE TYPE-VALUE-PAIR>
520 <EMIT ,INST-MOVQ <COND (.ALREADY? <MA-REG .ALREADY?>)
521 (<ADDR-VAR-TYPE-VALUE .VAR>)> <MA-REG .AC>>
523 <EMIT ,INST-BICW2 <MA-WORD-IMM ,SHORT-TYPE-MASK> <MA-REG .AC>>)>)
525 <COND (<OR .SAFE? .TSTORED?>
526 <MOVE-TO-AC .AC <ADDR-VAR-TYPE .VAR> WORD>
529 <MA-WORD-IMM ,SHORT-TYPE-MASK>
531 (<SET DCL <VARTBL-DECL .VAR>>
532 <MOVE-TO-AC .AC <TYPE-CODE .DCL> LONG>
534 (<ERROR "NO TYPE CODE" LOAD-VAR-INTO-AC>)>)
535 (<==? .MODE COUNT> <MOVE-TO-AC .AC <ADDR-VAR-COUNT .VAR> WORD>)
536 (<==? .MODE TYPE-WORD>
537 <COND (.SAFE? <MOVE-TO-AC .AC <ADDR-VAR-TYPE .VAR> LONG>)
539 <COND (<SET DCL <VARTBL-DECL .VAR>>
540 <COND (<COUNT-NEEDED? .DCL>
541 <MOVE-TO-AC .AC <VAR-COUNT-ADDRESS .VAR> LONG>
542 <MOVE-TO-AC .AC <TYPE-CODE .DCL> WORD>)
543 (ELSE <MOVE-TO-AC .AC <TYPE-WORD .DCL> LONG>)>)
544 (<SET LVAR <FIND-CACHE-VAR .VAR>>
545 <COND (<SET TAC <LINKVAR-TYPE-AC .LVAR>>
546 <COND (<SET CAC <LINKVAR-COUNT-AC .LVAR>>
547 <MOVE-TO-AC .AC <MA-REG .CAC> WORD>
551 <MOVE-TO-AC .AC <MA-REG .TAC> WORD>)
552 (<ERROR "NO TYPE WORD" LOAD-VAR-INTO-AC>)>)
553 (<ERROR "NO TYPE WORD" LOAD-VAR-INTO-AC>)>
557 (<==? .MODE VALUE> <MOVE-TO-AC .AC <ADDR-VAR-VALUE .VAR> LONG>)>
558 <COND (<NOT .MODIFY?> <SET RLVAR <LINK-VAR-TO-AC .VAR .AC .MODE T <>>>)
559 ;(<AND <==? .MODE TYPE-VALUE-PAIR> <NOT .TMOD>>
560 <SET RLVAR <LINK-VAR-TO-AC .VAR .AC TYPE-WORD T <>>>)>
562 <COND (.CLEAR-TYPE? <LINKVAR-TYPE-STORED .RLVAR <>>)>
563 <COND (.CLEAR-COUNT? <LINKVAR-COUNT-STORED .RLVAR <>>)>)>>
565 <DEFINE MATCH-AC? (AC MODE)
566 #DECL ((AC) AC (MODE) AC-CHOICES)
567 <COND (<TYPE? .MODE AC> <==? .AC .MODE>) (ELSE T)>>
569 <DEFINE VAR-VALUE-ADDRESS (VAR "OPTIONAL" (WRITE? <>) "AUX" LVAR TAC)
570 #DECL ((VAR) VARTBL (KIND) ATOM)
571 <COND (<AND <SET LVAR <FIND-CACHE-VAR .VAR>>
572 <SET TAC <LINKVAR-VALUE-AC .LVAR>>>
573 <COND (<AND .WRITE? <NOT <LENGTH? <AC-VARS .TAC> 1>>>
574 <STORE-AC .TAC T .LVAR>)>
577 (<ADDR-VAR-VALUE .VAR>)>>
579 <DEFINE VAR-TYPE-ADDRESS (VAR "OPTIONAL" (MODE TYPE) (WRITE? <>)
581 #DECL ((VAR) VARTBL (KIND) ATOM (MODE) ATOM)
582 <COND (<AND <==? .MODE TYPE>
583 <SET LVAR <FIND-CACHE-VAR .VAR>>
584 <OR <SET TAC <LINKVAR-TYPE-AC .LVAR>>
585 <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>>>
586 <COND (<AND .WRITE? <NOT <LENGTH? <AC-VARS .TAC> 1>>>
587 <STORE-AC .TAC T .LVAR>)>
590 (<AND <OR <==? .MODE TYPE-WORD>
592 <==? .MODE TYPEWORD>>
593 <SET LVAR <FIND-CACHE-VAR .VAR>>
594 <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>>
595 <COND (<AND .WRITE? <NOT <LENGTH? <AC-VARS .TAC> 1>>>
596 <STORE-AC .TAC T .LVAR>)>
599 (<ADDR-VAR-TYPE .VAR>)>>
601 <DEFINE VAR-COUNT-ADDRESS (VAR "OPTIONAL" (WRITE? <>) "AUX" LVAR TAC)
602 #DECL ((VAR) VARTBL (KIND) ATOM)
603 <COND (<AND <SET LVAR <FIND-CACHE-VAR .VAR>>
604 <SET TAC <LINKVAR-COUNT-AC .LVAR>>>
605 <COND (<AND .WRITE? <NOT <LENGTH? <AC-VARS .TAC> 1>>>
606 <STORE-AC .TAC T .LVAR>)>
609 (<ADDR-VAR-COUNT .VAR>)>>
611 <DEFINE STORE-ALL-ACS () <MAPF <> <FUNCTION (AC) <STORE-AC .AC <>>> ,ALL-ACS>>
613 <DEFINE PUSH-TEMPS ("OPTIONAL" (MODEL ,TOP-MODEL))
614 <COND (<NOT <0? <SM-PATCHLOC .MODEL>>>
617 <INSERT-PATCH <SM-PATCHLOC .MODEL> <END-CODE-INSERT>>
618 <MAPF <> ,PUSH-TEMPS <SM-KIDS .MODEL>>)>>
620 <DEFINE PUSH-TEMP (VAR "AUX" IVAL DCL)
622 <COND (<SET IVAL <VARTBL-INIT .VAR>> <PUSH-CONSTANT .IVAL>)
623 (<SET DCL <VARTBL-RDECL .VAR>>
624 <EMIT-PUSH <TYPE-WORD .DCL> LONG>
626 (ELSE <CLEAR-PUSH DOUBLE>)>>
628 <DEFINE PUSH-CONSTANT (IVAL "AUX" RVAL)
629 #DECL ((IVAL) ANY (RVAL) <OR FALSE FIX>)
630 <COND (<TYPE? .IVAL SPEC-FALSE> <SET IVAL <CHTYPE .IVAL FALSE>>)>
631 <COND (<SET RVAL <FIX-CONSTANT? .IVAL>>
632 <EMIT-PUSH <TYPE-WORD <TYPE .IVAL>> LONG>
633 <COND (<0? .RVAL> <CLEAR-PUSH LONG>)
634 (<EMIT-PUSH <MA-LONG-IMM .RVAL> LONG>)>)
636 <EMIT-PUSH <ADDR-TYPE-MQUOTE .IVAL> DOUBLE>)>>
638 <DEFINE PUSH-VAR (VAR "AUX" VAC LVAR TAC DCL (DONE <>))
640 <COND (<AND <SET LVAR <FIND-CACHE-VAR .VAR>>
641 <SET TAC <LINKVAR-TYPE-WORD-AC .LVAR>>>
642 <COND (<AND <SET VAC <LINKVAR-VALUE-AC .LVAR>>
643 <==? <+ <AC-NUMBER .TAC> 1> <AC-NUMBER .VAC>>>
644 <EMIT-PUSH <MA-REG .TAC> DOUBLE>
648 <EMIT-PUSH <MA-REG .TAC> LONG>)>
650 (<SAFE-TYPE-WORD? .VAR>
651 <COND (<OR <NOT .LVAR>
652 <LINKVAR-VALUE-STORED .LVAR>>
653 <EMIT-PUSH <ADDR-VAR-TYPE .VAR> DOUBLE>
656 <EMIT-PUSH <ADDR-VAR-TYPE .VAR> LONG>)>)
657 (<SET DCL <VARTBL-DECL .VAR>>
658 <COND (<COUNT-NEEDED? .DCL>
659 <EMIT-PUSH <TYPE-CODE .DCL FIX> WORD>
660 <EMIT-PUSH <VAR-COUNT-ADDRESS .VAR> WORD>)
661 (<EMIT-PUSH <TYPE-WORD .DCL> LONG>)>)
662 (<AND .LVAR <SET TAC <LINKVAR-TYPE-AC .LVAR>>>
663 <EMIT-PUSH <MA-REG .TAC> WORD>
665 <COND (<SET TAC <LINKVAR-COUNT-AC .LVAR>>
666 <EMIT-PUSH <MA-REG .TAC> WORD>
668 (<ERROR "NO TYPE WORD" PUSH-VAR>)>
670 <EMIT-PUSH <VAR-VALUE-ADDRESS .VAR> LONG>)>>
672 <DEFINE MOVE-COUNT-FROM-TYPEWORD (VAR TAC ACTYPE MODIFY? "AUX" NAC)
673 #DECL ((TAC) AC (ACTYPE) AC-CHOICES (MODIFY?) BOOLEAN)
674 <COND (<ALL-STORED? .TAC>
677 <EMIT ,INST-BICL2 <MA-LONG-IMM 65535> <MA-REG .TAC>>
678 <EMIT ,INST-ROTL <MA-BYTE-IMM 16> <MA-REG .TAC> <MA-REG .TAC>>)
681 <SET NAC <GET-AC .ACTYPE T>>
682 <EMIT ,INST-BICL3 <MA-LONG-IMM 65535>
683 <MA-REG .TAC> <MA-REG .NAC>>
684 <EMIT ,INST-ROTL <MA-BYTE-IMM 16> <MA-REG .NAC> <MA-REG .NAC>>)>
685 <OR .MODIFY? <LINK-VAR-TO-AC .VAR .NAC COUNT NO-CHANGE>>
688 <DEFINE MOVE-TYPE-FROM-TYPEWORD (VAR TAC ACTYPE MODIFY? "AUX" NAC)
689 #DECL ((NAC TAC) AC (ACTYPE) AC-CHOICES (MODIFY?) BOOLEAN)
690 <COND (<ALL-STORED? .TAC>
692 <EMIT ,INST-MOVZWL <MA-REG .TAC> <MA-REG .TAC>>
696 <SET NAC <GET-AC .ACTYPE T>>
697 <EMIT ,INST-MOVZWL <MA-REG .TAC> <MA-REG .NAC>>)>
700 <MA-WORD-IMM ,SHORT-TYPE-MASK>
702 <OR .MODIFY? <LINK-VAR-TO-AC .VAR .NAC TYPE NO-CHANGE>>
706 <DEFINE VARTBL-ASSIGNED? (VAR)
708 <OR <VARTBL-LOC .VAR> <FIND-CACHE-VAR .VAR>>>
710 <DEFINE PUSH-MODEL (MODEL)
711 #DECL ((MODEL) STK-MODEL)
713 <FCN (VAR) <COND (<VARTBL-TEMP? .VAR> <PUSH-TEMP .VAR>)>>
714 <SM-VARLIST .MODEL>>>
716 <DEFINE ADDR-VAR-OFFSET (VAR)