1 <COND (<NOT <GASSIGNED? WIDTH-MUNG>> <FLOAD "MIMOC20DEFS.MUD">)>
7 <NEWTYPE OLD-AND-USELESS VECTOR>
9 <NEWTYPE LOCAL-NAME FIX>
11 <NEWTYPE CONSTANT FIX>
13 <NEWTYPE CONSTANT-LABEL FIX>
23 <DEFINE REF-PRINT (R) #DECL ((R) REF)
28 ;"----------------------------------------------------------------------------"
30 <DEFINE PPOLE (CODE-L "TUPLE" T "AUX" (PREPREV <>) (PREVIOUS <>) ZERO)
31 #DECL ((T) <PRIMTYPE VECTOR>
32 (PREVIOUS) <SPECIAL <OR FALSE REF INST OLD-AND-USELESS>>
34 <PRINTTYPE REF ,REF-PRINT>
35 <GENERATE-CIRCULAR-REFERENCES .T>
37 <FUNCTION (NEW-T "AUX" (ITM <1 .NEW-T>) BACKLIST OPP REFERENCE NXT TMP)
38 #DECL ((NEW-T) <SPECIAL <PRIMTYPE VECTOR>>
39 (ITM) <OR INST REF OLD-AND-USELESS> (BACKLIST) LIST)
40 <COND (<TYPE? .ITM OLD-AND-USELESS>)
41 (<TYPE? .ITM REF> ;"Handling of references"
42 <DELETE-ADJACENT-REFS .NEW-T>
43 <COND (<UNCONDITIONAL-BRANCH? <2 .NEW-T>>
44 <BRANCH-CHAIN .NEW-T>)>
46 <AND <GASSIGNED? LOOPTAGS> <MEMQ <1 .ITM> ,LOOPTAGS>>>
47 <COND (.PREPREV <POST-ACCESS .ITM .NEW-T>)>
48 <COND (<AND <EMPTY? <3 .ITM>>
49 <NOT <MEMQ <1 .ITM> ,LOCATIONS>>>
50 <PUT .NEW-T 1 <CHTYPE [<1 .NEW-T>] OLD-AND-USELESS>>)
51 (<AND <NOT ,DONT-HACK>
53 <TYPE? <1 .NEW-T> REF>
54 <1? <LENGTH <3 .ITM>>>>
55 <SINGLE-PATH-OPTIMIZE .T .NEW-T>)>)
56 (<UNCONDITIONAL-BRANCH? .ITM>
57 <SKIP-MODIFY .NEW-T .PREVIOUS .PREPREV>)
58 (<CONDITIONAL-BRANCH? .ITM>
59 <COND (<AND <NOT <EMPTY? <REST .NEW-T>>>
60 <UNCONDITIONAL-BRANCH? <2 .NEW-T>>
61 <==? <NTH .ITM <LENGTH .ITM>> <3 .NEW-T>>
62 <SET OPP <GETPROP <1 .ITM> OPPOSITE>>>
63 <SET REFERENCE <2 <2 .NEW-T>>>
64 <PUT <1 .NEW-T> 1 .OPP>
65 <PUT <1 .NEW-T> 3 .REFERENCE>
66 <PUT .REFERENCE 3 (<1 .NEW-T> !<3 .REFERENCE>)>
67 <PUT .NEW-T 2 <ELIMINATE <2 .NEW-T>>>)>)
68 (<AND <NOT ,DONT-HACK> <NOT ,CIRC-LOOP?> <MOVE? .ITM>>
69 <MOVE-CHECK .NEW-T .ITM>
70 <MOVE-NEEDED? .NEW-T .ITM>)
71 (<AND <==? <1 .ITM> PUSH>
73 <SET ZERO <FINDZERO>>>
74 <PUSH-OPTIMIZE .NEW-T .ZERO <2 .ITM>>)
75 (<AND <OR <==? <1 .ITM> ADDI> <==? <1 .ITM> SUBI>>
78 <NOT <EMPTY? <REST .NEW-T>>>
79 <TYPE? <SET NXT <2 .NEW-T>> INST>>
80 <COND (<==? <1 .NXT> JRST>
82 <COND (<==? <1 .ITM> ADDI> AOJA) (T SOJA)>
86 <PUT .NEW-T 1 <CHTYPE .ITM OLD-AND-USELESS>>)
95 <==? <2 .NXT> <2 .ITM>>>
97 <COND (<==? <1 .ITM> ADDI>
116 <PUT .NEW-T 1 <CHTYPE .ITM OLD-AND-USELESS>>)>)>
117 <COND (<NOT <TYPE? <1 .NEW-T> OLD-AND-USELESS>>
118 <SET PREPREV .PREVIOUS>
119 <SET PREVIOUS <1 .NEW-T>>)>>
121 <UNLABEL-THIS-TUPLE .CODE-L .T>
122 <PRINTTYPE REF ,PRINT>
125 <DEFINE NEW-INST (NEW-T NEW-OP CINST NXTINST BASE "AUX" NEW REFQ)
126 #DECL ((NEW-T) <PRIMTYPE VECTOR> (NEW-OP) ATOM
127 (CINST NXTINST) INST (BASE) FIX)
128 <COND (<G? <LENGTH .NXTINST> .BASE> ;"JRST @"
130 <IVECTOR <+ <LENGTH .CINST> <- <LENGTH .NXTINST> .BASE>>>>
131 <SUBSTRUC .CINST 0 <- <LENGTH .CINST> 1> .NEW>
134 <- <LENGTH .NXTINST> <- .BASE 1>>
135 <REST .NEW <- <LENGTH .CINST> 1>>>
136 <2 .NEW-T <SET CINST <CHTYPE .NEW INST>>>)
137 (T <3 .CINST <NTH .NXTINST .BASE>> <2 .NEW-T .CINST>)>
138 <COND (<AND <TYPE? <SET REFQ <NTH .CINST <LENGTH .CINST>>> REF>
139 <G=? <LENGTH .REFQ> 3>>
141 <FUNCTION (RL "AUX" (I <1 .RL>))
142 <COND (<==? .I .NXTINST> <PUT .RL 1 .CINST>)>>
143 <CHTYPE <3 .REFQ> LIST>>)>
147 " Generate-circular-references makes labels be circular objects.
148 First all the tags are found and a dummy reference shell is created.
149 Then for all the lines which contain references, one links up the code
150 and outputs the circular lines."
152 <DEFINE GENERATE-CIRCULAR-REFERENCES (TUP "AUX" TAGS)
153 #DECL ((TUP) <PRIMTYPE VECTOR> (TAGS) LIST)
158 <MAPRET <LAB-NAM .ITEM> <CHTYPE [<LAB-NAM .ITEM> T '()] REF>>>
161 <FUNCTION (CODE "AUX"
162 (LINE <1 .CODE>) ;"Current line"
163 LAST ;"Last item in current line"
164 LL ;"Reference list segment"
165 NEW-REF) ;"New reference"
166 #DECL ((CODE) <PRIMTYPE VECTOR> (LINE) <OR INST REF ATOM>
167 (LAST) <OR LIST REF ATOM FIX CHARACTER> (LL) <OR LIST FALSE>
169 <COND (<AND <TYPE? .LINE INST>
171 <AND <TYPE? <SET LAST <NTH .LINE <LENGTH .LINE>>> REF>
172 <SET LL <MEMQ <1 .LAST> .TAGS>>>
173 <AND <==? <1 .LINE> DISPATCH>
174 <SET LL <MEMQ <2 .LINE> .TAGS>>>
175 <AND <TYPE? <1 .LINE> GFRM SGFRM SBFRM>
176 <SET LL <MEMQ <CHTYPE <1 .LINE> ATOM> .TAGS>>>>>
177 <SET NEW-REF <2 .LL>>
178 <PUT .NEW-REF 3 (.LINE !<3 .NEW-REF>)>
179 <PUT .LINE <LENGTH .LINE> .NEW-REF>
180 <COND (<TYPE? <1 .LINE> GFRM SGFRM SBFRM>
181 <PUT .LINE 1 <CHTYPE <1 .NEW-REF> <TYPE <1 .LINE>>>>)>)
182 (<AND <TYPE? .LINE ATOM>
183 <SET LL <MEMQ .LINE .TAGS>>>
184 <PUT .CODE 1 <2 .LL>>)
185 (<TYPE? .LINE ATOM> ;"Reference which was deleted"
186 <PUT .CODE 1 <CHTYPE [.LINE] OLD-AND-USELESS>>)>>
189 ;"Delete-adjacent-refs will delete the first reference of a pair of references
190 next to each other and call itself recursively."
192 <DEFINE DELETE-ADJACENT-REFS (TUP "AUX" (ITM <1 .TUP>) (NXT <2 .TUP>) USELESS)
193 #DECL ((TUP) <PRIMTYPE VECTOR> (NXT) <OR OLD-AND-USELESS REF INST> (ITM) REF)
195 <COND (<TYPE? .NXT REF>;"Deletes adjacent ref"
199 <PUT .ITM 3 (.INS !<3 .ITM>)>
200 <COND (<TYPE? <1 .INS> GFRM SGFRM SBFRM>
202 <CHTYPE <1 .ITM> <TYPE <1 .INS>>>>)>
203 <PUT .INS <LENGTH .INS> .ITM>>
204 <CHTYPE <3 .NXT> LIST>>
206 <PUT .TUP 1 <CHTYPE [<1 .NXT>] OLD-AND-USELESS>>
207 <COND (<EMPTY? <SET TUP <REST .TUP>>> <RETURN>)>
212 <DEFINE PUSH-OPTIMIZE (NEW-T ZERO AC "AUX" (COUNT 0)(AC2 T*))
213 #DECL ((COUNT) FIX (AC AC2) ATOM (NEW-T) <PRIMTYPE VECTOR>)
214 <COND (<==? .AC .AC2><SET AC2 B1*>)>
216 <FUNCTION (TUP "AUX" (LINE <1 .TUP>) C)
217 #DECL ((TUP) <PRIMTYPE VECTOR>
218 (LINE) <OR INST OLD-AND-USELESS REF>)
219 <COND (<AND <==? <1 .LINE> PUSH>
221 <TYPE? <SET C <3 .LINE>> REF>
223 <SET COUNT <+ .COUNT 1>>)
226 <COND (<G=? .COUNT 5>
227 <PUT .NEW-T 1 <CHTYPE [XMOVEI .AC2 2 (.AC)] INST>>
228 <PUT .NEW-T 2 <CHTYPE [ADJSP .AC .COUNT] INST>>
229 <PUT .NEW-T 3 <CHTYPE [SETZM -1 (.AC2)] INST>>
230 <PUT .NEW-T 4 <CHTYPE [HRLI .AC2 -1 (.AC2)] INST>>
231 <PUT .NEW-T 5 <CHTYPE [BLT .AC2 (.AC)] INST>>
232 <REPEAT ((CNT <- .COUNT 4>)
233 (TUP <REST .NEW-T 5>))
234 #DECL ((CNT) FIX (TUP) <PRIMTYPE VECTOR> (ZRO) OLD-AND-USELESS)
235 <COND (<0? <SET CNT <- .CNT 1>>><RETURN>)
236 (ELSE <PUT .TUP 1 <ELIMINATE <1 .TUP>>>
237 <SET TUP <REST .TUP>>)>>)>>
239 <DEFINE SKIP-MODIFY (NEW-T PREVIOUS PREPREV
240 "AUX" (ITM <1 .NEW-T>)
242 <AND <NOT <EMPTY? <REST .NEW-T>>> <2 .NEW-T>>) OPP
244 #DECL ((NEW-T) <PRIMTYPE VECTOR> (ITM) INST
245 (PREVIOUS NEXTLINE) <OR OLD-AND-USELESS INST REF FALSE>)
246 <COND (<AND .NEXTLINE
248 <NOT <EMPTY? <REST .NEW-T 2>>>
249 <NOT <TYPE? .ITM OLD-AND-USELESS>>
250 <OR <==? <SET FOO <NTH .ITM <LENGTH .ITM>>> <3 .NEW-T>>
251 <==? .FOO .NEXTLINE>>>
252 <COND (<AND <CONDITIONAL-SKIP? .PREVIOUS>
253 <UNCONDITIONAL-BRANCH? .NEXTLINE>
255 <NOT <CONDITIONAL-SKIP? .PREPREV>>>
256 <SET OPP <GETPROP <1 .PREVIOUS> OPPOSITE>>>
257 <PUT .PREVIOUS 1 .OPP>
258 <PUT .NEW-T 1 <ELIMINATE <1 .NEW-T>>>)
259 (<TYPE? .NEXTLINE REF OLD-AND-USELESS>
260 <PUT .NEW-T 1 <ELIMINATE .ITM>>)
261 (ELSE <PUT .NEW-T 1 <CHTYPE [CAIA A1* A1*] INST>>)>)>>
263 <DEFINE UNLABEL-THIS-TUPLE (L T "AUX" RF)
264 #DECL ((T) <PRIMTYPE VECTOR> (RF) ANY (L) LIST)
265 <AND ,PEEP-CHANNEL <CRLF ,PEEP-CHANNEL>>
267 <FUNCTION (STATEMENT)
268 #DECL ((STATEMENT) <OR INST REF OLD-AND-USELESS>)
269 <COND (<TYPE? .STATEMENT REF>
270 <COND (,PEEP-CHANNEL <PRINT <1 .STATEMENT> ,PEEP-CHANNEL>)>
271 <PUT <SET L <REST .L>> 1 <1 .STATEMENT>>)
272 (<TYPE? .STATEMENT OLD-AND-USELESS>
273 <COND (,PEEP-CHANNEL <PRINT .STATEMENT ,PEEP-CHANNEL>)>)
274 (<AND <TYPE? .STATEMENT INST>
275 <==? <1 .STATEMENT> DISPATCH>
276 <TYPE? <SET RF <2 .STATEMENT>> REF>>
277 <PUT .STATEMENT 2 <1 .RF>>
278 <COND (,PEEP-CHANNEL <PRINT .STATEMENT ,PEEP-CHANNEL>)>
279 <PUT <SET L <REST .L>> 1 .STATEMENT>)
280 (<AND <TYPE? .STATEMENT INST>
282 <SET RF <NTH .STATEMENT <LENGTH .STATEMENT>>>
284 <COND (<TYPE? <1 .STATEMENT> SGFRM GFRM SBFRM>
285 <PUT .STATEMENT <LENGTH .STATEMENT> T>)
287 <PUT .STATEMENT <LENGTH .STATEMENT>
288 <CHTYPE [<1 .RF>] REF>>)>
290 <PRINT .STATEMENT ,PEEP-CHANNEL>)>
291 <PUT <SET L <REST .L>> 1 .STATEMENT>)
293 <COND (,PEEP-CHANNEL <PRINT .STATEMENT ,PEEP-CHANNEL>)>
294 <PUT <SET L <REST .L>> 1 .STATEMENT>)>>
298 <DEFINE POST-ACCESS (BACK0 TUP "AUX" (BACK1 <1 <SET TUP <BACK .TUP>>>)
299 (BACK2 <1 <BACK .TUP>>))
300 #DECL ((TUP) <PRIMTYPE VECTOR>
301 (BACK0 BACK1 BACK2) <OR FALSE INST REF OLD-AND-USELESS>)
302 <COND (<TYPE? .BACK0 OLD-AND-USELESS>
303 <POST-ACCESS .BACK0 <BACK .TUP>>)
304 (<OR <NOT <UNCONDITIONAL-BRANCH? .BACK1>>
305 <CONDITIONAL-SKIP? .BACK2>
306 <UNCONDITIONAL-SKIP? .BACK2>
307 <AND <OR <CONDITIONAL-BRANCH? .BACK2>
308 <UNCONDITIONAL-BRANCH? .BACK2>>
309 <==? .BACK0 <NTH .BACK2 <LENGTH .BACK2>>>>>)
310 (ELSE <PUT .BACK0 2 <>>)>>
312 <DEFINE CONDITIONAL-BRANCH? (ITEM)
313 #DECL ((ITEM) <OR OLD-AND-USELESS INST REF>)
314 <MEMQ <1 .ITEM> ,CJ-JUMP-LIST>>
316 <DEFINE CONDITIONAL-SKIP? (ITEM)
317 #DECL ((ITEM) <OR OLD-AND-USELESS INST REF>)
318 <MEMQ <1 .ITEM> ,CS-JUMP-LIST>>
320 <DEFINE UNCONDITIONAL-BRANCH? (ITEM "AUX" LBL)
321 #DECL ((ITEM) <OR OLD-AND-USELESS INST REF>)
322 <AND <MEMQ <1 .ITEM> ,UJ-JUMP-LIST>
323 <TYPE? <SET LBL <NTH .ITEM <LENGTH .ITEM>>> REF>
324 <N==? <1 .LBL> COMPERR>>>
326 <DEFINE UNCONDITIONAL-SKIP? (ITEM)
327 #DECL ((ITEM) <OR OLD-AND-USELESS INST REF>)
328 <==? <1 .ITEM> CAIA>>
330 <DEFINE JUMP? (INSTR)
331 #DECL ((INSTR) <OR OLD-AND-USELESS INST REF>)
332 <OR <CONDITIONAL-BRANCH? .INSTR>
333 <CONDITIONAL-SKIP? .INSTR>
334 <UNCONDITIONAL-BRANCH? .INSTR>
335 <UNCONDITIONAL-SKIP? .INSTR>>>
337 <GDECL (UJ-JUMP-LIST US-JUMP-LIST CJ-JUMP-LIST CS-JUMP-LIST)
340 !<LIST [4 <LIST [REST ATOM]>]>>
343 (<SETG UJ-JUMP-LIST '(JUMPA AOJA SOJA JRST PUSHJ JSP UJ)>
344 <SETG US-JUMP-LIST '(CAIA SKIPA AOSA SOSA US)>
396 <DEFINE MAKE-OPPOSITES (ITEM-1 ITEM-2)
397 #DECL ((ITEM-1 ITEM-2) ATOM)
398 <PUTPROP .ITEM-1 OPPOSITE .ITEM-2>
399 <PUTPROP .ITEM-2 OPPOSITE .ITEM-1>>
401 <DEFINE SINGLE-PATH-OPTIMIZE (TOP-OF-TUP NEW-T
402 "AUX" (BACKREG-LIST '())
404 (ACS '(A1* A2* B1* B2* C1*
406 #DECL ((BACKREG-LIST ACS) LIST (TOP-OF-TUP NEW-T) <PRIMTYPE VECTOR>
407 (LBL) <OR INST OLD-AND-USELESS REF>)
408 <REPEAT ((STATEMENT <1 <3 .LBL>>)(NTUP <MEMQ .STATEMENT .TOP-OF-TUP>) ACC?)
409 #DECL ((STATEMENT) <OR INST REF OLD-AND-USELESS>
410 (NTUP) <OR FALSE <PRIMTYPE VECTOR>> (ACC?) <OR REF ATOM FIX LIST>)
411 <COND (<OR <TYPE? .STATEMENT REF>
412 <AND <TYPE? .STATEMENT INST>
413 <OR <==? <1 .STATEMENT> PUSHJ>
414 <==? <1 .STATEMENT> JSP>>>>
416 (<AND <MOVE? .STATEMENT>
417 <MEMQ <SET ACC? <2 .STATEMENT>> .ACS>
418 <NOT <MEMQ .ACC? .BACKREG-LIST>>>
420 <FUNCTION (ACLIST "AUX" (AC <1 .ACLIST>))
421 #DECL ((ACLIST) LIST (AC) ATOM)
422 <COND (<==? .ACC? .AC><MAPSTOP !<REST .ACLIST>>)
423 (ELSE <MAPRET .AC>)>>
425 <SET BACKREG-LIST (.ACC? .STATEMENT !.BACKREG-LIST)>)
426 (<AND <G? <LENGTH .STATEMENT> 1>
427 <TYPE? <SET ACC? <2 .STATEMENT>> ATOM>
430 <FUNCTION (ACLIST "AUX" (AC <1 .ACLIST>))
431 #DECL ((ACLIST) LIST (AC) ATOM)
432 <COND (<==? .ACC? .AC><MAPSTOP !<REST .ACLIST>>)
433 (ELSE <MAPRET .AC>)>>
435 <COND (<OR <NOT .NTUP> <==? .NTUP .TOP-OF-TUP>><RETURN>)
436 (ELSE <SET STATEMENT <1 <SET NTUP <BACK .NTUP>>>>)>>
439 <FUNCTION (NTUP "AUX" (STATEMENT <1 .NTUP>) STM)
440 #DECL ((NTUP) <PRIMTYPE VECTOR>
441 (STATEMENT) <OR INST OLD-AND-USELESS REF>)
442 <COND (<JUMP? .STATEMENT><MAPLEAVE>)
443 (<TYPE? .STATEMENT REF><MAPLEAVE>)
444 (<AND <MOVE? .STATEMENT>
445 <NOT <MEMQ <2 .STATEMENT> .ACS>>
446 <SET STM <MEMQ .STATEMENT .BACKREG-LIST>>>
447 <SET ACS (<2 .STATEMENT> !.ACS)>
448 <PUT .STM 1 <ELIMINATE <1 .STM>>>
449 <PUT .NTUP 1 <ELIMINATE <1 .NTUP>>>)
451 <SET ACS (<2 .STATEMENT> !.ACS)>)>>
455 #DECL ((ITM) <OR INST REF OLD-AND-USELESS>)
456 <AND <TYPE? .ITM INST>
457 <MEMQ <1 .ITM> '[MOVE DMOVE MOVSI MOVEI MOVNI]>
458 <IS-REAL-AC? <2 .ITM>>>>
461 <REPEAT ((NCV ,CONSTANT-VECTOR))
463 <COND (<EMPTY? .NCV><RETURN <>>)
464 (<==? <CB-VAL <1 .NCV>> #CONSTANT *000000000000*>
466 (ELSE <SET NCV <REST .NCV>>)>>>
468 <DEFINE MOVE-CHECK (NEW-T LINE
469 "AUX" (LABEL <1 .LINE>) (DESTINATION <2 .LINE>)
471 (SOURCE <AND <TYPE? <3 .LINE> ATOM> <3 .LINE>>)
473 #DECL ((LINE) INST (LABEL) ATOM (NEW-T) <PRIMTYPE VECTOR>
474 (DESTINATION SOURCE) <OR ATOM FIX FALSE LIST>
475 (SOURCE2 DESTINATION2) <OR FALSE ATOM> (USEFUL-CODE) LIST)
477 (<AND <IS-REAL-AC? .DESTINATION> .SOURCE <IS-REAL-AC? .SOURCE>>
480 <FUNCTION (NEW-TUP "AUX" (LINE <1 .NEW-TUP>))
481 #DECL ((LINE) <OR INST REF OLD-AND-USELESS>)
482 <COND (<TYPE? .LINE REF>
483 <COND (<L-LOOP? .NEW-TUP> <MAPLEAVE '()>)
485 (<CONDITIONAL-BRANCH? .LINE>
487 (<UNCONDITIONAL-BRANCH? .LINE>
489 (<OR <AND <==? <1 .LINE> JRST> <==? <2 .LINE> @>>
490 <==? <1 .LINE> PUSHJ>
493 (ELSE <MAPRET .LINE>)>>
495 <COND (<EMPTY? .USEFUL-CODE>)
496 (<AND <==? .LABEL MOVE>
497 <NOT <IS-THIS-AC-USED? .SOURCE .USEFUL-CODE .DESTINATION>>>
498 <REPLACE-ACS .SOURCE .DESTINATION .USEFUL-CODE>
499 <PUT .NEW-T 1 <ELIMINATE <1 .NEW-T>>>)
500 (<AND <==? .LABEL DMOVE>
501 <SET SOURCE2 <GETPROP .SOURCE AC-PAIR>>
502 <SET DESTINATION2 <GETPROP .DESTINATION AC-PAIR>>
503 <NOT <IS-THIS-AC-USED? .SOURCE .USEFUL-CODE .DESTINATION>>
504 <NOT <IS-THIS-AC-USED? .SOURCE2 .USEFUL-CODE .DESTINATION2>>>
505 <REPLACE-ACS .SOURCE .DESTINATION .USEFUL-CODE>
506 <REPLACE-ACS .SOURCE2 .DESTINATION2 .USEFUL-CODE>
507 <PUT .NEW-T 1 <ELIMINATE <1 .NEW-T>>>)>)>>
509 <DEFINE REPLACE-ACS (AC1 AC2 CODE "AUX" (LAC1 (.AC1)) (LAC2 (.AC2)))
510 #DECL ((AC1 AC2) ATOM (LAC1 LAC2) LIST (CODE) LIST)
512 <FUNCTION (LINE "AUX" SUBSET)
514 <OR VECTOR INST REF OLD-AND-USELESS FALSE>)
515 <COND (<SET SUBSET <MEMBER .LAC2 .LINE>>
516 <PUT .SUBSET 1 .LAC1>)
517 (<MEMQ <1 .LINE> '[MOVE DMOVE]>)
518 (<SET SUBSET <MEMQ .AC2 .LINE>>
519 <PUT .SUBSET 1 .AC1>)>>
522 <DEFINE IS-THIS-AC-USED? (ACCUM CODE DEST
523 "AUX" (ACCUM2 <GETPROP .ACCUM AC-PAIR>)(MOVED? <>)
525 (DEST2 <GETPROP .DEST AC-PAIR>)
526 (LDEST2 <AND .DEST2 (.DEST2)>)
527 (SRC-USED <>) (DST-USED <>) R)
528 #DECL ((ACCUM) ATOM (CODE) LIST)
531 #DECL ((LINE) <OR INST REF OLD-AND-USELESS>)
533 <COND (<OR <MEMQ .DEST .LINE>
541 (<AND <OR <MEMQ .ACCUM .LINE>
543 <MEMQ .ACCUM2 .LINE>>>
544 <MEMQ <1 .LINE> '[DMOVEM MOVEM]>>
545 <COND (.DST-USED <MAPLEAVE T>) (ELSE <>)>)
546 (<AND <OR <MEMQ .DEST .LINE>
548 <MEMQ .DEST2 .LINE>>>
549 <MEMQ <1 .LINE> '[DMOVEM MOVEM]>>
550 <COND (.SRC-USED <MAPLEAVE T>) (ELSE <>)>)
551 (<AND <OR <MEMQ .ACCUM .LINE>
553 <MEMQ .ACCUM2 .LINE>>>
554 <MEMQ <1 .LINE> '[DMOVE MOVE MOVSI MOVEI MOVNI]>
555 <NOT <AND <TYPE? <SET R <NTH .LINE <LENGTH .LINE>>> LIST>
556 <OR <==? <1 .R> .ACCUM>
557 <==? <1 .R> .ACCUM2>>>>>
560 (<OR <MEMQ .ACCUM .LINE>
561 <AND .ACCUM2 <MEMQ .ACCUM2 .LINE>>>
562 <COND (.DST-USED <MAPLEAVE T>)
563 (ELSE <SET SRC-USED T> <>)>)
564 (<OR <MEMQ .DEST .LINE>
565 <AND .DEST2 <MEMQ .DEST2 .LINE>>>
566 <COND (.SRC-USED <MAPLEAVE T>)
567 (ELSE <SET DST-USED T> <>)>)
571 <DEFINE IS-REAL-AC? (ITEM)
573 <MEMQ .ITEM '[A1* A2* B1* B2* C1* C2* X* T*]>>
575 <DEFINE MOVE-NEEDED? (NEW-T ITM
576 "AUX" (BOTH? <==? <1 .ITM> DMOVE>) (REG <2 .ITM>)
577 (INDEX (.REG)) AFT-SKIP
578 (REG2 <AND .BOTH? <GETPROP .REG AC-PAIR>>)
579 (INDEX2 <AND .BOTH? (.REG2)>))
580 #DECL ((ITM) INST (BOTH) <OR FALSE T> (REG) ATOM (REG2) <OR FALSE ATOM>
581 (INDEX2) <OR LIST FALSE> (NEW-T) <PRIMTYPE VECTOR>)
583 <FUNCTION (TT "AUX" (LINE <1 .TT>) (OP <1 .LINE>) F)
584 #DECL ((TT) <PRIMTYPE VECTOR> (LINE) <OR INST REF OLD-AND-USELESS>
586 <COND (<TYPE? .LINE REF>
587 <COND (<L-LOOP? .TT>)
588 (ELSE <PUT .NEW-T 1 <ELIMINATE <1 .NEW-T>>>)>
592 <AND <==? .OP JRST> <==? <2 .LINE> @>>
594 <LDB-REGISTER-USED? .LINE .REG .REG2>>>
596 (<AND <MEMQ <1 .LINE> [DMOVE MOVE MOVNI MOVSI MOVEI]>
599 <OR <NOT <TYPE? <SET F <NTH .LINE <LENGTH .LINE>>>
603 <PUT .TT 1 <ELIMINATE <1 .TT>>>)
604 (<MEMBER .INDEX .LINE> <MAPLEAVE>)
605 (<AND <==? .OP MOVEM> <MEMQ .REG .LINE>>
606 <COND (<AND <TYPE? <3 .LINE> LOCAL-NAME>
607 <=? <REST .LINE 2> <REST .ITM 2>>>
608 <PUT .NEW-T 1 <ELIMINATE <1 .NEW-T>>>
609 <PUT .TT 1 <ELIMINATE <1 .TT>>>)>
611 (<AND <==? .OP DMOVEM>
612 <SET REG2 <GETPROP .REG AC-PAIR>>
615 (<AND <UNCONDITIONAL-BRANCH? .LINE>
617 <PUT .NEW-T 1 <ELIMINATE <1 .NEW-T>>>
620 <OR <MEMQ .REG2 .LINE> <MEMBER .INDEX2 .LINE>>>
623 (<OR <CONDITIONAL-SKIP? .LINE>
624 <UNCONDITIONAL-SKIP? .LINE>>
630 <DEFINE BRANCH-CHAIN (NEW-T "AUX" (TAG1 <1 .NEW-T>)(JUMP1 <2 .NEW-T>)
631 (TAG2 <NTH .JUMP1 <LENGTH .JUMP1>>)
633 #DECL ((NEW-T) <PRIMTYPE VECTOR> (TAG1 TAG2) REF (JUMP1) INST)
635 <FUNCTION (LINE) #DECL ((LINE) INST)
636 <COND (<TYPE? <1 .LINE> SGFRM>
639 <COND (<TYPE? <1 .LINE> GFRM SBFRM>
640 <PUT .LINE 1 <CHTYPE <1 .TAG2> <TYPE <1 .LINE>>>>)>
641 <PUT .LINE <LENGTH .LINE> .TAG2>
642 <PUT .TAG2 3 (.LINE !<3 .TAG2>)>)>>
645 <PUT .NEW-T 1 <CHTYPE [<1 .TAG1>] OLD-AND-USELESS>>
646 <COND (<AND <UNCONDITIONAL-BRANCH? <1 <BACK .NEW-T>>>
647 <NOT <CONDITIONAL-SKIP? <1 <BACK .NEW-T 2>>>>>
648 <PUT .NEW-T 2 <ELIMINATE <2 .NEW-T>>>)>)>>
651 <DEFINE LDB-REGISTER-USED? (ITM REG1 REG2 "AUX" (CNST <AND <TYPE? <3 .ITM> REF>
653 CONSTANT FIELD1 FIELD2 CONSTANT-THING)
654 #DECL ((ITM) INST (REG1) ATOM (REG2) <OR FALSE ATOM>
655 (CNST) <OR CONSTANT-LABEL FALSE>
656 (CONSTANT CONSTANT-THING) ANY (FIELD1 FIELD2) FIX)
657 <COND (<AND <SET CONSTANT <MEMQ .CNST ,CONSTANT-VECTOR>>
658 <SET CONSTANT-THING <2 .CONSTANT>>
659 <TYPE? .CONSTANT-THING CONSTANT>
660 <SET FIELD1 <CHTYPE <GETBITS .CONSTANT-THING <BITS 4 18>> FIX>>
661 <SET FIELD2 <CHTYPE <GETBITS .CONSTANT-THING <BITS 14 0>> FIX>>>
662 <OR <==? .FIELD1 <2 <MEMQ .REG1 ,ACS>>>
663 <AND .REG2 <==? .FIELD1 <2 <MEMQ .REG2 ,ACS>>>>
669 <PUTPROP A1* AC-PAIR A2*>
671 <PUTPROP A2* AC-PAIR A1*>
673 <PUTPROP B1* AC-PAIR B2*>
675 <PUTPROP B2* AC-PAIR B1*>
677 <PUTPROP C1* AC-PAIR C2*>
679 <PUTPROP C2* AC-PAIR C1*>
681 <DEFINE L-LOOP? (TUP "AUX" (LAB <1 .TUP>))
682 #DECL ((TUP) <PRIMTYPE VECTOR>)
684 <FUNCTION (NEWTUP "AUX" (LINE <1 .NEWTUP>))
685 <COND (<TYPE? .LINE REF>
693 <DEFINE ELIMINATE (STATEMENT "AUX" LAST)
694 <COND (<AND <TYPE? .PREVIOUS INST>
695 <CONDITIONAL-SKIP? .PREVIOUS>
697 <PUT .PREVIOUS 1 MOVE>)>
698 <COND (<TYPE? .STATEMENT REF>
699 <PUT .STATEMENT 3 '()>
700 <CHTYPE [<1 .STATEMENT>] OLD-AND-USELESS>)
701 (<AND <TYPE? .STATEMENT INST>
702 <TYPE? <SET LAST <NTH .STATEMENT <LENGTH .STATEMENT>>> REF>
703 <==? <LENGTH .LAST> 3>
704 <TYPE? <3 .LAST> LIST>>
709 <COND (<==? .LINE .STATEMENT> <MAPRET>)
710 (ELSE <MAPRET .LINE>)>>
712 <PUT .STATEMENT <LENGTH .STATEMENT> <CHTYPE [<1 .LAST>] REF>>
713 <CHTYPE .STATEMENT OLD-AND-USELESS>)
714 (ELSE <CHTYPE .STATEMENT OLD-AND-USELESS>)>>
718 <MAKE-OPPOSITES CAIGE CAIL>
719 <MAKE-OPPOSITES CAIN CAIE>
720 <MAKE-OPPOSITES CAIG CAILE>
721 <MAKE-OPPOSITES CAMGE CAML>
722 <MAKE-OPPOSITES CAMN CAME>
723 <MAKE-OPPOSITES CAMG CAMLE>
724 <MAKE-OPPOSITES SKIPLE SKIPG>
725 <MAKE-OPPOSITES SKIPGE SKIPL>
726 <MAKE-OPPOSITES SKIPN SKIPE>
727 <MAKE-OPPOSITES TRNN TRNE>
728 <MAKE-OPPOSITES TLNN TLNE>
729 <MAKE-OPPOSITES JUMPGE JUMPL>
730 <MAKE-OPPOSITES JUMPN JUMPE>
731 <MAKE-OPPOSITES JUMPG JUMPLE>
732 <MAKE-OPPOSITES SOJG SOJLE>
733 <MAKE-OPPOSITES SOJL SOJGE>
734 <MAKE-OPPOSITES SOJE SOJN>>