3 <ENTRY ARITH-GEN ABS-GEN FLOAT-GEN FIX-GEN MOD-GEN ROT-GEN LSH-GEN 1?-GEN
4 GEN-FLOAT GENFLOAT MIN-MAX PRED:BRANCH:GEN 0-TEST FLIP TEST-GEN>
6 <USE "CACS" "CODGEN" "CHKDCL" "COMCOD" "COMPDEC" "CONFOR" "STRGEN">
9 " This file contains analyzers and code generators for arithmetic
10 SUBRs and predicates. For convenience many of the SUBRs that are
11 similar are combined into one analyzer/generator. For more info
12 on analyzers see SYMANA and on generators see CODGEN.
15 "A type TRANS specifies to an inferior node what arithmetic transforms are
16 prohibited, permitted or desired. A transform consists of 3 main elements:
17 a NODE, an input, an output. The input and output are UVECTORS of 7 fixes:
19 1) negative ok 0-no, 1-ok, 2-pref
20 2) + or - const ok 0-no, 1-ok, 2-pref
22 4) * or / const ok 0-no, 1-* ok, 2-* pref, 3-/ ok, 4-/ pref
23 5) hw ok 0-no, 1-ok, 2-pref
24 6) hw swapped also 0-no, 1-ok, 2-pref
27 <SETG SNODES ![,QUOTE-CODE ,LVAL-CODE ,GVAL-CODE!]>
29 <SETG SNODES1 <REST ,SNODES>>
31 <DEFINE COMMUTE (K OP L "AUX" TT FK KK TYP NN N CD CD1)
32 #DECL ((K KK FK) <LIST [REST NODE]> (N NN) NODE (CD1 CD) FIX (L) LIST)
34 <COND (<EMPTY? <SET KK <REST <SET FK .K>>>> <RETURN>)>
35 <SET TYP <ISTYPE? <RESULT-TYPE <1 .KK>>>>
37 <AND <EMPTY? .KK> <RETURN>>
40 <SET TYP <ISTYPE? <RESULT-TYPE <SET NN <1 .KK>>>>>>
41 <SET CD1 <NODE-TYPE .NN>>
43 (<AND <==? <SET CD <NODE-TYPE <SET N <1 .FK>>>> ,QUOTE-CODE>
44 <==? .CD1 ,QUOTE-CODE>>
47 <APPLY ,.OP <NODE-NAME .N> <NODE-NAME .NN>>>
48 <PUTREST .FK <SET KK <REST .KK>>>
51 (<==? .CD ,QUOTE-CODE>
55 (<AND <NOT <MEMQ .CD1 ,SNODES>>
57 <NOT <SIDE-EFFECTS .NN>>>
58 <COND (<AND <==? .CD ,LVAL-CODE>
59 <COND (<==? <LENGTH <SET TT <TYPE-INFO .N>>> 2> <2 .TT>)
61 <SET TT <NODE-NAME .N>>
64 <AND <==? <1 .LL> .TT> <MAPLEAVE>>>
66 <SET L ((<NODE-NAME .N> <>) !.L)>)>
70 <SET KK <REST <SET FK .KK>>>>
71 <COND (.REDO <SET REDO <>> <AGAIN>)>
75 " Generate code for +,-,* and /. Note sexy AOS and SOS generator. Also
76 note bug causing result to be left in AC even if not wanted."
78 <DEFINE ARITH-GEN AG (NOD WHERE
79 "AUX" REG (K <KIDS .NOD>) REG1 T1
81 <LENGTH <MEMQ <NODE-NAME .NOD> '![/ * - +!]>>) TT
82 (MODE 1) (TEM <1 .K>) SEGF SHFT TRIN
83 (COM <OR <==? .ATYP 1> <==? .ATYP 3>>) INA
84 (DONE <>) (NEGF <>) (ONO .NO-KILL)
86 #DECL ((NOD TEM TT) NODE (K) <LIST [REST NODE]> (ATYP MODE) FIX
87 (REG1 REG) DATUM (WHERE COM) ANY (NO-KILL) <SPECIAL LIST>)
88 <SET REG <GOODACS .NOD .WHERE>>
90 <COMMUTE <REST .K <NTH '![0 1 0 1!] .ATYP>>
91 <NTH '![+ + * *!] .ATYP>
94 (<AND <==? <RESULT-TYPE .NOD> FIX> ;"All this hair to try for AOS or SOS."
95 <OR <==? .ATYP 1> <==? .ATYP 2>> ;"+ or - only."
97 <==? <NODE-TYPE <SET TEM <1 .K>>> ,LVAL-CODE>
98 <==? <NODE-TYPE <SET TT <2 .K>>> ,QUOTE-CODE>
99 <==? <NODE-NAME .TT> 1>
100 <NOT <EMPTY? <SET T1 <PARENT .NOD>>>>
101 <==? <NODE-TYPE <SET TT .T1>> ,SET-CODE>
102 <==? <NODE-NAME .TEM> <NODE-NAME .TT>>
103 <STORED <NODE-NAME .TEM>>
104 <OR <NOT <SET INA <INACS <NODE-NAME .TEM>>>>
105 <NOT <PROG-AC <NODE-NAME .TEM>>>>>
106 <COND (<SET INA <INACS <NODE-NAME .TEM>>>
107 <AND <TYPE? <DATTYP .INA> AC> <MUNG-AC <DATTYP .INA> .INA>>
108 <AND <TYPE? <DATVAL .INA> AC> <MUNG-AC <DATVAL .INA> .INA>>)>
109 <PUT <NODE-NAME .TEM> ,INACS <>>
110 <EMIT <INSTRUCTION <NTH '![`AOS `SOS !] .ATYP>
111 !<COND (<TYPE? <DATVAL .REG> AC>
112 <SGETREG <DATVAL .REG> .REG>
113 (<ACSYM <DATVAL .REG>>))
114 (<==? <DATVAL .REG> ANY-AC>
115 <PUT .REG ,DATVAL <GETREG .REG>>
116 (<ACSYM <DATVAL .REG>>))
118 <SET REG <DATUM <1 .WHERE> <2 .WHERE>>>
120 !<ADDR:VALUE <LADDR <NODE-NAME .TEM>
122 <1 <TYPE-INFO .TT>>>>>>
123 <PUT <NODE-NAME .TEM> ,INACS .REG>
125 <RETURN <COND (<G? <LENGTH .WHERE> 2>
126 <MOVE:ARG .REG <CHTYPE <REST .WHERE 2> DATUM>>)
129 (<AND <==? <RESULT-TYPE .NOD> FIX>
131 <==? <NODE-TYPE <2 .K>> ,QUOTE-CODE>>
133 (<AND <ASSIGNED? TRANSFORM>
134 <==? <PARENT .NOD> <1 .TRANSFORM>>
135 <SET TRIN <2 .TRANSFORM>>
139 <AND <==? <2 .TRIN> 2>
141 <COND (<1? .ATYP> <- <NODE-NAME <2 .K>>>)
142 (ELSE <NODE-NAME <2 .K>>)>>>>>
143 <PUT <PUT <3 .TRANSFORM> 2 1>
145 <COND (<1? .ATYP> <- <NODE-NAME <2 .K>>>)
146 (ELSE <NODE-NAME <2 .K>>)>>)
149 <AND <==? <4 .TRIN> 4>
150 <==? <5 .TRIN> <NODE-NAME <2 .K>>>>>>
151 <PUT <PUT <3 .TRANSFORM> 4 4> 5 <NODE-NAME <2 .K>>>)
153 <RETURN <GEN <1 .K> .WHERE> .AG>)
154 (<N==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
158 <COND (<L? .ATYP 3> 2) (ELSE 0)>
159 <COND (<1? .ATYP> <NODE-NAME <2 .K>>)
160 (<==? .ATYP 2> <- <NODE-NAME <2 .K>>>)
163 <COND (<==? .ATYP 3> 2) (ELSE 4)>)
165 <COND (<G? .ATYP 2> <NODE-NAME <2 .K>>) (ELSE 1)>
168 #DECL ((TRANSFORM) <SPECIAL TRANS>)
171 <COND (<AND <TYPE? <DATVAL .REG> AC>
172 <ACLINK <DATVAL .REG>>>
173 <DATUM <DATTYP .REG> ANY-AC>)
179 <COND (<NOT <0? .NN>>
180 <RETURN <MOVE:ARG .REG .WHERE> .AG>)>>
183 (<==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
185 <GEN <SET TEM <1 <KIDS .TEM>>>
186 <DATUM <STRUCTYP <RESULT-TYPE .TEM>> ANY-AC>>>
188 <SEGINS .ATYP T .TEM .REG .REG1 1 <GET-DF <NODE-NAME .NOD>>>>)
192 <COND (<AND <TYPE? <DATVAL .REG> AC>
193 <ACLINK <DATVAL .REG>>>
194 <DATUM <DATTYP .REG> ANY-AC>)
196 <AND <==? <RESULT-TYPE .TEM> FLOAT> <SET MODE 2>>)>
197 <AND <TYPE? <DATTYP .REG> ATOM>
198 <PUT .REG ,DATTYP <NTH '![FIX FLOAT!] .MODE>>>
201 "AUX" NN TEM TRANSFORM
204 (<==? <NODE-TYPE <SET NN <1 .N>>> ,SEG-CODE>
206 <GEN <SET NN <1 <KIDS .NN>>>
207 <DATUM <STRUCTYP <RESULT-TYPE .NN>> ANY-AC>>)
212 <COND (<AND .NEGF <G? .ATYP 2>> 2)
220 <GEN .NN DONT-CARE>)>) (COM .COM))
221 #DECL ((N) <LIST NODE> (NXT REG) DATUM (MODE) FIX (NN) NODE
222 (TRANSFORM) <SPECIAL TRANS>)
225 <SET MODE <SEGINS .ATYP <> .NN .REG .NXT .MODE 0>>
228 <AND <ASSIGNED? TRANSFORM>
229 <NOT <0? <1 <3 .TRANSFORM>>>>
232 <SET NEGF <NOT .NEGF>>>>
234 <COND (<==? <ISTYPE? <RESULT-TYPE .NN>> FIX>
236 <DATTYP-FLUSH <SET NXT <GEN-FLOAT .NXT>>>
237 <PUT .NXT ,DATTYP FLOAT>)>)
238 (<==? <ISTYPE? <RESULT-TYPE .NN>> FLOAT>
240 <DATTYP-FLUSH <SET REG <GEN-FLOAT .REG>>>
241 <PUT .REG ,DATTYP FLOAT>
244 <NOT <TYPE? <DATVAL .REG> AC>>
245 <TYPE? <DATVAL .NXT> AC>>
249 <SET NXT <SAME-AC-FIX .REG .NXT>>
250 <COND (<AND <==? .ATYP 3>
252 <==? <NODE-TYPE .NN> ,QUOTE-CODE>
253 <SET SHFT <POPWR2 <NODE-NAME .NN>>>>
254 <SHIFT-INS .REG .SHFT .ATYP>)
257 <ARITH-INS <COND (<AND .NEGF <L? .ATYP 3>>
263 <AND <EMPTY? <REST .N>>
265 <==? <DATVAL .WHERE> <DATVAL .NXT>>>
269 <COND (<AND <ASSIGNED? TRANSFORM>
270 <==? <1 .TRANSFORM> <PARENT .NOD>>
271 <NOT <0? <1 <2 .TRANSFORM>>>>>
272 <PUT <3 .TRANSFORM> 1 1>)
273 (ELSE <EMIT <INSTRUCTION `MOVNS !<ADDR:VALUE .REG>>>)>)>
274 <DELAY-KILL .NO-KILL .ONO>
275 <MOVE:ARG .REG .WHERE>>
277 <DEFINE SAME-AC-FIX (D1 D2 "AUX" (ACQ <DATVAL .D1>))
278 #DECL ((D1 D2) DATUM)
280 (<AND <TYPE? .ACQ AC> <==? .ACQ <DATVAL .D2>>>
289 <FLUSH-RESIDUE .ACQ .SYM>
290 <SET D2 <LADDR .SYM <> <ISTYPE-GOOD? <DATTYP .D2>>>>
293 (ELSE <RET-TMP-AC .D2>)>)>
296 <DEFINE SHIFT-INS (REG SHFT ATYP)
297 #DECL ((REG) DATUM (SHFT ATYP) FIX)
299 <MUNG-AC <DATVAL .REG> .REG>
300 <EMIT <INSTRUCTION `ASH
301 <ACSYM <DATVAL .REG>>
302 <COND (<==? .ATYP 3> .SHFT) (ELSE <- .SHFT>)>>>>
304 <DEFINE SEGINS (ATYP FD N REG REG2 MD DEFLT
305 "AUX" SAC SL TYP (STYP <RESULT-TYPE .N>) (TG <MAKE:TAG>)
306 (LOOP <MAKE:TAG>) RAC)
307 #DECL ((N) NODE (ATYP SL MD) FIX (REG REG2) DATUM (RAC SAC) AC)
309 <COND (<==? <GET-ELE-TYPE .STYP ALL> FIX> 1) (ELSE 2)>>
310 <SET STYP <STRUCTYP .STYP>>
311 <SET SL <MINL <RESULT-TYPE .N>>>
313 <COND (<TYPE? <DATVAL .REG> AC>
314 <SGETREG <SET RAC <DATVAL .REG>> .REG>)
315 (ELSE <SET RAC <GETREG .REG>> <PUT .REG ,DATVAL .RAC>)>
318 <SET SAC <DATVAL <TOACV .REG2>>>
320 <PUT .RAC ,ACPROT <>>
322 <AND <==? .TYP 2> <==? .DEFLT 1> <SET DEFLT 1.0>>
323 <IMCHK '(`MOVE `MOVEI `MOVNI )
325 <REFERENCE:ADR .DEFLT>>
327 <EMPTY-JUMP .STYP .SAC .TG>)>
328 <COND (<OR <==? .ATYP 2> <==? .ATYP 4>>
329 <GETEL .RAC .SAC .STYP>
337 <DATTYP-FLUSH <SET REG <GEN-FLOAT .REG>>>
338 <PUT .REG ,DATTYP FLOAT>>
339 <SET RAC <DATVAL .REG>>
342 <SET SAC <DATVAL <TOACV .REG2>>>
344 <PUT .RAC ,ACPROT <>>)>
345 <COND (<L? .SL 1> <EMPTY-JUMP .STYP .SAC .TG>)>
347 <EMITSEG .RAC .SAC .STYP .ATYP .TYP .MD>
348 <ADVANCE-AND-CHECK .STYP .SAC .LOOP>
353 <DEFINE ADVANCE (STYP SAC "AUX" AMT)
354 #DECL ((STYP) ATOM (SAC) AC (AMT) FIX)
355 <SET AMT <COND (<==? .STYP UVECTOR> 1) (ELSE 2)>>
356 <COND (<==? .STYP LIST>
357 <EMIT <INSTRUCTION `HRRZ <ACSYM .SAC> (<ADDRSYM .SAC>)>>)
359 <EMIT <INSTRUCTION `ADD <ACSYM .SAC> [<FORM .AMT (.AMT)>]>>)>>
361 <DEFINE ADVANCE-AND-CHECK (STYP SAC TG)
362 #DECL ((SAC) AC (STYP) ATOM)
363 <COND (<==? .STYP UVECTOR>
364 <EMIT <INSTRUCTION `AOBJN <ACSYM .SAC> .TG>>)
366 <EMIT <INSTRUCTION `HRRZ <ACSYM .SAC> (<ADDRSYM .SAC>)>>
367 <EMIT <INSTRUCTION `JUMPN <ACSYM .SAC> .TG>>)
369 <EMIT <INSTRUCTION `ADD <ACSYM .SAC> '[<2 (2)>]>>
370 <EMIT <INSTRUCTION `JUMPL <ACSYM .SAC> .TG>>)>>
372 <DEFINE EMPTY-JUMP (STYP SAC TG)
373 #DECL ((SAC) AC (STYP TG) ATOM)
374 <COND (<==? .STYP LIST>
375 <EMIT <INSTRUCTION `JUMPE <ACSYM .SAC> .TG>>)
376 (ELSE <EMIT <INSTRUCTION `JUMPGE <ACSYM .SAC> .TG>>)>>
378 <DEFINE EMITSEG (RAC SAC STYP ATYP TYP MD "AUX" DAT)
379 #DECL ((SAC RAC) AC (TYP MD ATYP) FIX (DAT) DATUM)
380 <COND (<AND <==? .MD 2> <==? .TYP 1>>
381 <SET DAT <DATUM FIX ANY-AC>>
382 <PUT .DAT ,DATVAL <GETREG .DAT>>
383 <GETEL <DATVAL .DAT> .SAC .STYP>
384 <DATTYP-FLUSH <SET DAT <GEN-FLOAT .DAT>>>
385 <PUT .DAT ,DATTYP FLOAT>
386 <GENINS .ATYP .MD .RAC 0 <ADDRSYM <DATVAL .DAT>>>
392 <COND (<==? .STYP UVECTOR> 0) (ELSE 1)>
395 <DEFINE GENINS (ATYP MD RAC OFFS ADD "AUX" INS)
396 #DECL ((MD ATYP OFFS) FIX (RAC) AC)
398 <EMIT <INSTRUCTION <NTH '![`CAMG `CAML!] <- .ATYP 4>>
402 <EMIT <INSTRUCTION `MOVE <ACSYM .RAC> .OFFS .ADD>>)
404 <SET INS <NTH <NTH <2 ,INS1> .MD> .ATYP>>
405 <AND <TYPE? .INS LIST> <SET INS <1 .INS>>>
406 <EMIT <INSTRUCTION .INS <ACSYM .RAC> .OFFS .ADD>>)>>
408 <DEFINE GETEL (RAC SAC STYP)
409 <EMIT <INSTRUCTION `MOVE
411 <COND (<==? .STYP UVECTOR> 0) (ELSE 1)>
415 ![![![`ADDM `SUBM `IMULM `IDIVM !]
416 ![`FADRM `FSBRM `FMPRM `FDVRM !]!]
417 ![![(`ADD `ADDI `SUBI )
421 ![(`FADR () () `FADRI )
422 (`FSBR () () `FSBRI )
423 (`FMPR () () `FMPRI )
424 (`FDVR () () `FDVRI )!]!]!]>
426 " Do the actual arithmetic code generation here with all args set up."
428 <DEFINE ARITH-INS (ATYP REG REG2 MEM MODE "AUX" RTM INS T TT REG+1)
429 #DECL ((ATYP MODE) FIX (REG REG2) DATUM (T) AC)
433 <COND (<AND <TYPE? <DATVAL .REG> AC>
434 <OR <AC+1OK? <DATVAL .REG>>
435 <AND <N==? <DATVAL .REG> ,LAST-AC>
436 <==? <NTH ,ALLACS <+ <ACNUM <DATVAL .REG>> 1>>
439 <SET REG <MOVE:ARG .REG <DATUM <DATTYP .REG> .TT>>>)
440 (<TYPE? <DATVAL .REG> AC>
441 <COND (<AND <NOT .MEM>
442 <OR <==? <DATVAL .REG> ,LAST-AC>
443 <N==? <NTH ,ALLACS <+ 1 <ACNUM <DATVAL .REG>>>>
445 <EMIT <INSTRUCTION `PUSH `P* <ADDRSYM <DATVAL .REG>> 1>>
447 (ELSE <TOACV .REG> <AGAIN>)>
448 <AND <NOT <ASSIGNED? RTM>>
450 <MUNG-AC <SET REG+1 <NTH ,ALLACS <+ 1 <ACNUM <DATVAL .REG>>>>>>
451 <PUT .REG+1 ,ACPROT T>>)
452 (<NOT <TYPE? <DATVAL .REG> AC>> <TOACV .REG>)>
453 <PUT <DATVAL .REG> ,ACPROT T>
454 <SET INS <NTH <NTH <NTH ,INS1 <COND (.MEM 1) (ELSE 2)>> .MODE> .ATYP>>
455 <OR .MEM <MUNG-AC <DATVAL .REG> .REG>>
456 <COND (<TYPE? .INS LIST>
457 <IMCHK .INS <ACSYM <DATVAL .REG>> <DATVAL .REG2>>)
459 <EMIT <INSTRUCTION .INS
460 <ACSYM <DATVAL .REG>>
461 !<ADDR:VALUE .REG2>>>)>
462 <AND <ASSIGNED? REG+1> <PUT .REG+1 ,ACPROT <>>>
463 <PUT <DATVAL .REG> ,ACPROT <>>
465 <EMIT <INSTRUCTION `POP `P* <ADDRSYM <DATVAL .REG>> 1>>>
466 <COND (.MEM <RET-TMP-AC .REG> .REG2) (ELSE <RET-TMP-AC .REG2> .REG)>>>
468 <DEFINE MIN-MAX (NOD WHERE
469 "AUX" (MAX? <==? MAX <NODE-NAME .NOD>>) (K <KIDS .NOD>) REG
470 (MODE 1) REG1 SEGF (C <OR <AND .MAX? 5> 6>) TEM
471 (ONO .NO-KILL) (NO-KILL .ONO))
472 #DECL ((NOD) NODE (MODE C) FIX (MAX?) ANY (REG) DATUM (K) <LIST [REST NODE]>
473 (NO-KILL) <SPECIAL LIST>)
474 <SET NO-KILL <COMMUTE .K <NODE-NAME .NOD> .NO-KILL>>
475 <SET REG <REG? <RESULT-TYPE .NOD> .WHERE>>
476 <COND (<==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
478 <GEN <SET TEM <1 <KIDS .TEM>>>
479 <DATUM <STRUCTYP <RESULT-TYPE .TEM>> ANY-AC>>>
487 <OR <AND .MAX? <MAX>> <MIN>>>>)
489 <SET REG <GEN .TEM .REG>>
490 <AND <==? <RESULT-TYPE .TEM> FLOAT> <SET MODE 2>>)>
495 (<==? <NODE-TYPE .N> ,SEG-CODE>
497 <GEN <SET N <1 <KIDS .N>>>
498 <DATUM <STRUCTYP <RESULT-TYPE .N>> ANY-AC>>)
499 (ELSE <SET SEGF <>> <GEN .N DONT-CARE>)>))
500 #DECL ((NXT REG) DATUM (N) NODE (MODE) FIX)
502 <SET MODE <SEGINS .C <> .N .REG .NXT .MODE 0>>
506 <COND (<==? <ISTYPE? <RESULT-TYPE .N>> FIX>
507 <DATTYP-FLUSH <SET NXT <GEN-FLOAT .NXT>>>
508 <PUT .NXT ,DATTYP FLOAT>)>)
509 (<==? <ISTYPE? <RESULT-TYPE .N>> FLOAT>
510 <DATTYP-FLUSH <SET REG <GEN-FLOAT .REG>>>
511 <PUT .REG ,DATTYP FLOAT>
513 <COND (<AND <NOT <TYPE? <DATVAL .REG> AC>>
514 <TYPE? <DATVAL .NXT> AC>>
518 <COND (<TYPE? <DATVAL .REG> AC>
519 <MUNG-AC <DATVAL .REG> .REG>)>
520 <TOACV .REG> ;"Make sure in AC"
521 <PUT <DATVAL .REG> ,ACPROT T>
522 <IMCHK <COND (.MAX? '(`CAMG `CAIG )) (ELSE '(`CAML `CAIL ))>
523 <ACSYM <DATVAL .REG>>
525 <MOVE:VALUE <DATVAL .NXT> <DATVAL .REG>>
526 <PUT <DATVAL .REG> ,ACPROT <>>
529 <DELAY-KILL .NO-KILL .ONO>
530 <MOVE:ARG .REG .WHERE>>
532 <DEFINE ABS-GEN ACT (N W
533 "AUX" (K1 <1 <KIDS .N>>) NUM (TRIN <>)
534 (ABSFLG <==? <NODE-NAME .N> ABS>) TEM T2 (DONE <>))
535 #DECL ((N K1) NODE (NUM) DATUM (TEM) <DATUM ANY AC> (TRANSFORM) TRANS)
536 <PROG ((TRANSFORM <MAKE-TRANS .N 2 0 0 0 1 0 0>))
537 #DECL ((TRANSFORM) <SPECIAL TRANS>)
540 <COND (<AND <==? <NODE-TYPE .K1> ,LNTH-CODE>
544 <COND (<NOT <0? <1 <3 .TRANSFORM>>>>
545 <RETURN <MOVE:ARG .NUM .W> .ACT>)>>
546 <COND (<AND <ASSIGNED? TRANSFORM>
547 <==? <1 .TRANSFORM> <PARENT .N>>
549 <SET TRIN <2 .TRANSFORM>>)>
551 (<AND <TYPE? .W DATUM>
552 <REPEAT ((W <CHTYPE .W LIST>))
554 <COND (<EMPTY? .W> <RETURN <>>)
555 (<OR <=? <DATVAL .W> <DATVAL .NUM>>
556 <AND <TYPE? <DATVAL .NUM> AC>
557 <==? <DATVAL .W> ANY-AC>>>
559 (ELSE <SET W <REST .W 2>>)>>>
560 <COND (<NOT <AND .TRIN <NOT <0? <1 .TRIN>>>>>
561 <AND <TYPE? <DATVAL .NUM> AC> <MUNG-AC <DATVAL .NUM> .NUM>>
562 <EMIT <INSTRUCTION <COND (.ABSFLG `MOVMS ) (ELSE `MOVNS )>
563 !<ADDR:VALUE .NUM>>>)
564 (ELSE <PUT <3 .TRANSFORM> 1 1>)>
566 (<AND <==? .W DONT-CARE> <TYPE? <DATVAL .NUM> AC>>
567 <COND (<NOT <AND .TRIN <NOT <0? <1 .TRIN>>>>>
568 <AND <TYPE? <DATVAL .NUM> AC> <MUNG-AC <DATVAL .NUM> .NUM>>
569 <EMIT <INSTRUCTION <COND (.ABSFLG `MOVMS ) (ELSE `MOVNS )>
570 !<ADDR:VALUE .NUM>>>)
571 (ELSE <PUT <3 .TRANSFORM> 1 1>)>
573 (<AND .TRIN <NOT <0? <1 .TRIN>>>>
574 <PUT <3 .TRANSFORM> 1 1>
578 <OR <ISTYPE? <DATTYP .NUM>> <ISTYPE? <RESULT-TYPE .K1>>>>
579 <SET TEM <REG? .T2 .W T>>)
581 <SET TEM <REG? TUPLE .W T>>
582 <COND (<AND <NOT <==? <DATVAL .TEM> <DATTYP .NUM>>>
583 <==? <DATVAL .NUM> <DATTYP .TEM>>>
584 <MUNG-AC <DATVAL .TEM> .TEM>
585 <EMIT <INSTRUCTION <COND (.ABSFLG `MOVM ) (ELSE `MOVN )>
586 <ACSYM <DATVAL .TEM>>
588 <RET-TMP-AC <DATVAL .NUM> .NUM>
590 <COND (<==? <DATTYP .TEM> ANY-AC>
591 <PUT .TEM ,DATTYP <GETREG .TEM>>)
592 (<TYPE? <DATTYP .TEM> AC> <SGETREG <DATTYP .TEM> .TEM>)>
593 <MOVE:TYP <DATTYP .NUM> <DATTYP .TEM>>)>
595 <PUT <DATVAL .TEM> ,ACLINK (.TEM !<ACLINK <DATVAL .TEM>>)>
597 <MUNG-AC <DATVAL .TEM> .TEM>
598 <EMIT <INSTRUCTION <COND (.ABSFLG `MOVM ) (ELSE `MOVN )>
599 <ACSYM <DATVAL .TEM>>
600 !<ADDR:VALUE .NUM>>>)>
601 <MOVE:ARG .TEM .W>)>>
604 "AUX" (N1 <GEN <1 <KIDS .N>> DONT-CARE>) NN
605 (N2 <GEN <SET NN <2 <KIDS .N>>> DONT-CARE>) TEM T1 TT
606 (ACE ,LAST-AC) (ACD ,LAST-AC-1))
607 #DECL ((N) NODE (N1 N2) DATUM (ACE ACD TT T1) AC)
609 (<AND <==? <NODE-TYPE .NN> ,QUOTE-CODE>
610 <POPWR2 <NODE-NAME .NN>>>
611 <SET N1 <MOVE:ARG .N1 <REG? FIX .W>>>
612 <MUNG-AC <DATVAL .N1> .N1>
613 <IMCHK '(`AND `ANDI )
615 <REFERENCE:ADR <- <NODE-NAME .NN> 1>>>)
618 <COND (<AC+1OK? <SET TEM <DATVAL .N1>>> <SET T1 .TEM>)
620 <SET N1 <MOVE:ARG .N1 <DATUM FIX <SET T1 .TEM>>>>)
621 (<TYPE? <SET TEM <DATVAL .N1>> AC>
622 <COND (<==? <SET T1 .TEM> .ACE>
623 <SET N1 <MOVE:ARG .N1 <DATUM FIX <SGETREG .ACD <>>>>>
625 (ELSE <SGETREG <NTH ,ALLACS <+ <ACNUM .T1> 1>> <>>)>)
627 <SET TEM <ACPROT .ACE>>
630 <PUT .ACE ,ACPROT .TEM>
632 <PUT <SET TT <NTH ,ALLACS <+ <ACNUM .T1> 1>>> ,ACPROT T>
635 <AND <ACLINK .T1> <RET-TMP-AC .T1 .N1>>
636 <RET-TMP-AC <DATTYP .N1> .N1>
637 <PUT .N1 ,DATTYP FIX>
638 <PUT .N1 ,DATVAL <SET TT <NTH ,ALLACS <+ <ACNUM .T1> 1>>>>
639 <MUNG-AC <PUT .TT ,ACLINK (.N1 !<ACLINK .TT>)> .N1>
641 <IMCHK '(`IDIV `IDIVI ) <ACSYM .T1> <DATVAL .N2>>
642 <EMIT <INSTRUCTION `SKIPGE <ADDRSYM .TT>>>
643 <IMCHK '(`ADD `ADDI ) <ACSYM .TT> <DATVAL .N2>>
645 <PUT .T1 ,ACPROT <>>>)>
648 <DEFINE ROT-GEN (N W) <ROT-LSH-GEN .N .W `ROT>>
650 <DEFINE LSH-GEN (N W) <ROT-LSH-GEN .N .W `LSH>>
652 <DEFINE ROT-LSH-GEN (N W INS
653 "AUX" (K <KIDS .N>) (A1 <1 .K>) (A2 <2 .K>) W1 W2 AC1)
654 #DECL ((N A1 A2) NODE (K) <LIST [2 NODE]> (W1 W2) DATUM (AC1) AC)
655 <COND (<==? <NODE-TYPE .A2> ,QUOTE-CODE> ;" LSH-ROT by fixed amount"
656 <SET W1 <GEN .A1 DONT-CARE>>
658 <RET-TMP-AC <DATTYP .W1> .W1>
659 <PUT .W1 ,DATTYP WORD>
660 <MUNG-AC <DATVAL .W1> .W1>
661 <EMIT <INSTRUCTION .INS <ACSYM <DATVAL .W1>> <NODE-NAME .A2>>>)
663 <COND (<AND <MEMQ <NODE-TYPE .A1> ,SNODES>
664 <NOT <MEMQ <NODE-TYPE .A2> ,SNODES>>
665 <NOT <SIDE-EFFECTS .A2>>>
666 <SET W2 <GEN .A2 DONT-CARE>>
667 <SET W1 <GEN .A1 DONT-CARE>>)
669 <SET W1 <GEN .A1 DONT-CARE>>
670 <SET W2 <GEN .A2 DONT-CARE>>)>
672 <RET-TMP-AC <DATTYP .W1> .W1>
673 <PUT .W1 ,DATTYP WORD>
674 <SET AC1 <DATVAL .W1>>
677 <PUT .AC1 ,ACPROT <>>
679 <EMIT <INSTRUCTION .INS
681 (<ADDRSYM <CHTYPE <DATVAL .W2> AC>>)>>
685 <DEFINE FLOAT-GEN (N W
686 "AUX" (NUM <1 <KIDS .N>>) TEM1 (RT <RESULT-TYPE .NUM>) BR
688 #DECL ((N NUM) NODE (TEM TEM1) DATUM (BR) ATOM)
689 <COND (<==? .RT FLOAT>
690 <MESSAGE WARNING "UNECESSARY FLOAT ">
692 (<==? <ISTYPE? .RT> FIX>
693 <SET TEM <GEN-FLOAT <GEN .NUM <GOODACS .N .W>>>>
694 <RET-TMP-AC <DATTYP .TEM> .TEM>
695 <PUT .TEM ,DATTYP FLOAT>
698 <SET TEM <GEN .NUM DONT-CARE>>
699 <EMIT <INSTRUCTION GETYP!-OP `O* !<ADDR:TYPE .TEM>>>
700 <RET-TMP-AC <DATTYP <SET TEM <MOVE:ARG .TEM <REG? FLOAT .W>>>>
702 <PUT .TEM ,DATTYP FLOAT>
703 <SET TEM1 <DATUM !.TEM>>
704 <MOVE:ARG <GEN-FLOAT .TEM <SET BR <MAKE:TAG>>> .TEM1>
706 <MOVE:ARG .TEM1 .W>)>>
709 "AUX" (NUM <1 <KIDS .N>>) (RT <RESULT-TYPE .NUM>) TEM TEM1 BR)
710 #DECL ((N NUM) NODE (TEM TEM1) DATUM (BR) ATOM)
711 <COND (<==? <ISTYPE? .RT> FIX>
712 <MESSAGE WARNING "UNECESSARY FIX ">
715 <SET TEM <GEN-FIX <GEN .NUM DONT-CARE>>>
716 <RET-TMP-AC <DATTYP .TEM> .TEM>
717 <PUT .TEM ,DATTYP FIX>
720 <SET TEM <GEN .NUM DONT-CARE>>
721 <EMIT <INSTRUCTION GETYP!-OP `O* !<ADDR:TYPE .TEM>>>
722 <RET-TMP-AC <DATTYP <SET TEM <MOVE:ARG .TEM <REG? FIX .W>>>>
724 <PUT .TEM ,DATTYP FIX>
725 <SET TEM1 <DATUM !.TEM>>
726 <MOVE:ARG <GEN-FIX .TEM <SET BR <MAKE:TAG>>> .TEM1>
728 <MOVE:ARG .TEM1 .W>)>>
730 <DEFINE GEN-FLOAT (DAT "OPTIONAL" (BR <>) "AUX" TT T RTM)
731 #DECL ((DAT) DATUM (T) AC)
733 <COND (<AC+1OK? <DATVAL .DAT>>)
735 <SET DAT <MOVE:ARG .DAT <DATUM <DATTYP .DAT> .TT>>>)
736 (<TYPE? <DATVAL .DAT> AC>
737 <EMIT <INSTRUCTION `PUSH `P* <ADDRSYM <DATVAL .DAT>> 1>>
739 (ELSE <TOACV .DAT> <AGAIN>)>
740 <SET T <DATVAL .DAT>>
742 <PUT <NTH ,ALLACS <+ <ACNUM .T> 1>> ,ACPROT T>>
744 <AND <NOT <ASSIGNED? RTM>>
745 <PUT <NTH ,ALLACS <+ <ACNUM .T> 1>> ,ACPROT <>>
746 <MUNG-AC <NTH ,ALLACS <+ <ACNUM .T> 1>>>>
748 <EMIT <INSTRUCTION `CAIE `O* '<TYPE-CODE!-OP!-PACKAGE FIX>>>
750 <EMIT <INSTRUCTION `IDIVI <ACSYM .T> 131072>>
751 <EMIT <INSTRUCTION `FSC <ACSYM .T> 172>>
752 <EMIT <INSTRUCTION `FSC <AC1SYM .T> 155>>
753 <EMIT <INSTRUCTION `FADR <ACSYM .T> <ACNUM .T> 1>>
755 <EMIT <INSTRUCTION `POP `P* <ADDRSYM .T> 1>>>
758 <DEFINE GEN-FIX (DAT "OPTIONAL" (BR <>) "AUX" TEM TT (ACE ,LAST-AC)
759 (ACD ,LAST-AC-1) T1 NXTAC)
760 #DECL ((DAT) DATUM (ACE ACD TT TEM) AC)
762 <COND (<AC+1OK? <SET T1 <DATVAL .DAT>>> <SET TEM .T1>)
764 <SET DAT <MOVE:ARG .DAT <DATUM FIX <SET TEM .T1>>>>)
765 (<TYPE? <SET T1 <DATVAL .DAT>> AC>
766 <COND (<==? <SET TEM .T1> .ACE>
768 <DATUM FIX <SET TEM <SGETREG .ACD <>>>>>)
770 <SGETREG <NTH ,ALLACS <+ <ACNUM .TEM> 1>> <>>)>)
772 <SET T1 <ACPROT .ACE>>
775 <PUT .ACE ,ACPROT .T1>
777 <PUT <SET NXTAC <NTH ,ALLACS <+ <ACNUM .TEM> 1>>>
781 <PUT .NXTAC ,ACPROT <>>
782 <AND <ACLINK .TEM> <RET-TMP-AC .TEM .DAT>>
783 <RET-TMP-AC <DATTYP .DAT> .DAT>
784 <PUT .DAT ,DATTYP FIX>
785 <PUT .DAT ,DATVAL <SET TT .NXTAC>>
786 <MUNG-AC <PUT .TT ,ACLINK (.DAT !<ACLINK .TT>)> .DAT>
788 <EMIT '<`CAIE 0 <TYPE-CODE!-OP!-PACKAGE FLOAT>>>
790 <EMIT <INSTRUCTION `MULI <ACSYM .TEM> 256>>
791 <EMIT <INSTRUCTION `TSC <ACSYM .TEM> <ADDRSYM .TEM>>>
792 <EMIT <INSTRUCTION `ASH <ACSYM .TT> (<ADDRSYM .TEM>) -163>>
796 #DECL ((SUBR VALUE) ATOM)
798 '![G? L? G? G=? L=? G=? ==? ==? N==? N==? 1? -1? 1? 0?
801 <DEFINE FLIP (SUBR "AUX" N)
802 #DECL ((N) FIX (SUBR VALUE) ATOM)
805 <SET N <LENGTH <MEMQ .SUBR ,0SUBRS>>>
806 <COND (<0? <MOD .N 2>> -1) (ELSE 1)>>>>
808 <SETG 0SUBRS ![1? N1? -1? N-1? 0? N0? G? L=? L? G=? ==? N==?!]>
810 <DEFINE PRED? (N) #DECL ((N) FIX) <1? <NTH ,PREDV .N>>>
812 <DEFINE PRED:BRANCH:GEN (TAG NOD TF
813 "OPTIONAL" (WHERE FLUSHED) (NF <>)
816 <COND (<==? .WHERE FLUSHED> DONT-CARE)
817 (<AND <TYPE? .WHERE DATUM>
818 <ISTYPE? <DATTYP .WHERE>>>
819 <DATUM ANY-AC <DATVAL .WHERE>>)
820 (ELSE .WHERE)>) TAG2)
821 #DECL ((NOD) NODE (TT) DATUM)
822 <COND (<==? <RESULT-TYPE .NOD> NO-RETURN>
825 (<PRED? <NODE-TYPE .NOD>>
826 <APPLY <NTH ,GENERATORS <NODE-TYPE .NOD>>
833 <SET TT <GEN .NOD DONT-CARE>>
835 <COND (<==? .WHERE FLUSHED>
836 <D:B:TAG .TAG .TT <NOT .TF> <RESULT-TYPE .NOD>>
838 (<D:B:TAG <SET TAG2 <MAKE:TAG>> .TT .TF <RESULT-TYPE .NOD>>
840 <SET TT <MOVE:ARG <REFERENCE .TF> .WHERE>>
845 <SET TT <GEN .NOD .W2>>
847 <D:B:TAG .TAG .TT .TF <RESULT-TYPE .NOD>>
848 <MOVE:ARG .TT .WHERE>)>>
852 <AND <==? <NODE-TYPE .N> ,LNTH-CODE>
853 <==? <STRUCTYP <RESULT-TYPE <1 <KIDS .N>>>> LIST>>>
855 <DEFINE 0-TEST (NOD WHERE
856 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
857 "AUX" (REG ,NO-DATUM) (NN <1 <KIDS .NOD>>)
859 <MAKE-TRANS .NOD 1 1 0 1 1 1 <SW? <NODE-NAME .NOD>>>))
860 #DECL ((TRANSFORM) <SPECIAL TRANS> (NOD NN) NODE (REG) DATUM)
861 <OR <LN-LST .NN> <SET REG <GEN .NN DONT-CARE>>>
868 <DO-TRANS 0 .TRANSFORM>
869 <NOT <0? <1 <3 .TRANSFORM>>>>>>
873 <COND (<MEMQ .SBR '![0? N0? 1? -1? N1? N-1? ==? N==?!]> 0)
876 <DEFINE MAKE-TRANS (N NEG +- +-V */ */V HW SW)
877 #DECL ((N) NODE (NEG +- +-V */ */V HW SW) FIX)
878 <CHTYPE [.N ![.NEG .+- .+-V .*/ .*/V .HW .SW!] <IUVECTOR 7 0>]
881 <DEFINE DO-TRANS (N TR "AUX" (X <3 .TR>) (NN <NODE-NAME <1 .TR>>))
882 #DECL ((TR) TRANS (N) FIX (X) <UVECTOR [7 FIX]>)
883 <COND (<AND <NOT <0? .N>> <NOT <0? <6 .X>>> <NOT <0? <7 .X>>>>
884 <COND (<==? .NN G?> <SET N <- .N 1>>)
885 (<==? .NN L=?> <SET N <- .N 1>>)>)>
886 <COND (<NOT <0? <1 .X>>> <SET N <- .N>>)>
887 <COND (<NOT <0? <2 .X>>> <SET N <+ .N <3 .X>>>)>
888 <COND (<G? <4 .X> 2> <SET N </ .N <5 .X>>>)
889 (<NOT <0? <4 .X>>> <SET N <* .N <5 .X>>>)>
890 <COND (<NOT <0? <6 .X>>>
891 <SET N <CHTYPE <ANDB .N 262143> FIX>>
892 <COND (<NOT <0? <7 .X>>>
893 <SET N <CHTYPE <PUTBITS 0 <BITS 18 18> .N> FIX>>)>)>
896 <DEFINE UPDATE-TRANS (NOD TR "AUX" (X <3 .TR>) FLG)
899 <COND (<NOT <0? <1 .X>>> 2) (ELSE 0)>
900 <COND (<SET FLG <NOT <0? <2 .X>>>> 2) (ELSE 0)>
901 <COND (.FLG <3 .X>) (ELSE 0)>
902 <COND (<SET FLG <G? <4 .X> 2>> 4)
903 (<SET FLG <NOT <0? <4 .X>>>> 2)
905 <COND (.FLG <5 .X>) (ELSE 1)>
906 <COND (<NOT <0? <6 .X>>> 2) (ELSE 0)>
907 <COND (<NOT <0? <7 .X>>> 2) (ELSE 0)>>>
909 <DEFINE TEST-DISP (N W NF BR DI REG NUM NEG)
910 #DECL ((NUM) <OR FIX FLOAT> (N) NODE)
911 <COND (<==? .REG ,NO-DATUM>
912 <LIST-LNT-SPEC .N .W .NF .BR .DI .NUM>)
913 (<0? .NUM> <0-TEST1 .N .W .NF .BR .DI .REG .NEG>)
914 (<AND <OR <1? .NUM> <==? .NUM -1>>
915 <OR <==? <NODE-NAME .N> 1?>
916 <==? <ISTYPE? <RESULT-TYPE <1 <KIDS .N>>>> FIX>>>
917 <COND (<==? .NUM -1> <SET NEG T>)>
918 <1?-TEST .N .W .NF .BR .DI .REG .NEG>)
919 (ELSE <TEST-GEN2 .N .W .NF .BR .DI .REG .NUM .NEG>)>>
921 <DEFINE 0-TEST1 (NOD WHERE NOTF BRANCH DIR REG NEG
922 "AUX" (SBR <NODE-NAME .NOD>) B2 (RW .WHERE)
923 (ARG <1 <KIDS .NOD>>) (SDIR .DIR)
924 (ATYP <ISTYPE? <RESULT-TYPE .ARG>>) (LDAT <>) S TT)
925 #DECL ((NOD ARG) NODE (REG) DATUM (LDAT) <OR FALSE DATUM> (S) SYMTAB)
926 <SET WHERE <UPDATE-WHERE .NOD .WHERE>>
928 <COND (<==? <NODE-TYPE .NOD> ,0-TST-CODE> <SET SBR <FLOP .SBR>>)
930 <COND (<SET TT <MEMQ .SBR '![G? G=? G? L? L=? L?!]>>
931 <SET SBR <2 .TT>>)>)>)>
932 <COND (<AND <NOT <TYPE? <DATVAL .REG> AC>>
934 <==? <NODE-TYPE .ARG> ,LVAL-CODE>
935 <STORED <SET S <NODE-NAME .ARG>>>
937 <OR <SPEC-SYM .S> <2 <TYPE-INFO .ARG>>>
939 <SET LDAT <DATUM .ATYP <GETREG <>>>>
940 <PUT .S ,INACS .LDAT>
941 <PUT <DATVAL .LDAT> ,ACRESIDUE (.S)>)>
943 <AND .NOTF <SET DIR <NOT .DIR>>>
944 <AND .DIR <SET SBR <FLIP .SBR>>>
946 <COND (<==? .RW FLUSHED>
947 <ZER-JMP .SBR .REG .BRANCH .LDAT>
951 <SET SBR <FLIP .SBR>>
952 <ZER-JMP .SBR .REG .B2 .LDAT>
955 <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
960 <AND .NOTF <SET SBR <FLIP .SBR>>>
962 <AND <TYPE? .WHERE ATOM> <SET WHERE <ANY2ACS>>>
963 <ZER-JMP .SBR .REG <SET BRANCH <MAKE:TAG>> .LDAT>
965 <MOVE:ARG <REFERENCE T> .WHERE>
967 <BRANCH:TAG <SET B2 <MAKE:TAG>>>
969 <MOVE:ARG <REFERENCE <>> .WHERE>
971 <MOVE:ARG .WHERE .RW>)>>
973 <DEFINE ZER-JMP (SBR REG BR LDAT "AUX" TEM)
974 #DECL ((REG) DATUM (LDAT) <OR FALSE DATUM>)
975 <COND (<TYPE? <SET TEM <DATVAL .REG>> AC>
976 <EMIT <INSTRUCTION <NTH ,0JMPS <LENGTH <MEMQ .SBR ,0SUBRS>>>
980 <EMIT <INSTRUCTION <NTH ,0SKPS <LENGTH <MEMQ .SBR ,0SUBRS>>>
981 <COND (.LDAT <ACSYM <DATVAL .LDAT>>) (ELSE 0)>
986 ![`SKIPN `SKIPE `SKIPGE `SKIPL `SKIPLE `SKIPG `SKIPN `SKIPE !]>
989 ![`JUMPE `JUMPN `JUMPL `JUMPGE `JUMPG `JUMPLE `JUMPE `JUMPN !]>
991 <DEFINE 1?-GEN (NOD WHERE
992 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
993 "AUX" (REG ,NO-DATUM) (NN <1 <KIDS .NOD>>)
995 <MAKE-TRANS .NOD 1 2 -1 1 1 1 <SW? <NODE-NAME .NOD>>>))
996 #DECL ((NOD NN) NODE (REG) DATUM (TRANSFORM) <SPECIAL TRANS>)
997 <OR <LN-LST .NN> <SET REG <GEN .NN DONT-CARE>>>
1004 <DO-TRANS 1 .TRANSFORM>
1005 <NOT <0? <1 <3 .TRANSFORM>>>>>>
1007 <DEFINE 1?-TEST (NOD WHERE NOTF BRANCH DIR REG NEG
1008 "AUX" (SBR <NODE-NAME .NOD>) B2 (RW .WHERE) (K <1 <KIDS .NOD>>)
1009 (SDIR .DIR) (NM <>) (ATYP <ISTYPE? <RESULT-TYPE .K>>)
1010 (RFLG <MEMQ .ATYP ![FIX FLOAT!]>) (SDIR .DIR))
1011 #DECL ((NOD K) NODE (REG) DATUM)
1013 <MOVE:ARG .REG <DATUM <COND (.ATYP) (ELSE ANY-AC)> ANY-AC>>>
1014 <SET NM <ACRESIDUE <DATVAL .REG>>>
1015 <SET WHERE <UPDATE-WHERE .NOD .WHERE>>
1017 <AND .NOTF <SET DIR <NOT .DIR>>>
1018 <COND (<AND .CAREFUL <NOT .RFLG>> <CFFLARG .REG>)>
1020 <COND (<==? .RW FLUSHED>
1030 <GENFLOAT .REG .DIR .BRANCH .NEG>
1031 <GEN-COMP FIX .REG .DIR .BRANCH .SBR .NEG .NM>)>
1044 <GENFLOAT .REG <NOT .DIR> .B2 .NEG>
1045 <GEN-COMP FIX .REG <NOT .DIR> .B2 .SBR .NEG .NM>)>
1048 <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
1049 <BRANCH:TAG .BRANCH>
1053 <COND (<AND .CAREFUL <NOT .RFLG>> <CFFLARG .REG>)>
1055 <AND <TYPE? .WHERE ATOM> <SET WHERE <ANY2ACS>>>
1060 <SET BRANCH <MAKE:TAG>>
1065 <GENFLOAT .REG .NOTF <SET BRANCH <MAKE:TAG>> .NEG>
1066 <GEN-COMP FIX .REG .NOTF .BRANCH .SBR .NEG .NM>)>
1068 <MOVE:ARG <REFERENCE T> .WHERE>
1070 <BRANCH:TAG <SET B2 <MAKE:TAG>>>
1072 <MOVE:ARG <REFERENCE <>> .WHERE>
1074 <MOVE:ARG .WHERE .RW>)>>
1077 ![`AOJL `AOJLE `AOJG `AOJGE `AOJE `AOJN `AOJE `AOJN `AOJE
1078 `AOJN `AOJE `AOJN !]>
1081 ![`SOJL `SOJLE `SOJG `SOJGE `SOJE `SOJN `SOJE `SOJN `SOJE
1082 `SOJN `SOJE `SOJN !]>
1084 <DEFINE GEN-COMP (TYP REG DIR BR SBR NEG NM)
1085 #DECL ((REG) <DATUM ANY AC> (TYP BR) ATOM)
1087 (<==? <ISTYPE? .TYP> FIX>
1088 <AND .DIR <SET SBR <FLIP .SBR>>>
1091 <NTH <NTH ,SKIPS <LENGTH <MEMQ .SBR ,CMSUBRS>>>
1092 <COND (.NEG 1) (ELSE 2)>>
1093 <ACSYM <DATVAL .REG>>
1094 <COND (.NEG '[-1]) (ELSE 1)>>>
1097 <MUNG-AC <DATVAL .REG> .REG>
1098 <EMIT <INSTRUCTION <NTH <COND (.NEG ,AOJS) (ELSE ,SOJS)>
1099 <LENGTH <MEMQ .SBR ,CMSUBRS>>>
1100 <ACSYM <DATVAL .REG>>
1103 <EMIT <INSTRUCTION <COND (.DIR `CAMN ) (ELSE `CAME )>
1104 <ACSYM <DATVAL .REG>>
1105 <COND (.NEG '[-1.0]) (ELSE '[1.0])>>>
1108 <DEFINE GENFLOAT (REG DIR BR NEG)
1109 <EMIT <INSTRUCTION <COND (<NOT .DIR> `CAME ) (ELSE `CAMN )>
1110 <ACSYM <DATVAL .REG>>
1111 <COND (.NEG '[-1.0]) (ELSE '[1.0])>>>
1112 <COND (.DIR <BRANCH:TAG .BR>)>>
1114 <DEFINE CFFLARG (DAT "AUX" (LABGOOD <MAKE:TAG>))
1115 #DECL ((DAT) DATUM (LABGOOD) ATOM)
1116 <EMIT <INSTRUCTION GETYP!-OP `O* !<ADDR:TYPE .DAT>>>
1117 <EMIT <INSTRUCTION `CAIE `O* '<TYPE-CODE!-OP!-PACKAGE FLOAT>>>
1118 <EMIT <INSTRUCTION `CAIN `O* '<TYPE-CODE!-OP!-PACKAGE FIX>>>
1120 <BRANCH:TAG .LABGOOD>
1121 <BRANCH:TAG |COMPERR>
1122 <LABEL:TAG .LABGOOD>>
1124 <DEFINE TEST-GEN (NOD WHERE
1125 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
1126 "AUX" (K <1 <KIDS .NOD>>) (K2 <2 <KIDS .NOD>>) REGT REGT2
1127 (S <SW? <NODE-NAME .NOD>>) TRANSFORM ATYP ATYP2 B2
1128 (SDIR .DIR) (RW .WHERE) TRANS1 (FLS <==? .RW FLUSHED>)
1129 TEM (ONO .NO-KILL) (NO-KILL .ONO)
1131 #DECL ((NOD K K2) NODE (REGT) DATUM (TRANSFORM) <SPECIAL TRANS>
1132 (TRANS1) TRANS (NO-KILL) <SPECIAL LIST>)
1134 <COND (<==? .WHERE FLUSHED> FLUSHED)
1135 (ELSE <UPDATE-WHERE .NOD .WHERE>)>>
1136 <COND (<OR <==? <NODE-TYPE .K2> ,QUOTE-CODE>
1137 <AND <NOT <MEMQ <NODE-TYPE .K> ,SNODES>>
1138 <NOT <SIDE-EFFECTS .NOD>>
1139 <MEMQ <NODE-TYPE .K2> ,SNODES>>>
1140 <COND (<AND <==? <NODE-TYPE .K> ,LVAL-CODE>
1141 <COND (<==? <LENGTH <SET TEM <TYPE-INFO .K>>> 2> <2 .TEM>)
1143 <SET TEM <NODE-NAME .K>>
1146 <AND <==? <1 .LL> .TEM> <MAPLEAVE>>>
1148 <SET NO-KILL ((<NODE-NAME .K> <>) !.NO-KILL)>)>
1150 <SET K2 <1 <KIDS .NOD>>>
1151 <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>)>
1152 <SET ATYP <ISTYPE? <RESULT-TYPE .K2>>>
1153 <SET ATYP2 <ISTYPE-GOOD? <RESULT-TYPE .K>>>
1155 <DATUM <COND (.ATYP .ATYP) (ELSE ANY-AC)> ANY-AC>>
1157 <COND (<OR <==? <NODE-TYPE .K> ,QUOTE-CODE>
1158 <NOT <SIDE-EFFECTS .K2>>>
1160 (.ATYP2 <DATUM .ATYP2 ANY-AC>)
1161 (ELSE <DATUM ANY-AC ANY-AC>)>>
1162 <COND (<N==? <NODE-TYPE .K> ,QUOTE-CODE>
1163 <COND (<OR <==? .ATYP FLOAT> <==? .ATYP2 FLOAT>>)
1165 <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>
1166 <PUT <2 .TRANSFORM> 6 1>
1167 <PUT <2 .TRANSFORM> 7 0>)>
1168 <SET REGT2 <GEN .K .REGT2>>
1169 <COND (<ASSIGNED? TRANSFORM>
1170 <SET TRANS1 .TRANSFORM>
1171 <SET TRANSFORM <UPDATE-TRANS .NOD .TRANS1>>)>
1172 <COND (<TYPE? <DATVAL .REGT2> AC>
1173 <SET REGT <GEN .K2 DONT-CARE>>
1174 <COND (<TYPE? <DATVAL .REGT2> AC>
1175 <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>
1179 <COND (<ASSIGNED? TRANSFORM>
1181 <SET TRANS1 .TRANSFORM>
1182 <SET TRANSFORM .TEM>)>
1186 (ELSE <TOACV .REGT>)>)
1187 (ELSE <SET REGT <GEN .K2 .REGT>>)>)
1189 <COND (<OR <==? .ATYP FIX>
1191 <1? <NODE-NAME .K>>>
1192 <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>)>
1193 <COND (<==? .ATYP FIX>
1194 <PUT <PUT <2 .TRANSFORM> 2 1> 3 <FIX <NODE-NAME .K>>>)>
1195 <COND (<LN-LST .K2> <SET REGT ,NO-DATUM>)
1197 <SET REGT <GEN .K2 .REGT>>
1198 <DATTYP-FLUSH .REGT>
1199 <PUT .REGT ,DATTYP .ATYP>)>
1207 <COND (<ASSIGNED? TRANSFORM>
1208 <DO-TRANS <FIX <NODE-NAME .K>> .TRANSFORM>)
1209 (ELSE <NODE-NAME .K>)>
1210 <AND <ASSIGNED? TRANSFORM> <NOT <0? <1 <3 .TRANSFORM>>>>>>
1212 <DELAY-KILL .NO-KILL .ONO>
1213 <AND <ASSIGNED? TRANSFORM>
1214 <CONFORM .REGT .REGT2 .TRANSFORM .TRANS1>
1215 <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>>
1217 <AND .NOTF <SET DIR <NOT .DIR>>>
1219 <GEN-COMP2 <NODE-NAME .NOD>
1224 <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
1225 <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE:TAG>>)>>
1227 <SET RW <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
1228 <BRANCH:TAG .BRANCH>
1233 <GEN-COMP2 <NODE-NAME .NOD>
1239 <SET BRANCH <MAKE:TAG>>>
1240 <MOVE:ARG <REFERENCE T> .WHERE>
1242 <BRANCH:TAG <SET B2 <MAKE:TAG>>>
1244 <MOVE:ARG <REFERENCE <>> .WHERE>
1246 <MOVE:ARG .WHERE .RW>)>>
1248 <DEFINE TEST-GEN2 (NOD WHERE NOTF BRANCH DIR REG NUM NEG
1249 "AUX" (SDIR .DIR) (RW .WHERE) (FLS <==? .RW FLUSHED>) B2
1250 (SBR <NODE-NAME .NOD>))
1251 #DECL ((NOD) NODE (REG) DATUM (NUM) <OR FIX FLOAT>)
1253 <COND (<==? .WHERE FLUSHED> FLUSHED)
1254 (ELSE <UPDATE-WHERE .NOD .WHERE>)>>
1257 <COND (.NEG <SET SBR <FLOP .SBR>>)>
1258 <AND .NOTF <SET DIR <NOT .DIR>>>
1262 <ISTYPE? <DATTYP .REG>>
1265 <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
1266 <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE:TAG>>)>>
1269 <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
1270 <BRANCH:TAG .BRANCH>
1275 <AND .NOTF <SET DIR <NOT .DIR>>>
1276 <COND (.NEG <SET SBR <FLOP .SBR>>)>
1279 <ISTYPE? <DATTYP .REG>>
1283 <SET BRANCH <MAKE:TAG>>>
1284 <MOVE:ARG <REFERENCE T> .WHERE>
1286 <BRANCH:TAG <SET B2 <MAKE:TAG>>>
1288 <MOVE:ARG <REFERENCE <>> .WHERE>
1290 <MOVE:ARG .WHERE .RW>)>>
1292 <DEFINE GEN-COMP2 (SB T1 T2 R1 R2 D BR)
1293 #DECL ((R1) DATUM (R2) <DATUM ANY AC> (SB T1 T2 BR) ATOM)
1294 <AND .D <SET SB <FLIP .SB>>>
1295 <COND (<==? .T1 .T2>)
1296 (<==? <ISTYPE? .T1> FIX>
1297 <DATTYP-FLUSH <SET R1 <GEN-FLOAT .R1>>>
1298 <PUT .R1 ,DATTYP FLOAT>)
1300 <DATTYP-FLUSH <GEN-FLOAT .R2>>
1301 <PUT .R2 ,DATTYP FLOAT>)>
1302 <OR <TYPE? <DATVAL .R2> AC> <TOACV .R2>>
1303 <PUT <DATVAL .R2> ,ACPROT T>
1304 <IMCHK <NTH ,SKIPS <LENGTH <MEMQ .SB ,CMSUBRS>>>
1305 <ACSYM <DATVAL .R2>>
1313 <NTH '[0 0 1 1 1.7014117E+38 -1.7014117E+38]
1314 <LENGTH <MEMQ .S '![MAX MIN * / - +!]>>>>
1316 <SETG CMSUBRS '![0? N0? 1? N1? -1? N-1? ==? N==? G? G=? L? L=?!]>