3 <ENTRY NOT-GEN TYPE?-GEN ==-GEN>
5 <USE "CODGEN" "COMCOD" "CHKDCL" "CACS" "COMPDEC">
8 " Generate NOT code. This is done in a variety of ways.
9 1) If NOTs arg is a predicate itself and this is a predicate usage
10 (flagged by BRANCH arg), just pass through setting the NOTF arg.
11 2) If NOTs arg is a predicate but a value is needed,
12 set up a predicate like situation and return NOT of the normal
14 3) Else just compile and complement result."
16 <DEFINE NOT-GEN (NOD WHERE
17 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR T)
18 "AUX" (P <1 <KIDS .NOD>>) (RW .WHERE)
19 (PF <PRED? <NODE-TYPE .P>>) T1 T2 TT (FLG <>))
20 #DECL ((NOD P) NODE (TT) DATUM)
21 <SET WHERE <GOODACS .NOD .WHERE>>
22 <SET NOTF <NOT .NOTF>>
23 <COND (<AND .BRANCH .PF>
25 <APPLY <NTH ,GENERATORS <NODE-TYPE .P>>
27 <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .WHERE)>
31 (<AND .BRANCH <==? .RW FLUSHED>>
32 <AND .NOTF <SET DIR <NOT .DIR>>>
33 <SET WHERE <GEN .P .WHERE>>
35 <D:B:TAG .BRANCH .WHERE .DIR <RESULT-TYPE .P>>)
37 <SET TT <GEN .P DONT-CARE>>
40 <D:B:TAG .T1 .TT .DIR <RESULT-TYPE .P>>
42 <SET WHERE <MOVE:ARG <REFERENCE .DIR> .WHERE>>
45 (<==? .RW FLUSHED> <SET WHERE <GEN .P FLUSHED>>)
46 (<OR <SET FLG <==? <ISTYPE? <RESULT-TYPE .NOD>> FALSE>>
47 <NOT <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>>
49 <SET WHERE <MOVE:ARG <REFERENCE <NOT .FLG>> .WHERE>>)
53 <APPLY <NTH ,GENERATORS <NODE-TYPE .P>>
59 <MOVE:ARG <REFERENCE <>> .WHERE>
63 <MOVE:ARG <REFERENCE T> .WHERE>
68 <SET TT <GEN .P DONT-CARE>>
70 <D:B:TAG .T1 .TT T <RESULT-TYPE .P>>
72 <MOVE:ARG <REFERENCE T> .WHERE>
76 <MOVE:ARG <REFERENCE <>> .WHERE>
78 <MOVE:ARG .WHERE .RW>>
80 <DEFINE PRED? (N) #DECL ((N) FIX) <1? <NTH ,PREDV .N>>>
82 " Generate code for ==?. If types are the same then just compare values,
83 otherwise generate a full comparison."
85 <DEFINE ==-GEN (NOD WHERE
86 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
87 "AUX" (K <KIDS .NOD>) REG REG2 B2 T2OK T2 T1
88 (T1OK <ISTYPE? <RESULT-TYPE <1 .K>>>)
91 <SET T2OK <ISTYPE? <RESULT-TYPE <2 .K>>>>>
92 .T1OK>) (RW .WHERE) (SDIR .DIR)
93 (FLS <==? .RW FLUSHED>) INA)
94 #DECL ((NOD) NODE (K) <LIST [REST NODE]>)
95 <COND (<==? <NODE-SUBR .NOD> ,N==?> <SET NOTF <NOT .NOTF>>)>
100 " ARGS CAN NEVER BE EQUAL "
104 <COND (<OR <==? <NODE-TYPE <SET T1 <1 .K>>> ,QUOTE-CODE>
105 <AND <NOT <SIDE-EFFECTS .NOD>>
106 <N==? <NODE-TYPE <SET T2 <2 .K>>> ,QUOTE-CODE>
107 <MEMQ <NODE-TYPE .T1> ,SNODES>
108 <OR <N==? <NODE-TYPE .T2> ,LVAL-CODE>
109 <AND <==? <NODE-TYPE .T1> ,LVAL-CODE>
110 <SET INA <INACS <NODE-NAME .T2>>>
111 <TYPE? <DATVAL .INA> AC>>>>>
117 <SET WHERE <UPDATE-WHERE .NOD .WHERE>>
119 <COND (<ISTYPE-GOOD? .T1OK> <DATUM .T1OK ANY-AC>)
120 (ELSE <DATUM ANY-AC ANY-AC>)>>
123 <AND .NOTF <SET DIR <NOT .DIR>>>
130 <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
132 <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE:TAG>>)>>
135 <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
140 <SET BRANCH <MAKE:TAG>>
150 <MOVE:ARG <REFERENCE T> .WHERE>
152 <BRANCH:TAG <SET B2 <MAKE:TAG>>>
154 <MOVE:ARG <REFERENCE <>> .WHERE>
156 <MOVE:ARG .WHERE .RW>)>>
158 <DEFINE GEN-EQTST (R11 R21 N1 N2 T1 T2 DIR TYPS BR "AUX" (TMP <>) AC R1 R2)
159 #DECL ((N1 N2) NODE (R1 R2) DATUM (AC) AC)
160 <SET R1 <GEN .N1 .R11>>
161 <SET R2 <GEN .N2 .R21>>
163 <COND (<TYPE? <DATVAL .R1> AC>)
164 (<TYPE? <DATVAL .R2> AC>
172 <AND <TYPE? <DATVAL .R2> AC>
173 <PUT <SET TMP <DATVAL .R2>> ,ACPROT T>>
174 <PUT <DATVAL .R1> ,ACPROT T>
176 <IMCHK <COND (.DIR '(`CAMN `CAIN )) (ELSE '(`CAME `CAIE ))>
181 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O !<ADDR:TYPE .R1>>>)
183 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O !<ADDR:TYPE .R2>>>)
185 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O !<ADDR:TYPE .R2>>>
186 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
187 <ACSYM <SET AC <GETREG <>>>>
189 <IMCHK '(`CAMN `CAIN ) <ACSYM <DATVAL .R1>> <DATVAL .R2>>
193 <COND (.T1 <FORM TYPE-CODE!-OP!-PACKAGE .T1>)
194 (.T2 <FORM TYPE-CODE!-OP!-PACKAGE .T2>)
195 (ELSE (<ADDRSYM .AC>))>>>
196 <AND .DIR <EMIT '<`SKIPA >>>)>
200 <AND <TYPE? .TMP AC> <PUT .TMP ,ACPROT <>>>>
202 " Generate TYPE? code for all various cases."
204 <DEFINE TYPE?-GEN (NOD WHERE
205 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
206 "AUX" B2 REG (RW .WHERE) (K <KIDS .NOD>) (SDIR .DIR)
207 (FLS <==? .RW FLUSHED>) B3 (TEST? T))
208 #DECL ((NOD) NODE (K) <LIST [REST NODE]> (REG) DATUM
209 (WHERE BRANCH B2 B3) ANY)
210 <COND (<==? <RESULT-TYPE .NOD> FALSE>
211 <MESSAGE WARNING "TYPE? NEVER TRUE " .NOD>
212 <SET TEST? #FALSE (1)>)
213 (<NOT <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>
214 <MESSAGE WARNING "TYPE? ALWAYS TRUE " .NOD>
215 <SET TEST? #FALSE (2)>)>
216 ;"Type of false indicates always true or false"
218 <GEN <1 .K> <COND (<AND <NOT .TEST?> .FLS> FLUSHED) (ELSE DONT-CARE)>>>
219 <AND .NOTF <SET DIR <NOT .DIR>>>
223 <AND <NOT .FLS> <NOT <EMPTY? <REST .K>>> <==? <1 .TEST?> 2>>>
224 <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O* !<ADDR:TYPE .REG>>>)>
227 (<AND .BRANCH .FLS> ;"In a COND, OR or AND?"
228 <AND <NOT <EMPTY? <REST .K>>> <NOT .DIR> <SET B2 <MAKE:TAG>>>
232 <COND (.TEST? <TYPINS .DIR <1 .K>>)>
234 <AND .DIR <==? <1 .TEST?> 2>>
235 <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
236 <BRANCH:TAG .BRANCH>)>
237 <AND <ASSIGNED? B2> <LABEL:TAG .B2>>
243 <BRANCH:TAG <COND (.DIR .BRANCH) (ELSE .B2)>>)>
244 <COND (<EMPTY? <SET K <REST .K 2>>>
245 <COND (<OR <AND <NOT .DIR> .TEST?>
247 <OR <AND .DIR <==? <1 .TEST?> 2>>
249 <==? <1 .TEST?> 1>>>>>
253 (<AND .FLS <NOT .TEST?> <NOT .BRANCH>>)
254 (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
255 <SET WHERE <GOODACS .NOD .WHERE>>
260 <COND (<EMPTY? <REST .K>>
261 <TYPINS <COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>
267 <COND (<EMPTY? <SET K <REST .K 2>>>
268 <AND <N==? <NOT .BRANCH> .DIR>
271 <BRANCH:TAG <OR <AND .BRANCH .NOTF .B3> .B2>>>
275 <MOVE:ARG <REFERENCE .SDIR> .WHERE>
278 (ELSE <TRUE-FALSE .NOD .BRANCH .WHERE>)>)
281 <COND (<OR <AND .DIR <==? <1 .TEST?> 2>>
282 <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
283 <MOVE:ARG <REFERENCE .SDIR> .WHERE>
284 <BRANCH:TAG .BRANCH>)>)
285 (ELSE <MOVE:ARG <==? <1 .TEST?> 2> .WHERE>)>)>)
287 <SET WHERE <GOODACS .NOD .WHERE>>
289 <SET REG <REG? ATOM .WHERE>>
291 (<OR .TEST? <AND <G=? <LENGTH .K> 2> <==? <1 .TEST?> 2>>>
293 <FUNCTION (TYL "AUX" (TY <1 .TYL>))
294 <COND (<NOT <AND <NOT .TEST?> <EMPTY? <REST .TYL>>>>
296 <BRANCH:TAG <SET B3 <MAKE:TAG>>>)>
297 <MOVE:ARG <REFERENCE <NODE-NAME .TY>> .REG>
298 <COND (<EMPTY? <REST .TYL>>
300 <RET-TMP-AC <MOVE:ARG .REG .WHERE>>
305 <BRANCH:TAG <SET B2 <MAKE:TAG>>>
307 <MOVE:ARG <REFERENCE <>> .WHERE>
317 <COND (<OR <AND .DIR <==? <1 .TEST?> 2>>
318 <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
319 <MOVE:ARG <REFERENCE <AND .DIR <NODE-NAME <1 .K>>>> .WHERE>
320 <BRANCH:TAG .BRANCH>)>)
321 (ELSE <MOVE:ARG <REFERENCE <AND .DIR <NODE-NAME <1 .K>>>> .WHERE>)>)>)>
322 <MOVE:ARG .WHERE .RW>>
324 <DEFINE TYPINS (DIR N)
326 <EMIT <INSTRUCTION <COND (.DIR `CAIN ) (ELSE `CAIE )>
327 <FORM TYPE-CODE!-OP!-PACKAGE <NODE-NAME .N>>>>>