4 "This version written by CLR 2/85 based entirely on SAMs previous version.
7 a) Bit masks used instead of lists of names for efficiency.
9 b) Attempt to flush dead SETs.
11 There are two interesting structures:
13 1) Each temp atom's value is a uvector of fixes.
14 The first element is its number (starting at 0)
15 and increasing so each temp has a number.
17 The rest of the elements are essentially constitute
18 a string of 1 bit bytes big enough for the total
19 number of temps. The bit being on indicates a temp
20 that can't be merged with this one.
22 2) The lists of live variables associated with branches is
23 also the same kind of bit string."
27 <ENTRY REMOVE-DEADS FIXUP-DEATH DEBUG-DEATH MAINTAIN-DECLS>
31 <SETG DEBUG-DEATH %<>>
32 <SETG MAINTAIN-DECLS %<>>
34 "NAME-UV is a vector of temp names. It is used to get from a number back to
35 the name of a temp. NOTE: temp values start at 0 so 1 always must be added
36 to index into this vector."
38 <GDECL (NAME-UV) <VECTOR [REST ATOM]> (UVSIZE) FIX>
40 <NEWTYPE DEAD-VAR ATOM>
42 <NEWSTRUC LABEL VECTOR
44 L-INS <LIST [REST FIX]>
46 L-ASSIGN <OR FALSE <LIST [REST !<LIST ATOM FIX>]>>>
48 <NEWSTRUC BRANCH VECTOR
50 B-OUTS <LIST [REST FIX]>
53 B-JUMP-DEADS <OR FALSE UVECTOR>>
56 <DEFMAC /32 ('X) <FORM LSH .X -5>>
58 <DEFINE FIXUP-DEATH (CODE:LIST "AUX" (OUTCHAN .OUTCHAN))
60 <PRINTSTRING "Fixup-death: " .OUTCHAN>
61 <PRIN1 <2 <1 .CODE>:FORM> .OUTCHAN>
63 <PRINTSTRING "Removing deads" .OUTCHAN>
65 <SETG ANY-FLUSHED-INS <>>
66 <BIND ((CODELEN:FIX <REMOVE-DEADS .CODE>)
67 (VCODE:<SPECIAL VECTOR> <IVECTOR .CODELEN>) (VC:VECTOR .VCODE)
68 LOOP-LABELS:<LIST [REST LABEL]>)
71 <COND (<AND <TYPE? .X FORM>
74 <PUT .VC 1 .X> ;"Note: ENDIFs go in twice!"
80 <PRINTSTRING "Preparing labels and temps" .OUTCHAN>
82 <SET LOOP-LABELS <PREPARE-LABELS-AND-TEMPS .VCODE>>
84 <PRINTSTRING "Preparing branches" .OUTCHAN>
86 <PREPARE-BRANCHES .VCODE 1 .CODELEN .CODELEN ()>
88 <PRINTSTRING "Backwalking" .OUTCHAN>
92 <PRINTSTRING "Pass " .OUTCHAN>
93 <PRIN1 .LEVEL .OUTCHAN>
95 <SETG SOMETHING-CHANGED %<>>
96 <BACKWALK-FROM-LABEL .VCODE <NTH .VCODE .CODELEN> .LEVEL>
98 <FUNCTION (LABEL:LABEL)
99 <BACKWALK-FROM-LABEL .VCODE .LABEL .LEVEL>>
101 <COND (<NOT ,SOMETHING-CHANGED>
103 <SET LEVEL <+ .LEVEL 1>>>
105 <PRINTSTRING "SET optimization" .OUTCHAN>
107 <OPTIMIZE-SETS .VCODE>
109 <PRINTSTRING "General optimization" .OUTCHAN>
111 <OPTIMIZE-TEMPS .VCODE>
112 ;"This pass never seems to find anything it can merge."
113 <COND (<NOT ,MAINTAIN-DECLS>
115 <PRINTSTRING "Optional optimization pass (ignoring decls)"
118 <OPTIMIZE-TEMPS/BASH-DECLS .VCODE>)>
120 <PRINTSTRING "Preparing deads" .OUTCHAN>
122 <PREPARE-DEADS-FROM-LABEL .VCODE <NTH .VCODE .CODELEN>>
124 <FUNCTION (LABEL:LABEL)
125 <PREPARE-DEADS-FROM-LABEL .VCODE .LABEL>>
128 <PRINTSTRING "Inserting deads" .OUTCHAN>
130 <INSERT-DEADS .CODE .VCODE>>
132 <PRINTSTRING "Death complete: " .OUTCHAN>
133 <PRIN1 <2 <1 .CODE>:FORM> .OUTCHAN>
137 "ADD-LIST ORs a bit into a uvector. In the old world it addes an atom to
140 <DEFINE ADD-LIST (ATM:ATOM L:UVECTOR "VALUE" UVECTOR
141 "AUX" (NUM:FIX <1 <GVAL .ATM>:UVECTOR>)
142 (WD:FIX <+ </32 .NUM> 1>) (BIT:FIX <MOD .NUM 32>))
143 <PUT .L .WD <ORB <NTH .L .WD> <LSH 1 .BIT>>>>
145 "ADD-LIST? same as ADD-LIST except returns #FALSE () if already there."
147 <DEFINE ADD-LIST? (ATM:ATOM L:UVECTOR "VALUE" <OR FALSE UVECTOR>
148 "AUX" (NUM:FIX <1 <GVAL .ATM>:UVECTOR>) TEM:FIX
149 (WD:FIX <+ </32 .NUM> 1>) (BIT:FIX <MOD .NUM 32>))
150 <COND (<==? <ANDB <SET TEM <NTH .L .WD>> <SET BIT <LSH 1 .BIT>>> 0>
151 <PUT .L .WD <ORB .TEM .BIT>>)>>
153 "REM-LIST kill a bit in the uvector same way as ADD-LIST."
155 <DEFINE REM-LIST (ATM:ATOM L:UVECTOR
156 "AUX" (NUM:FIX <1 <GVAL .ATM>:UVECTOR>)
157 (WD:FIX <+ </32 .NUM> 1>) (BIT:FIX <MOD .NUM 32>))
158 <PUT .L .WD <ANDB <NTH .L .WD> <ROT <XORB 1 -1> .BIT>>>>
160 "REM-LIST? return false if not there, else remove it and return true"
162 <DEFINE REM-LIST? (ATM:ATOM L:UVECTOR
163 "AUX" (NUM:FIX <1 <GVAL .ATM>:UVECTOR>) TEM:FIX
164 (WD:FIX <+ </32 .NUM> 1>) (BIT:FIX <MOD .NUM 32>))
165 <SET BIT <LSH 1 .BIT>>
166 <COND (<N==? <ANDB <SET TEM <NTH .L .WD>> .BIT> 0>
167 <PUT .L .WD <XORB .TEM .BIT>>)>>
169 "IN-LIST? see if bit is on"
171 <DEFINE IN-LIST? (ATM:ATOM L:UVECTOR "VALUE" <OR FALSE UVECTOR>
172 "AUX" (NUM:FIX <1 <GVAL .ATM>:UVECTOR>)
173 (WD:FIX <+ </32 .NUM> 1>) (BIT:FIX <MOD .NUM 32>))
174 <COND (<==? <ANDB <NTH .L .WD> <LSH 1 .BIT>> 0> <>)
177 <DEFINE INTERSECT-LISTS (L1:<LIST [REST ATOM]> L2:<LIST [REST ATOM]>)
178 ;"I know this isn't the most efficient way, but I'm too tired to figure
179 it out now, and it doesn't get called much."
182 <COND (<MEMQ .A1 .L2> <MAPRET .A1>)
186 <DEFINE ATOM-PART (TEMP:<OR ATOM ADECL LIST> "VALUE" ATOM)
187 <COND (<TYPE? .TEMP ATOM> .TEMP)
188 (<TYPE? .TEMP ADECL> <1 .TEMP>)
189 (ELSE <ATOM-PART <1 .TEMP>>)>>
191 <DEFINE DECL-PART (TEMP:<OR ATOM ADECL LIST>)
192 <COND (<TYPE? .TEMP ATOM> %<>)
193 (<TYPE? .TEMP ADECL> <2 .TEMP>)
194 (ELSE <DECL-PART <1 .TEMP>>)>>
196 <DEFINE INST-PART (INST)
197 <COND (<TYPE? .INST BRANCH> <B-INST .INST>)
198 (<TYPE? .INST LABEL> <L-INST .INST>)
201 ;"REMOVE-DEADS also counts number of ins (and one extra per ENDIF)"
203 <DEFINE REMOVE-DEADS (CODE:LIST)
204 <REPEAT ((RCODE:LIST <REST .CODE>) INST OP (CODE-SIZE:FIX 1))
205 <COND (<EMPTY? .RCODE> <RETURN .CODE-SIZE>)>
206 <SET INST <1 .RCODE>>
207 <COND (<AND <TYPE? .INST FORM>
209 <KILL-FUNNY-DEADS .INST>
210 <COND (<==? <SET OP <1 .INST>> `DEAD>
211 <PUTREST .CODE <SET RCODE <REST .RCODE>>>
214 <SET CODE-SIZE <+ .CODE-SIZE 1>>
217 <SET CODE-SIZE <+ .CODE-SIZE 1>>
218 <SET RCODE <REST <SET CODE .RCODE>>>)>>>
220 <DEFINE KILL-FUNNY-DEADS (INST:FORM "AUX" (N:FIX <LENGTH .INST>) "VALUE" ATOM)
222 <COND (<AND <TYPE? <SET L <NTH .INST .N>> LIST>
224 <OR <==? <SET FOO <1 .L>> `DEAD-FALL>
225 <==? .FOO `DEAD-JUMP>>>
226 <PUTREST <REST .INST <- .N 2>> ()>
230 <DEFINE PREPARE-LABELS-AND-TEMPS (CODE:VECTOR
232 (ALL-VARS:LIST ()) (NTEMPS:FIX 0)
233 (CODELEN:FIX <LENGTH .CODE>)
234 (LOOP-LABELS:<LIST [REST LABEL]> ()))
235 <REPEAT ((I:FIX 1) INST OP (LOOP-LABEL? %<>) LABEL:LABEL (DID-ENDIF <>))
236 <SET INST <NTH .CODE .I>>
237 <COND (<TYPE? .INST ATOM>
239 <SET LABEL <CHTYPE [.INST () 0 %<>] LABEL>>
241 <SET LOOP-LABELS (.LABEL !.LOOP-LABELS)>
242 <SET LOOP-LABEL? %<>>)>
243 <PUT .CODE .I .LABEL>)
244 (<AND <TYPE? .INST FORM> <NOT <EMPTY? .INST>>>
246 <COND (<OR <==? .OP `END>
247 <AND <==? .OP `ENDIF>
250 <PUT .CODE .I <CHTYPE [.INST () 0 %<>] LABEL>>)
251 (<AND <==? .OP `ENDIF> <NOT .DID-ENDIF>>
255 (<==? .OP `ACTIVATION>
256 <SET LABEL <CHTYPE [.INST () 0 %<>] LABEL>>
257 <SET LOOP-LABELS (.LABEL !.LOOP-LABELS)>
258 <PUT .CODE .I .LABEL>)
261 <SET ALL-VARS (<SET INST <REST .INST 3>> !.ALL-VARS)>
262 <SET NTEMPS <+ .NTEMPS <LENGTH .INST>>>)
264 <SET ALL-VARS (<SET INST <REST .INST>> !.ALL-VARS)>
265 <SET NTEMPS <+ .NTEMPS <LENGTH .INST>>>)
267 <SET ALL-VARS (<REST .INST> !.ALL-VARS)>
268 <SET NTEMPS <+ .NTEMPS <LENGTH .INST> -3>>)>)>
269 <COND (<==? .I .CODELEN> <RETURN>)>
271 <CONSTRUCT-TEMPS .NTEMPS .ALL-VARS>
274 ;"CONSTRUCT-TEMPS SETGs each temp to a uvector. THe first element ins this temp's
275 number and the rest are essentially bit masks for the unmeargeabl lists"
277 <DEFINE CONSTRUCT-TEMPS (NTEMPS:FIX ALL-VARS:<LIST [REST LIST]>
278 "AUX" (UVSIZE </32 <+ .NTEMPS 32 31>>)
279 (UV-OF-NAMES <IVECTOR .NTEMPS>) (I:FIX 0))
283 <FUNCTION (ATM "AUX" UV:UVECTOR)
284 <COND (<==? .ATM => <MAPLEAVE>)>
285 <SETG <SET ATM <ATOM-PART .ATM>>
286 <SET UV <IUVECTOR .UVSIZE 0>>>
288 <PUT .UV-OF-NAMES <+ .I 1> .ATM>
292 <SETG NAME-UV .UV-OF-NAMES>
293 <SETG UVSIZE <- .UVSIZE 1>> ;"Since only bit masks stored">
295 <DEFMAC MAKE-BRANCH ('INST)
296 <FORM CHTYPE [.INST () <FORM IUVECTOR ',UVSIZE 0>
297 <FORM IUVECTOR ',UVSIZE 0> %<>] BRANCH>>
299 ;"END is required to be the location of the return label."
301 <DEFINE PREPARE-BRANCHES (CODE:VECTOR START:FIX END:FIX RETURN-LABEL:FIX
302 ACT-LABELS:<LIST [REST FIX]>)
303 <REPEAT ((I:FIX .START) INST OP TO ASSIGN LAB:LABEL INST2
304 (DONT-BRANCH-IFSYS <>))
305 <SET INST <NTH .CODE .I>>
306 <COND (<TYPE? .INST LABEL>
307 <SET INST <L-INST .INST>>
308 <COND (<AND <TYPE? .INST FORM> <==? <1 .INST> `ACTIVATION>>
309 <SET ACT-LABELS (.I .RETURN-LABEL !.ACT-LABELS)>)>
310 <MAKE-CONNECTION .CODE .I <+ .I 1>>)
311 (<AND <TYPE? .INST FORM> <NOT <EMPTY? .INST>>>
313 <COND (<==? .OP `ENDIF>
314 <COND (<AND <TYPE? <SET INST2 <NTH .CODE <+ .I 2>>> FORM>
315 <NOT <EMPTY? .INST2>>
316 <OR <AND <==? <SET OP <1 .INST2>> `IFSYS>
317 <NOT-MERGEABLE-IFSYS-TYPES <2 .INST2>
319 <AND <OR <==? .OP `IFCAN>
321 <=? <2 .INST> <2 .INST2>>>>>
322 ;"ENDIF followed immediately by IFSYS, IFCAN,
323 IFCANNOT that is mutually exclusive should act
324 like jump to beyond the NEXT ENDIF"
325 <SET DONT-BRANCH-IFSYS T>
326 <PUT .CODE .I <MAKE-BRANCH .INST>>
330 <FUNNY-FIND-ENDIF .CODE
335 <MAKE-CONNECTION .CODE .I <+ .I 1>>)>)
337 <PUT .CODE .I <MAKE-BRANCH .INST>>
339 <COND (<GASSIGNED? .TO>
340 <MAKE-CONNECTION .CODE .I ,.TO>)
342 <MAKE-CONNECTION .CODE .I .RETURN-LABEL>)>)
343 (<OR <==? .OP `RETURN>
346 <PUT .CODE .I <MAKE-BRANCH .INST>>
347 <MAKE-CONNECTION .CODE .I .RETURN-LABEL>)
349 <PUT .CODE .I <MAKE-BRANCH .INST>>
350 <COND (<NOT <EMPTY? .ACT-LABELS>>
353 <MAKE-CONNECTION .CODE .I .ACT>>
356 <COND (<AND <GASSIGNED? .TO> <N==? ,.TO <+ .I 1>>>
357 <MAKE-CONNECTION .CODE .I ,.TO>)
358 (<NOT <GASSIGNED? .TO>>
359 <MAKE-CONNECTION .CODE .I .RETURN-LABEL>)>
360 <MAKE-CONNECTION .CODE .I <+ .I 1>>)
370 <COND (<NOT <EMPTY? .ACT-LABELS>>
371 <PUT .CODE .I <MAKE-BRANCH .INST>>
374 <MAKE-CONNECTION .CODE .I .ACT>>
376 <MAKE-CONNECTION .CODE .I <+ .I 1>>)
378 <SET TO <NTH .INST <LENGTH .INST>>>
379 <COND (<AND <TYPE? .TO LIST>
381 <==? <1 .TO> `BRANCH-FALSE>>
383 <PUT .CODE .I <MAKE-BRANCH .INST>>
384 <MAKE-CONNECTION .CODE .I <+ .I 1>>
385 <COND (<GASSIGNED? .TO>
386 <MAKE-CONNECTION .CODE .I ,.TO>)
388 <MAKE-CONNECTION .CODE .I .RETURN-LABEL>)>)>)
390 <PUT .CODE .I <MAKE-BRANCH .INST>>
393 <COND (<GASSIGNED? .TO>
394 <MAKE-CONNECTION .CODE .I ,.TO>)
396 <MAKE-CONNECTION .CODE .I .RETURN-LABEL>)>>
398 (<OR <==? .OP `IFSYS>
401 <COND (<NOT .DONT-BRANCH-IFSYS>
402 <PUT .CODE .I <MAKE-BRANCH .INST>>)>
403 <MAKE-CONNECTION .CODE .I <+ .I 1>>
404 <COND (.DONT-BRANCH-IFSYS <SET DONT-BRANCH-IFSYS <>>)
406 <MAKE-CONNECTION .CODE .I <FIND-ENDIF .CODE .I>>)>)
409 <PREPARE-BRANCHES .CODE <+ .I 1> .TO .RETURN-LABEL
414 <SET TO ,<2 .INST>> ;"the index of the return label"
415 ;"If there is an = FOO in the ICALL, this is actually
416 set at the return label, so make that happen."
417 <SET ASSIGN <MEMQ = <REST .INST 2>>>
419 <SET LAB <NTH .CODE .TO>>
420 <L-ASSIGN .LAB ((<2 .ASSIGN> .I)
422 <PREPARE-BRANCHES .CODE <+ .I 1> .TO .TO .ACT-LABELS>
424 (<OR <SET TO <MEMQ + .INST>>
425 <SET TO <MEMQ - .INST>>>
427 <PUT .CODE .I <MAKE-BRANCH .INST>>
428 <MAKE-CONNECTION .CODE .I <+ .I 1>>
429 <COND (<GASSIGNED? .TO>
430 <MAKE-CONNECTION .CODE .I ,.TO>)
432 <MAKE-CONNECTION .CODE .I .RETURN-LABEL>)>)
434 <MAKE-CONNECTION .CODE .I <+ .I 1>>)>)>
436 <COND (<==? .I .END> <RETURN .CODE>)>>
439 <DEFINE MAKE-CONNECTION (CODE:VECTOR FROM:FIX TO:FIX
440 "AUX" FROM-BRANCH TO-LABEL)
441 <COND (<TYPE? <SET FROM-BRANCH <NTH .CODE .FROM>> BRANCH>
442 <B-OUTS .FROM-BRANCH (.TO !<B-OUTS .FROM-BRANCH>)>)>
443 <COND (<TYPE? <SET TO-LABEL <NTH .CODE .TO>> LABEL>
444 <L-INS .TO-LABEL (.FROM !<L-INS .TO-LABEL>)>)>
447 ;"NOT-MERGEABLE-IFSYS-TYPES returns true if the ifsys args aren't a subset"
449 <DEFINE NOT-MERGEABLE-IFSYS-TYPES (A B)
450 <COND (<=? .A "TOPS20"> <N=? .B "TOPS20">)
452 (<=? .A "UNIX"> <> ;"B must be VAX, MAC or UNIX")
453 (<=? .B "UNIX"> <> ;"A must be VAX, MAC or UNIX")
456 <DEFINE FIND-ENDIF (CODE:VECTOR I:FIX)
457 <REAL-FIND-ENDIF .CODE .I <>>>
459 <DEFINE FUNNY-FIND-ENDIF (CODE:VECTOR I:FIX "TUPLE" MTUP)
460 <REAL-FIND-ENDIF .CODE .I .MTUP>>
462 <DEFINE REAL-FIND-ENDIF (CODE:VECTOR I:FIX MTUP:<OR FALSE <PRIMTYPE VECTOR>>
466 <SET INST <NTH .CODE .I>>
467 <COND (<AND <TYPE? .INST LABEL>
468 <TYPE? <SET INST <L-INST .INST>> FORM>
469 <NOT <EMPTY? .INST>>>
471 <COND (<==? .OP `ENDIF>
476 <TYPE? <SET INST <NTH .CODE <+ .I 2>>>
478 <==? <1 .INST> `IFSYS>
481 <COND (<NOT-MERGEABLE-IFSYS-TYPES
484 (ELSE <MAPLEAVE <>>)>>
488 (ELSE <SET LEVEL <- .LEVEL 1>>)>)
489 (<OR <==? .OP `IFSYS>
492 <SET LEVEL <+ .LEVEL 1>>)>)>>>
494 <DEFINE BACKWALK-FROM-LABEL (CODE:VECTOR LABEL:LABEL CUR-LEV:FIX)
496 <FUNCTION (IN:FIX "AUX" (INST <NTH .CODE .IN>))
497 <COND (<TYPE? .INST BRANCH>
498 <BACKWALK .CODE .IN <UVECTOR !<B-LIVES .INST>> .CUR-LEV>)>>
501 <DEFINE BACKWALK (CODE:VECTOR I:FIX LIVE-TEMPS:UVECTOR CUR-LEV:FIX)
502 <REPEAT (INST INS:<LIST [REST FIX]>
503 ASSIGN:<OR FALSE <LIST [REST !<LIST ATOM FIX>]>>)
504 <SET INST <NTH .CODE .I>>
505 <COND (<TYPE? .INST LABEL>
506 <COND (<L=? .CUR-LEV <L-LEVEL .INST>> <RETURN>)
507 (ELSE <L-LEVEL .INST .CUR-LEV>)>
508 <SET ASSIGN <L-ASSIGN .INST>>
509 <SET INS <L-INS .INST>>
511 <COND (<==? .CUR-LEV 1>
513 "FILE-DEATH: Warning--unreachable code at "
515 <PRIN1 <L-INST .INST> .OUTCHAN>
520 <FUNCTION (IN "AUX" (LV:UVECTOR <UVECTOR !.LIVE-TEMPS>))
523 <FUNCTION (LL:!<LIST ATOM FIX>)
524 <COND (<==? <2 .LL> .IN>
525 <REM-LIST <1 .LL> .LV>
526 <UNMERGEABLE <1 .LL> .LV>
529 <BACKWALK .CODE .IN .LV .CUR-LEV>>
534 <FUNCTION (LL:!<LIST ATOM FIX>)
535 <COND (<==? <2 .LL> .I>
536 <REM-LIST <1 .LL> .LIVE-TEMPS>
537 <UNMERGEABLE <1 .LL> .LIVE-TEMPS>
540 (<TYPE? .INST BRANCH>
541 <SET LIVE-TEMPS <MERGE-TEMPS .LIVE-TEMPS .INST>>
542 <SET LIVE-TEMPS <UPDATE-TEMPS <B-INST .INST> .LIVE-TEMPS>>
544 (ELSE ;"had better be a form"
545 <SET LIVE-TEMPS <UPDATE-TEMPS .INST .LIVE-TEMPS>>
547 <COND (<0? .I> <RETURN>)>>>
549 <DEFINE MERGE-TEMPS (LIVES:UVECTOR BRANCH:BRANCH
550 "AUX" B-LIVES:UVECTOR (TEMP-OFFS:FIX 0))
551 ;"Add to each list the items on the other list."
552 ;"Every time a temp is added to B-LIVES, it must be declared UNMERGEABLE
553 with the ones already there."
554 <SET B-LIVES <B-LIVES .BRANCH>>
555 ;"First put all temps from both into LIVES"
557 <FUNCTION (LP:UVECTOR BP:UVECTOR)
558 <PUT .LP 1 <ORB <1 .LP> <1 .BP>>>>
560 ;"Now make any to be added to B-LIVES unmeargable with those there and
561 flag the fact that a change occured"
563 <FUNCTION (LP:UVECTOR BP:UVECTOR
564 "AUX" (ADDED:FIX <XORB <1 .LP> <1 .BP>>))
565 <COND (<N==? .ADDED 0>
566 ;"Something was added to B-LIVES"
567 <SETG SOMETHING-CHANGED T>
568 ;"Now do the unmergeables"
569 <REPEAT ((TNO:FIX <+ .TEMP-OFFS 1>) (MSK:FIX 1))
570 <COND (<N==? <ANDB .MSK .ADDED> 0>
571 <SET ADDED <XORB .ADDED .MSK>>
572 <UNMERGEABLE <NTH ,NAME-UV .TNO> .LIVES>
573 <COND (<==? .ADDED 0> <RETURN>)>)>
574 <SET MSK <LSH .MSK 1>>
575 <SET TNO <+ .TNO 1>>>)>
576 <SET TEMP-OFFS <+ .TEMP-OFFS 32>>
579 <B-LIVES .BRANCH .B-LIVES>
582 ;"ICALL is weird. Even though it can have an = FOO, this assignment
583 effectively takes place at the exit label."
585 <DEFINE UPDATE-TEMPS (INST:FORM LIVES:UVECTOR
586 "AUX" OP ITEM TWO THREE FOUR)
587 <COND (<NOT <EMPTY? .INST>>
589 <COND (<==? .OP `SET>
590 <REM-LIST <SET TWO <2 .INST>> .LIVES>
591 <UNMERGEABLE .TWO .LIVES>
592 <COND (<TYPE? <SET THREE <3 .INST>> ATOM>
593 <SET LIVES <ADD-LIVE .THREE .LIVES>>)>)
595 <REM-LIST <SET TWO <2 .INST>> .LIVES>
596 <UNMERGEABLE .TWO .LIVES>
597 <COND (<TYPE? <SET THREE <3 .INST>> ATOM>
598 <SET LIVES <ADD-LIVE .THREE .LIVES>>)>
599 <COND (<TYPE? <SET FOUR <4 .INST>> ATOM>
600 <SET LIVES <ADD-LIVE .FOUR .LIVES>>)>)
602 <REM-LIST <SET THREE <3 .INST>> .LIVES>
603 <UNMERGEABLE .THREE .LIVES>
604 <COND (<TYPE? <SET TWO <2 .INST>> ATOM>
605 <SET LIVES <ADD-LIVE .TWO .LIVES>>)>
606 <COND (<TYPE? <SET FOUR <4 .INST>> ATOM>
607 <SET LIVES <ADD-LIVE .FOUR .LIVES>>)>)
610 <FUNCTION (T "AUX" ATM)
611 <COND (<TYPE? .T LIST>
612 <REM-LIST <SET ATM <ATOM-PART .T>>
614 <UNMERGEABLE .ATM .LIVES>)>>
618 <FUNCTION (T "AUX" ATM)
619 <COND (<==? .T => <MAPLEAVE>)
621 <REM-LIST <SET ATM <ATOM-PART .T>>
623 <UNMERGEABLE .ATM .LIVES>)>>
626 <COND (<TYPE? <SET TWO <2 .INST>> ATOM>
627 <SET LIVES <ADD-LIVE .TWO .LIVES>>)>
628 <COND (<TYPE? <SET THREE <3 .INST>> ATOM>
629 <SET LIVES <ADD-LIVE .THREE .LIVES>>)>)
630 (<AND <N==? .OP `FCN>
635 <N==? .OP `OPT-DISPATCH>>
636 <SET ITEM <MEMQ = <REST .INST>>>
638 <COND (<N==? <SET TWO <2 .ITEM>> `STACK>
639 <REM-LIST .TWO .LIVES>
640 <UNMERGEABLE .TWO .LIVES>)>)>
641 <REPEAT ((RINST <REST .INST>) ONE)
642 <COND (<EMPTY? .RINST> <RETURN>)>
644 <COND (<OR <==? .ONE =>
647 <SET RINST <REST .RINST 2>>)
649 <SET LIVES <ADD-LIVE .ONE .LIVES>>
650 <SET RINST <REST .RINST>>)
651 (<AND <==? .OP `CHTYPE>
653 <NOT <LENGTH? .ONE 1>>
655 <TYPE? <SET TWO <2 .ONE>> ATOM>>
656 <SET LIVES <ADD-LIVE .TWO .LIVES>>
657 <SET RINST <REST .RINST>>)
659 <SET RINST <REST .RINST>>)>>)>)>
662 <DEFINE ADD-LIVE (ATM:ATOM L:UVECTOR
663 "AUX" NL:<OR FALSE UVECTOR>
665 <SET NL <ADD-LIST? .ATM .L>>
666 <COND (.NL <UNMERGEABLE .ATM .L> .NL)
669 <DEFINE UNMERGEABLE (NEW-LIVE:ATOM LIVES:UVECTOR
670 "AUX" NL-LIST:UVECTOR NUM:FIX WD:FIX BIT:FIX
672 ;"The error tests were removed to make things run faster. Believe it
673 or not, this function is one of the big time sinks of the package."
674 <COND (<NOT <GASSIGNED? .NEW-LIVE>>
675 <ERROR TEMP-WITHOUT-LIST!-ERRORS .NEW-LIVE UNMERGEABLE>)>
676 <COND (<N==? .NEW-LIVE `STACK>
677 <SET NL-LIST ,.NEW-LIVE>
678 <SET NUM <1 .NL-LIST>>
679 <SET NL-LIST <REST .NL-LIST>>
681 <FUNCTION (LIVE:FIX "AUX" ATM)
682 <COND (<N==? .LIVE 0>
683 <REPEAT ((TNO:FIX .TEMP-OFFS) (MSK:FIX 1))
684 <COND (<AND <N==? <ANDB .LIVE .MSK> 0>
685 <SET LIVE <XORB .LIVE .MSK>>
686 <COND (<N==? .TNO .NUM>)
689 <SET ATM <NTH ,NAME-UV
691 <COND (<NOT <GASSIGNED? .ATM>>
693 TEMP-WITHOUT-LIST!-ERRORS
695 <ADD-LIST .ATM .NL-LIST>
696 <ADD-LIST .NEW-LIVE <REST ,.ATM>>
697 <COND (<==? .LIVE 0> <RETURN>)>)>
699 <SET MSK <LSH .MSK 1>>>)>
700 <SET TEMP-OFFS <+ .TEMP-OFFS 32>>>
704 <DEFINE OPTIMIZE-SETS (CODE:VECTOR)
705 <REPEAT ((I:FIX 1) (CODELEN:FIX <LENGTH .CODE>) INST ATM1 ATM2)
706 <SET INST <NTH .CODE .I>>
707 <COND (<AND <TYPE? .INST FORM>
708 <NOT <LENGTH? .INST 2>>
710 <TYPE? <SET ATM1 <2 .INST>> ATOM>
711 <TYPE? <SET ATM2 <3 .INST>> ATOM>
712 <NOT <IN-LIST? .ATM1 <REST ,.ATM2>>>>
713 <MAYBE-MERGE .CODE .ATM1 .ATM2>)>
714 <COND (<==? .I .CODELEN> <RETURN>)>
717 <DEFINE MAYBE-MERGE (CODE:VECTOR ATM1:ATOM ATM2:ATOM)
718 <REPEAT WHOLE-THING ((I:FIX 1) (CODELEN:FIX <LENGTH .CODE>) INST)
719 <SET INST <NTH .CODE .I>>
720 <COND (<AND <TYPE? .INST FORM>
722 <OR <==? <1 .INST> `TEMP>
723 <==? <1 .INST> `MAKTUP>>>
724 <REPEAT ((LONG:LIST <REST .INST>) ONE-LONG)
725 <COND (<OR <EMPTY? .LONG>
726 <==? <SET ONE-LONG <1 .LONG>> =>>
728 (<==? <ATOM-PART .ONE-LONG> .ATM1>
729 <PROBABLY-MERGE .CODE .LONG .ATM1 .ATM2>
730 <RETURN T .WHOLE-THING>)
731 (<==? <ATOM-PART .ONE-LONG> .ATM2>
732 <PROBABLY-MERGE .CODE .LONG .ATM2 .ATM1>
733 <RETURN T .WHOLE-THING>)>
734 <SET LONG <REST .LONG>>>)>
735 <COND (<==? .I .CODELEN> <RETURN>)>
739 <DEFINE PROBABLY-MERGE (CODE:VECTOR LONG:LIST NEW-TEMP:ATOM OLD-TEMP:ATOM
740 "AUX" (OUTCHAN:CHANNEL .OUTCHAN))
741 <REPEAT ((MEDIUM:LIST .LONG) (SHORT:LIST <REST .LONG>) ONE-SHORT)
742 <COND (<OR <EMPTY? .SHORT> <==? <SET ONE-SHORT <1 .SHORT>> =>> <RETURN>)
743 (<==? <ATOM-PART .ONE-SHORT> .OLD-TEMP>
744 <COND (<MERGEABLE? <1 .LONG> .ONE-SHORT>
745 <COND (<TYPE? .ONE-SHORT LIST>
746 <1 .LONG <1 .ONE-SHORT <1 .LONG>>>)>
747 <PUTREST .MEDIUM <REST .SHORT>>
749 <PRINTSTRING "Merging " .OUTCHAN>
750 <PRIN1 .OLD-TEMP .OUTCHAN>
751 <PRINTSTRING " with " .OUTCHAN>
752 <PRIN1 .NEW-TEMP .OUTCHAN>
754 <UNMERGEABLE .NEW-TEMP <REST ,.OLD-TEMP>>
755 <PERFORM-MERGE .CODE .NEW-TEMP .OLD-TEMP>)>
757 <SET SHORT <REST <SET MEDIUM .SHORT>>>>
760 <DEFINE OPTIMIZE-TEMPS (CODE:VECTOR)
761 <REPEAT ((I:FIX 1) (CODELEN:FIX <LENGTH .CODE>) INST OP)
762 <SET INST <NTH .CODE .I>>
763 <COND (<AND <TYPE? .INST FORM>
764 <NOT <EMPTY? .INST>>>
766 <COND (<OR <==? .OP `TEMP> <==? .OP `MAKTUP>>
767 <REALLY-OPTIMIZE .CODE <REST .INST>>)>)>
768 <COND (<==? .I .CODELEN> <RETURN>)>
771 <DEFINE REALLY-OPTIMIZE (CODE:VECTOR TEMPS:LIST
772 "AUX" (OUTCHAN:CHANNEL .OUTCHAN)
773 OLD-TEMP:ATOM NEW-TEMP:ATOM)
774 <COND (<NOT <EMPTY? .TEMPS>>
775 <REPEAT ((LONG:LIST .TEMPS) ONE-LONG)
776 <COND (<OR <EMPTY? .LONG> <==? <SET ONE-LONG <1 .LONG>> =>> <RETURN>)>
777 <REPEAT ((MEDIUM:LIST .LONG) (SHORT:LIST <REST .MEDIUM>) ONE-SHORT)
778 <COND (<OR <EMPTY? .SHORT> <==? <SET ONE-SHORT <1 .SHORT>> =>>
780 <COND (<MERGEABLE? .ONE-LONG .ONE-SHORT>
781 <SET NEW-TEMP <ATOM-PART .ONE-LONG>>
782 <SET OLD-TEMP <ATOM-PART .ONE-SHORT>>
783 <COND (<TYPE? .ONE-SHORT LIST>
784 <1 .LONG <1 .ONE-SHORT .ONE-LONG>>)>
785 <PUTREST .MEDIUM <SET SHORT <REST .SHORT>>>
787 <PRINTSTRING "Merging " .OUTCHAN>
788 <PRIN1 .OLD-TEMP .OUTCHAN>
789 <PRINTSTRING " with " .OUTCHAN>
790 <PRIN1 .NEW-TEMP .OUTCHAN>
792 <UNMERGEABLE .NEW-TEMP <REST ,.OLD-TEMP>>
793 <PERFORM-MERGE .CODE .NEW-TEMP .OLD-TEMP>)
795 <SET SHORT <REST <SET MEDIUM .SHORT>>>)>>
796 <SET LONG <REST .LONG>>>)>>
798 <DEFINE MERGEABLE? (TEMP1:<OR ATOM ADECL LIST> TEMP2:<OR ATOM ADECL LIST>)
799 <AND <==? <DECL-PART .TEMP1> <DECL-PART .TEMP2>>
800 <NOT <AND <TYPE? .TEMP1 LIST> <TYPE? .TEMP2 LIST>>>
801 <NOT <IN-LIST? <ATOM-PART .TEMP1> <REST ,<ATOM-PART .TEMP2>>>>>>
803 <DEFINE OPTIMIZE-TEMPS/BASH-DECLS (CODE:VECTOR)
804 <REPEAT ((I:FIX 1) (CODELEN:FIX <LENGTH .CODE>) INST OP)
805 <SET INST <NTH .CODE .I>>
806 <COND (<AND <TYPE? .INST FORM>
807 <NOT <EMPTY? .INST>>>
809 <COND (<OR <==? .OP `TEMP> <==? .OP `MAKTUP>>
810 <REALLY-OPTIMIZE/BASH-DECLS .CODE <REST .INST>>)>)>
811 <COND (<==? .I .CODELEN> <RETURN>)>
814 <DEFINE REALLY-OPTIMIZE/BASH-DECLS (CODE:VECTOR TEMPS:LIST
815 "AUX" (OUTCHAN:CHANNEL .OUTCHAN)
816 OLD-TEMP:ATOM NEW-TEMP:ATOM)
817 <COND (<NOT <EMPTY? .TEMPS>>
818 <REPEAT ((LONG:LIST .TEMPS) ONE-LONG)
819 <COND (<OR <EMPTY? .LONG> <==? <SET ONE-LONG <1 .LONG>> =>>
821 <REPEAT ((MEDIUM:LIST .LONG) (SHORT:LIST <REST .MEDIUM>) ONE-SHORT)
822 <COND (<OR <EMPTY? .SHORT> <==? <SET ONE-SHORT <1 .SHORT>> =>>
824 <COND (<MERGEABLE?/BASH-DECLS .ONE-LONG .ONE-SHORT>
825 <SET NEW-TEMP <ATOM-PART .ONE-LONG>>
826 <SET OLD-TEMP <ATOM-PART .ONE-SHORT>>
827 <COND (<AND <DECL-PART .ONE-LONG>
828 <N==? <DECL-PART .ONE-LONG>
829 <DECL-PART .ONE-SHORT>>>
830 <COND (<TYPE? .ONE-LONG ADECL>
831 <1 .LONG <SET ONE-LONG <1 .ONE-LONG>>>)
832 (<TYPE? .ONE-LONG LIST>
833 <1 .ONE-LONG <1 <1 .ONE-LONG>>>)>)>
834 <COND (<TYPE? .ONE-SHORT LIST>
835 <1 .LONG <1 .ONE-SHORT .ONE-LONG>>)>
836 <PUTREST .MEDIUM <SET SHORT <REST .SHORT>>>
838 <PRINTSTRING "Merging " .OUTCHAN>
839 <PRIN1 .OLD-TEMP .OUTCHAN>
840 <PRINTSTRING " with " .OUTCHAN>
841 <PRIN1 .NEW-TEMP .OUTCHAN>
843 <UNMERGEABLE .NEW-TEMP <REST ,.OLD-TEMP>>
844 <PERFORM-MERGE .CODE .NEW-TEMP .OLD-TEMP>)
846 <SET SHORT <REST <SET MEDIUM .SHORT>>>)>>
847 <SET LONG <REST .LONG>>>)>>
849 <DEFINE MERGEABLE?/BASH-DECLS (TEMP1:<OR ATOM ADECL LIST>
850 TEMP2:<OR ATOM ADECL LIST>)
851 <AND <NOT <AND <TYPE? .TEMP1 LIST> <TYPE? .TEMP2 LIST>>>
852 <NOT <IN-LIST? <ATOM-PART .TEMP1> <REST ,<ATOM-PART .TEMP2>>>>>>
854 <DEFINE PERFORM-MERGE (CODE:VECTOR NEW-TEMP:ATOM OLD-TEMP:ATOM)
856 <FUNCTION (INST "AUX" OP L ASSIGN)
857 <COND (<TYPE? .INST BRANCH>
858 <COND (<IN-LIST? .OLD-TEMP <B-LIVES .INST>>
859 <REM-LIST .OLD-TEMP <B-LIVES .INST>>
860 <ADD-LIST .NEW-TEMP <B-LIVES .INST>>)>
861 <SET INST <B-INST .INST>>)
863 <COND (<SET ASSIGN <L-ASSIGN .INST>>
865 <FUNCTION (LL:!<LIST ATOM FIX>)
866 <COND (<==? <1 .LL> .OLD-TEMP>
867 <PUT .LL 1 .NEW-TEMP>
870 <SET INST <L-INST .INST>>)>
871 <COND (<AND <TYPE? .INST FORM> <NOT <EMPTY? .INST>>>
873 <COND (<==? .OP `LOOP>
876 <REPLACE-ATOM .L .NEW-TEMP .OLD-TEMP>>
879 <COND (<G=? <LENGTH .INST> 3>
880 <REPLACE-ATOM <REST .INST 3>
884 <REPLACE-ATOM <REST .INST> .NEW-TEMP .OLD-TEMP>
887 <COND (<AND <TYPE? .I FORM>
890 <==? <2 .I> .OLD-TEMP>>
894 <REPLACE-ATOM <REST .INST> .NEW-TEMP .OLD-TEMP>)>)>>
897 <DEFINE REPLACE-ATOM (L:<PRIMTYPE LIST> NEW-ATOM:ATOM OLD-ATOM:ATOM)
899 <FUNCTION (RL "AUX" (ONE <1 .RL>))
900 <COND (<==? .ONE .OLD-ATOM>
905 <DEFINE PREPARE-DEADS-FROM-LABEL (CODE:VECTOR LABEL:LABEL)
907 <FUNCTION (IN:FIX "AUX" (INST <NTH .CODE .IN>))
908 <COND (<TYPE? .INST BRANCH>
909 <PREPARE-DEADS .CODE .IN <UVECTOR !<B-LIVES .INST>> -1>)>>
912 <DEFINE PREPARE-DEADS (CODE:VECTOR I:FIX LIVE-TEMPS:UVECTOR
914 <REPEAT (INST INS:<LIST [REST FIX]>
915 ASSIGN:<OR FALSE <LIST [REST !<LIST ATOM FIX>]>>)
916 <SET INST <NTH .CODE .I>>
917 <COND (<TYPE? .INST LABEL>
918 <COND (<==? <L-LEVEL .INST> -1> <RETURN>)
919 (ELSE <L-LEVEL .INST -1>)>
920 <SET ASSIGN <L-ASSIGN .INST>>
921 <SET INS <L-INS .INST>>
923 <ERROR UNREACHABLE-CODE!-ERRORS PREPARE-DEADS>)
926 <FUNCTION (IN "AUX" (LV:UVECTOR <UVECTOR !.LIVE-TEMPS>))
929 <FUNCTION (LL:!<LIST ATOM FIX>)
930 <COND (<==? <2 .LL> .IN>
931 <REM-LIST <1 .LL> .LV>
934 <PREPARE-DEADS .CODE .IN .LV .I>>
940 <FUNCTION (LL:!<LIST ATOM FIX>)
941 <COND (<==? <2 .LL> .I>
942 <REM-LIST <1 .LL> .LIVE-TEMPS>
945 (<TYPE? .INST BRANCH>
947 <MERGE-DEADS .LIVE-TEMPS .INST <==? .FROM <+ .I 1>>>>
948 <SET LIVE-TEMPS <UPDATE-DEADS <B-INST .INST> .LIVE-TEMPS>>
951 (ELSE ;"had better be a form"
952 <SET LIVE-TEMPS <UPDATE-DEADS .INST .LIVE-TEMPS>>
955 <COND (<0? .I> <RETURN>)>>>
957 <DEFINE MERGE-DEADS (LIVES:UVECTOR BRANCH:BRANCH FALL?
958 "AUX" B-LIVES:UVECTOR
959 (ND1:UVECTOR <IUVECTOR ,UVSIZE 0>) JD)
960 ;"Add to LIVES any atoms that are not already there. Do this without
961 modifying B-LIVES. Declare all atoms added DEAD in the appropriate
963 ;"Since we know that LIVES is a subset of B-LIVES, much of the code
965 <SET B-LIVES <B-LIVES .BRANCH>>
967 <FUNCTION (LP:UVECTOR BP:UVECTOR NDP:UVECTOR "AUX" L:FIX B:FIX)
968 <COND (<N==? <SET L <1 .LP>> <SET B <1 .BP>>>
969 <PUT .LP 1 <ORB .L .B>>
970 <PUT .NDP 1 <XORB .L .B>>)>>
971 .LIVES .B-LIVES .ND1>
973 <B-FALL-DEADS .BRANCH .ND1>)
975 <SET JD <B-JUMP-DEADS .BRANCH>>
977 <B-JUMP-DEADS .BRANCH <INTERSECT-UVS .ND1 .JD>>)
979 <B-JUMP-DEADS .BRANCH .ND1>)>)>
982 <DEFINE INTERSECT-UVS (U1:UVECTOR U2:UVECTOR "AUX" (U3:UVECTOR <IUVECTOR ,UVSIZE>))
984 <FUNCTION (UP1 UP2 UP3)
985 <PUT .UP3 1 <ANDB <1 .UP1> <1 .UP2>>>>
991 ;"ICALL is weird. Even though it can have an = FOO, this assignment
992 effectively takes place at the exit label."
994 <DEFINE UPDATE-DEADS (INST:FORM LIVES:UVECTOR "AUX" SETTER OP TEM)
995 ;"Any time an atom is added to the list of LIVES, it must be declared
996 DEAD, unless it is also SET in the same instruction."
997 <COND (<NOT <EMPTY? .INST>>
999 <COND (<==? .OP `SET>
1000 <SET SETTER <CHTYPE <2 .INST> ATOM>>
1001 <COND (<NOT <REM-LIST? .SETTER .LIVES>>
1002 <SETG ANY-FLUSHED-INS T>
1003 <PUT .INST 2 <CHTYPE .SETTER DEAD-VAR>>)>
1004 <COND (<TYPE? <3 .INST> ATOM DEAD-VAR>
1005 <ADD-DEAD <REST .INST 2> .LIVES .SETTER>)>)
1007 <SET SETTER <CHTYPE <2 .INST> ATOM>>
1008 <COND (<NOT <REM-LIST? .SETTER .LIVES>>
1009 <SETG ANY-FLUSHED-INS T>
1010 <PUT .INST 2 <CHTYPE .SETTER DEAD-VAR>>)>
1011 <COND (<TYPE? <3 .INST> ATOM DEAD-VAR>
1012 <ADD-DEAD <REST .INST 2> .LIVES .SETTER>)>
1013 <COND (<TYPE? <4 .INST> ATOM DEAD-VAR>
1014 <ADD-DEAD <REST .INST 3> .LIVES .SETTER>)>)
1016 <SET SETTER <CHTYPE <3 .INST> ATOM>>
1017 <COND (<NOT <REM-LIST? .SETTER .LIVES>>
1018 <SETG ANY-FLUSHED-INS T>
1019 <PUT .INST 3 <CHTYPE .SETTER DEAD-VAR>>)>
1020 <COND (<TYPE? <2 .INST> ATOM DEAD-VAR>
1021 <ADD-DEAD <REST .INST 1> .LIVES .SETTER>)>
1022 <COND (<TYPE? <4 .INST> ATOM DEAD-VAR>
1023 <ADD-DEAD <REST .INST 3> .LIVES .SETTER>)>)
1027 <COND (<TYPE? .T LIST>
1028 <REM-LIST <ATOM-PART .T> .LIVES>)>>
1033 <COND (<==? .T => <MAPLEAVE>)
1035 <REM-LIST <ATOM-PART .T> .LIVES>)>>
1037 (<==? .OP `DISPATCH>
1038 <COND (<TYPE? <2 .INST> ATOM DEAD-VAR>
1039 <ADD-DEAD <REST .INST 1> .LIVES %<>>)>
1040 <COND (<TYPE? <3 .INST> ATOM DEAD-VAR>
1041 <ADD-DEAD <REST .INST 2> .LIVES %<>>)>)
1042 (<AND <N==? .OP `FCN>
1044 <N==? .OP `OPT-DISPATCH>
1048 <SET TEM <MEMQ = <REST .INST>>>
1050 <SET SETTER <CHTYPE <2 .TEM> ATOM>>
1051 <COND (<N==? .SETTER `STACK>
1052 <COND (<AND <NOT <REM-LIST? .SETTER .LIVES>>
1055 <N==? .OP `SYSCALL>>
1056 <SETG ANY-FLUSHED-INS T>
1057 <PUT .TEM 2 <CHTYPE .SETTER DEAD-VAR>>)>)>)
1058 (ELSE <SET SETTER %<>>)>
1059 <REPEAT ((RINST <REST .INST>) ONE)
1060 <COND (<EMPTY? .RINST> <RETURN>)>
1061 <SET ONE <1 .RINST>>
1062 <COND (<OR <==? .ONE =>
1065 <SET RINST <REST .RINST 2>>)
1066 (<TYPE? .ONE ATOM DEAD-VAR>
1067 <ADD-DEAD .RINST .LIVES .SETTER>
1068 <SET RINST <REST .RINST>>)
1069 (<AND <==? .OP `CHTYPE>
1071 <NOT <LENGTH? .ONE 1>>
1072 <==? <1 .ONE> `TYPE>
1073 <TYPE? <2 .ONE> ATOM>>
1074 <ADD-DEAD <REST .ONE> .LIVES .SETTER>
1075 <SET RINST <REST .RINST>>)
1077 <SET RINST <REST .RINST>>)>>)>)>
1080 <DEFINE ADD-DEAD (RINST:<LIST <OR ATOM DEAD-VAR>> L:UVECTOR
1081 SETTER:<OR ATOM FALSE>
1082 "AUX" (ATM:ATOM <CHTYPE <1 .RINST> ATOM>))
1083 <COND (<AND <ADD-LIST? .ATM .L> <N==? .ATM .SETTER>>
1084 <1 .RINST <CHTYPE .ATM DEAD-VAR>>)>>
1086 <DEFINE INSERT-DEADS (CODE:LIST VCODE:VECTOR "AUX" (RCODE:LIST .CODE))
1088 <FUNCTION (INST "AUX" DEADS:LIST FALL-DEADS:LIST JUMP-DEADS:LIST OP
1089 TMPL:<OR FALSE LIST> BJL:<OR FALSE UVECTOR>)
1090 <COND (<TYPE? .INST BRANCH>
1091 <SET DEADS <FIND-DEADS <B-INST .INST>>>
1092 <SET FALL-DEADS <UV-TO-L <B-FALL-DEADS .INST>>>
1093 <SET BJL <B-JUMP-DEADS .INST>>
1095 <SET JUMP-DEADS <UV-TO-L .BJL>>)
1096 (ELSE <SET JUMP-DEADS ()>)>
1097 <SET INST <B-INST .INST>:FORM>
1098 ;"BEGIN TEMPORARY HACK"
1099 ;<SET FALL-DEADS <INTERSECT-LISTS .FALL-DEADS .JUMP-DEADS>>
1100 ;<SET JUMP-DEADS ()>
1101 ;"END TEMOPRARY HACK"
1102 <COND (<NOT <EMPTY? .JUMP-DEADS>>
1103 <PUTREST <REST .INST <- <LENGTH .INST> 1>>
1104 ((`DEAD-JUMP !.JUMP-DEADS))>)>
1105 <COND (<NOT <EMPTY? .FALL-DEADS>>
1106 <PUTREST <REST .INST <- <LENGTH .INST> 1>>
1107 ((`DEAD-FALL !.FALL-DEADS))>)>
1108 <COND (<NOT <EMPTY? .DEADS>>
1110 (<CHTYPE (`DEAD !.DEADS) FORM>
1112 <SET RCODE <REST .RCODE>>)>
1113 <SET RCODE <REST <SET CODE .RCODE>>>)
1115 <COND (<AND <NOT <EMPTY? .INST>>
1116 <OR <AND <==? <SET OP <1 .INST>> `SET>
1117 <OR <==? <2 .INST> <3 .INST>>
1118 <TYPE? <2 .INST> DEAD-VAR>>>
1119 <AND <==? .OP `SETLR>
1120 <TYPE? <2 .INST> DEAD-VAR>>
1121 <AND <==? .OP `SETRL>
1122 <TYPE? <3 .INST> DEAD-VAR>>
1123 <AND <SET TMPL <MEMQ = .INST>>
1124 <TYPE? <2 .TMPL> DEAD-VAR>>>
1125 <SETG ANY-FLUSHED-INS T>
1126 <COND (<OR <==? .OP `CALL> <==? .OP `ACALL>>
1127 <PUTREST <REST .INST <- <LENGTH .INST>
1131 (<OR <==? .OP `SCALL> <==? .OP `SYSOP>
1133 <PUT .TMPL 2 <CHTYPE <2 .TMPL> ATOM>>
1136 <PUT .RCODE 1 '<`ADJ -1>>
1137 <SET RCODE <REST <SET CODE .RCODE>>>
1141 <SET RCODE <REST .RCODE>>>
1144 <SET DEADS <FIND-DEADS .INST>>
1145 <COND (<NOT <EMPTY? .DEADS>>
1147 (<FORM `DEAD !.DEADS>
1149 <SET RCODE <REST .RCODE>>)>
1150 <SET RCODE <REST <SET CODE .RCODE>>>)>)
1151 (<NOT <AND <TYPE? .INST LABEL>
1152 <TYPE? <SET INST <L-INST .INST>> FORM>
1153 <NOT <EMPTY? .INST>>
1154 <==? <1 .INST> `ENDIF>>>
1155 <SET RCODE <REST <SET CODE .RCODE>>>)>>
1158 <DEFINE FIND-DEADS (INST:FORM "AUX" OP (PASSED=?:<OR FALSE <LIST ANY>> <>))
1159 <COND (<NOT <EMPTY? .INST>>
1162 <FUNCTION (RINST "AUX" (ONE <1 .RINST>))
1164 <SET PASSED=? .RINST>
1167 <OR <==? .OP `CALL> <==? .OP `ACALL>>
1168 <TYPE? .ONE DEAD-VAR>>
1169 <PUTREST <REST .INST
1175 (<TYPE? .ONE DEAD-VAR>
1176 <SET ONE <CHTYPE .ONE ATOM>>
1179 (<AND <TYPE? .ONE FORM>
1181 <NOT <LENGTH? .ONE 1>>
1182 <==? <1 .ONE> `TYPE>
1183 <TYPE? <2 .ONE> DEAD-VAR>>
1184 <2 .ONE <CHTYPE <2 .ONE> ATOM>>
1190 <DEFINE UV-TO-L (UV:UVECTOR "AUX" (L:LIST ()) (TEMP-OFFS:FIX 0))
1194 <REPEAT ((TNO:FIX <+ .TEMP-OFFS 1>)
1196 <COND (<N==? <ANDB .MSK .WD> 0>
1197 <SET L (<NTH ,NAME-UV .TNO> !.L)>
1198 <SET WD <XORB .WD .MSK>>
1199 <COND (<==? .WD 0> <RETURN>)>)>
1200 <SET TNO <+ .TNO 1>>
1201 <SET MSK <LSH .MSK 1>>>)>
1202 <SET TEMP-OFFS <+ .TEMP-OFFS 32>>>