1 <COND (<NOT <GASSIGNED? INST-NULLF>>
2 <SETG INST-NULLF <CHTYPE <LSH ,INST-NULL 24> FIX>>)>
4 <DEFINE SAVE-LOAD-STATE ()
5 #DECL ((VALUE) SLOAD-STATE)
8 <AND <NOT <AC-USE .AC>>
9 <CHTYPE <VECTOR <AC-LLOAD .AC> <AC-LLOAD-EA .AC>>
13 <DEFINE SET-AC-LOAD-STATE (LSTATE)
14 #DECL ((LSTATE) SLOAD-STATE)
19 <PUT .AC ,AC-LLOAD <ACL-LLOAD .ACLS>>
20 <PUT .AC ,AC-LLOAD-EA <ACL-LLOAD-EA .ACLS>>)
22 <PUT .AC ,AC-LLOAD <>>
23 <PUT .AC ,AC-LLOAD-EA <>>)>>
27 <DEFINE SAVE-STATE ("AUX" (CACHE ,VARIABLE-CACHE))
28 #DECL ((SSTATE) <OR FALSE VECTOR> (VALUE) <PRIMTYPE VECTOR>)
29 <MAPF ,VECTOR <FCN (LVAR) <COPY-LINKVAR .LVAR>> .CACHE>>
31 <DEFINE PAIR-MERGE-STATE (SSTATE1 SSTATE2
32 "OPTIONAL" (SSTATE <>) LEN
34 #DECL ((SSTATE1 SSTATE2) AC-STATE
35 (SSTATE) <OR FALSE <PRIMTYPE VECTOR>>)
36 <SET LEN <MAX <LENGTH .SSTATE1> <LENGTH .SSTATE2>>>
37 <COND (.SSTATE <SET SSTATE <ADJUST-LENGTH .SSTATE .LEN>>)
38 (ELSE <SET SSTATE <IVECTOR .LEN>>)>
39 <SET SSTATE <REST .SSTATE <LENGTH .SSTATE>>>
42 <COND (<SET LKV2 <LINK-FIND .LKV1 .SSTATE2>>
43 <COND (<SET LKV2 <ADJUST-LINKS .LKV1 .LKV2>>
44 <SET SSTATE <BACK .SSTATE>>
45 <PUT .SSTATE 1 .LKV2>)>)>>
49 <DEFINE LINK-FIND (LK1 LINKS "AUX" (VAR <LINKVAR-VAR .LK1>))
50 #DECL ((LK1) LINKVAR (LINKS) <VECTOR [REST LINKVAR]>)
53 <COND (<==? <LINKVAR-VAR .LK2> .VAR> <MAPLEAVE .LK2>)>>
56 <DEFINE ADJUST-LINKS (LK1 LK2
57 "AUX" DECL (VAC <>) (TAC <>) (TWAC <>) (CAC <>) MXREFS)
58 #DECL ((LK1 LK2) LINKVAR)
59 <COND (<==? <LINKVAR-DECL .LK1> <LINKVAR-DECL .LK2>>
60 <SET DECL <LINKVAR-DECL .LK1>>)
62 <COND (<==? <LINKVAR-TYPE-AC .LK1> <LINKVAR-TYPE-AC .LK2>>
63 <SET TAC <LINKVAR-TYPE-AC .LK1>>)>
64 <COND (<==? <LINKVAR-VALUE-AC .LK1> <LINKVAR-VALUE-AC .LK2>>
65 <SET VAC <LINKVAR-VALUE-AC .LK1>>)>
66 <COND (<==? <LINKVAR-COUNT-AC .LK1> <LINKVAR-COUNT-AC .LK2>>
67 <SET CAC <LINKVAR-COUNT-AC .LK1>>)>
68 <COND (<==? <LINKVAR-TYPE-WORD-AC .LK1> <LINKVAR-TYPE-WORD-AC .LK2>>
69 <SET TWAC <LINKVAR-TYPE-WORD-AC .LK1>>)>
70 <COND (<OR .VAC .TAC .TWAC .CAC>
71 <SET LK1 <COPY-LINKVAR .LK1>>
72 <PUT .LK1 ,LINKVAR-DECL .DECL>
73 <PUT .LK1 ,LINKVAR-TYPE-AC .TAC>
74 <PUT .LK1 ,LINKVAR-VALUE-AC .VAC>
75 <PUT .LK1 ,LINKVAR-TYPE-WORD-AC .TWAC>
76 <PUT .LK1 ,LINKVAR-COUNT-AC .CAC>
78 <MERGE-XREFS <LINKVAR-POTENTIAL-SAVES .LK1>
79 <LINKVAR-POTENTIAL-SAVES .LK2>>>
82 <AND <LINKVAR-VALUE-STORED .LK1>
83 <LINKVAR-VALUE-STORED .LK2>>>
86 <AND <LINKVAR-TYPE-STORED .LK1>
87 <LINKVAR-TYPE-STORED .LK2>>>
90 <AND <LINKVAR-COUNT-STORED .LK1>
91 <LINKVAR-COUNT-STORED .LK2>>>
92 <PUT .LK1 ,LINKVAR-POTENTIAL-SAVES .MXREFS>)>>
94 <DEFINE MERGE-XREFS (LX1 LX2)
95 #DECL ((LX1 LX2) <LIST [REST XREF-INFO]>)
97 <FCN (XF1) <COND (<MEMQ .XF1 .LX2> <MAPRET .XF1>) (<MAPRET>)>>
100 <DEFINE SET-AC-STATE (SSTATE)
101 #DECL ((SSTATE) AC-STATE)
102 <FLUSH-VAR-TEMP-DECLS>
103 <SETG VARIABLE-CACHE <REST ,VARIABLE-CACHE <LENGTH ,VARIABLE-CACHE>>>
105 <FUNCTION (AC "AUX" (VARS <AC-VARS .AC>))
107 <PUT .AC ,AC-VARS <REST .VARS <LENGTH .VARS>>>>
110 <FCN (LV "AUX" (VAR <LINKVAR-VAR .LV>) DCL)
112 <AND <SET DCL <LINKVAR-DECL .LV>>
113 <INDICATE-VAR-TEMP-DECL .VAR .DCL>>>
116 <FCN (FLKV "AUX" VAC (LKV <FIND-CACHE-VAR <LINKVAR-VAR .FLKV>>))
117 <AND <SET VAC <LINKVAR-VALUE-AC .LKV>>
118 <PLACE-LV-IN-AC .VAC .LKV>>
119 <AND <SET VAC <LINKVAR-TYPE-AC .LKV>>
120 <PLACE-LV-IN-AC .VAC .LKV>>
121 <AND <SET VAC <LINKVAR-COUNT-AC .LKV>>
122 <PLACE-LV-IN-AC .VAC .LKV>>
123 <AND <SET VAC <LINKVAR-TYPE-WORD-AC .LKV>>
124 <PLACE-LV-IN-AC .VAC .LKV>>>
128 <DEFINE PROCESS-LABEL-MERGE (LABEL UCB? PATCH
129 "AUX" SSTATE NSSTATE (PRE-STATE <>))
130 #DECL ((LABEL) LABEL-REF (UCB?) BOOLEAN (PATCH) FIX)
131 <COND (<NOT .UCB?> <SET PRE-STATE <SAVE-STATE>>)>
132 <SET SSTATE <COMPUTE-MERGE-STATE .PRE-STATE .LABEL>>
133 <OR .UCB? <ADJUST-PRE-LABEL .PRE-STATE .SSTATE .PATCH>>
136 <COND (<SET NSSTATE <XREF-INFO-SAVED-AC-INFO .XREF>>
137 <ADJUST-JUMP .XREF .NSSTATE .SSTATE>)>>
138 <LABEL-REF-XREFS .LABEL>>
139 <SET SSTATE <COMPUTE-MERGE-STATE .PRE-STATE .LABEL>>
140 <COND (.SSTATE <SET-AC-STATE .SSTATE>)
141 (<MAPF <> ,CLEAR-VARS-FROM-AC ,ALL-ACS>)>
142 <CLEAN-UP-LABEL .LABEL>>
144 <DEFINE CLEAN-UP-LABEL (LABEL)
145 #DECL ((LABEL) LABEL-REF)
148 <PUT .JUMP ,XREF-INFO-SAVED-AC-INFO <>>
149 <PUT .JUMP ,XREF-INFO-SLSTATE <>>>
150 <LABEL-REF-XREFS .LABEL>>>
152 <DEFINE COMPUTE-MERGE-STATE (PSSTATE LABEL "AUX" NSSTATE (SSTATE .PSSTATE))
153 #DECL ((PSSTATE) <OR FALSE AC-STATE> (LABEL) LABEL-REF)
156 <COND (<SET NSSTATE <XREF-INFO-SAVED-AC-INFO .XREF>>
157 <COND (<NOT .PSSTATE>
158 <SET PSSTATE .NSSTATE>
159 <SET SSTATE .PSSTATE>)
162 <PAIR-MERGE-STATE .PSSTATE .NSSTATE>>
163 <SET PSSTATE .SSTATE>)>)>>
164 <LABEL-REF-XREFS .LABEL>>
167 <DEFINE ADJUST-JUMP (XREF JSSTATE LSSTATE "AUX" SVEC)
168 #DECL ((XREF) XREF-INFO (JSSTATE LSSTATE) AC-STATE)
169 <SET-AC-LOAD-STATE <XREF-INFO-SLSTATE .XREF>>
170 <SET SVEC <GEN-INSERT .JSSTATE .LSSTATE .XREF>>
173 <XREF-INFO-STATUS .XREF>
174 <XREF-INFO-LILEN .XREF>
175 <XREF-INFO-CP .XREF>>>
176 <PUT .XREF ,XREF-INFO-STACK-SAVE-CODE .SVEC>>
178 <DEFINE PRE-INSERT (CDV STATUS? LILEN CP "AUX" INS1 (INS2 <>) RES)
179 #DECL ((CDV) CODEVEC (STATUS?) ANY (LILEN CP) FIX)
180 <COND (<OR <==? .STATUS? UNCONDITIONAL-BRANCH> <EMPTY? .CDV>> .CDV)
182 <SET INS1 <NTH-CODE <- .CP .LILEN>>>
183 <COND (<G=? .LILEN 2>
185 <REPEAT ((L ()) (NLILEN 0)) #DECL ((L) LIST)
186 <COND (<G=? <SET NLILEN <+ .NLILEN 1>>
189 <SET L (<NTH-CODE <- .CP .NLILEN>> !.L)>
190 <PUT-CODE <- .CP .NLILEN> ,INST-NULLF>>>)>
191 <COND (<TYPE? .STATUS? AC>
192 <SET RES <RE-GEN .CDV .STATUS? .INS1 .INS2>>)
193 (<==? .LILEN 1> <SET RES <UVECTOR !.CDV .INS1>>)
194 (<SET RES <UVECTOR !.CDV .INS1 !.INS2>>)>
195 <PUT-CODE <- .CP .LILEN> ,INST-NULLF>
198 <DEFINE RE-GEN (CDV AC INS1 INS2)
199 #DECL ((INS1) FIX (INS2) <OR FALSE <LIST [REST FIX]>>
200 (CDV) CODEVEC (AC) AC)
201 <SETG RE-GEN-POST ()>
203 <INT-RE-GEN .CDV .AC <>>
204 <COND (.INS2 <UVECTOR !,RE-GEN-PRE .INS1 !.INS2 !,RE-GEN-POST>)
205 (<UVECTOR !,RE-GEN-PRE .INS1 !,RE-GEN-POST>)>>
208 <DEFINE GET-I-FIELD (X) <CHTYPE <LSH .X -24> FIX>>
210 <DEFINE GET-S-FIELD (X "AUX" (OP1 <CHTYPE <ANDB <LSH .X -16> *377*> FIX>))
211 <COND (<==? <CHTYPE <ANDB .OP1 *360*> FIX> ,AM-REG>
212 <CHTYPE <ANDB .OP1 *17*> FIX>)
215 <DEFINE INT-RE-GEN (CDV AC PSAVE)
216 #DECL ((AC) AC (CDV) CODEVEC (PSAVE) <OR FALSE PTN-SAVE>)
217 <REPEAT (IFLD IREG INST)
218 <COND (<EMPTY? .CDV> <RETURN>)>
219 <SET IFLD <GET-I-FIELD <SET INST <1 .CDV>>>>
220 <SET IREG <GET-S-FIELD .INST>>
221 <COND (<==? .IFLD ,INST-PSTORE>
222 <SET PSAVE <GET-PTNS <CHTYPE <ANDB .INST
224 <PSTORE-RE-GEN <PTNS-CODE .PSAVE> .AC .PSAVE .INST>
225 <SET CDV <REST .CDV>>)
226 (<AND <OR <==? .IFLD ,INST-MOVW>
227 <==? .IFLD ,INST-MOVL>
228 <==? .IFLD ,INST-MOVB>>
229 <==? .IREG <AC-NUMBER .AC>>>
230 <GROUP-INST POST .PSAVE .INST (<2 .CDV>)>
231 <SET CDV <REST .CDV 2>>)
233 <COND (<OR <==? .IFLD ,INST-MOVB>
234 <==? .IFLD ,INST-MOVW>
235 <==? .IFLD ,INST-MOVL>>
236 <GROUP-INST PRE .PSAVE .INST (<2 .CDV>)>
237 <SET CDV <REST .CDV 2>>)
239 <GROUP-INST PRE .PSAVE .INST <>>
240 <SET CDV <REST .CDV>>)>)>>>
242 <DEFINE PSTORE-RE-GEN (CDV AC PSAVE INST)
243 #DECL ((AC) AC (CDV) CODEVEC (PSAVE) <OR FALSE PTN-SAVE> (INST) FIX)
244 <COND (<==? <TEST-PRE-POST .CDV .AC> ALL-PRE>
245 <GROUP-INST PRE <> .INST <>>)
246 (<==? <TEST-PRE-POST .CDV .AC> ALL-POST>
247 <GROUP-INST POST <> .INST <>>)
248 (<INT-RE-GEN .CDV .AC .PSAVE>)>>
250 <DEFINE TEST-PRE-POST (CDV AC "AUX" (MODE <>))
251 #DECL ((AC) AC (CDV) CODEVEC)
252 <REPEAT (IFLD IREG IMOD INST)
253 <COND (<EMPTY? .CDV> <RETURN .MODE>)>
254 <SET IFLD <GET-I-FIELD <SET INST <1 .CDV>>>>
255 <SET IREG <GET-S-FIELD .INST>>
256 <COND (<AND <OR <==? .IFLD ,INST-MOVW> <==? .IFLD ,INST-MOVL>>
257 <==? .IREG <AC-NUMBER .AC>>>
258 <COND (<N==? .MODE ALL-PRE> <SET MODE ALL-POST>)
260 <SET CDV <REST .CDV 2>>)
262 <COND (<==? .MODE ALL-POST> <RETURN MIXED>)
263 (<SET MODE ALL-PRE>)>
264 <COND (<OR <==? .IFLD ,INST-MOVB>
265 <==? .IFLD ,INST-MOVW>
266 <==? .IFLD ,INST-MOVL>>
267 <SET CDV <REST .CDV 2>>)
268 (<SET CDV <REST .CDV>>)>)>>>
270 <DEFINE GROUP-INST (MODE PSAVE INST1 INST2 "AUX" ADD NPSAVE)
271 #DECL ((MODE) ATOM (PSAVE) <OR FALSE PTN-SAVE> (INST1) FIX
272 (INST2) <OR FALSE LIST>)
274 <COND (.INST2 <SET ADD <UVECTOR .INST1 !.INST2>>)
275 (<SET ADD <UVECTOR .INST1>>)>
276 <SET NPSAVE <COPY-PSAVE .PSAVE .ADD>>
277 <COND (<==? .MODE PRE> <SETG RE-GEN-PRE (.NPSAVE !,RE-GEN-PRE)>)
278 (<SETG RE-GEN-POST (.NPSAVE !,RE-GEN-POST)>)>)
280 <COND (<==? .MODE PRE>
282 <SETG RE-GEN-PRE (.INST1 !.INST2 !,RE-GEN-PRE)>)
283 (<SETG RE-GEN-PRE (.INST1 !,RE-GEN-PRE)>)>)
285 <SETG RE-GEN-POST (.INST1 !.INST2 !,RE-GEN-POST)>)
286 (<SETG RE-GEN-POST (.INST1 !,RE-GEN-POST)>)>)>)>>
288 <DEFINE GEN-INSERT (JSSTATE LSSTATE "OPTIONAL" (XREF <>))
289 #DECL ((JSSTATE LSSTATE) AC-STATE)
292 <FCN (JLV "AUX" LLV (VAR <LINKVAR-VAR .JLV>))
293 <COND (<SET LLV <FIND-CACHE-VAR .VAR .LSSTATE>>
294 <CHECK-VALUE-STORED .JLV .LLV .XREF>
295 <CHECK-TYPE-STORED .JLV .LLV .XREF>
296 <CHECK-COUNT-STORED .JLV .LLV .XREF>)
297 (ELSE <ISTORE-VAR .JLV .XREF>)>>
301 <DEFINE ADJUST-PRE-LABEL (JSSTATE LSSTATE PATCH "AUX" SVEC)
302 #DECL ((JSSTATE LSSTATE) AC-STATE (PATCH) FIX)
303 <SET SVEC <GEN-INSERT .JSSTATE .LSSTATE>>
304 <INSERT-PATCH .PATCH .SVEC>>
306 <DEFINE CHECK-VALUE-STORED (JLV LLV XREF
307 "AUX" DADDR VAC (VAR <LINKVAR-VAR .JLV>) SVEC)
308 #DECL ((JLV LLV) LINKVAR (XREF) <OR FALSE XREF-INFO>)
309 <COND (<AND <LINKVAR-VALUE-AC .JLV>
310 <NOT <LINKVAR-VALUE-AC .LLV>>
311 <NOT <LINKVAR-VALUE-STORED .JLV>>>
313 <COND (<NOT <SET VAC <LINKVAR-VALUE-AC .JLV>>>
314 <ERROR "VARIABLE NOT IN AC" CHECK-VALUE-STORED>)>
315 <SET DADDR <ADDR-VAR-VALUE .VAR>>
316 <EMIT-STORE-AC .VAC .DADDR LONG>
317 <PUT .JLV ,LINKVAR-VALUE-STORED T>
318 <SET SVEC <END-CODE-INSERT>>
319 <EMIT-POTENTIAL-STORE .SVEC VALUE .JLV>
320 <AND .XREF <KILL-STORES .XREF VALUE .VAR>>)>>
322 <DEFINE KILL-STORES (XREF KIND VAR)
323 #DECL ((XREF) XREF-INFO (KIND) ATOM (VAR) VARTBL)
326 <COND (<AND <==? <PTNS-VAR .PSAVE> .VAR>
327 <STRONGER-SAVE? .KIND <PTNS-KIND .PSAVE>>>
328 <KILL-PSAVE .PSAVE>)>>
329 <XREF-INFO-PSAVES .XREF>>>
331 <DEFINE STRONGER-SAVE? (KIND1 KIND2)
332 #DECL ((KIND1 KIND2) ATOM)
333 <OR <==? .KIND1 .KIND2>
334 <==? .KIND1 TYPE-COUNT-VALUE>
335 <AND <==? .KIND1 TYPE-COUNT>
336 <OR <==? .KIND2 TYPE> <==? .KIND2 COUNT>>>
337 <AND <==? .KIND1 TYPE-VALUE>
338 <OR <==? .KIND2 TYPE> <==? .KIND2 VALUE>>>
339 <AND <==? .KIND1 COUNT-VALUE>
340 <OR <==? .KIND2 COUNT> <==? .KIND2 VALUE>>>>>
342 <DEFINE CHECK-TYPE-STORED (JLV LLV XREF
343 "AUX" DADDR TAC DCL (VAR <LINKVAR-VAR .JLV>) SVEC
345 #DECL ((JLV LLV) LINKVAR (XREF) <OR FALSE XREF-INFO>)
346 <COND (<AND <NOT <LINKVAR-TYPE-STORED .JLV>>
347 <NOT <LINKVAR-DECL .LLV>>
348 <NOT <LINKVAR-TYPE-AC .LLV>>
349 <NOT <LINKVAR-TYPE-WORD-AC .LLV>>>
351 <SET DADDR <ADDR-VAR-TYPE .VAR>>
352 <PUT .JLV ,LINKVAR-TYPE-STORED T>
353 <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .JLV>>
354 <EMIT-STORE-AC .TAC .DADDR LONG>
355 <PUT .JLV ,LINKVAR-COUNT-STORED T>
356 <SET KIND TYPE-COUNT>)
357 (<SET DCL <LINKVAR-DECL .JLV>>
358 <STORE-TYPE .DCL .DADDR>
359 <COND (<NOT <COUNT-NEEDED? .DCL>>
360 <PUT .JLV ,LINKVAR-COUNT-STORED T>)>)
361 (<SET TAC <LINKVAR-TYPE-AC .JLV>>
362 <EMIT-STORE-AC .TAC .DADDR WORD>)
363 (<ERROR "VARIABLE NOT IN AC" ISTORE-ADDR>)>
364 <SET SVEC <END-CODE-INSERT>>
365 <EMIT-POTENTIAL-STORE .SVEC .KIND .JLV>
366 <AND .XREF <KILL-STORES .XREF .KIND .VAR>>)>>
368 <DEFINE CHECK-COUNT-STORED (JLV LLV XREF
369 "AUX" DADDR TAC DCL SVEC (KIND COUNT)
370 (VAR <LINKVAR-VAR .JLV>))
371 #DECL ((JLV LLV) LINKVAR (XREF) <OR FALSE XREF-INFO>)
372 <COND (<AND <NOT <LINKVAR-COUNT-AC .LLV>>
373 <NOT <LINKVAR-TYPE-WORD-AC .LLV>>
374 <NOT <LINKVAR-COUNT-STORED .JLV>>
375 <OR <NOT <SET DCL <LINKVAR-DECL .LLV>>>
376 <COUNT-NEEDED? .DCL>>
377 <OR <NOT <SET DCL <LINKVAR-DECL .JLV>>>
378 <COUNT-NEEDED? .DCL>>>
380 <SET DADDR <ADDR-VAR-COUNT <LINKVAR-VAR .JLV>>>
381 <PUT .JLV ,LINKVAR-COUNT-STORED T>
382 <COND (<SET TAC <LINKVAR-TYPE-WORD-AC .JLV>>
383 <SET DADDR <ADDR-VAR-TYPE <LINKVAR-VAR .JLV>>>
384 <EMIT-STORE-AC .TAC .DADDR LONG>
385 <PUT .JLV ,LINKVAR-TYPE-STORED T>
386 <SET KIND TYPE-COUNT>)
387 (<SET TAC <LINKVAR-COUNT-AC .JLV>>
388 <EMIT-STORE-AC .TAC .DADDR WORD>)>
389 <SET SVEC <END-CODE-INSERT>>
390 <EMIT-POTENTIAL-STORE .SVEC .KIND .JLV>
391 <AND .XREF <KILL-STORES .XREF .KIND .VAR>>)>>
393 <DEFINE SETUP-PSAVES (XREF "AUX" (CACHE ,VARIABLE-CACHE))
394 #DECL ((XREF) XREF-INFO)
396 <FCN (LVAR "AUX" (PSAVES <LINKVAR-POTENTIAL-SAVES .LVAR>))
397 <PUT .LVAR ,LINKVAR-POTENTIAL-SAVES (.XREF !.PSAVES)>>
400 <DEFINE LOOP-GEN ("TUPLE" VARS)
401 #DECL ((VARS) <TUPLE [REST <OR ATOM LIST>]>)
404 <FCN (MVARS "AUX" (VARLST <1 .MVARS>))
405 <COND (<TYPE? .VARLST ATOM>
406 <PUT .MVARS 1 <LIST <FIND-VAR .VARLST> VALUE>>)
409 (<FIND-VAR <1 .VARLST>> !<REST .VARLST>)>)>>
411 <SETUP-LOOP-ACS .VARS>
412 <SETG LOOP-VARS <SAVE-STATE>>
416 <DEFINE SETUP-LOOP-ACS (VARS "AUX" TAC)
417 #DECL ((VARS) <TUPLE [REST LIST]>)
419 <FCN (LVAR "AUX" (VAR <LINKVAR-VAR .LVAR>))
420 <COND (<NOT <FIND-INFO .VAR .VARS>>
425 <FCN (LVAR "AUX" (VAR <LINKVAR-VAR .LVAR>) RVAR NLVAR
426 (CS <LINKVAR-COUNT-STORED .LVAR>)
427 (VS <LINKVAR-VALUE-STORED .LVAR>)
428 (TS <LINKVAR-TYPE-STORED .LVAR>))
429 <SET RVAR <FIND-INFO .VAR .VARS>>
430 <SET NLVAR <COPY-LINKVAR .LVAR>>
431 <AND <MEMQ TYPE .RVAR> <SET TS T>>
432 <AND <MEMQ VALUE .RVAR> <SET VS T>>
433 <COND (<MEMQ LENGTH .RVAR>
436 ; "Make sure that if we're storing the type we also store
437 the value, so we don't get garbage pointers on the stack."
438 <COND (<OR <NOT .VS><NOT .TS><NOT .CS>>
440 (<LINKVAR-COUNT-STORED .NLVAR .CS>
441 <LINKVAR-TYPE-STORED .NLVAR .TS>
442 <LINKVAR-VALUE-STORED .NLVAR .VS>)>
443 <COND (<AND <SET TAC <LINKVAR-TYPE-AC .NLVAR>>
444 <NOT <MEMQ TYPE .RVAR>>>
445 <AND <LINKVAR-TYPE-AC .LVAR> <BREAK-LINK .TAC .VAR>>
446 <PUT .LVAR ,LINKVAR-TYPE-STORED T>)>
447 <COND (<AND <SET TAC <LINKVAR-COUNT-AC .NLVAR>>
448 <NOT <MEMQ LENGTH .RVAR>>>
449 <PUT .LVAR ,LINKVAR-COUNT-STORED T>
450 <AND <LINKVAR-COUNT-AC .LVAR> <BREAK-LINK .TAC .VAR>>)>
451 <COND (<AND <SET TAC <LINKVAR-TYPE-WORD-AC .NLVAR>>
452 <NOT <MEMQ TYPE .RVAR>>
453 <NOT <MEMQ LENGTH .RVAR>>>
454 <AND <LINKVAR-TYPE-WORD-AC .LVAR> <BREAK-LINK .TAC .VAR>>
455 <PUT .LVAR ,LINKVAR-TYPE-STORED T>
456 <PUT .LVAR ,LINKVAR-COUNT-STORED T>)>>
459 <FCN (RVAR "AUX" VAC (VAR <1 .RVAR>) LVAR)
460 <COND (<VARTBL-ASSIGNED? .VAR>
461 <COND (<SET LVAR <FIND-CACHE-VAR .VAR>>
462 <AND <SET VAC <LINKVAR-TYPE-AC .LVAR>> <PROTECT .VAC>>
463 <AND <SET VAC <LINKVAR-COUNT-AC .LVAR>> <PROTECT .VAC>>
464 <AND <SET VAC <LINKVAR-TYPE-WORD-AC .LVAR>>
466 <AND <MEMQ VALUE .RVAR> <PROTECT <LOAD-VAR-APP .VAR <>>>>
467 <COND (<AND <MEMQ TYPE .RVAR> <MEMQ LENGTH .RVAR>>
468 <PROTECT <LOAD-VAR .VAR TYPE-WORD <> PREF-TYPE>>)
470 <PROTECT <LOAD-VAR .VAR TYPE <> PREF-TYPE>>)
472 <PROTECT <LOAD-VAR .VAR TYPE-WORD <> PREF-TYPE>>)>
473 <SET LVAR <FIND-CACHE-VAR .VAR>>
474 <LINKVAR-POTENTIAL-SAVES .LVAR ()>
475 <AND <MEMQ TYPE .RVAR> <PUT .LVAR ,LINKVAR-TYPE-STORED <>>>
476 <AND <MEMQ VALUE .RVAR> <PUT .LVAR ,LINKVAR-VALUE-STORED <>>>
477 <AND <MEMQ LENGTH .RVAR>
478 <PUT .LVAR ,LINKVAR-COUNT-STORED <>>>)>>
482 <DEFINE FIND-INFO (VAR VARS)
483 #DECL ((VAR) VARTBL (VARS) <TUPLE [REST LIST]>)
485 <FCN (RVAR) <COND (<==? .VAR <1 .RVAR>> <MAPLEAVE .RVAR>)>>
488 <DEFINE RESTORE-LOOP-STATE (LSTATE)
489 #DECL ((LSTATE) AC-STATE)
491 <FCN (LVAR "AUX" (VAR <LINKVAR-VAR .LVAR>) LVAR1)
492 <COND (<SET LVAR1 <FIND-CACHE-VAR .VAR .LSTATE>>
493 <PROTECT-MATCHES .LVAR .LVAR1>)
494 (ELSE <ISTORE-VAR .LVAR <> T> <DEAD-VAR .VAR>)>>
497 <FCN (LVAR "AUX" (VAR <LINKVAR-VAR .LVAR>) VAC)
498 <AND <SET VAC <LINKVAR-VALUE-AC .LVAR>>
499 <PROTECT <LP-LOAD-VAR .VAR VALUE <> .VAC>>>
500 <AND <SET VAC <LINKVAR-TYPE-AC .LVAR>>
501 <PROTECT <LP-LOAD-VAR .VAR TYPE <> .VAC>>>
502 <AND <SET VAC <LINKVAR-TYPE-WORD-AC .LVAR>>
503 <PROTECT <LP-LOAD-VAR .VAR TYPE-WORD <> .VAC>>>
504 <AND <SET VAC <LINKVAR-COUNT-AC .LVAR>>
505 <PROTECT <LP-LOAD-VAR .VAR COUNT <> .VAC>>>>
507 <SET-AC-STATE .LSTATE>>
509 <DEFINE PROTECT-MATCHES (LVAR1 LVAR2 "AUX" VAC (VAR <LINKVAR-VAR .LVAR1>))
510 #DECL ((LVAR1 LVAR2) LINKVAR)
511 <AND <LINKVAR-VALUE-AC .LVAR2> <PUT .LVAR1 ,LINKVAR-VALUE-STORED T>>
512 <AND <LINKVAR-TYPE-AC .LVAR2> <PUT .LVAR1 ,LINKVAR-TYPE-STORED T>>
513 <AND <LINKVAR-COUNT-AC .LVAR2> <PUT .LVAR2 ,LINKVAR-COUNT-STORED T>>
514 <AND <LINKVAR-TYPE-WORD-AC .LVAR2>
515 <PUT .LVAR1 ,LINKVAR-TYPE-STORED T>
516 <PUT .LVAR1 ,LINKVAR-COUNT-STORED T>>
517 <COND (<SET VAC <LINKVAR-TYPE-AC .LVAR1>>
518 <COND (<AND <NOT <LINKVAR-TYPE-AC .LVAR2>>
519 <NOT <LINKVAR-TYPE-WORD-AC .LVAR2>>>
520 <ISTORE-VAR .LVAR1 <> T>
521 <BREAK-LINK .VAC .VAR>)
522 (<==? .VAC <LINKVAR-TYPE-AC .LVAR2>> <PROTECT .VAC>)>)>
523 <COND (<SET VAC <LINKVAR-VALUE-AC .LVAR1>>
524 <COND (<NOT <LINKVAR-VALUE-AC .LVAR2>>
525 <ISTORE-VAR .LVAR1 <> T>
526 <BREAK-LINK .VAC .VAR>)
527 (<==? .VAC <LINKVAR-VALUE-AC .LVAR2>> <PROTECT .VAC>)>)>
528 <COND (<SET VAC <LINKVAR-TYPE-WORD-AC .LVAR1>>
529 <COND (<AND <NOT <LINKVAR-TYPE-WORD-AC .LVAR2>>
530 <NOT <LINKVAR-COUNT-AC .LVAR2>>
531 <NOT <LINKVAR-TYPE-AC .LVAR2>>>
532 <ISTORE-VAR .LVAR1 <> T>
533 <BREAK-LINK .VAC .VAR>)
534 (<==? .VAC <LINKVAR-TYPE-WORD-AC .LVAR2>>
536 <COND (<SET VAC <LINKVAR-COUNT-AC .LVAR1>>
537 <COND (<AND <NOT <LINKVAR-COUNT-AC .LVAR2>>
538 <NOT <LINKVAR-TYPE-WORD-AC .LVAR2>>>
539 <ISTORE-VAR .LVAR1 <> T>
540 <BREAK-LINK .VAC .VAR>)
541 (<==? .VAC <LINKVAR-COUNT-AC .LVAR2>>
544 "THE STATUS INFORMATION THAT IS CURRENTLY-GENERATED IS AN ATOM
545 EITHER NORMAL, UNCONDITIONAL-BRANCH, LOOP-LABEL"
547 <DEFINE GEN-LABEL (LABEL STATUS "AUX" LREF PATCH)
548 #DECL ((LABEL STATUS) ATOM)
549 <COND (<MEMQ .LABEL ,INT-LABELS>
550 <EMIT-LABEL .LABEL <>>
551 <MAPF <> ,CLEAR-VARS-FROM-AC ,ALL-ACS>)
553 <COND (<MEMQ .LABEL ,ICALL-LABELS>
555 <SETG ICALL-LEVEL <- ,ICALL-LEVEL 1>>
556 <MAPF <> ,CLEAR-VARS-FROM-AC ,ALL-ACS>)>
557 <AND <N==? .STATUS UNCONDITIONAL-JUMP>
558 <SET PATCH <ADD-PATCH LABEL-MERGE>>>
559 <COND (<==? .STATUS LOOP-LABEL>
560 <SET LREF <EMIT-LABEL .LABEL ,LOOP-VARS>>)
561 (<SET LREF <EMIT-LABEL .LABEL <>>>)>
562 <COND (<==? .STATUS UNCONDITIONAL-BRANCH>
563 <PROCESS-LABEL-MERGE .LREF T 0>)
564 (<PROCESS-LABEL-MERGE .LREF <> .PATCH>)>)>>
566 <DEFINE GEN-BRANCH (INST LABEL STATUS?
567 "OPTIONAL" (ACNUM <>) (FLONG? <>) (NO-KILL <>)
568 "AUX" XREF LREF INSRT (LLEN ,LAST-INST-LENGTH)
569 (CCOUNT ,CODE-COUNT) LSTATE)
570 #DECL ((INST CC) FIX (LABEL) <OR ATOM SPEC-LABEL>
571 (ACNUM) ANY (STATUS?) ANY (FLONG?) BOOLEAN)
572 <SET XREF <EMIT-BRANCH .INST .LABEL .STATUS? .LLEN .ACNUM .FLONG?>>
573 <COND (<TYPE? .LABEL SPEC-LABEL>)
574 (<AND <SET LREF <XREF-INFO-LABEL .XREF>>
575 <SET LSTATE <LABEL-REF-LOOP-LABEL .LREF>>>
577 <RESTORE-LOOP-STATE .LSTATE>
578 <SET INSRT <END-CODE-INSERT>>
579 <SET INSRT <PRE-INSERT .INSRT .STATUS? .LLEN .CCOUNT>>
580 <PUT .XREF ,XREF-INFO-STACK-SAVE-CODE .INSRT>)
581 (<NOT <MEMQ .LREF ,OUTST-LABEL-TABLE>>
582 <ERROR "JUMPING BACK TO A NON-LOOP LABEL" .LREF>)
584 <COND (<NOT .NO-KILL> <SET-DEATH .CODPTR T>)>
585 <SAVE-XREF-AC-INFO .XREF <SAVE-STATE> <SAVE-LOAD-STATE>>
587 <SETUP-PSAVES .XREF>)>>
589 <DEFINE LP-LOAD-VAR (VAR TYP MUNG VAC "AUX" TAC LVAR)
590 #DECL ((VAR) VARTBL (TYP) ATOM (MUNG) BOOLEAN (VAC) AC)
591 <COND (<AND <SET LVAR <FIND-CACHE-VAR .VAR>>
592 <OR <AND <==? .TYP TYPE>
593 <==? <LINKVAR-TYPE-AC .LVAR> .VAC>>
594 <AND <==? .TYP VALUE>
595 <==? <LINKVAR-VALUE-AC .LVAR> .VAC>>
596 <AND <==? .TYP COUNT>
597 <==? <LINKVAR-COUNT-AC .LVAR> .VAC>>
598 <AND <==? .TYP TYPE-WORD>
599 <==? <LINKVAR-TYPE-WORD-AC .LVAR> .VAC>>>>)
600 (<NOT <ALL-DEAD? .VAC>>
601 <COND (<SET TAC <FREE-AC?>>
602 <EMIT-EXCH .VAC .TAC>
603 <EXCH-AC .TAC .VAC>)>)>
604 <LOAD-VAR .VAR .TYP .MUNG .VAC>>