3 <ENTRY GETREG SGETREG RET-TMP-AC TOACT TOACV FLUSH-RESIDUE TOACT FLUSH-RESIDUE
4 SAVE-STATE MUNG-AC TOACV AC+1OK? DATTYP-FLUSH SAVE:RES PREFER-DATUM
5 MERGE-STATE GET2REG SMASH-INACS SAVE-NUM-SYM ANY2ACS RESTORE-STATE KILL-LIST
6 CHECK:VARS CALL-INTERRUPT SINACS FREE-ACS REGSTO FIX-NUM-SYM SPEC-OFFPTR
7 KILL-LOOP-AC SMASH-NUM-SYM GET-NUM-SYM STORE-VAR STORE-TVAR STOREV VAR-STORE
10 <USE "COMPDEC" "CHKDCL" "COMCOD" "CODGEN" "CUP">
13 "OPTIONAL" (TYPE-AC <>)
14 "AUX" AC (BEST <>) (OLDAGE <CHTYPE <MIN> FIX>)(WINNAGE -1))
15 #DECL ((DAT) ANY (BEST) <OR FALSE AC> (VALUE) AC (WINNAGE OLDAGE) FIX)
17 <FUNCTION (AC "AUX" (SCORE 0) PAC NAC)
18 #DECL ((AC PAC NAC) AC (SCORE) FIX)
20 <COND (<ACPROT .AC> <RETURN>)>
22 <COND (<G? .WINNAGE ,LINKED> <RETURN>)>
23 <COND (<G? <ACAGE .AC> .OLDAGE> <RETURN>)>
25 <SET OLDAGE <ACAGE <SET BEST .AC>>>
27 <COND (<ACRESIDUE .AC>
28 <COND (<G? .WINNAGE ,NO-RESIDUE> <RETURN>)>
29 <COND (<ALL-STORED? <ACRESIDUE .AC>>
30 <COND (<G? .WINNAGE ,STORED-RESIDUE> <RETURN>)>
31 <SET SCORE ,STORED-RESIDUE>)
32 (<G? .WINNAGE ,NOT-STORED-RESIDUE> <RETURN>)
33 (ELSE <SET SCORE ,NOT-STORED-RESIDUE>)>)
34 (ELSE <SET SCORE ,NO-RESIDUE>)>
35 <COND (<NOT <ACPREF .AC>> <SET SCORE <+ .SCORE ,NOT-PREF>>)>
36 <COND (<NOT .TYPE-AC> <SET SCORE <+ .SCORE <RATE .AC PREV>>>)
37 (ELSE <SET SCORE <+ .SCORE ,P-N-CLEAN>>)>
38 <SET SCORE <+ .SCORE <RATE .AC NEXT>>>
39 <COND (<G? .SCORE .WINNAGE>
43 <SET BEST <CHTYPE .BEST AC>>
44 ;"Make sure the poor compiler knows this guy is an AC"
45 <COND (<TYPE? .DAT DATUM> <PUT .BEST ,ACLINK (.DAT)>)
46 (ELSE <PUT .BEST ,ACLINK .DAT>)>
47 <COND (<ACRESIDUE .BEST>
49 <FUNCTION (SYMT "AUX" (INAC <SINACS .SYMT>) IAC)
51 <COND (<AND <TYPE? <SET IAC <DATTYP .INAC>> AC>
53 <FLUSH-RESIDUE .IAC .SYMT>)>
54 <COND (<AND <TYPE? <SET IAC <DATVAL .INAC>> AC>
56 <FLUSH-RESIDUE .IAC .SYMT>)>
59 <PUT .BEST ,ACRESIDUE <>>)>
60 <PUT .BEST ,ACAGE <SETG ATIME <+ ,ATIME 1>>>
63 <DEFINE ALL-STORED? (L) #DECL ((L) LIST)
64 <MAPF <> <FUNCTION (S) <COND (<AND <TYPE? .S SYMTAB>
66 <MAPLEAVE <>>)> T> .L>>
68 <DEFINE RATE (AC PREV-OR-NEXT
69 "AUX" (PREV <==? .PREV-OR-NEXT PREV>) (SCORE 0) OTHAC)
70 #DECL ((AC OTHAC) AC (PREV-OR-NEXT) ATOM)
73 <COND (<OR <==? .AC ,AC-A>
75 <NTH ,ALLACS <- <ACNUM .AC> 1>>>>>
77 (<OR <==? .AC ,LAST-AC>
78 <ACPROT <SET OTHAC <NTH ,ALLACS <+ <ACNUM .AC> 1>>>>>
80 <COND (<ACLINK .OTHAC> <RETURN ,P-N-LINKED>)>
81 <COND (<ACRESIDUE .OTHAC>
82 <COND (<ALL-STORED? <ACRESIDUE .OTHAC>>
83 <RETURN ,P-N-STO-RES>)
84 (ELSE <RETURN ,P-N-NO-STO-RES>)>)
85 (ELSE <RETURN ,P-N-CLEAN>)>>>
87 <DEFINE UNPREFER () <MAPF <> <FUNCTION (X) <PUT .X ,ACPREF <>>> ,ALLACS>>
89 <DEFINE PREFER-DATUM (WHERE)
90 #DECL ((WHERE) <OR DATUM ATOM>)
91 <COND (<NOT <TYPE? .WHERE ATOM>>
93 <PREF-AC <2 .WHERE>>)>>
95 <DEFINE PREF-AC (DAT) <COND (<TYPE? .DAT AC> <PUT .DAT ,ACPREF T>)>>
97 <DEFINE RELREG (AC D "AUX" (ACL <ACLINK .AC>))
98 #DECL ((AC) AC (ACL) <OR FALSE <LIST [REST DATUM]>> (D) DATUM)
102 <AND <EMPTY? .ACL> <RETURN>>
103 <COND (<==? <1 .ACL> .D>
104 <COND (<==? .ACL <ACLINK .AC>>
105 <PUT .AC ,ACLINK <REST .ACL>>)
106 (ELSE <PUTREST .ACP <REST .ACL>>)>)>
107 <SET ACL <REST <SET ACP .ACL>>>>
108 <AND <EMPTY? <ACLINK .AC>> <PUT .AC ,ACLINK <>>>)>
112 <DEFINE GETTMP (TYP) <CHTYPE <VECTOR <CREATE-TMP .TYP> <>> TEMP>>
114 <DEFINE SAVE:REG (AC FLS
115 "OPTIONAL" (HANDLE-VARS T)
116 "AUX" TMP (ACL <ACLINK .AC>) (TYPS <>) (VALS <>) TTMP HLAC)
117 #DECL ((AC) AC (TMP) TEMP (ACL) <OR FALSE <LIST [REST DATUM]>> (TTMP) DATUM)
119 (<AND .HANDLE-VARS <ACRESIDUE .AC>>
121 <FUNCTION (SYM "AUX" SAC (INAC <SINACS .SYM>))
122 #DECL ((SYM) SYMBOL (INAC) DATUM)
123 <COND (<AND <TYPE? .SYM SYMTAB> <NOT <STORED .SYM>>>
126 <COND (<AND <TYPE? <SET SAC <DATTYP .INAC>> AC>
128 <FLUSH-RESIDUE .SAC .SYM>)
129 (<AND <TYPE? <SET SAC <DATVAL .INAC>> AC>
131 <FLUSH-RESIDUE .SAC .SYM>)>
132 <SMASH-INACS .SYM <>>
135 <TYPE? <NUM-SYM .SYM> LIST>
137 <PUT <NUM-SYM .SYM> 1 <>>)>)>>
142 <GETTMP <COND (<AND <TYPE? <DATTYP <1 .ACL>> ATOM>
143 <VALID-TYPE? <DATTYP <1 .ACL>>>>
146 <OR .FLS <PUT .TMP ,TMPAC <DATUM !<1 .ACL>>>>
147 <COND (<TYPE? <DATTYP <SET TTMP <1 .ACL>>> TEMP>
148 <PUT <CHTYPE <DATVAL .TTMP> AC> ,ACPROT T>
150 <PUT <CHTYPE <DATVAL .TTMP> AC> ,ACPROT <>>)
151 (<TYPE? <DATVAL .TTMP> TEMP>
152 <PUT <CHTYPE <DATTYP .TTMP> AC> ,ACPROT T>
154 <PUT <CHTYPE <DATTYP .TTMP> AC> ,ACPROT <>>)>
158 <COND (<TYPE? <SET HLAC <DATTYP .D>> AC>
159 <OR .TYPS <SET TYPS .HLAC>>
160 <PUT <PUT .HLAC ,ACLINK <>> ,ACPROT <>>
162 <MEMQ .TMP <ACRESIDUE .HLAC>>
165 (.TMP !<ACRESIDUE <DATTYP .D>>)>>
166 <PUT .D ,DATTYP .TMP>)
167 (<TYPE? .HLAC OFFPTR>
168 <SET VALS <HACK-OFFPTR .HLAC .TMP>>
169 <SET VALS <3 .HLAC>>)>
170 <COND (<TYPE? <SET HLAC <DATVAL .D>> AC>
171 <OR .VALS <SET VALS .HLAC>>
172 <PUT <PUT .HLAC ,ACLINK <>> ,ACPROT <>>
174 <MEMQ .TMP <ACRESIDUE .HLAC>>
175 <PUT .HLAC ,ACRESIDUE (.TMP !<ACRESIDUE
177 <PUT .D ,DATVAL .TMP>)
178 (<TYPE? .HLAC OFFPTR>
179 <SET VALS <HACK-OFFPTR .HLAC .TMP>>
180 <SET TYPS <3 .HLAC>>)>>
182 <OR .TYPS <SET TYPS <DATTYP <1 .ACL>>>>
183 <SET VALS <CHTYPE <OR .VALS <DATVAL <1 .ACL>>> AC>>
184 <COND (<TYPE? .TYPS AC>
185 <STORE-TMP <ACSYM .TYPS> <ACSYM .VALS> <STEMP:ADDR .TMP>>)
186 (ELSE <STORE-TMP .TYPS <ACSYM .VALS> <STEMP:ADDR .TMP>>)>)>
189 <MESSAGE INCONSISTENCY "AC-LOSSAGE">>
190 <AND .FLS <PUT .AC ,ACRESIDUE <>>>
193 <DEFINE RETTMP (TMP "AUX" INAC AC)
194 #DECL ((TMP) TEMP (INAC) <OR FALSE DATUM>)
195 <COND (<SET INAC <SINACS .TMP>>
196 <COND (<TYPE? <SET AC <DATTYP .INAC>> AC>
197 <FLUSH-RESIDUE .AC .TMP>)>
198 <COND (<TYPE? <SET AC <DATVAL .INAC>> AC>
199 <FLUSH-RESIDUE .AC .TMP>)>)>>
201 <DEFINE MUNG-AC (AC "OPTIONAL" (GD <>) (FLS T) "AUX" ACL (ACPR <ACPROT .AC>))
202 #DECL ((AC) AC (GD ACL) <PRIMTYPE LIST>)
206 <FUNCTION (V "AUX" (INAC <SINACS .V>) TT)
207 #DECL ((INAC) <OR DATUM FALSE>)
211 <OR <COND (<OR <AND <==? .AC <DATTYP .INAC>>
212 <TYPE? <SET TT <DATVAL .INAC>> AC>>
213 <AND <==? .AC <DATVAL .INAC>>
214 <TYPE? <SET TT <DATTYP .INAC>> AC>>>
215 <MUNG-AC .TT .GD .FLS>)>
217 <AND <TYPE? <SET TT <DATTYP .INAC>> AC>
219 <MUNG-AC .TT .INAC .FLS>>
220 <AND <TYPE? <SET TT <DATVAL .INAC>> AC>
222 <MUNG-AC .TT .INAC .FLS>>>>>>
224 <COND (.FLS <PUT .AC ,ACRESIDUE <>>)>)>
225 <COND (<AND .GD <SET ACL <ACLINK .AC>>>
228 <AND <EMPTY? .ACL> <RETURN <SET GD <>>>>
229 <COND (<==? <1 .ACL> .GD>
231 <COND (<EMPTY? <REST .ACL>>
232 <PUT .AC ,ACLINK <>>)
233 (ELSE <PUT .AC ,ACLINK <REST .ACL>>)>)
234 (ELSE <PUTREST .OA <REST .ACL>>)>
236 <SET ACL <REST <SET OA .ACL>>>>)
241 <PUT .AC ,ACPROT .ACPR>)>
244 <DEFINE VAR-STORE ("OPTIONAL" (FLS T))
246 <MAPF <> <FUNCTION (AC) <MUNG-AC .AC <> .FLS>> ,ALLACS>>
248 <DEFINE GET:ACS () <MAPF ,LIST
249 <FUNCTION (X) <CHTYPE <VECTOR !.X> AC>>
252 <DEFINE REGSTO (FLUSH-RES "OPTIONAL" (HANDLE-VARS T))
254 <FUNCTION (AC) #DECL ((AC) AC) <SAVE:REG .AC .FLUSH-RES .HANDLE-VARS>>
257 <DEFINE SGETREG (AC DAT "AUX" (ACL <ACLINK .AC>))
258 #DECL ((AC) AC (ACL) <OR FALSE <LIST [REST DATUM]>>)
260 <MESSAGE INCONSISTENCY "NEEDED AC IS PROTECTED? ">>
268 (<AND <NOT <ACLINK .AC1>> <NOT <ACPROT .AC1>>>
270 <PUT .AC1 ,ACLINK .ACL>
271 <PUT .AC1 ,ACRESIDUE <ACRESIDUE .AC>>
273 <FUNCTION (D "AUX" (L <MEMQ .AC .D>))
274 #DECL ((D) DATUM (L) <PRIMTYPE LIST>)
275 <COND (.L <PUT .L 1 .AC1>)
277 <MESSAGE INCONSISTENCY " AC LOSSAGE ">)>>
280 <FUNCTION (SYM "AUX" L)
282 <COND (<SET L <MEMQ .AC <CHTYPE <SINACS .SYM> DATUM>>>
285 <PUT .AC ,ACRESIDUE <>>
286 <MOVE:VALUE .AC .AC1>
287 <MAPLEAVE T>)>> ,ALLACS>)
288 (ELSE <SAVE:REG .AC T>)>)
289 (ELSE <MUNG-AC .AC>)>
290 <COND (<TYPE? .DAT DATUM> <PUT .AC ,ACLINK (.DAT)>)
291 (ELSE <PUT .AC ,ACLINK .DAT>)>
292 <PUT .AC ,ACAGE <SETG ATIME <+ ,ATIME 1>>>
295 <DEFINE DATUM (TY VA) #DECL ((VALUE) DATUM) <CHTYPE (.TY .VA) DATUM>>
297 <DEFINE OFFPTR (OFF DAT TYP) <CHTYPE (.OFF .DAT .TYP) OFFPTR>>
299 <DEFINE SPEC-OFFPTR (OFF DAT TYP AT) <CHTYPE (.OFF .DAT .TYP .AT) OFFPTR>>
301 <DEFINE DATTYP-FLUSH (DAT)
303 <COND (<N==? <DATVAL .DAT> <DATTYP .DAT>>
304 <RET-TMP-AC <DATTYP .DAT> .DAT>)>>
306 <DEFINE RET-TMP-AC (ADR "OPTIONAL" D "AUX" (AD .ADR))
308 <COND (<TYPE? .ADR AC> <RELREG .ADR .D>)
309 (<TYPE? .ADR TEMP> <RETTMP .ADR>)
312 <AND <EMPTY? .ADR> <RETURN>>
313 <RET-TMP-AC <DATTYP .ADR> .AD>
314 <RET-TMP-AC <DATVAL .ADR> .AD>
315 <SET ADR <REST .ADR 2>>>)
316 (<TYPE? .ADR OFFPTR> <RET-TMP-AC <2 .ADR>>)>>
319 <DEFINE TOACV (DAT "AUX" AC)
320 #DECL ((DAT) DATUM (AC) AC)
322 <COND (<NOT <TYPE? <DATVAL .DAT> AC>>
323 <MOVE:VALUE <DATVAL .DAT> <SET AC <GETREG .DAT>>>
324 <RET-TMP-AC <DATVAL .DAT>>
325 <PUT .DAT ,DATVAL .AC>)>
328 <DEFINE TOACT (DAT "AUX" AC)
329 #DECL ((DAT) DATUM (AC) AC)
331 <COND (<NOT <TYPE? <DATTYP .DAT> AC>>
332 <MOVE:TYP <DATTYP .DAT> <SET AC <GETREG .DAT>>>
334 <PUT .DAT ,DATTYP .AC>)>
338 <COND (<TYPE? .AC AC>
339 <REPEAT ((F ,ALLACS) (AC .AC))
340 #DECL ((F) <UVECTOR [REST AC]> (AC) AC)
341 <AND <==? .AC <1 .F>> <RETURN <NOT <ACLINK <2 .F>>>>>
342 <AND <EMPTY? <REST <SET F <REST .F>>>> <RETURN <>>>>)>>
345 #DECL ((VALUE) <OR AC FALSE>)
346 <REPEAT ((F ,ALLACS))
347 #DECL ((F) <UVECTOR [REST AC]>)
348 <AND <NOT <ACLINK <1 .F>>>
349 <NOT <ACLINK <2 .F>>>
351 <AND <EMPTY? <REST <SET F <REST .F>>>> <RETURN <>>>>>
353 <DEFINE ANY2ACS ("AUX" T)
354 #DECL ((VALUE) DATUM)
355 <RELREG <DATTYP <SET T <DATUM <GETREG ()> <GETREG <>>>>>
360 #DECL ((VALUE) <OR AC FALSE>)
361 <REPEAT ((F ,ALLACS))
362 #DECL ((F) <UVECTOR [REST AC]>)
363 <OR <ACLINK <1 .F>> <RETURN <1 .F>>>
364 <AND <EMPTY? <SET F <REST .F>>> <RETURN <>>>>>
366 <DEFINE FREE-ACS ("OPTIONAL" (SUPER-FREE <>) "AUX" (N 0))
367 #DECL ((N VALUE) FIX)
371 <COND (<AND <NOT <ACPROT .AC>>
373 <OR <NOT .SUPER-FREE>
374 <AND <NOT <ACRESIDUE .AC>>
375 <NOT <ACPREF .AC>>>>>
380 <DEFINE SAVE-STATE ("AUX" (STATV #SAVED-STATE ()) ST)
381 #DECL ((STATV) SAVED-STATE (ST) <OR FALSE <LIST NODE>>)
383 <FUNCTION (AC) #DECL ((AC) AC)
387 <LIST !<ACRESIDUE .AC>>
392 <AND <TYPE? .X SYMTAB> <STORED .X>>
393 <AND <TYPE? .X SYMTAB>
394 <AND <SET ST <PROG-AC .X>>
395 <NOT <MEMQ .X <LOOP-VARS <1 .ST>>>>>>)>
396 <CHTYPE <ACRESIDUE .AC> LIST>>)
402 <DEFINE RESTORE-STATE (STATV
404 "AUX" (MUNGED-SYMS ()) PA OACR)
405 #DECL ((STATV) SAVED-STATE (PA) <OR FALSE <LIST NODE>> (OACR) <OR FALSE LIST>)
408 "AUX" (AC <1 .ACLST>) (SMT <2 .ACLST>) (SYMT <REST .ACLST 2>))
411 <OR FALSE <LIST [REST SYMBOL]>>
412 [REST <LIST SYMBOL ANY>]>
414 <LIST [REST <LIST SYMBOL ANY>]>
418 <OR FALSE <LIST [REST SYMBOL]>>)
419 <AND .SMT <EMPTY? .SMT> <SET SMT <>>>
422 <OR <MEMQ .ST .MUNGED-SYMS> <SMASH-INACS .ST <> <>>>>
424 <AND .SMT <SET SMT <LIST !.SMT>>>
425 <SET OACR <ACRESIDUE .AC>>
426 <PUT .AC ,ACRESIDUE .SMT>
428 <FUNCTION (SYMB "AUX" (SYMT <1 .SYMB>) (INAC <2 .SYMB>))
429 #DECL ((SYMB) <LIST SYMBOL ANY> (SYMT) SYMBOL)
430 <COND (<TYPE? .SYMT SYMTAB>
433 <GET-STORED .SYMT <3 .SYMB> <4 .SYMB>>>
434 <COND (<SET PA <PROG-AC .SYMT>>
436 <NOT <MEMQ .SYMT <LOOP-VARS <1 .PA>>>>
438 <NOT <MEMQ .SYMT .OACR>>
440 <FLUSH-RESIDUE .AC .SYMT>
443 <FLUSH-RESIDUE .AC .SYMT>
445 <OR <MEMQ .SYMT .MUNGED-SYMS>
446 <SET MUNGED-SYMS (.SYMT !.MUNGED-SYMS)>>
447 <SMASH-INACS .SYMT .INAC>>
451 <DEFINE GET-STORED (SYMT PREV-STORED PROG-AC-POSS "AUX" PAC)
452 #DECL ((PREV-STORED PROG-AC-POSS) <OR FALSE ATOM> (PAC) <OR FALSE <LIST NODE>>
456 <OR <NOT <SET PAC <PROG-AC .SYMT>>>
457 <NOT <MEMQ .SYMT <LOOP-VARS <1 .PAC>>>>>>)
460 <DEFINE MERGE-STATE (STATV)
461 #DECL ((STATV) SAVED-STATE)
464 "AUX" (AC <1 .STATV>) (DATS <REST .STATV 2>)
465 (STATAC <ACRESIDUE .AC>) (NINACS ()) (NRES ()))
466 #DECL ((STATV) <LIST AC ANY [REST <LIST SYMBOL ANY>]>
467 (AC) AC (DATS) <LIST [REST <LIST SYMBOL ANY>]>
468 (STATAC) <OR FALSE <LIST [REST SYMBOL]>>
469 (NRES) <LIST [REST SYMBOL]>
470 (NINACS) <LIST [REST <LIST SYMBOL ANY>]>)
473 "AUX" (SYMT <1 .ACX>) (INAC <2 .ACX>) (OINAC <SINACS .SYMT>)
475 #DECL ((ACX) <LIST SYMBOL ANY>
477 (INAC OINAC) <PRIMTYPE LIST>)
478 <COND (<TYPE? .SYMT SYMTAB>
479 <COND (<STORED .SYMT>
482 <GET-STORED .SYMT <3 .ACX> <4 .ACX>>>)>
483 <COND (<AND <SS-POTENT-SLOT .ACX> <NOT <PROG-AC .SYMT>>>
486 (<AND <MEMQ .SYMT .STATAC>
490 <==? <DATVAL .INAC> <DATVAL .OINAC>>
491 <OR <==? <DATTYP .INAC> <DATTYP .OINAC>>
492 <AND <TYPE? .SYMT SYMTAB>
494 <ISTYPE? <1 <CHTYPE <DECL-SYM .SYMT>
496 <OR <==? <DATTYP .INAC> .TEM>
497 <==? <DATTYP .OINAC> .TEM>>>>>
498 <SET NRES (.SYMT !.NRES)>
500 ((.SYMT <DATUM <OR .TEM <DATTYP .INAC>> <DATVAL .INAC>>)
503 <OR <TYPE? <SET TEM <DATTYP .INAC>> AC>
504 <TYPE? <SET TEM <DATTYP .OINAC>> AC>>>
505 <FLUSH-RESIDUE .TEM .SYMT>)>)>
507 <OR <==? .AC <DATTYP .OINAC>>
508 <==? .AC <DATVAL .OINAC>>>>
509 <SMASH-INACS .SYMT <> <>>)>>
513 #DECL ((SYMT) SYMBOL)
514 <SMASH-INACS .SYMT <> <>>>
516 <PUT .AC ,ACRESIDUE <COND (<NOT <EMPTY? .NRES>> .NRES)>>
518 <FUNCTION (SYMB "AUX" (SYMT <1 .SYMB>) (ELEIN <2 .SYMB>))
519 #DECL ((SYMT) SYMBOL)
520 <SMASH-INACS .SYMT .ELEIN>>
525 #DECL ((SYM) SYMBOL (VALUE) <OR DATUM FALSE>)
526 <COND (<TYPE? .SYM TEMP> <TMPAC .SYM>)
527 (<TYPE? .SYM COMMON> <COMMON-DATUM .SYM>)
530 <DEFINE SMASH-INACS (ITEM OBJ "OPTIONAL" (SMASH-NUM-SYM T))
531 #DECL ((ITEM) SYMBOL)
532 <COND (<TYPE? .ITEM COMMON> <PUT .ITEM ,COMMON-DATUM .OBJ>)
533 (<TYPE? .ITEM TEMP> <PUT .ITEM ,TMPAC .OBJ>)
534 (ELSE <PUT .ITEM ,INACS .OBJ>)>>
536 <DEFINE TEMP-MOD (DAT "AUX" TAC VAC TDAC VDAC)
538 <COND (<TYPE? <SET TDAC <DATTYP .DAT>> TEMP>
539 <COND (<SET TAC <TMPAC .TDAC>>
540 <AND <TYPE? <SET TAC <DATTYP .TAC>> AC>
541 <PUT .TAC ,ACLINK (.DAT)>
542 <PUT .DAT ,DATTYP .TAC>
543 <OR <MEMQ .TDAC <CHTYPE <ACRESIDUE .TAC> LIST>>
546 (.TDAC !<ACRESIDUE .TAC>)>>>)>)>
547 <COND (<TYPE? <SET VDAC <DATVAL .DAT>> TEMP>
548 <COND (<SET VAC <TMPAC .VDAC>>
549 <AND <TYPE? <SET VAC <DATVAL .VAC>> AC>
550 <PUT .VAC ,ACLINK (.DAT)>
551 <PUT .DAT ,DATVAL .VAC>
552 <OR <MEMQ .VDAC <CHTYPE <ACRESIDUE .VAC> LIST>>
555 (.VDAC !<ACRESIDUE .VAC>)>>>)>)>>
557 <DEFINE POTENT-L-V? (SYM "AUX" PA) #DECL ((SYM) SYMTAB (PA) <OR FALSE <LIST NODE>>)
558 <COND (<AND <STORED .SYM>
559 <SET PA <PROG-AC .SYM>>
560 <NOT <MEMQ .SYM <LOOP-VARS <1 .PA>>>>> T)>>
564 <DEFINE SAVE:RES ("AUX" (SYM-LIST ())) #DECL ((SYM-LIST) LIST)
569 <FUNCTION (SYMT "AUX" ONSYMT OP!-PACKAGE)
570 <COND (<AND <TYPE? .SYMT SYMTAB>
571 <NOT <MEMQ .SYMT .SYM-LIST>>>
572 <SET OP!-PACKAGE <POTLV .SYMT>>
573 <SET ONSYMT <NUM-SYM .SYMT>>
574 <SMASH-NUM-SYM .SYMT>
582 <COND (<NOT <STORED .SYMT>> <STOREV .SYMT <>>)
584 <COND (<NOT .OP!-PACKAGE>
585 <PUT .SYMT ,STORED <>>
587 <PUT .SYMT ,POTLV T>)>
588 <PUT .SYM-LIST 5 <LIST !<NUM-SYM .SYMT>>>)>)>>
593 <DEFINE SAVE-NUM-SYM (SYM-LIST "AUX" (L (())) (LP .L) TMP)
594 #DECL ((SYM-LIST) <LIST [REST SYMTAB ANY ANY <OR FALSE ATOM> ANY]>)
596 <COND (<EMPTY? .SYM-LIST> <RETURN <REST .L>>)>
601 (<LIST !<COND (<AND <TYPE? <SET TMP <NUM-SYM <1 .SYM-LIST>>> LIST>
605 <SET SYM-LIST <REST .SYM-LIST 5>>>>
607 <DEFINE FIX-NUM-SYM (L1 L2 "AUX" LL TMP)
608 #DECL ((L1) <LIST [REST LIST]>
609 (L2) <LIST [REST SYMTAB ANY ANY <OR FALSE ATOM> ANY]>)
611 <COND (<OR <EMPTY? .L1> <EMPTY? .L2>> <RETURN>)
612 (<AND <TYPE? <SET TMP <NUM-SYM <1 .L2>>> LIST>
615 <REPEAT ((L <REST .TMP>))
616 <COND (<EMPTY? .L> <RETURN>)>
617 <COND (<NOT <MEMQ <1 .L> .LL>>
618 <PUTREST .TMP <REST .L>>
620 (ELSE <SET L <REST <SET TMP .L>>>)>>)>
622 <SET L2 <REST .L2 5>>>>
624 <DEFINE CHECK:VARS (RES UNK "AUX" SLOT TEM SYMT PRGAC)
626 <LIST [REST SYMTAB ANY ANY <OR FALSE ATOM> <OR FALSE LIST>]>
632 <OR FALSE <LIST NODE>>
636 <COND (<EMPTY? .PTR> <RETURN>)>
638 <COND (<AND <INACS .SYMT> .UNK>
639 <COND (<AND <1 <SET SLOT <NUM-SYM .SYMT>>>
640 <NOT <EMPTY? <REST .SLOT>>>>
641 <PUT .SYMT ,STORED <POTENT-L-V? .SYMT>>
642 <MAPF <> ,KILL-STORE <REST .SLOT>>)>)>
643 <COND (<AND <POTLV .SYMT>
644 <NOT <AND <SET PRGAC <PROG-AC .SYMT>>
645 <MEMQ .SYMT <LOOP-VARS <1 .PRGAC>>>>>
647 <G=? <LENGTH .TEM> 1>
650 <MAPF <> ,KILL-STORE <REST .TEM>>)>
651 <COND (<=? <NUM-SYM .SYMT> '(#FALSE ())>
652 <PUT .SYMT ,NUM-SYM <3 .PTR>>
653 <COND (<AND <TYPE? <NUM-SYM .SYMT> LIST>
654 <NOT <EMPTY? <NUM-SYM .SYMT>>>>
655 <PUT <NUM-SYM .SYMT> 1 <>>)>)
656 (ELSE <PUT .SYMT ,NUM-SYM <3 .PTR>>)>
657 <PUT .SYMT ,POTLV <4 .PTR>>
658 <SET PTR <REST .PTR 5>>>>
661 <DEFINE STORE-TVAR (NAME DAT1 DAT2 ADDR)
662 <EMIT <CHTYPE [,STORE:TVAR
667 <NOT <TYPE? .DAT1 AC>>]
670 <DEFINE KILL-STORE (SS)
671 <SET SS <CHTYPE .SS ATOM>>
672 <SET KILL-LIST (.SS !.KILL-LIST)>
673 <EMIT <CHTYPE [,KILL:STORE .SS] TOKEN>>>
675 <DEFINE STORE-VAR (NAME DAT ADDR BOOL)
677 <EMIT <CHTYPE [,STORE:VAR
680 <COND (<TYPE? <DATTYP .DAT> AC> <ACSYM <DATTYP .DAT>>)
682 <COND (<TYPE? <DATVAL .DAT> AC> <ACSYM <DATVAL .DAT>>)
687 <DEFINE FLUSH-RESIDUE (AC SYMT) #DECL ((AC) AC (SYMT) SYMBOL)
688 <AND <NOT <EMPTY? <ACRESIDUE .AC>>>
689 <PUT .AC ,ACRESIDUE <RES-FLS <ACRESIDUE .AC> .SYMT>>>>
692 <DEFINE CALL-INTERRUPT ("AUX" (ACDATA ![0 0!]) (ACLIST ()) (ACNUM 1))
693 #DECL ((ACNUM) FIX (ACDATA) <UVECTOR FIX FIX> (ACLIST) <SPECIAL LIST>)
695 <FUNCTION (AC "AUX" TYP (ACL <ACLINK .AC>) (ACR <ACRESIDUE .AC>))
696 #DECL ((AC) AC (ACR) <OR FALSE LIST> (ACL) <OR FALSE <LIST [REST DATUM]>>)
701 <DEPOSIT-DATA <1 .ACDATA>
708 <DEPOSIT-DATA <2 .ACDATA>
711 <DATTYP <1 .ACL>>>>)>)
716 <DEPOSIT-DATA <1 .ACDATA>
727 <SINACS <1 .ACR>>>>)>)>
728 <SET ACNUM <+ .ACNUM 1>>>
730 <COND (<AND <0? <1 .ACDATA>> <0? <2 .ACDATA>>> <EMIT '<INTGO!-OP!-PACKAGE>>)
732 <EMIT '<`SKIPGE |INTFLG >>
734 <FUNCTION (PTR "AUX" (TYP <1 .PTR>))
738 <FORM 0 <FORM TYPE-WORD!-OP!-PACKAGE .TYP>>>>
740 <EMIT <INSTRUCTION <COND (<0? <2 .ACDATA>> `SAVAC* ) (ELSE `LSAVA* )>
741 <COND (<0? <2 .ACDATA>>
742 [<FORM (<GETBITS <1 .ACDATA> <BITS 18 18>>)
743 <GETBITS <1 .ACDATA> <BITS 18>>>
746 [<FORM (<GETBITS <1 .ACDATA> <BITS 18 18>>)
747 <GETBITS <1 .ACDATA> <BITS 18>>>
748 <FORM (<GETBITS <2 .ACDATA> <BITS 18 18>>)
749 <GETBITS <2 .ACDATA> <BITS 18>>>
752 <DEFINE DEPOSIT-DATA (DATA ACNUM AC DAT "AUX" TYP)
753 #DECL ((DATA ACNUM) FIX (AC) AC (DAT) DATUM)
754 <COND (<TYPE? <SET TYP <DATTYP .DAT>> ATOM>
755 <DEPOSIT-TYPE .DATA .ACNUM .TYP>)
757 <COND (<N=? .AC .TYP> <DEPOSIT-AC .DATA .ACNUM .TYP>)
759 (<TYPE? .TYP OFFPTR> <DEPOSIT-TYPE .DATA .ACNUM <3 .TYP>>)>>
761 <DEFINE DEPOSIT-TYPE (DATA ACNUM TYP "AUX" (ACL .ACLIST))
762 #DECL ((DATA ACNUM) FIX (TYP) ATOM (ACLIST ACL) LIST)
763 <COND (<==? <TYPEPRIM .TYP> TEMPLATE>
765 <CHTYPE <PUTBITS .DATA
766 <NTH ,DATABITS .ACNUM>
767 #WORD *000000000077*>
769 <COND (<EMPTY? .ACL> <SET ACLIST (.TYP)>)
770 (<PUTREST <REST .ACL <- <LENGTH .ACL> 1>> (.TYP)>)>)
771 (<==? <TYPEPRIM .TYP> WORD>)
773 <CHTYPE <PUTBITS .DATA
774 <NTH ,DATABITS .ACNUM>
775 <+ <CHTYPE <PRIM-CODE <TYPE-C .TYP>> FIX> 8>>
779 <DEFINE DEPOSIT-AC (DATA ACNUM TYP)
780 #DECL ((DATA ACNUM) FIX (TYP) AC)
781 <CHTYPE <PUTBITS .DATA <NTH ,DATABITS .ACNUM> <ACNUM .TYP>>
792 <GDECL (DATABITS) <UVECTOR [6 BITS]>>
794 <DEFINE FIND-AC-TYPE (OBJ) <COND (<TYPE? .OBJ OFFPTR> <3 .OBJ>) (.OBJ)>>
796 <DEFINE FIND-AC-VAL (OBJ) <COND (<TYPE? .OBJ OFFPTR> <DATVAL <2 .OBJ>>)>>
798 <DEFINE FIND-TYPE-OF-ACL (DAT "AUX" D1)
800 <COND (<OR <TYPE? <SET D1 <DATTYP .DAT>> OFFPTR>
801 <TYPE? <SET D1 <DATVAL .DAT>> OFFPTR>>
802 <3 <CHTYPE .D1 OFFPTR>>) ;"This CHTYPE to get around compiler bug."
803 (<AND <TYPE? <SET D1 <DATTYP .DAT>> ATOM> <VALID-TYPE? .D1>>
806 <DEFINE HACK-OFFPTR (OFF TMP "AUX" DAT)
807 #DECL ((OFF) OFFPTR (TMP) TEMP)
809 <PUT .DAT ,DATVAL .TMP>>
813 <DEFINE STOREV (SYM "OPTIONAL" (FLS T) "AUX" (DAT <SINACS .SYM>))
814 #DECL ((SYM) <OR TEMP SYMTAB COMMON> (DAT) <OR FALSE DATUM>)
815 <SMASH-INACS .SYM <> <>>
821 <PROG ((SLOT <NUM-SYM .SYM>) NT ADDR)
822 <SET NT <GET-NUM-SYM .SYM>>
824 (<TYPE? <ADDR-SYM .SYM> TEMPV>
826 <COND (<TYPE? <DATTYP .DAT> AC> <ACSYM <DATTYP .DAT>>)
827 (ELSE <DATTYP .DAT>)>
828 <ACSYM <CHTYPE <DATVAL .DAT> AC>>
830 <LADDR .SYM <> <ISTYPE-GOOD? <DATTYP .DAT>> <>>>>>)
834 <DATVAL <SET ADDR <LADDR .SYM <> <ISTYPE-GOOD? <DATTYP .DAT>> <>>>>
835 <ISTYPE-GOOD? <DATTYP .ADDR>>>)>
837 <PUT .SYM ,STORED T>>>)>
838 <COND (.FLS <SMASH-INACS .SYM <>>)
839 (<SMASH-INACS .SYM .DAT>)>>
842 <DEFINE GET-NUM-SYM (SYM "AUX" (SLOT <NUM-SYM .SYM>) NT)
843 <COND (<AND <TYPE? .SLOT LIST> <1 .SLOT>>
844 <PUTREST .SLOT (<SET NT <MAKE:TAG "VAR">> !<REST .SLOT>)>)
849 <DEFINE KILL-LOOP-AC (SYMT "AUX" PNOD)
850 <COND (<AND <TYPE? .SYMT SYMTAB>
851 <SET PNOD <PROG-AC .SYMT>>
852 <NOT <MEMQ .SYMT <LOOP-VARS <PROG-SLOT .PNOD>>>>>
853 <PUT .SYMT ,PROG-AC <>>)>>
856 <DEFINE SMASH-NUM-SYM (SYM) #DECL ((SYM) SYMTAB) <PUT .SYM ,NUM-SYM (T)>>