19 <USE "COMPDEC" "CODGEN" "CHKDCL" "STRGEN" "MIMGEN" "ADVMESS">
21 " This file contains analyzers and code generators for arithmetic
22 SUBRs and predicates. For convenience many of the SUBRs that are
23 similar are combined into one analyzer/generator. For more info
24 on analyzers see SYMANA and on generators see CODGEN.
27 "A type TRANS specifies to an inferior node what arithmetic transforms are
28 prohibited, permitted or desired. A transform consists of 3 main elements:
29 a NODE, an input, an output. The input and output are UVECTORS of 7 fixes:
31 1) negative ok 0-no, 1-ok, 2-pref
32 2) + or - const ok 0-no, 1-ok, 2-pref
34 4) * or / const ok 0-no, 1-* ok, 2-* pref, 3-/ ok, 4-/ pref
35 5) hw ok 0-no, 1-ok, 2-pref
36 6) hw swapped also 0-no, 1-ok, 2-pref
39 <SETG SNODES <UVECTOR ,QUOTE-CODE ,LVAL-CODE ,GVAL-CODE>>
41 <SETG SNODES1 <REST ,SNODES>>
43 <GDECL (SNODES SNODES1) <UVECTOR [REST FIX]>>
45 <DEFINE COMMUTE (K OP L "AUX" TT FK KK TYP NN N CD CD1)
46 #DECL ((K KK FK) <LIST [REST NODE]> (N NN) NODE (CD1 CD) FIX (L) LIST)
48 <COND (<EMPTY? .K> <RETURN>)>
49 <COND (<EMPTY? <SET KK <REST <SET FK .K>>>> <RETURN>)>
50 <SET TYP <ISTYPE? <RESULT-TYPE <1 .KK>>>>
52 <AND <EMPTY? .KK> <RETURN>>
54 (<==? .TYP <SET TYP <ISTYPE? <RESULT-TYPE <SET NN <1 .KK>>>>>>
55 <SET CD1 <NODE-TYPE .NN>>
57 (<AND <==? <SET CD <NODE-TYPE <SET N <1 .FK>>>> ,QUOTE-CODE>
58 <==? .CD1 ,QUOTE-CODE>>
59 <PUT .N ,NODE-NAME <APPLY ,.OP <NODE-NAME .N> <NODE-NAME .NN>>>
60 <PUTREST .FK <SET KK <REST .KK>>>
63 (<==? .CD ,QUOTE-CODE> <PUT .KK 1 .N> <PUT .FK 1 .NN> <SET REDO T>)
64 (<AND <NOT <MEMQ .CD1 ,SNODES>>
67 <NOT <SIDE-EFFECTS .NN>>>
68 <COND (<AND <==? .CD ,LVAL-CODE>
69 <COND (<==? <LENGTH <SET TT <TYPE-INFO .N>>> 2> <2 .TT>)
71 <SET TT <NODE-NAME .N>>
74 <AND <==? <1 .LL> .TT> <MAPLEAVE>>>
76 <SET L ((<NODE-NAME .N> <>) !.L)>)>
80 <SET KK <REST <SET FK .KK>>>>
81 <COND (.REDO <SET REDO <>> <AGAIN>)>
85 " Generate code for +,-,* and /."
87 <DEFINE ARITH-GEN AG (NOD WHERE
88 "AUX" REG (K <KIDS .NOD>) REG1 T1
89 (ATYP <LENGTH <CHTYPE <MEMQ <NODE-NAME .NOD>
92 TT (MODE 1) (TEM <1 .K>) SEGF SHFT TRIN
93 (COM <OR <==? .ATYP 1> <==? .ATYP 3>>) INA
94 (DONE <>) (NEGF <>) (ONO .NO-KILL)
95 (NO-KILL .NO-KILL) TRAN)
96 #DECL ((NOD TEM TT) NODE (K) <LIST [REST NODE]> (ATYP MODE) FIX
97 (WHERE COM) ANY (NO-KILL) <SPECIAL LIST>
98 (TRANSFORM TRAN) TRANS)
100 <COMMUTE <REST .K <NTH '![0 1 0 1!] .ATYP>>
101 <NTH '[+ + * *] .ATYP>
104 (<AND <==? <RESULT-TYPE .NOD> FIX>
106 <==? <NODE-TYPE <2 .K>> ,QUOTE-CODE>>
108 (<AND <ASSIGNED? TRANSFORM>
109 <==? <PARENT .NOD> <1 <SET TRAN .TRANSFORM>>>
114 <AND <==? <2 .TRIN> 2>
117 <- <CHTYPE <NODE-NAME <2 .K>> FIX>>)
118 (ELSE <NODE-NAME <2 .K>>)>>>>>
119 <PUT <PUT <3 .TRAN> 2 1>
121 <COND (<1? .ATYP> <- <CHTYPE <NODE-NAME <2 .K>> FIX>>)
122 (ELSE <NODE-NAME <2 .K>>)>>)
125 <AND <==? <4 .TRIN> 4>
126 <==? <5 .TRIN> <NODE-NAME <2 .K>>>>>>
127 <PUT <PUT <3 .TRAN> 4 4> 5 <NODE-NAME <2 .K>>>)
129 <RETURN <GEN <1 .K> .WHERE> .AG>)
130 (<N==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
134 <COND (<L? .ATYP 3> 2) (ELSE 0)>
135 <COND (<1? .ATYP> <NODE-NAME <2 .K>>)
136 (<==? .ATYP 2> <- <CHTYPE <NODE-NAME <2 .K>>
140 <COND (<==? .ATYP 3> 2) (ELSE 4)>)
142 <COND (<G? .ATYP 2> <NODE-NAME <2 .K>>) (ELSE 1)>
145 #DECL ((TRANSFORM) <SPECIAL TRANS>)
146 <SET REG <GEN .TEM DONT-CARE>>
151 <COND (<NOT <0? .NN>>
152 <RETURN <MOVE-ARG .REG .WHERE> .AG>)>>
155 (<==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
156 <SET REG1 <GEN <SET TEM <1 <KIDS .TEM>>> <GEN-TEMP <>>>>
162 <COND (<==? .WHERE DONT-CARE>
163 <SET WHERE <GEN-TEMP <>>>)
164 (<OR <NOT <TYPE? .WHERE TEMP>>
165 <G? <TEMP-REFS .WHERE> 0>>
170 <GET-DF <NODE-NAME .NOD>>>>)
173 <COND (<AND <==? .WHERE DONT-CARE>
175 <L? <TEMP-REFS .REG> 2>>
177 (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP <>>>)>
178 <COND (<AND <TYPE? .REG TEMP> <NOT <EMPTY? <REST .K>>>>
179 <SET REG <INTERF-CHANGE .REG <2 .K>>>)>
180 <COND (<==? <RESULT-TYPE .TEM> FLOAT> <SET MODE 2>)>)>
183 "AUX" NN TEM TRANSFORM
186 (<==? <NODE-TYPE <SET NN <1 .N>>> ,SEG-CODE>
188 <GEN <SET NN <1 <KIDS .NN>>>>)
193 <COND (<AND .NEGF <G? .ATYP 2>> 2)
201 <GEN .NN DONT-CARE>)>) (COM .COM)
202 (LAST <EMPTY? <REST .N>>))
203 #DECL ((N) <LIST NODE> (MODE) FIX (NN) NODE
204 (TRANSFORM) <SPECIAL TRANS>)
206 <COND (<OR <NOT <TYPE? .NXT TEMP>> <G? <TEMP-REFS .NXT> 1>>
207 <SET NXT <MOVE-ARG .NXT <GEN-TEMP <>>>>)>
208 <SET MODE <SEGINS .ATYP <> .NN .REG .NXT .MODE 0>>
211 <AND <ASSIGNED? TRANSFORM>
212 <NOT <0? <1 <3 .TRANSFORM>>>>
215 <SET NEGF <NOT .NEGF>>>>
217 <COND (<==? <ISTYPE? <RESULT-TYPE .NN>> FIX>
219 <GEN-FLOAT .NXT <PROT .NXT FLOAT>>>)>)
220 (<==? <ISTYPE? <RESULT-TYPE .NN>> FLOAT>
221 <SET REG <GEN-FLOAT .REG <PROT .REG FLOAT>>>
223 <COND (<AND <==? .ATYP 3>
225 <==? <NODE-TYPE .NN> ,QUOTE-CODE>
226 <SET SHFT <POPWR2 <NODE-NAME .NN>>>>
227 <SET REG <SHIFT-INS .REG .SHFT .ATYP .LAST .WHERE>>)
230 <ARITH-INS <COND (<AND .NEGF <L? .ATYP 3>>
242 <COND (<AND <ASSIGNED? TRANSFORM>
243 <==? <1 <SET TRAN .TRANSFORM>> <PARENT .NOD>>
244 <NOT <0? <1 <2 .TRAN>>>>>
246 (ELSE <GEN-NEGATE .REG>)>)>
247 <DELAY-KILL .NO-KILL .ONO>
248 <MOVE-ARG .REG .WHERE>>
250 <DEFINE PROT (DAT TYP)
251 <COND (<TYPE? .DAT TEMP> <DEALLOCATE-TEMP .DAT>)>
252 <COND (<AND <TYPE? .DAT TEMP> <L=? <TEMP-REFS .DAT> 0>>
255 (<TYPE? .DAT TEMP> <GEN-TEMP .TYP>)
258 <DEFINE SHIFT-INS (REG SHFT ATYP LAST W)
259 #DECL ((SHFT ATYP) FIX)
261 <COND (<==? .ATYP 3> .SHFT) (ELSE <- .SHFT>)>
262 <SET REG <COND (<AND .LAST <N==? .REG .W>>
264 <COND (<==? .W DONT-CARE>
266 (<TYPE? .W TEMP> <USE-TEMP .W FIX> .W)
268 (<TYPE? .REG TEMP> .REG)
269 (ELSE <GEN-TEMP <>>)>>>
272 <DEFINE SEGINS (ATYP FD N REG REG2 MD DEFLT
273 "AUX" SAC SL TYP (STYP <RESULT-TYPE .N>) (TG <MAKE-TAG>)
274 (LOOP <MAKE-TAG>) RAC)
275 #DECL ((N) NODE (ATYP SL MD) FIX)
276 <SET TYP <COND (<==? <GET-ELE-TYPE .STYP ALL> FIX> 1) (ELSE 2)>>
277 <SET STYP <STRUCTYP .STYP>>
278 <SET SL <MINL <RESULT-TYPE .N>>>
281 <AND <==? .TYP 2> <==? .DEFLT 1> <SET DEFLT 1.0>>
285 (`TYPE <COND (<==? .TYP 1> FIX) (ELSE FLOAT)>)>
286 <EMPTY-JUMP .STYP .REG2 .TG>)>
287 <COND (<OR <==? .ATYP 2> <==? .ATYP 4>>
288 <SET REG <GETEL .REG .REG2 .STYP>>
289 <ADVANCE .STYP .REG2>
292 (<AND <1? .MD> <==? .TYP 2>>
293 <SET REG <GEN-FLOAT .REG <PROT .REG FLOAT>>>)>
294 <COND (<L? .SL 1> <EMPTY-JUMP .STYP .REG2 .TG>)>
296 <EMITSEG .REG .REG2 .STYP .ATYP .TYP .MD>
297 <ADVANCE-AND-CHECK .STYP .REG2 .LOOP>
301 <DEFINE ADVANCE (STYP SAC "AUX" AMT)
302 #DECL ((STYP) ATOM (AMT) FIX)
303 <SET AMT <COND (<==? .STYP UVECTOR> 1) (ELSE 2)>>
304 <COND (<==? .STYP LIST>
305 <NTH-LIST .SAC 1 .SAC>)
307 <NTH-UVECTOR .SAC .SAC 1>)
309 <NTH-VECTOR .SAC .SAC 1>)>>
311 <DEFINE ADVANCE-AND-CHECK (STYP SAC TG)
313 <COND (<==? .STYP LIST>
314 <REST-LIST .SAC .SAC 1>
315 <EMPTY-LIST .SAC .TG <>>)
317 <REST-VECTOR .SAC .SAC 1>
318 <EMPTY-VECTOR .SAC .TG <>>)
320 <REST-UVECTOR .SAC .SAC 1>
321 <EMPTY-UVECTOR .SAC .TG <>>)>>
323 <DEFINE EMPTY-JUMP (STYP SAC TG)
324 #DECL ((STYP TG) ATOM)
325 <COND (<==? .STYP LIST>
326 <EMPTY-LIST .SAC .TG T>)
328 <EMPTY-VECTOR .SAC .TG T>)
330 <EMPTY-UVECTOR .SAC .TG T>)>>
332 <DEFINE EMITSEG (RAC SAC STYP ATYP TYP MD "AUX" DAT (TMP <GEN-TEMP>))
333 #DECL ((TYP MD ATYP) FIX)
334 <COND (<AND <==? .MD 2> <==? .TYP 1>>
335 <GETEL .TMP .SAC .STYP>
336 <GEN-FLOAT .TMP .TMP>
337 <GENINS .ATYP .MD .RAC .TMP>)
338 (ELSE <GETEL .TMP .SAC .STYP> <GENINS .ATYP .MD .RAC .TMP>)>
341 <DEFINE GENINS (ATYP MD RAC ADD "AUX" INS (TG <MAKE-TAG>))
342 #DECL ((MD ATYP) FIX)
344 <IEMIT <NTH '[`GRTR? `LESS?] <- .ATYP 4>> .RAC .ADD + .TG>
345 <IEMIT `SET .RAC .ADD>
348 <SET INS <NTH <NTH ,INS1 .MD> .ATYP>>
354 (`TYPE <COND (<==? .MD 1> FIX) (ELSE FLOAT)>)>)>>
356 <DEFINE GETEL (RAC SAC STYP)
357 <COND (<==? .RAC DONT-CARE> <SET RAC <GEN-TEMP>>)>
358 <COND (<==? .STYP LIST> <NTH-LIST .SAC .RAC 1>)
359 (<==? .STYP VECTOR> <NTH-VECTOR .SAC .RAC 1>)
360 (ELSE <NTH-UVECTOR .SAC .RAC 1>)>
363 <SETG INS1 [[`ADD `SUB `MUL `DIV] [`ADDF `SUBF `MULF `DIVF]]>
365 <GDECL (INS1) !<VECTOR [2 !<VECTOR [4 ANY]>]>>
367 " Do the actual arithmetic code generation here with all args set up."
369 <DEFINE ARITH-INS (ATYP REG REG2 MODE LAST W "AUX" INS)
370 #DECL ((ATYP MODE REFS) FIX)
371 <SET INS <NTH <NTH ,INS1 .MODE> .ATYP>>
377 <COND (<AND .LAST <N==? .REG .W>>
379 <COND (<==? .W DONT-CARE>
380 <GEN-TEMP <COND (<==? .MODE 1> FIX)
383 <USE-TEMP .W <COND (<==? .MODE 1> FIX)
386 (<AND .LAST <==? .REG .W>> .REG)
387 (<AND <TYPE? .REG TEMP> <L=? <TEMP-REFS .REG> 1>>
389 (<AND <TYPE? .W TEMP> <L? <TEMP-REFS .W> 1>>
390 <USE-TEMP .W <COND (<==? .MODE 1> FIX)
395 <GEN-TEMP <COND (<==? .MODE 1> FIX)
397 <COND (<==? .MODE 2> '(`TYPE FLOAT))(ELSE '(`TYPE FIX))>>
400 <DEFINE MIN-MAX (NOD WHERE
401 "AUX" (MAX? <==? MAX <NODE-NAME .NOD>>) (K <KIDS .NOD>) REG
402 (MODE 1) REG1 SEGF (C <OR <AND .MAX? 5> 6>) TEM
403 (ONO .NO-KILL) (NO-KILL .ONO))
404 #DECL ((NOD) NODE (MODE C) FIX (MAX?) ANY (K) <LIST [REST NODE]>
405 (NO-KILL) <SPECIAL LIST>)
406 <SET NO-KILL <COMMUTE .K <NODE-NAME .NOD> .NO-KILL>>
407 <SET REG <GEN-TEMP <>>>
408 <COND (<==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
410 <GEN <SET TEM <1 <KIDS .TEM>>> <GEN-TEMP <>>>>
418 <CHTYPE <OR <AND .MAX? <MAX>> <MIN>>
419 <RESULT-TYPE .NOD>>>>
422 <SET REG <GEN .TEM .REG>>
423 <AND <==? <RESULT-TYPE .TEM> FLOAT> <SET MODE 2>>)>
428 (<==? <NODE-TYPE .N> ,SEG-CODE>
430 <GEN <SET N <1 <KIDS .N>>> <GEN-TEMP <>>>)
431 (ELSE <SET SEGF <>> <GEN .N DONT-CARE>)>) TG)
432 #DECL ((N) NODE (MODE) FIX)
434 <SET MODE <SEGINS .C <> .N .REG .NXT .MODE 0>>)
437 <COND (<==? <ISTYPE? <RESULT-TYPE .N>> FIX>
438 <SET NXT <GEN-FLOAT .NXT <PROT .NXT FLOAT>>>)>)
439 (<==? <ISTYPE? <RESULT-TYPE .N>> FLOAT>
440 <SET REG <GEN-FLOAT .REG <PROT .REG FLOAT>>>
442 <IEMIT <COND (.MAX? `LESS?) (ELSE `GRTR?)> .REG .NXT -
444 <SET-TEMP .REG .NXT (`TYPE <COND (<==? .MODE 2> FLOAT)
449 <DELAY-KILL .NO-KILL .ONO>
450 <MOVE-ARG .REG .WHERE>>
452 <DEFINE ABS-GEN ACT (N W
453 "AUX" (K1 <1 <KIDS .N>>) NUM (TRIN <>)
454 (ABSFLG <==? <NODE-NAME .N> ABS>) (DONE <>) W1
455 TG (RT <RESULT-TYPE .N>))
456 #DECL ((N K1) NODE (TRANSFORM) TRANS)
457 <PROG ((TRANSFORM <MAKE-TRANS .N 2 0 0 0 1 0 0>))
458 #DECL ((TRANSFORM) <SPECIAL TRANS>)
459 <SET NUM <GEN .K1 <COND (<==? .W ,POP-STACK> DONT-CARE) (ELSE .W)>>>
460 <COND (<NOT <0? <1 <3 .TRANSFORM>>>>
461 <RETURN <MOVE-ARG .NUM .W> .ACT>)>>
462 <COND (<AND <ASSIGNED? TRANSFORM>
463 <==? <1 .TRANSFORM> <PARENT .N>>
465 <SET TRIN <2 .TRANSFORM>>)>
466 <COND (<AND .TRIN <NOT <0? <1 .TRIN>>>>
467 <PUT <3 .TRANSFORM> 1 1>
471 <COND (<TYPE? .W TEMP> <USE-TEMP <SET W1 .W> .RT>)
472 (<AND <TYPE? .NUM TEMP> <L=? <TEMP-REFS .NUM> 1>>
474 (ELSE <SET W1 <GEN-TEMP .RT>>)>
475 <COND (<N==? .NUM .W1>
476 <DEALLOCATE-TEMP <SET NUM <MOVE-ARG .NUM .W1>>>)>
477 <DO-LESS? .NUM <SET TG <MAKE-TAG>> .RT>
478 <DO-SUB .NUM .W1 .RT>
480 <SET W <MOVE-ARG .W1 .W>>)
482 <COND (<AND <==? .W DONT-CARE>
484 <L=? <TEMP-REFS .NUM> 1>>
486 (<==? .W DONT-CARE> <SET W <GEN-TEMP .RT>>)>
488 <COND (<N==? .W .NUM> <FREE-TEMP .NUM>)>)>
491 <DEFINE DO-SUB (NUM W TY "AUX" TG1 TG2)
492 #DECL ((TG1 TG2) ATOM)
493 <COND (<==? <ISTYPE? .TY> FIX> <IEMIT `SUB 0 .NUM = .W '(`TYPE FIX)>)
494 (<==? <ISTYPE? .TY> FLOAT>
495 <IEMIT `SUBF 0 .NUM = .W '(`TYPE FLOAT)>)
499 <GEN-TYPE? .NUM FIX .TG1 <>>
500 <IEMIT `SUB 0 .NUM = .W '(`TYPE FIX)>
503 <COND (<TYPE-OK? .TY '<NOT <OR FIX FLOAT>>>
504 <GEN-TYPE? .NUM FLOAT `COMPERR <>>)>
505 <IEMIT `SUBF 0.0000000 .NUM = .W '(`TYPE FLOAT)>
509 <DEFINE DO-LESS? (NUM TG TY "AUX" TG1 TG2)
510 #DECL ((TG1 TG2) ATOM)
511 <COND (<==? <ISTYPE? .TY> FIX>
512 <IEMIT `LESS? .NUM 0 - .TG '(`TYPE FIX)>)
513 (<==? <ISTYPE? .TY> FLOAT>
514 <IEMIT `LESS? .NUM 0.0 - .TG '(`TYPE FLOAT)>)
518 <GEN-TYPE? .NUM FIX .TG1 <>>
519 <IEMIT `LESS? .NUM 0 - .TG '(`TYPE FIX)>
522 <COND (<AND .CAREFUL <TYPE-OK? .TY '<NOT <OR FIX FLOAT>>>>
523 <GEN-TYPE? .NUM FLOAT `COMPERR <>>)>
524 <IEMIT `LESS? .NUM 0.0 - .TG '(`TYPE FLOAT)>
528 "AUX" (N1 <1 <KIDS .N>>) (N2 <2 <KIDS .N>>)
532 (<AND <==? <NODE-TYPE .N2> ,QUOTE-CODE>
533 <POPWR2 <NODE-NAME .N2>>>
534 <FREE-TEMP <SET W1 <GEN .N1 DONT-CARE>>>
535 <IEMIT `AND .W1 <- <CHTYPE <NODE-NAME .N2> FIX> 1> =
536 <COND (<TYPE? .W TEMP>
540 <SET W <GEN-TEMP FIX>>)
543 <COND (<AND <MEMQ <NODE-TYPE .N1> ,SNODES>
544 <NOT <MEMQ <NODE-TYPE .N2> ,SNODES>>
545 <NOT <SIDE-EFFECTS .N2>>>
546 <SET W2 <GEN .N2 DONT-CARE>>
547 <SET W2 <INTERF-CHANGE .W2 .N1>>
548 <SET W1 <GEN .N1 DONT-CARE>>)
550 <SET W1 <GEN .N1 DONT-CARE>>
551 <SET W1 <INTERF-CHANGE .W1 .N2>>
552 <SET W2 <GEN .N2 DONT-CARE>>)>
555 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)
556 (<TYPE? .W TEMP> <USE-TEMP .W FIX>)>
557 <IEMIT `MOD .W1 .W2 = .W '(`TYPE FIX)>)>
560 <DEFINE ROT-GEN (N W) <ROT-LSH-GEN .N .W `ROT>>
562 <DEFINE LSH-GEN (N W) <ROT-LSH-GEN .N .W `LSH>>
564 <DEFINE ROT-LSH-GEN (N W INS
565 "AUX" (K <KIDS .N>) (A1 <1 .K>) (A2 <2 .K>) W1 W2)
566 #DECL ((N A1 A2) NODE (K) <LIST [2 NODE]>)
567 <COND (<==? <NODE-TYPE .A2> ,QUOTE-CODE>
568 ;" LSH-ROT by fixed amount"
569 <SET W1 <GEN .A1 DONT-CARE>>
571 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)
572 (<TYPE? .W TEMP> <USE-TEMP .W FIX>)>
573 <IEMIT .INS .W1 <NODE-NAME .A2> = .W '(`TYPE FIX)>)
575 <COND (<AND <MEMQ <NODE-TYPE .A1> ,SNODES>
576 <NOT <MEMQ <NODE-TYPE .A2> ,SNODES>>
577 <NOT <SIDE-EFFECTS .A2>>>
578 <SET W2 <GEN .A2 DONT-CARE>>
579 <SET W2 <INTERF-CHANGE .W2 .A1>>
580 <SET W1 <GEN .A1 DONT-CARE>>)
582 <SET W1 <GEN .A1 DONT-CARE>>
583 <SET W1 <INTERF-CHANGE .W1 .A2>>
584 <SET W2 <GEN .A2 DONT-CARE>>)>
587 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)
588 (<TYPE? .W TEMP> <USE-TEMP .W FIX>)>
589 <IEMIT .INS .W1 .W2 = .W '(`TYPE FIX)>)>
592 <DEFINE FLOAT-GEN (N W
593 "AUX" (NUM <1 <KIDS .N>>) TEM1 (RT <RESULT-TYPE .NUM>) TG
595 #DECL ((N NUM) NODE (TG) ATOM)
596 <COND (<==? .RT FLOAT>
597 <COMPILE-WARNING "Unnecessary FLOAT: " .N>
599 (<==? <ISTYPE? .RT> FIX>
602 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FLOAT>>)
603 (<TYPE? .W TEMP> <USE-TEMP .W FLOAT>)>
607 <COND (<OR <NOT <TYPE? .W TEMP>>
608 <NOT <TEMP-NO-RECYCLE .W>>
609 <N==? <TEMP-NO-RECYCLE .W> ANY>>
610 <SET TEM <GEN-TEMP <>>>)
612 <SET TEM <GEN .NUM .TEM>>
614 <GEN-TYPE? .TEM FLOAT .TG T>
615 <GEN-FLOAT .TEM .TEM>
617 <COND (<N==? .TEM .W> <MOVE-ARG .TEM .W>)
621 "AUX" (NUM <1 <KIDS .N>>) (RT <RESULT-TYPE .NUM>) TEM TEM1
623 #DECL ((N NUM) NODE (BR) ATOM)
624 <COND (<==? <ISTYPE? .RT> FIX>
625 <COMPILE-WARNING "Unnecessary FIX: " .N>
630 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)
631 (<TYPE? .W TEMP> <USE-TEMP .W FIX>)>
635 <COND (<OR <NOT <TYPE? .W TEMP>>
636 <NOT <TEMP-NO-RECYCLE .W>>
637 <N==? <TEMP-NO-RECYCLE .W> ANY>>
638 <SET TEM <GEN-TEMP <>>>)
640 <SET TEM <GEN .NUM .TEM>>
641 <GEN-TYPE? .TEM FIX <SET BR <MAKE-TAG>> T>
644 <COND (<N==? .TEM .W> <MOVE-ARG .TEM .W>)
647 <DEFINE GEN-FLOAT (DAT W)
648 <COND (<TYPE? .DAT FIX> <FLOAT .DAT>)
650 <IEMIT `FLOAT .DAT = .W '(`TYPE FLOAT)>
653 <DEFINE GEN-FIX (DAT "OPTIONAL" (W <GEN-TEMP <>>))
654 <COND (<TYPE? .DAT FLOAT> <FIX .DAT>)
656 <IEMIT `FIX .DAT = .W '(`TYPE FIX)>
660 #DECL ((SUBR VALUE) ATOM)
662 '[G? L? G? G=? L=? G=? ==? ==? N==? N==? 1? -1? 1? 0?
665 <DEFINE FLIP (SUBR "AUX" N)
666 #DECL ((N) FIX (SUBR VALUE) ATOM)
669 <SET N <LENGTH <CHTYPE <MEMQ .SUBR ,0SUBRS> VECTOR>>>
670 <COND (<0? <MOD .N 2>> -1) (ELSE 1)>>>>
674 <DEFINE PRED? (N) #DECL ((N) FIX) <N==? <NTH ,PREDV .N> 0>>
678 <AND <==? <NODE-TYPE .N> ,LNTH-CODE>
679 <==? <STRUCTYP <RESULT-TYPE <1 <KIDS .N>>>> LIST>>>
681 <DEFINE 0-TEST (NOD WHERE
682 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
683 "AUX" (REG ,NO-DATUM) (NN <1 <KIDS .NOD>>)
685 <MAKE-TRANS .NOD 1 1 0 1 1 1 <SW? <NODE-NAME .NOD>>>))
686 #DECL ((TRANSFORM) <SPECIAL TRANS> (NOD NN) NODE)
687 <COND (<NOT <LN-LST .NN>>
688 <SET REG <GEN .NN DONT-CARE>>)>
695 <DO-A-TRANS 0 .TRANSFORM>
696 <NOT <0? <1 <3 .TRANSFORM>>>>
701 <COND (<MEMQ .SBR '[0? N0? 1? -1? N1? N-1? ==? N==?]> 0)
704 <DEFINE MAKE-TRANS (N NEG +- +-V */ */V HW SW)
705 #DECL ((N) NODE (NEG +- +-V */ */V HW SW) FIX)
706 <CHTYPE [.N <UVECTOR .NEG .+- .+-V .*/ .*/V .HW .SW> <IUVECTOR 7 0>]
709 <DEFINE DO-A-TRANS (N TR "AUX" (X <3 .TR>) (NN <NODE-NAME <1 .TR>>))
710 #DECL ((TR) TRANS (N) FIX (X) <UVECTOR [7 FIX]>)
711 <COND (<AND <NOT <0? .N>> <NOT <0? <6 .X>>> <NOT <0? <7 .X>>>>
712 <COND (<==? .NN G?> <SET N <- .N 1>>)
713 (<==? .NN L=?> <SET N <- .N 1>>)>)>
714 <COND (<NOT <0? <1 .X>>> <SET N <- .N>>)>
715 <COND (<NOT <0? <2 .X>>> <SET N <+ .N <3 .X>>>)>
716 <COND (<G? <4 .X> 2> <SET N </ .N <5 .X>>>)
717 (<NOT <0? <4 .X>>> <SET N <* .N <5 .X>>>)>
718 <COND (<NOT <0? <6 .X>>>
719 <SET N <CHTYPE <ANDB .N 262143> FIX>>
720 <COND (<NOT <0? <7 .X>>>
721 <SET N <CHTYPE <PUTBITS 0 <BITS 18 18> .N> FIX>>)>)>
724 <DEFINE UPDATE-TRANS (NOD TR "AUX" (X <3 .TR>) FLG)
727 <COND (<NOT <0? <1 .X>>> 2) (ELSE 0)>
728 <COND (<SET FLG <NOT <0? <2 .X>>>> 2) (ELSE 0)>
729 <COND (.FLG <3 .X>) (ELSE 0)>
730 <COND (<SET FLG <G? <4 .X> 2>> 4)
731 (<SET FLG <NOT <0? <4 .X>>>> 2)
733 <COND (.FLG <5 .X>) (ELSE 1)>
734 <COND (<NOT <0? <6 .X>>> 2) (ELSE 0)>
735 <COND (<NOT <0? <7 .X>>> 2) (ELSE 0)>>>
737 <DEFINE TEST-DISP (N W NF BR DI REG NUM NEG SF)
738 #DECL ((NUM) <OR FIX FLOAT> (N) NODE)
739 <COND (<==? .REG ,NO-DATUM> <LIST-LNT-SPEC .N .W .NF .BR .DI .NUM .SF>)
740 (<0? .NUM> <0-TEST1 .N .W .NF .BR .DI .REG .NEG .SF>)
741 (<AND <OR <==? .NUM 1> <==? .NUM 1.0> <==? .NUM -1>>
742 <OR <==? <NODE-NAME .N> 1?>
743 <==? <ISTYPE? <RESULT-TYPE <1 <KIDS .N>>>> FIX>>>
744 <COND (<==? .NUM -1> <SET NEG T>)>
745 <1?-TEST .N .W .NF .BR .DI .REG .NEG .SF>)
746 (ELSE <TEST-GEN2 .N .W .NF .BR .DI .REG .NUM .NEG .SF>)>>
748 <DEFINE 0-TEST1 (NOD WHERE NOTF BRANCH DIR REG NEG SF
749 "AUX" (SBR <NODE-NAME .NOD>) B2 (RW .WHERE)
750 (ARG <1 <KIDS .NOD>>) (SDIR .DIR)
751 (ATYP <ISTYPE? <RESULT-TYPE .ARG>>) (LDAT <>) S TT)
752 #DECL ((NOD ARG) NODE (S) SYMTAB)
753 <SET WHERE <COND (<==? .WHERE DONT-CARE> <GEN-TEMP <>>) (ELSE .WHERE)>>
755 <COND (<==? <NODE-TYPE .NOD> ,0-TST-CODE> <SET SBR <FLOP .SBR>>)
757 <COND (<SET TT <MEMQ .SBR '[G? G=? G? L? L=? L?]>>
758 <SET SBR <2 .TT>>)>)>)>
760 <AND .NOTF <SET DIR <NOT .DIR>>>
761 <AND .DIR <SET SBR <FLIP .SBR>>>
763 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
764 <COND (<==? .RW FLUSHED>
765 <ZER-JMP .SBR .REG .BRANCH .ATYP>
769 <SET SBR <FLIP .SBR>>
770 <ZER-JMP .SBR .REG .B2 .ATYP>
772 <MOVE-ARG <REFERENCE .SDIR>
773 <COND (<==? .RW DONT-CARE> <GEN-TEMP <>>)
779 <AND .NOTF <SET SBR <FLIP .SBR>>>
780 <ZER-JMP .SBR .REG <SET BRANCH <MAKE-TAG>> .ATYP>
781 <MOVE-ARG <REFERENCE T> .WHERE>
782 <BRANCH-TAG <SET B2 <MAKE-TAG>>>
784 <MOVE-ARG <REFERENCE <>> .WHERE>
786 <MOVE-ARG .WHERE .RW>)>>
788 <DEFINE ZER-JMP (SBR REG BR ATYP "AUX" (TEM <LENGTH <CHTYPE <MEMQ .SBR ,0SUBRS>
790 (B1 <MAKE-TAG>) (B2 <MAKE-TAG>))
792 <IEMIT <NTH ,0SKPS .TEM> .REG
793 <COND (<==? .ATYP FIX> 0)
794 (ELSE 0.0)> <NTH ,0JSENS .TEM> .BR
797 (<==? <NTH ,0SKPS .TEM> `VEQUAL?>
798 <IEMIT `VEQUAL? .REG 0 <NTH ,0JSENS .TEM> .BR '(`TYPE FIX)>
801 <IEMIT <NTH ,0SKPS .TEM> .REG 0 <NTH ,0JSENS .TEM> .BR>
804 <SETG 0SKPS [`VEQUAL? `VEQUAL? `LESS? `LESS? `GRTR? `GRTR? `VEQUAL? `VEQUAL?]>
806 <SETG 0JSENS [+ - + - + - + -]>
808 <SETG 0SUBRS [1? N1? -1? N-1? 0? N0? G? L=? L? G=? ==? N==?]>
810 <DEFINE 1?-GEN (NOD WHERE
811 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
812 "AUX" (REG ,NO-DATUM) (NN <1 <KIDS .NOD>>)
814 <MAKE-TRANS .NOD 1 2 -1 1 1 1 <SW? <NODE-NAME .NOD>>>))
815 #DECL ((NOD NN) NODE (TRANSFORM) <SPECIAL TRANS>)
816 <COND (<NOT <LN-LST .NN>>
817 <SET REG <GEN .NN DONT-CARE>>)>
824 <DO-A-TRANS 1 .TRANSFORM>
825 <NOT <0? <1 <3 .TRANSFORM>>>>
828 <DEFINE 1?-TEST (NOD WHERE NOTF BRANCH DIR REG NEG SF
829 "AUX" (SBR <NODE-NAME .NOD>) B2 (RW .WHERE)
830 (K <1 <KIDS .NOD>>) (SDIR .DIR) (NM <>)
831 (ATYP <ISTYPE? <RESULT-TYPE .K>>))
833 <SET WHERE <COND (<==? .WHERE DONT-CARE> <GEN-TEMP <>>) (ELSE .WHERE)>>
835 <AND .NOTF <SET DIR <NOT .DIR>>>
837 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
838 <COND (<==? .RW FLUSHED>
839 <GEN-COMP .ATYP .REG .DIR .BRANCH .SBR .NEG .NM>
843 <GEN-COMP .ATYP .REG <NOT .DIR> .B2 .SBR .NEG .NM>
845 <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .WHERE> .RW>>
851 <COND (<==? .WHERE DONT-CARE> <GEN-TEMP <>>)
856 <SET BRANCH <MAKE-TAG>>
860 <MOVE-ARG <REFERENCE T> .WHERE>
861 <BRANCH-TAG <SET B2 <MAKE-TAG>>>
863 <MOVE-ARG <REFERENCE <>> .WHERE>
865 <MOVE-ARG .WHERE .RW>)>>
867 <DEFINE GEN-COMP (TYP REG DIR BR SBR NEG NM
868 "AUX" TEM (LBL <MAKE-TAG>) (LBL2 <MAKE-TAG>))
870 <COND (<OR <==? .TYP FIX> <==? .TYP FLOAT>>
871 <COND (.DIR <SET SBR <FLIP .SBR>>)>
872 <IEMIT <1 <SET TEM <NTH ,SKIPS <LENGTH <CHTYPE <MEMQ .SBR ,CMSUBRS>
875 <COND (<==? .TYP FIX> <COND (.NEG -1) (ELSE 1)>)
876 (ELSE <COND (.NEG -1.0) (ELSE 1.0)>)>
882 <GEN-TYPE? .REG FLOAT .LBL <>>
885 <COND (.NEG -1.0) (ELSE 1.0)>
887 <COND (.DIR .BR) (ELSE .LBL2)>
889 <COND (<NOT .DIR> <BRANCH-TAG .BR>)
890 (ELSE <BRANCH-TAG .LBL2>)>
892 <GEN-TYPE? .REG FIX `COMPERR <>>
895 <COND (.NEG -1) (ELSE 1)>
896 <COND (.DIR +) (ELSE -)>
902 <DEFINE TEST-GEN (NOD WHERE
903 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
904 "AUX" (K <1 <KIDS .NOD>>) (K2 <2 <KIDS .NOD>>) REGT REGT2
905 (S <SW? <NODE-NAME .NOD>>) TRANSFORM ATYP ATYP2 B2
906 (SDIR .DIR) (RW .WHERE) TRANS1 (FLS <==? .RW FLUSHED>)
907 TEM (ONO .NO-KILL) (NO-KILL .ONO)
909 #DECL ((NOD K K2) NODE (TRANSFORM) <SPECIAL TRANS> (TRANS1) TRANS
910 (NO-KILL) <SPECIAL LIST>)
912 <COND (<==? .WHERE FLUSHED> FLUSHED)
913 (<==? .WHERE DONT-CARE> <GEN-TEMP <>>)
915 <COND (<OR <==? <NODE-TYPE .K2> ,QUOTE-CODE>
916 <AND <NOT <MEMQ <NODE-TYPE .K> ,SNODES>>
917 <NOT <SIDE-EFFECTS .NOD>>
918 <MEMQ <NODE-TYPE .K2> ,SNODES>>>
919 <COND (<AND <==? <NODE-TYPE .K> ,LVAL-CODE>
920 <COND (<==? <LENGTH <SET TEM <TYPE-INFO .K>>> 2>
923 <SET TEM <NODE-NAME .K>>
926 <AND <==? <1 .LL> .TEM> <MAPLEAVE>>>
928 <SET NO-KILL ((<NODE-NAME .K> <>) !.NO-KILL)>)>
930 <SET K2 <1 <KIDS .NOD>>>
931 <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>)>
932 <SET ATYP <ISTYPE? <RESULT-TYPE .K2>>>
933 <SET ATYP2 <ISTYPE-GOOD? <RESULT-TYPE .K>>>
935 (<N==? <NODE-TYPE .K> ,QUOTE-CODE>
938 <COND (<AND <N==? .ATYP .ATYP2> <==? .ATYP2 FIX>> <GEN-TEMP <>>)
940 <COND (<ASSIGNED? TRANSFORM>
941 <SET TRANS1 .TRANSFORM>
942 <SET TRANSFORM <UPDATE-TRANS .NOD .TRANS1>>)>
943 <SET REGT2 <INTERF-CHANGE .REGT2 .K2>>
946 <COND (<AND <N==? .ATYP .ATYP2> <==? .ATYP FIX>> <GEN-TEMP <>>)
949 <COND (<OR <==? .ATYP FIX> <==? <NODE-NAME .K> 0>>
950 <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>)>
951 <COND (<==? .ATYP FIX>
952 <PUT <PUT <2 .TRANSFORM> 2 1> 3 <FIX <NODE-NAME .K>>>)>
953 <COND (<LN-LST .K2> <SET REGT ,NO-DATUM>) (ELSE <SET REGT <GEN .K2>>)>
954 <RETURN <TEST-DISP .NOD
960 <COND (<ASSIGNED? TRANSFORM>
961 <DO-A-TRANS <FIX <NODE-NAME .K>> .TRANSFORM>)
962 (ELSE <NODE-NAME .K>)>
963 <AND <ASSIGNED? TRANSFORM>
964 <NOT <0? <1 <3 .TRANSFORM>>>>>
967 <DELAY-KILL .NO-KILL .ONO>
968 <AND <ASSIGNED? TRANSFORM>
969 '<CONFORM .REGT .REGT2 .TRANSFORM .TRANS1>
970 '<PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>>
972 <AND .NOTF <SET DIR <NOT .DIR>>>
974 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
975 <GEN-COMP2 <FLOP <NODE-NAME .NOD>>
980 <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
981 <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE-TAG>>)>>
983 <SET RW <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .WHERE> .RW>>
988 <GEN-COMP2 <FLOP <NODE-NAME .NOD>>
994 <SET BRANCH <MAKE-TAG>>>
995 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE T> .WHERE>>
996 <BRANCH-TAG <SET B2 <MAKE-TAG>>>
998 <MOVE-ARG <REFERENCE <>> .WHERE>
1000 <MOVE-ARG .WHERE .RW>)>>
1002 <DEFINE TEST-GEN2 (NOD WHERE NOTF BRANCH DIR REG NUM NEG SF
1003 "AUX" (SDIR .DIR) (RW .WHERE) (FLS <==? .RW FLUSHED>) B2
1004 (SBR <NODE-NAME .NOD>))
1005 #DECL ((NOD) NODE (NUM) <OR FIX FLOAT>)
1007 <COND (<==? .WHERE FLUSHED> FLUSHED)
1008 (<==? .WHERE DONT-CARE> <GEN-TEMP <>>)
1011 <COND (.NEG <SET SBR <FLOP .SBR>>)>
1012 <AND .NOTF <SET DIR <NOT .DIR>>>
1014 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
1020 <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
1021 <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE-TAG>>)>>
1024 <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .WHERE> .RW>>
1025 <BRANCH-TAG .BRANCH>
1029 <AND .NOTF <SET DIR <NOT .DIR>>>
1030 <COND (.NEG <SET SBR <FLOP .SBR>>)>
1037 <SET BRANCH <MAKE-TAG>>>
1038 <MOVE-ARG <REFERENCE T> .WHERE>
1039 <BRANCH-TAG <SET B2 <MAKE-TAG>>>
1041 <MOVE-ARG <REFERENCE <>> .WHERE>
1043 <MOVE-ARG .WHERE .RW>)>>
1045 <DEFINE GEN-COMP2 (SB T1 T2 R1 R2 D BR "AUX" TEM)
1046 #DECL ((SB BR) ATOM)
1047 <AND .D <SET SB <FLIP .SB>>>
1048 <COND (<AND .T1 .T2 <N==? .T1 .T2> <TYPE? .R1 TEMP> <TYPE? .R2 TEMP>>
1049 <COND (<==? .T1 FIX>
1051 <SET R2 <GEN-FLOAT .R2 .R2>>)>
1052 <COND (<==? .T2 FIX>
1054 <SET R1 <GEN-FLOAT .R1 .R1>>)>)>
1055 <COND (<TYPE? .R1 TEMP> <FREE-TEMP .R1 <>>)>
1056 <COND (<TYPE? .R2 TEMP> <FREE-TEMP .R2 <>>)>
1057 <IEMIT <1 <SET TEM <NTH ,SKIPS <LENGTH <CHTYPE <MEMQ .SB ,CMSUBRS>
1063 (`TYPE <OR .T1 .T2>)>>
1068 <LENGTH <CHTYPE <MEMQ .S '[MAX MIN * / - +]> VECTOR>>>>
1070 <DEFINE POPWR2 (X) #DECL ((X) FIX)
1071 <COND (<==? .X 0> <>)
1072 (<==? <CHTYPE <ANDB <- .X> .X> FIX> .X>
1073 <REPEAT ((Y 0)) #DECL ((Y) FIX)
1074 <COND (<==? .X 1> <RETURN .Y>)>
1075 <SET X <CHTYPE <LSH .X -1> FIX>>
1076 <SET Y <+ .Y 1>>>)>>
1078 <SETG DF-VALS [0 0 1 1 <MIN> <MAX>]>
1081 <VECTOR [REST <LIST ATOM ATOM>]>
1082 (0SUBRS 0SKPS 0JSENS CMSUBRS)
1083 <VECTOR [REST ATOM]>
1087 <SETG CMSUBRS '[0? N0? 1? N1? -1? N-1? ==? N==? G? G=? L? L=?]>