2 <DEFINE CREATE-AC (NAME NUM "AUX" RNUM LVS)
3 #DECL ((NAME) ATOM (NUM) FIX)
4 <SET LVS <IVECTOR ,NUMVARS-AC>>
5 <SET LVS <REST .LVS ,NUMVARS-AC>>
6 <CHTYPE [.NAME .NUM 0 <> .NUM <> <> .LVS <>] AC>>
8 <DEFINE INITIALIZE-ACS ("AUX" (NUM -1))
10 <FUNCTION (ATM1 ATM2 NUM-SYM)
11 <SETG .ATM1 <CREATE-AC .ATM2 <SET NUM <+ .NUM 1>>>>
12 <COND (<TYPE? .NUM-SYM ATOM> <SETG .NUM-SYM .NUM>)>>
13 '[AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6 AC-7 AC-8 AC-9 AC-10 AC-M
14 AC-F AC-TP AC-P AC-PC]
15 '[AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6 AC-7 AC-8 AC-9 AC-10 M F TP
17 '[0 0 0 0 0 0 0 0 0 0 0 NAC-M NAC-F NAC-TP NAC-P NAC-PC]>
30 <SETG VAL-ACS [,AC-1 ,AC-3 ,AC-5 ,AC-7 ,AC-9]>
31 <SETG TYPE-ACS [,AC-0 ,AC-2 ,AC-4 ,AC-6 ,AC-8]>
33 <INIT-VARIABLE-CACHE>>
35 <DEFINE RESET-AC-STACK-MODEL ("AUX" (CACHE ,VARIABLE-CACHE))
37 <FCN (AC "AUX" (VARS <AC-VARS .AC>))
38 <PUT .AC ,AC-VARS <REST .VARS <LENGTH .VARS>>>>
40 <SETG VARIABLE-CACHE <REST .CACHE <LENGTH .CACHE>>>
46 <DEFINE CLEAR-DEATH ()
47 <MAPF <> <FCN (VAR) <PUT .VAR ,VARTBL-DEAD? <>>> ,VAR-LIST>>
49 <DEFINE INDICATE-ALL-DEAD ()
50 <MAPF <> <FCN (VAR) <PUT .VAR ,VARTBL-DEAD? T>> ,VAR-LIST>>
52 <DEFINE SAFE-DEAD-VAR ("TUPLE" VARS)
53 #DECL ((VARS) <TUPLE [REST <OR VARTBL ATOM>]>)
55 <FUNCTION (VAR "AUX" LV VAC CAC TAC TWAC)
58 <COND (<AND <SET LV <FIND-CACHE-VAR .VAR>>
59 <OR <NOT <VARTBL-RDECL .VAR>>
60 <NOT <LINKVAR-DECL .LV>>
61 <COUNT-NEEDED? <LINKVAR-DECL .LV>>>>
62 <COND (<OR <AND <LINKVAR-COUNT-STORED .LV>
63 <NOT <LINKVAR-VALUE-STORED .LV>>>
64 <AND <LINKVAR-TYPE-STORED .LV>
65 <NOT <LINKVAR-VALUE-STORED .LV>>>
66 <AND <LINKVAR-VALUE-STORED .LV>
67 <OR <NOT <LINKVAR-COUNT-STORED .LV>>
68 <NOT <LINKVAR-TYPE-STORED .LV>>>>>
69 <EMIT ,INST-CLRL <ADDR-VAR-TYPE .VAR>>)>)>
74 <DEFINE DEAD-VAR ("TUPLE" VARS)
75 #DECL ((VARS) <TUPLE [REST <OR VARTBL ATOM>]>)
78 <COND (<TYPE? .VAR VARTBL>
80 <FCN (AC) <BREAK-LINK .AC .VAR>>
85 <DEFINE USE-ALL-ACS () <MAPF <> ,USE-AC ,ALL-ACS>>
87 <GDECL (EMPTY-VAR) VARTBL (EMPTY-LINKVAR) LINKVAR>
89 <DEFINE CREATE-LINKVAR (VAR)
91 <CHTYPE <VECTOR .VAR <> <> <> <> <> <> <> <> ()> LINKVAR>>
93 <DEFINE COPY-LINKVAR (LV)
95 <CHTYPE <VECTOR <LINKVAR-VAR .LV>
96 <LINKVAR-VALUE-STORED .LV>
97 <LINKVAR-COUNT-STORED .LV>
98 <LINKVAR-TYPE-STORED .LV>
100 <LINKVAR-VALUE-AC .LV>
101 <LINKVAR-TYPE-AC .LV>
102 <LINKVAR-COUNT-AC .LV>
103 <LINKVAR-TYPE-WORD-AC .LV>
104 <LINKVAR-POTENTIAL-SAVES .LV>>
107 "THIS OPERATION SAYS THAT THE TYPE-WORD, VALUE-WORD, COUNT, OR TYPE
108 OF A VARIABLE IS IN AN AC"
110 <DEFINE LINK-VAR-TO-AC (VAR AC KIND
111 "OPTIONAL" (STORED? <>) (FLUSH-DECL T)
112 "AUX" PAC LV (TIN? <>) (CIN? <>) (VIN? <>))
113 #DECL ((LV) LINKVAR (AC) AC (SV) <OR ATOM FALSE>)
114 <SET LV <CACHE-VAR .VAR>>
115 <COND (<OR <LINKVAR-TYPE-AC .LV> <LINKVAR-TYPE-WORD-AC .LV>>
117 <COND (<OR? <LINKVAR-COUNT-AC .LV> <LINKVAR-TYPE-WORD-AC .LV>>
119 <COND (<LINKVAR-VALUE-AC .LV> <SET VIN? T>)>
120 <PLACE-LV-IN-AC .AC .LV>
121 <COND (<==? .KIND TYPE-VALUE-PAIR> <PLACE-LV-IN-AC <NEXT-AC .AC> .LV>)>
122 <AND .FLUSH-DECL <INDICATE-VAR-TEMP-DECL .VAR <>>>
123 <COND (<==? .KIND TYPE-VALUE-PAIR>
124 <AND <SET PAC <LINKVAR-TYPE-WORD-AC .LV>>
125 <REMOVE-LV-FROM-AC .PAC .LV>>
126 <PUT .LV ,LINKVAR-TYPE-WORD-AC .AC>
127 <SET AC <NEXT-AC .AC>>
128 <AND <SET PAC <LINKVAR-VALUE-AC .LV>>
129 <REMOVE-LV-FROM-AC .PAC .LV>>
130 <PUT .LV ,LINKVAR-VALUE-AC .AC>)
132 <AND <SET PAC <LINKVAR-VALUE-AC .LV>>
133 <REMOVE-LV-FROM-AC .PAC .LV>>
134 <PUT .LV ,LINKVAR-VALUE-AC .AC>)
136 <AND <SET PAC <LINKVAR-TYPE-AC .LV>>
137 <REMOVE-LV-FROM-AC .PAC .LV>>
138 <PUT .LV ,LINKVAR-TYPE-AC .AC>)
139 (<==? .KIND TYPE-WORD>
140 <AND <SET PAC <LINKVAR-TYPE-WORD-AC .LV>>
141 <REMOVE-LV-FROM-AC .PAC .LV>>
142 <PUT .LV ,LINKVAR-TYPE-WORD-AC .AC>)
144 <AND <SET PAC <LINKVAR-COUNT-AC .LV>>
145 <REMOVE-LV-FROM-AC .PAC .LV>>
146 <PUT .LV ,LINKVAR-COUNT-AC .AC>)
147 (<ERROR BAD-MODE .KIND LINK-VAR-TO-AC>)>
148 <COND (<N==? .STORED? NO-CHANGE>
149 <OR .VIN? <PUT .LV ,LINKVAR-VALUE-STORED .STORED?>>
150 <OR .TIN? <PUT .LV ,LINKVAR-TYPE-STORED .STORED?>>
151 <OR .CIN? <PUT .LV ,LINKVAR-COUNT-STORED .STORED?>>)>>
153 <DEFINE PLACE-LV-IN-AC (AC LV "AUX" (VARS <AC-VARS .AC>))
154 #DECL ((AC) AC (LV) LINKVAR)
155 <COND (<NOT <MEMQ .LV .VARS>>
156 <COND (<==? <TOP .VARS> .VARS> <SET VARS [.LV !.VARS]>)
157 (ELSE <SET VARS <BACK .VARS>> <PUT .VARS 1 .LV>)>
158 <AND <G? <LENGTH .VARS> 1> <USE-AC .AC>>
159 <PUT .AC ,AC-VARS .VARS>)>>
161 <DEFINE REMOVE-LV-FROM-AC (AC LV "AUX" (VARS <AC-VARS .AC>))
162 #DECL ((LV) LINKVAR (AC) AC)
163 <PUT .AC ,AC-VARS <REMOVE-LINKVAR .LV .VARS>>>
165 <DEFINE INDICATE-CACHED-VARIABLE-DECL (VAR DECL "AUX" LV)
166 #DECL ((VAR) VARTBL (DECL) <OR FALSE ATOM>)
167 <SET LV <FIND-CACHE-VAR .VAR>>
169 <PUT .LV ,LINKVAR-DECL .DECL>
170 <INDICATE-VAR-TEMP-DECL .VAR .DECL>)>>
172 <DEFINE INDICATE-CACHED-VARIABLE-STORED (VAR STORED? TYP "AUX" LV)
173 #DECL ((VAR) VARTBL (STORED?) <OR FALSE ATOM> (TYP) ATOM)
174 <SET LV <FIND-CACHE-VAR .VAR>>
176 <COND (<==? .TYP TYPE> <PUT .LV ,LINKVAR-TYPE-STORED .STORED?>)
177 (<==? .TYP VALUE> <PUT .LV ,LINKVAR-VALUE-STORED .STORED?>)
178 (<==? .TYP COUNT> <PUT .LV ,LINKVAR-COUNT-STORED .STORED?>)>
179 <PUT .LV ,LINKVAR-DECL .TYP>>>
181 <DEFINE INIT-VARIABLE-CACHE ("AUX" RES)
183 <SETG EMPTY-VAR <CREATE-VAR \ T>>
184 <SETG EMPTY-LINKVAR <CREATE-LINKVAR ,EMPTY-VAR>>
185 <SET RES <IVECTOR ,CACHE-LENGTH ,EMPTY-LINKVAR>>
186 <SETG VARIABLE-CACHE <REST .RES <LENGTH .RES>>>>
188 <DEFINE FIND-CACHE-VAR (VAR "OPTIONAL" (CACHE ,VARIABLE-CACHE))
189 #DECL ((VAR) VARTBL (CACHE) AC-STATE)
191 <FCN (LV) <AND <==? <LINKVAR-VAR .LV> .VAR> <MAPLEAVE .LV>>>
194 <DEFINE VAR-VALUE-IN-AC? (VAR "AUX" LVAR)
196 <SET LVAR <FIND-CACHE-VAR .VAR>>
197 <AND .LVAR <LINKVAR-VALUE-AC .LVAR>>>
199 <DEFINE VAR-TYPE-IN-AC? (VAR "AUX" LVAR)
201 <SET LVAR <FIND-CACHE-VAR .VAR>>
202 <AND .LVAR <OR <LINKVAR-TYPE-AC .LVAR> <LINKVAR-TYPE-WORD-AC .LVAR>>>>
204 <DEFINE VAR-COUNT-IN-AC? (VAR "AUX" LVAR)
206 <SET LVAR <FIND-CACHE-VAR .VAR>>
207 <AND .LVAR <LINKVAR-COUNT-AC .LVAR>>>
209 <DEFINE VAR-TYPE-WORD-IN-AC? (VAR "AUX" LVAR)
211 <SET LVAR <FIND-CACHE-VAR .VAR>>
212 <AND .LVAR <LINKVAR-TYPE-WORD-AC .LVAR>>>
214 <DEFINE VAR-COUNT-STORED? (VAR "AUX" LVAR)
215 <COND (<SET LVAR <FIND-CACHE-VAR .VAR>>
216 <AND <LINKVAR-COUNT-STORED .LVAR> <ADDR-VAR-COUNT .VAR>>)
217 (<ADDR-VAR-COUNT .VAR>)>>
219 <DEFINE SAFE-TYPE-WORD? (VAR "AUX" LVAR)
221 <COND (<SET LVAR <FIND-CACHE-VAR .VAR>>
222 <OR <LINKVAR-TYPE-WORD-AC .LVAR>
223 <AND <LINKVAR-TYPE-STORED .LVAR>
224 <LINKVAR-COUNT-STORED .LVAR>>
225 <AND <VARTBL-RDECL .VAR>
226 <NOT <COUNT-NEEDED? <LINKVAR-DECL .LVAR>>>>>)
229 <DEFINE CACHE-VAR (VAR "OPTIONAL" (LVC <>) "AUX" RES CACHE)
230 #DECL ((VAR) VARTBL (LVC) <OR FALSE LINKVAR>)
231 <COND (<SET RES <FIND-CACHE-VAR .VAR>>)
233 <SET CACHE ,VARIABLE-CACHE>
234 <COND (.LVC <SET RES <COPY-LINKVAR .LVC>>)
235 (<SET RES <CREATE-LINKVAR .VAR>>)>
236 <COND (<==? .CACHE <TOP .CACHE>> <SET CACHE [.RES !.CACHE]>)
237 (ELSE <SET CACHE <BACK .CACHE>> <PUT .CACHE 1 .RES>)>
238 <SETG VARIABLE-CACHE .CACHE>)>
241 <DEFINE BREAK-LINK (AC VAR "AUX" (VARS <AC-VARS .AC>) LV)
242 #DECL ((AC) AC (VAR) VARTBL)
243 <COND (<SET LV <FIND-CACHE-VAR .VAR .VARS>>
244 <REMOVE-LV-FROM-AC .AC .LV>
245 <COND (<==? <LINKVAR-VALUE-AC .LV> .AC>
246 <PUT .LV ,LINKVAR-VALUE-AC <>>)
247 (<==? <LINKVAR-TYPE-AC .LV> .AC>
248 <PUT .LV ,LINKVAR-TYPE-AC <>>)
249 (<==? <LINKVAR-TYPE-WORD-AC .LV> .AC>
250 <PUT .LV ,LINKVAR-TYPE-WORD-AC <>>)
251 (<==? <LINKVAR-COUNT-AC .LV> .AC>
252 <PUT .LV ,LINKVAR-COUNT-AC <>>)>
253 <COND (<AND <NOT <LINKVAR-VALUE-AC .LV>>
254 <NOT <LINKVAR-TYPE-AC .LV>>
255 <NOT <LINKVAR-TYPE-WORD-AC .LV>>
256 <NOT <LINKVAR-COUNT-AC .LV>>>
257 <REMOVE-VAR-FROM-CACHE .LV>)>)>>
259 <DEFINE REMOVE-VAR-FROM-CACHE (LV)
260 <SETG VARIABLE-CACHE <REMOVE-LINKVAR .LV ,VARIABLE-CACHE>>>
262 <DEFINE REMOVE-LINKVAR (LV "OPTIONAL" (CACHE ,VARIABLE-CACHE) "AUX" LVS DIST)
263 #DECL ((LV) LINKVAR (CACHE) <VECTOR [REST LINKVAR]>)
264 <SET LVS <MEMQ .LV .CACHE>>
266 <SET DIST <- <LENGTH .CACHE> <LENGTH .LVS>>>
267 <AND <G? .DIST 0> <SUBSTRUC .CACHE 0 .DIST <REST .CACHE>>>
271 <DEFINE CLEAR-VARS-FROM-AC (AC "OPTIONAL" (SAVE? <>) (ALL? <>)
272 "AUX" (VARS <AC-VARS .AC>))
273 <MAPF <> <FCN (LV "AUX" TAC)
275 <COND (<N==? .LV .SAVE?>
276 <BREAK-LINK .AC <LINKVAR-VAR .LV>>
278 ; "Only called by STORE-AC, which has
279 already stored everything in the AC.
280 This forces all parts of a variable
281 out of the ACs if any part is being
283 <COND (<AND <SET TAC <LINKVAR-VALUE-AC .LV>>
288 <LINKVAR-TYPE-WORD-AC .LV>>
292 <COND (<AND <SET TAC <LINKVAR-TYPE-AC .LV>>
296 <COND (<AND <SET TAC <LINKVAR-COUNT-AC .LV>>
299 <LINKVAR-VAR .LV>>)>)>)>>
302 <DEFINE MUNG-AC (VAC)
306 <CLEAR-VARS-FROM-AC .VAC>>
308 <DEFINE FLUSH-ACS () <MAPF <> ,MUNG-AC ,ALL-ACS>>
310 <DEFINE EXCH-AC (AC1 AC2 "AUX" (VARS <AC-VARS .AC2>))
312 <PUT .AC2 ,AC-VARS <AC-VARS .AC1>>
313 <PUT .AC1 ,AC-VARS .VARS>
320 <EXCH-TEST .AC1 .AC2 <LINKVAR-VALUE-AC .LV>>>
323 <EXCH-TEST .AC1 .AC2 <LINKVAR-TYPE-AC .LV>>>
326 <EXCH-TEST .AC1 .AC2 <LINKVAR-COUNT-AC .LV>>>
328 ,LINKVAR-TYPE-WORD-AC
329 <EXCH-TEST .AC1 .AC2 <LINKVAR-TYPE-WORD-AC .LV>>>>
332 <DEFINE EXCH-TEST (AC1 AC2 ACL)
333 #DECL ((AC1 AC2) AC (ACL) <OR AC FALSE>)
334 <COND (<==? .AC1 .ACL> .AC2) (<==? .AC2 .ACL> .AC1) (.ACL)>>
336 <DEFINE MOVE-AC (AC1 AC2 "AUX" (VARS1 <AC-VARS .AC1>) (VARS2 <AC-VARS .AC2>))
341 <COND (<==? <LINKVAR-VALUE-AC .LV> .AC1>
342 <PUT .LV ,LINKVAR-VALUE-AC .AC2>)
343 (<==? <LINKVAR-TYPE-AC .LV> .AC1>
344 <PUT .LV ,LINKVAR-TYPE-AC .AC2>)
345 (<==? <LINKVAR-TYPE-WORD-AC .LV> .AC1>
346 <PUT .LV ,LINKVAR-TYPE-WORD-AC .AC2>)
347 (<==? <LINKVAR-COUNT-AC .LV> .AC1>
348 <PUT .LV ,LINKVAR-COUNT-AC .AC2>)>>
350 <SET VARS2 <ADJUST-LENGTH .VARS2 <LENGTH .VARS1>>>
351 <PUT .AC2 ,AC-VARS .VARS2>
352 <MAPR <> <FCN (ACV2 ACV1) <PUT .ACV2 1 <1 .ACV1>>> .VARS2 .VARS1>
353 <CLEAR-VARS-FROM-AC .AC1>>
355 <DEFINE ADJUST-LENGTH (VEC LEN "AUX" TVEC)
356 #DECL ((VEC) VECTOR (LEN) FIX)
357 <COND (<G? <LENGTH .VEC> .LEN>
358 <SET VEC <REST .VEC <- <LENGTH .VEC> .LEN>>>)
359 (<L? <LENGTH .VEC> .LEN>
360 <SET TVEC <TOP .VEC>>
361 <COND (<G? <LENGTH .TVEC> .LEN>
362 <SET VEC <REST .TVEC <- <LENGTH .TVEC> .LEN>>>)
364 [!<IVECTOR <- <LENGTH .TVEC> .LEN>> !.TVEC]>)>)>
367 <DEFINE SET-AC-AGE (AC)
368 #DECL ((AC) AC (VAL) FIX)
369 <PUT .AC ,AC-AGE ,AC-TIME>
370 <SETG AC-TIME <+ ,AC-TIME 1>>>
372 <DEFINE USE-AC (AC) #DECL ((AC) AC) <PUT .AC ,AC-USE T>>
374 <DEFINE PROTECT (AC) #DECL ((AC) AC) <PUT .AC ,AC-PROT T> .AC>
376 <DEFINE PROTECT-USE (AC) #DECL ((AC) AC) <PROTECT .AC> <USE-AC .AC>>
378 <DEFINE UNPROTECT (AC) #DECL ((AC) AC) <PUT .AC ,AC-PROT <>>>
380 <DEFINE UNPROTECT-ACS () <MAPF <> ,UNPROTECT ,ALL-ACS>>
382 <DEFINE LOAD-AC (AC EA)
384 <PUT .AC ,AC-LLOAD ,CODE-COUNT>
385 <PUT .AC ,AC-LLOAD-EA .EA>
389 <DEFINE CLOAD-AC (AC)
391 <PUT .AC ,AC-LLOAD <>>
392 <PUT .AC ,AC-LLOAD-EA <>>>
394 <DEFINE SET-STATUS-AC (AC)
396 <COND (,AC-STORE-OPT <SETG STATUS-AC .AC>) (<CLEAR-STATUS>)>>
398 <DEFINE SET-STATUS-VAR (VAR STYP)
399 #DECL ((VAR) VARTBL (STYP) ATOM)
400 <COND (<AND ,STATUS-AC ,AC-STORE-OPT>
401 <SETG STATUS-VAR .VAR>
402 <SETG STATUS-TYPE .STYP>)>>
404 <DEFINE CLEAR-STATUS () <SETG STATUS-AC <>> <SETG STATUS-VAR <>>>
406 <DEFINE STATUS? (VAR STYPE "AUX" LVAR (SAC ,STATUS-AC))
407 #DECL ((VAR) VARTBL (STYPE) ATOM)
408 <COND (<AND ,STATUS-AC
409 <SET LVAR <FIND-CACHE-VAR .VAR <AC-VARS .SAC>>>
410 <OR <AND <==? .STYPE VALUE>
411 <==? <LINKVAR-VALUE-AC .LVAR> .SAC>>
413 <==? <LINKVAR-COUNT-AC .LVAR> .SAC>>>
415 (<AND <==? .VAR ,STATUS-VAR> <==? .STYPE ,STATUS-TYPE>>
416 <COND (,STATUS-AC ,STATUS-AC) (VAR)>)>>
418 <DEFINE PRINT-LINKVAR (LV "AUX" (OUTCHAN .OUTCHAN))
421 <PRINC <VARTBL-NAME <LINKVAR-VAR .LV>>>
423 <PRINC <LINKVAR-DECL .LV>>
424 <TESTPRINT <LINKVAR-VALUE-AC .LV> "VALUE" .OUTCHAN>
425 <TESTPRINT <LINKVAR-TYPE-AC .LV> "TYPE" .OUTCHAN>
426 <TESTPRINT <LINKVAR-TYPE-WORD-AC .LV> "TYPE-WORD" .OUTCHAN>
427 <TESTPRINT <LINKVAR-COUNT-AC .LV> "COUNT" .OUTCHAN>
430 <DEFINE TESTPRINT (AC TYP OUTCHAN)
431 #DECL ((AC) <OR FALSE AC> (TYP) STRING (OUTCHAN) <SPECIAL CHANNEL>)
436 <PRIN1 <AC-NAME .AC>>)>>
438 <COND (<GASSIGNED? PRINT-LINKVAR> <PRINTTYPE LINKVAR ,PRINT-LINKVAR>)>
440 <DEFINE PRINT-AC (AC "AUX" (OUTCHAN .OUTCHAN))
443 <PRIN1 <AC-NAME .AC>>
445 <MAPF <> <FCN (LV) <PRINT-SHORT-LINKVAR .LV .AC>> <AC-VARS .AC>>
448 <COND (<GASSIGNED? PRINT-AC><PRINTTYPE AC ,PRINT-AC>)>
450 <DEFINE PRINT-SHORT-LINKVAR (LV AC "AUX" (OUTCHAN .OUTCHAN))
451 #DECL ((LV) LINKVAR (AC) AC)
452 <COND (<==? <LINKVAR-TYPE-AC .LV> .AC> <PRINC "#TYPE ">)
453 (<==? <LINKVAR-VALUE-AC .LV> .AC> <PRINC "#VALUE ">)
454 (<==? <LINKVAR-TYPE-WORD-AC .LV> .AC> <PRINC "#TYPE-WORD ">)
455 (<==? <LINKVAR-COUNT-AC .LV> .AC> <PRINC "#COUNT ">)>
456 <PRINC <VARTBL-NAME <LINKVAR-VAR .LV>>>
459 <DEFINE FREE-TYPE-AC? ("OPTIONAL" (HOWFREE? NOVARS) (REAL? <>))
460 <FIND-FREE-AC ,TYPE-ACS .HOWFREE?>>
462 <DEFINE FREE-VALUE-AC? ("OPTIONAL" (HOWFREE? NOVARS))
463 <FIND-FREE-AC ,VAL-ACS .HOWFREE?>>
465 <DEFINE FREE-AC? ("OPTIONAL" (PREF NONE) (HOWFREE? NOVARS))
466 <COND (<==? .PREF DOUBLE> <FIND-FREE-PAIR .HOWFREE?>)
467 (<==? .PREF NONE> <FIND-FREE-AC ,ALL-ACS .HOWFREE?>)
468 (<OR <==? .PREF TYPE> <==? .PREF PREF-TYPE>>
469 <OR <FIND-FREE-AC ,TYPE-ACS .HOWFREE?>
470 <FIND-FREE-AC ,VAL-ACS .HOWFREE?>>)
471 (<OR <==? .PREF VALUE> <==? .PREF PREF-VAL>>
472 <OR <FIND-FREE-AC ,VAL-ACS .HOWFREE?>
473 <FIND-FREE-AC ,TYPE-ACS .HOWFREE?>>)
474 (<ERROR BAD-PREFERENCE FREE-AC?>)>>
476 <DEFINE FIND-FREE-PAIR (HOWFREE?)
477 <REPEAT ((ACS ,ALL-ACS) AC1 AC2)
478 <COND (<L? <LENGTH .ACS> 2> <RETURN <>>)>
479 <COND (<NOT <OR <AC-PROT <SET AC1 <1 .ACS>>>
480 <AC-PROT <SET AC2 <2 .ACS>>>>>
481 <COND (<==? .HOWFREE? NOVARS>
482 <COND (<AND <ALL-DEAD? .AC1> <ALL-DEAD? .AC2>>
484 (<==? .HOWFREE? STORED>
485 <COND (<AND <ALL-STORED? .AC1>
488 (ELSE <ERROR BAD-MODE FIND-FREE-PAIR>)>)>
489 <SET ACS <REST .ACS 2>>>>
491 <DEFINE FIND-FREE-AC (ACLIST HOWFREE?)
492 #DECL ((ACLIST) <VECTOR [REST AC]> (HOWFREE?) ATOM)
495 <AND <NOT <AC-PROT .AC>>
496 <COND (<==? .HOWFREE? NOVARS>
497 <AND <ALL-DEAD? .AC> <MAPLEAVE .AC>>)
498 (<==? .HOWFREE? STORED>
499 <AND <ALL-STORED? .AC> <MAPLEAVE .AC>>)
500 (<ERROR BAD-MODE FIND-FREE-AC>)>>>
503 <DEFINE AC-VAR-STORED? (VAR AC "AUX" LV)
504 #DECL ((VAR) VARTBL (AC) AC (LV) LINKVAR)
505 <COND (<SET LV <FIND-CACHE-VAR .VAR>>
506 <COND (<==? .AC <LINKVAR-VALUE-AC .LV>>
507 <LINKVAR-VALUE-STORED .LV>)
508 (<==? .AC <LINKVAR-COUNT-AC .LV>>
509 <LINKVAR-COUNT-STORED .LV>)
510 (<==? .AC <LINKVAR-TYPE-AC .LV>>
511 <LINKVAR-TYPE-STORED .LV>)
512 (<==? .AC <LINKVAR-TYPE-WORD-AC .LV>>
513 <LINKVAR-TYPE-STORED .LV>)
514 (<ERROR "VAR NOT IN AC" .VAR .AC>)>)
515 (<ERROR "VAR NOT IN AC" .VAR>)>>
517 <DEFINE ALL-STORED? (AC "AUX" (VAL T))
521 <COND (<==? .AC <LINKVAR-VALUE-AC .LV>>
522 <AND <NOT <LINKVAR-VALUE-STORED .LV>>
523 <MAPLEAVE <SET VAL <>>>>)
524 (<==? .AC <LINKVAR-COUNT-AC .LV>>
525 <AND <NOT <LINKVAR-COUNT-STORED .LV>>
526 <MAPLEAVE <SET VAL <>>>>)
527 (<==? .AC <LINKVAR-TYPE-AC .LV>>
528 <AND <NOT <LINKVAR-TYPE-STORED .LV>>
529 <MAPLEAVE <SET VAL <>>>>)
530 (<==? .AC <LINKVAR-TYPE-WORD-AC .LV>>
531 <AND <NOT <LINKVAR-TYPE-STORED .LV>>
532 <MAPLEAVE <SET VAL <>>>>)
533 (<ERROR "VAR NOT IN AC" ALL-STORED?>)>>
537 <DEFINE ALL-DEAD? (AC "AUX" (VAL T))
541 <COND (<AND <NOT <VARTBL-DEAD? <LINKVAR-VAR .LV>>>
542 <NOT <WILL-DIE? <LINKVAR-VAR .LV>>>>
543 <MAPLEAVE <SET VAL <>>>)>>
547 <DEFINE FLUSH-ALL-ACS () <MAPF <> ,MUNG-AC ,ALL-ACS>>
549 <DEFINE MOVE-TO-AC (AC ADDR LEN)
550 #DECL ((AC) AC (LEN) ATOM)
551 <COND (<==? .LEN LONG>
552 <EMIT-MOVE .ADDR <MA-REG .AC> LONG>
555 <EMIT ,INST-MOVZWL .ADDR <MA-REG .AC>>)
557 <EMIT ,INST-MOVZBL .ADDR <MA-REG .AC>>)>>
559 <DEFINE PREV-AC (AC "AUX" (ACN <AC-NUMBER .AC>))
561 <COND (<==? .ACN 0> <>) (ELSE <NTH ,ALL-ACS .ACN>)>>
563 <DEFINE NEXT-AC (AC "AUX" (ACN <AC-NUMBER .AC>)) <NTH ,ALL-ACS <+ .ACN 2>>>