1 <DEFINE GETBITS-GEN (FROM WIDTH SHIFT DEST "OPTIONAL" HINT "AUX" AC)
2 <COND (<==? .DEST STACK>
3 <EMIT-PUSH <TYPE-WORD FIX> LONG>)>
4 <COND (<AND <NOT <TYPE? .FROM VARTBL>>
5 <NOT <TYPE? .WIDTH VARTBL>>
6 <NOT <TYPE? .SHIFT VARTBL>>>
7 ; "Win if given all constants"
8 <EMIT-MOVE <MA-IMM <GETBITS .FROM <BITS .WIDTH .SHIFT>>>
9 <COND (<==? .DEST STACK>
12 <VAR-VALUE-ADDRESS .DEST T>)>
14 (<AND <TYPE? .WIDTH FIX>
16 <0? <MOD .SHIFT 8>> ; "On byte boundary"
17 <OR <==? .WIDTH 8> ; "Byte or halfword"
20 <NOT <VAR-VALUE-IN-AC? .FROM>>>>
21 ; "Make getting a halfword or byte not use EXTZV"
22 <EMIT <COND (<==? .WIDTH 8> ,INST-MOVZBL)
23 (T ,INST-MOVZWL)> ; "Depends on width"
25 ; "This works even if in AC"
26 <VAR-VALUE-ADDRESS .FROM>)
28 ; "Generate bizarre stack offset"
29 <GEN-LOC .FROM <+ 4 </ .SHIFT 8>>>)>
30 <COND (<==? .DEST STACK>
32 (<VAR-VALUE-ADDRESS .DEST T>)>>)
35 <COND (<TYPE? .SHIFT VARTBL>
36 <VAR-VALUE-ADDRESS .SHIFT>)
38 <COND (<TYPE? .WIDTH VARTBL>
39 <VAR-VALUE-ADDRESS .WIDTH>)
41 <COND (<TYPE? .FROM VARTBL>
42 <VAR-VALUE-ADDRESS .FROM>)
44 <COND (<==? .DEST STACK>
46 (<VAR-VALUE-ADDRESS .DEST T>)>>)>
47 <COND (<N==? .DEST STACK>
48 <COND (<SET AC <VAR-VALUE-IN-AC? .DEST>>
49 <DEST-DECL .AC .DEST FIX>)
50 (<N==? <VARTBL-DECL .DEST> FIX>
51 <INDICATE-VAR-TEMP-DECL .DEST FIX>
52 <EMIT-MOVE <TYPE-CODE FIX> <VAR-TYPE-ADDRESS .DEST> LONG>)>)>
55 <DEFINE PUTBITS-GEN (TO WIDTH SHIFT FROM DEST "OPTIONAL" HINT "AUX" RD
56 WIDOP SHIFTOP FROMOP (TAC <>) (ZERO? <>))
57 <COND (<AND <NOT <TYPE? .TO VARTBL>>
58 <NOT <TYPE? .WIDTH VARTBL>>
59 <NOT <TYPE? .SHIFT VARTBL>>
60 <NOT <TYPE? .FROM VARTBL>>>
61 ; "Win with all constants"
62 <COND (<==? .DEST STACK>
63 <EMIT-PUSH <TYPE-WORD FIX> LONG>)>
64 <EMIT-MOVE <MA-IMM <PUTBITS .TO <BITS .WIDTH .SHIFT> .FROM>>
65 <COND (<==? .DEST STACK> <MA-AINC ,AC-TP>)
66 (<VAR-VALUE-ADDRESS .DEST T>)>
69 <COND (<==? .DEST STACK>
70 <EMIT-PUSH <TYPE-WORD FIX> LONG>
71 <EMIT-PUSH <COND (<TYPE? .TO VARTBL>
72 <VAR-VALUE-ADDRESS .TO>)
73 (<MA-IMM .TO>)> LONG>)>
74 <COND (<AND <TYPE? .WIDTH FIX>
81 <AND <NOT <VAR-VALUE-IN-AC? .DEST>>
82 ; "This only works if shift is 0 anyway"
84 <COND (<AND <==? .TO 0>
86 ; "If putbits into 0, rightmost part, just do MOVZxL"
89 ; "<PUTBITS FROB X X FOO = FOO>, so can't clear word
91 <SET TAC <GET-AC PREF-VAL T>>
93 <COND (<TYPE? .TO VARTBL> <VAR-VALUE-ADDRESS .TO>)
97 (<AND <N==? .DEST STACK>
100 <COND (<TYPE? .TO VARTBL> <VAR-VALUE-ADDRESS .TO>)
102 <VAR-VALUE-ADDRESS .DEST T>
105 <COND (<==? .WIDTH 8> ,INST-MOVZBL)
107 (<==? .WIDTH 8> ,INST-MOVB)
109 <COND (<TYPE? .FROM VARTBL>
110 <VAR-VALUE-ADDRESS .FROM>)
113 <COND (<==? .DEST STACK>
115 <- -4 </ .SHIFT 8>>>)
118 (<VAR-VALUE-IN-AC? .DEST>
119 <VAR-VALUE-ADDRESS .DEST T>)
121 <GEN-LOC .DEST <+ 4 </ .SHIFT 8>>>)>>
123 <DEST-DECL .TAC .DEST FIX>)
124 (<N==? <VARTBL-DECL .DEST> FIX>
125 <INDICATE-VAR-TEMP-DECL .DEST FIX>
126 <EMIT-MOVE <TYPE-CODE FIX> <VAR-TYPE-ADDRESS .DEST>
129 <COND (<TYPE? .WIDTH VARTBL>
130 <SET WIDOP <VAR-VALUE-ADDRESS .WIDTH>>)
131 (<SET WIDOP <MA-LIT .WIDTH>>)>
132 <COND (<TYPE? .SHIFT VARTBL>
133 <SET SHIFTOP <VAR-VALUE-ADDRESS .SHIFT>>)
134 (<SET SHIFTOP <MA-LIT .SHIFT>>)>
135 <COND (<TYPE? .FROM VARTBL>
136 <SET FROMOP <VAR-VALUE-ADDRESS .FROM>>
137 <COND (<SET RD <VAR-VALUE-IN-AC? .FROM>>
140 <SET FROMOP <MA-IMM .FROM>>)>
141 <COND (<==? .DEST STACK>
142 <SET RD <MA-BD ,AC-TP -4>>)
144 <SET RD <VAR-VALUE-ADDRESS .TO>>)
145 (<AND <TYPE? .TO VARTBL>
146 <SET RD <VAR-VALUE-IN-AC? .TO>>>
148 <DEST-DECL .RD .DEST FIX>
149 <SET RD <MA-REG .RD>>)
150 (<SET RD <GET-AC PREF-VAL T>>
151 <DEST-DECL .RD .DEST FIX>
153 <COND (<TYPE? .TO VARTBL> <VAR-VALUE-ADDRESS .TO>)
155 <SET RD <MA-REG .RD>>>)>
163 <DEFINE ARITH-GEN (OP-2-ARG OP-3-ARG OP1 OP2 DEST COMMUTE MUD TYP
164 "AUX" TMP (USE-3 <>) (VAC <>))
165 #DECL ((OP-2-ARG OP-3-ARG) FIX (OP1 OP2) <OR FIX FLOAT VARTBL>
166 (DEST) <OR ATOM VARTBL> (COMMUTE) <OR ATOM FALSE>
168 <COND (<AND <TYPE? .OP1 FIX FLOAT> <TYPE? .OP2 FIX FLOAT>>
169 <SET VAC <GET-AC PREF-VAL T>>
170 <LOAD-CONSTANT .VAC <APPLY .MUD .OP1 .OP2>>)
172 <COND (<AND <TYPE? <SET TMP .OP1> FIX FLOAT> .COMMUTE>
175 <COND (<==? .DEST STACK>
177 <EMIT-PUSH <TYPE-WORD .TYP> LONG>)
178 (<TYPE? .OP1 FIX FLOAT> <SET USE-3 T>)
179 (<AND <TYPE? .OP1 VARTBL>
180 <SET VAC <VAR-VALUE-IN-AC? .OP1>>
181 <OR <AND <AVAILABLE? .VAC> <PROG ()
184 <AND <==? .OP1 .DEST>
185 <==? <LENGTH <AC-VARS .VAC>> 1>>>>)
186 (<AND <TYPE? .OP2 VARTBL>
187 <SET VAC <VAR-VALUE-IN-AC? .OP2>>
190 <COND (.COMMUTE <SET OP1 .OP2> <SET OP2 .TMP>)
191 (ELSE <SET USE-3 T>)>)
192 (ELSE <SET VAC <>> <COND (<N==? .OP1 .DEST> <SET USE-3 T>)>)>
193 <COND (<AND <TYPE? .OP2 FIX>
196 <OR <==? .OP-2-ARG ,INST-SUBL2>
197 <==? .OP-2-ARG ,INST-ADDL2>>>
199 <COND (<==? .OP-2-ARG ,INST-SUBL2>
200 <SET OP-2-ARG ,INST-ADDL2>
201 <SET OP-3-ARG ,INST-ADDL3>)
203 <SET OP-2-ARG ,INST-SUBL2>
204 <SET OP-3-ARG ,INST-SUBL3>)>)>
206 <OR <==? .OP1 0> <==? .OP1 0.0000000> <==? .OP1 -1>>
207 <OR <AND <==? .OP-2-ARG ,INST-SUBL2>
208 <OR <AND <==? .OP1 -1>
209 <SET OP-2-ARG ,INST-MCOML>>
210 <SET OP-2-ARG ,INST-MNEGL>>>
211 <AND <==? .OP-2-ARG ,INST-SUBF2>
212 <SET OP-2-ARG ,INST-MNEGF>>>>
214 <COND (.VAC <MA-REG .VAC>)
215 (ELSE <VAR-VALUE-ADDRESS .OP2>)>
216 <COND (<==? .DEST STACK> <SET VAC <>> <MA-AINC ,AC-TP>)
218 (ELSE <MA-REG <SET VAC <GET-AC PREF-VAL T>>>)>>)
220 <OR <NOT .USE-3> <==? .DEST .OP1>>
221 <OR <AND <==? .OP-2-ARG ,INST-ADDL2>
222 <SET OP-2-ARG ,INST-INCL>>
223 <AND <==? .OP-2-ARG ,INST-SUBL2>
224 <SET OP-2-ARG ,INST-DECL>>>>
225 <COND (<AND <NOT .VAC> <SET VAC <VAR-VALUE-IN-AC? .OP1>>>
228 <COND (.VAC <MA-REG .VAC>)
229 (ELSE <VAR-VALUE-ADDRESS .OP1>)>>)
232 <COND (<TYPE? .OP2 FIX> <MA-IMM .OP2>)
234 <FLOAT-IMM <FLOATCONVERT .OP2>>)
236 (ELSE <VAR-VALUE-ADDRESS .OP2>)>
237 <COND (<TYPE? .OP1 FIX> <MA-IMM .OP1>)
239 <FLOAT-IMM <FLOATCONVERT .OP1>>)
240 (ELSE <VAR-VALUE-ADDRESS .OP1>)>
241 <COND (<==? .DEST STACK> <SET VAC <>> <MA-AINC ,AC-TP>)
243 (ELSE <MA-REG <SET VAC <GET-AC PREF-VAL T>>>)>>)
245 <COND (<AND <NOT .VAC> <SET VAC <VAR-VALUE-IN-AC? .OP1>>>
248 <COND (<TYPE? .OP2 FIX> <MA-IMM .OP2>)
250 <FLOAT-IMM <FLOATCONVERT .OP2>>)
251 (ELSE <VAR-VALUE-ADDRESS .OP2>)>
252 <COND (.VAC <MA-REG .VAC>)
253 (ELSE <VAR-VALUE-ADDRESS .OP1>)>>)>)>
254 <COND (.VAC <DEST-DECL .VAC .DEST .TYP>)>
257 <DEFINE ADDFIX-GEN (OP1 OP2 DEST "OPTIONAL" (HINT <>))
258 #DECL ((OP1 OP2) <OR FIX VARTBL> (DEST) <OR VARTBL ATOM>)
259 <ARITH-GEN ,INST-ADDL2 ,INST-ADDL3 .OP1 .OP2 .DEST T ,+ FIX>>
261 <DEFINE LESSFIX-GEN (VAL1 VAL2 DIR LABEL "OPT" (HINT <>) "AUX" (TYP <>))
262 #DECL ((VAL1 VAL2) <OR VARTBL <PRIMTYPE FIX>> (DIR LABEL) ATOM)
263 <COND (.HINT <SET TYP <PARSE-HINT .HINT TYPE>>)>
264 <COND (<AND <NOT .TYP>
265 <NOT <AND <NOT <TYPE? .VAL1 VARTBL>>
267 <NOT <AND <NOT <TYPE? .VAL2 VARTBL>>
270 <COMP-GEN .VAL1 .VAL2 .DIR .LABEL ,CLT-CODE .TYP>>
272 <DEFINE GTFIX-GEN (VAL1 VAL2 DIR LABEL "OPT" (HINT <>) "AUX" (TYP <>))
273 #DECL ((VAL1 VAL2) <OR VARTBL <PRIMTYPE FIX>> (DIR LABEL) ATOM)
274 <COND (.HINT <SET TYP <PARSE-HINT .HINT TYPE>>)>
275 <COND (<AND <NOT .TYP>
276 <NOT <AND <NOT <TYPE? .VAL1 VARTBL>>
278 <NOT <AND <NOT <TYPE? .VAL2 VARTBL>>
281 <COMP-GEN .VAL1 .VAL2 .DIR .LABEL ,CGT-CODE .TYP>>
283 <DEFINE VEQUAL-GEN (VAL1 VAL2 DIR LABEL "OPT" (HINT <>) "AUX" (TYP <>))
284 #DECL ((VAL1 VAL2) ANY (DIR LABEL) ATOM)
285 <COND (.HINT <SET TYP <PARSE-HINT .HINT TYPE>>)>
286 <COND (<NOT .TYP> <SET TYP FIX>)>
287 <COMP-GEN .VAL1 .VAL2 .DIR .LABEL ,CEQ-CODE .TYP>>
289 <DEFINE EQUAL-GEN (VAL1 VAL2 DIR LABEL
290 "AUX" FVAL DCL VAC ELABEL MOFF TAC DCL1 TY-AD TMP)
291 #DECL ((VAL1) VARTBL (VAL2) ANY (DIR LABEL) ATOM)
292 <SET ELABEL <MAKE-LABEL T>>
293 <COND (<TYPE? .VAL2 VARTBL>
294 <COND (<AND <SET DCL <VARTBL-DECL .VAL1>>
295 <SET DCL1 <VARTBL-DECL .VAL2>>
296 <==? <CLEAN-DECL .DCL> <CLEAN-DECL .DCL1>>>
297 ; "no type comparison needed"
298 <VEQUAL-GEN .VAL1 .VAL2 .DIR .LABEL>)
299 (ELSE <VAR-EQUAL-GEN .VAL1 .VAL2 .DIR .LABEL .ELABEL>)>)
300 (<SET DCL <VARTBL-DECL .VAL1>>
301 <COND (<AND <==? <CLEAN-DECL .DCL> <TYPE .VAL2>>
302 <NOT <SAFE-TYPE-WORD? .VAL1>>>
303 ; "No type comparison"
304 <VEQUAL-GEN .VAL1 .VAL2 .DIR .LABEL>)
305 (<ERROR "NOT EQUAL" EQUAL-GEN>)>)
306 (<SET FVAL <FIX-CONSTANT? .VAL2>>
307 <GEN-COMP-INST <VAR-VALUE-ADDRESS .VAL1> <MA-IMM .FVAL> LONG>
308 <SET TY-AD <VAR-TYPE-ADDRESS .VAL1>>
309 <COND (<==? .DIR -> <GEN-BRANCH ,INST-BNEQ .LABEL <>>)
310 (<GEN-BRANCH ,INST-BNEQ .ELABEL <>>)>
311 <GEN-COMP-INST .TY-AD <TYPE-CODE <TYPE .VAL2> WORD> WORD>
312 <COND (<==? .DIR -> <GEN-BRANCH ,INST-BNEQ .LABEL <>>)
313 (<GEN-BRANCH ,INST-BEQL .LABEL <>>)>
314 <GEN-LABEL .ELABEL NORMAL>)
316 ; "Compare with structured constant"
317 <SET VAC <VAR-VALUE-IN-AC? .VAL1>>
318 <SET TAC <VAR-TYPE-WORD-IN-AC? .VAL1>>
319 <GEN-COMP-INST <VAR-TYPE-ADDRESS .VAL1>
320 <TYPE-CODE <TYPE .VAL2> WORD>
322 <SET TY-AD <VAR-VALUE-ADDRESS .VAL1>>
323 <COND (<==? .DIR -> <GEN-BRANCH ,INST-BNEQ .LABEL <>>)
324 (<GEN-BRANCH ,INST-BNEQ .ELABEL <>>)>
325 <GEN-COMP-INST .TY-AD
326 <ADDR-VALUE-MQUOTE .VAL2>
328 <COND (<==? .DIR -> <GEN-BRANCH ,INST-BNEQ .LABEL <>>)
329 (<GEN-BRANCH ,INST-BEQL .LABEL <>>)>
330 <GEN-LABEL .ELABEL NORMAL>)>
334 <DEFINE VAR-EQUAL-GEN (VAR1 VAR2 DIR LABEL ELABEL
335 "AUX" (DCL <VARTBL-DECL .VAR2>) TVAR
336 (DCL1 <VARTBL-DECL .VAR1>) TAC CAC VAC
338 #DECL ((VAR1 VAR2) VARTBL (DIR LABEL) ATOM (ELABEL) ATOM)
341 <N==? <CLEAN-DECL .DCL> <CLEAN-DECL .DCL1>>
342 <ERROR "NOT EQUAL" VAR-EQUAL-GEN>>
349 <SET VAC <VAR-VALUE-IN-AC? .VAR1>>
350 <SET TAC <VAR-TYPE-WORD-IN-AC? .VAR1>>
353 <COND (<SET OK1? <FRIENDLY-VAR? .VAR1 .TAC .VAC>>
354 <COND (<==? .OK1? AC> <SET OK1? <MA-REG .TAC>>)
355 (<SET OK1? <ADDR-VAR-TYPE .VAR1>>)>)>
356 <SET TAC <VAR-TYPE-WORD-IN-AC? .VAR2>>
357 <SET VAC <VAR-VALUE-IN-AC? .VAR2>>
358 <GEN-COMP-INST <VAR-VALUE-ADDRESS .VAR1>
359 <VAR-VALUE-ADDRESS .VAR2>
361 <COND (<==? .DIR -> <GEN-BRANCH ,INST-BNEQ .LABEL <> <> <> T>)
362 (ELSE <GEN-BRANCH ,INST-BNEQ .ELABEL <> <> <> T>)>
363 <COND (<AND ,GC-MODE <OR <NOT .DCL> <NOT .DCL1>>>
365 <COND (.DCL <TYPE-CODE .DCL>)
366 (ELSE <VAR-TYPE-ADDRESS .VAR2>)>
367 <COND (.DCL1 <TYPE-CODE .DCL1>)
368 (ELSE <VAR-TYPE-ADDRESS .VAR1>)>
369 <MA-REG <SET TAC <GET-AC PREF-TYPE T>>>>
370 <EMIT ,INST-BICW2 <MA-WORD-IMM ,SHORT-TYPE-MASK>
372 (<OR <NOT .DCL> <NOT .DCL1>>
374 <COND (.DCL1 <TYPE-CODE .DCL1>)
375 (ELSE <VAR-TYPE-ADDRESS .VAR1>)>
376 <COND (.DCL <TYPE-CODE .DCL>)
377 (ELSE <VAR-TYPE-ADDRESS .VAR2>)>
379 <COND (<==? .DIR -> <GEN-BRANCH ,INST-BNEQ .LABEL <>>)
380 (<GEN-BRANCH ,INST-BEQL .LABEL <>>)>
381 <GEN-LABEL .ELABEL NORMAL>
384 <DEFINE FRIENDLY-VAR? (VAR TAC VAC)
385 #DECL ((VAR) VARTBL (TAC VAC) <OR AC FALSE>)
386 <COND (<AND <NOT .VAC> <NOT .TAC>>)
387 (<AND .TAC .VAC <==? .VAC <NEXT-AC .TAC>>>
389 (<AND <NOT .TAC> <AC-VAR-STORED? .VAR .VAC>>
391 (<AND <NOT .VAC> <AC-VAR-STORED? .VAR .TAC>>
394 <DEFINE COMP-GEN (VAL1 VAL2 DIR LABEL MODE "OPT" (TYP FIX) "AUX" BRANCH-CODE)
395 #DECL ((VAL1 VAL2) ANY (DIR LABEL) ATOM (MODE) FIX
396 (TYP) <OR FALSE ATOM>)
397 <SET BRANCH-CODE <COMPUTE-DIRECTION .DIR .MODE>>
398 <COND (<NOT <TYPE? .VAL1 VARTBL>>
399 <CONST-COMP-GEN .VAL1 .VAL2 .LABEL <REVERSE-BC .BRANCH-CODE>
401 (<NOT <TYPE? .VAL2 VARTBL>>
402 <CONST-COMP-GEN .VAL2 .VAL1 .LABEL .BRANCH-CODE .TYP>)
403 (<VAR-COMP-GEN .VAL1 .VAL2 .LABEL .BRANCH-CODE .TYP>)>
407 <DEFINE CONST-COMP-GEN (CONST VAR LABEL DIRCODE "OPT" (TYP FIX)
408 "AUX" FIXCONST VAC CADDR)
409 #DECL ((CONST) ANY (VAR) VARTBL (LABEL) ATOM (DIRCODE) FIX
410 (TYP) <OR FALSE ATOM>)
411 <COND (<SET FIXCONST <FIX-CONSTANT? .CONST>>
412 <COND (<0? .FIXCONST> <ZERO-TEST-GEN .VAR .DIRCODE .LABEL .TYP>)
413 (<SET VAC <VAR-VALUE-IN-AC? .VAR>>
414 <GEN-COMP-INST <MA-REG .VAC>
415 <COND (<TYPE? .CONST FLOAT>
416 <FLOAT-IMM <FLOATCONVERT .CONST>>)
417 (ELSE <MA-IMM .FIXCONST>)> LONG
419 <GEN-TEST-INST .DIRCODE .LABEL <>>)
421 <GEN-COMP-INST <ADDR-VAR-VALUE .VAR>
422 <COND (<TYPE? .CONST FLOAT>
423 <FLOAT-IMM <FLOATCONVERT .CONST>>)
424 (ELSE <MA-IMM .FIXCONST>)>
426 <GEN-TEST-INST .DIRCODE .LABEL <>>)>)
428 <GEN-COMP-INST <VAR-VALUE-ADDRESS .VAR>
429 <ADDR-VALUE-MQUOTE .CONST> LONG
431 <GEN-TEST-INST .DIRCODE .LABEL <>>)>>
433 <SETG COMP-TABLE <UVECTOR ,COND-CODE-LT ,COND-CODE-EQ ,COND-CODE-GT>>
435 <SETG NCOMP-TABLE <UVECTOR ,COND-CODE-GE ,COND-CODE-NE ,COND-CODE-LE>>
437 <COND (<NOT <GASSIGNED? REVERSE-TABLE>><SETG REVERSE-TABLE <IUVECTOR 15 0>>)>
439 <DEFINE MAKE-REVERSE (CODE REV-CODE) <PUT ,REVERSE-TABLE .CODE .REV-CODE>>
441 <COND (<NOT <GASSIGNED? BRANCHES>><SETG BRANCHES <IUVECTOR 16 0>>)>
443 <GDECL (BRANCHES) <UVECTOR [REST FIX]>>
445 <DEFINE INIT-BRANCH-TABLES ("AUX" (B ,BRANCHES))
446 #DECL ((B) <UVECTOR [REST FIX]>)
447 <MAKE-REVERSE ,COND-CODE-EQ ,COND-CODE-EQ>
448 <MAKE-REVERSE ,COND-CODE-NE ,COND-CODE-NE>
449 <MAKE-REVERSE ,COND-CODE-LE ,COND-CODE-GE>
450 <MAKE-REVERSE ,COND-CODE-LT ,COND-CODE-GT>
451 <MAKE-REVERSE ,COND-CODE-GE ,COND-CODE-LE>
452 <MAKE-REVERSE ,COND-CODE-GT ,COND-CODE-LT>
455 #DECL ((L) <LIST FIX FIX>)
456 <PUT .B <+ <1 .L> 1> <2 .L>>>
457 ((,COND-CODE-EQ ,INST-BEQL)
458 (,COND-CODE-NE ,INST-BNEQ)
459 (,COND-CODE-LE ,INST-BLEQ)
460 (,COND-CODE-LT ,INST-BLSS)
461 (,COND-CODE-GT ,INST-BGTR)
462 (,COND-CODE-GE ,INST-BGEQ)
463 (,COND-CODE-ALWAYS ,INST-BRB))>>
465 <DEFINE COMPUTE-DIRECTION (DIR MODE)
466 #DECL ((DIR) ATOM (MODE) FIX)
467 <COND (<==? .DIR +> <NTH ,COMP-TABLE .MODE>)
468 (<==? .DIR -> <NTH ,NCOMP-TABLE .MODE>)
469 (<ERROR "BAD DIRECTION" .DIR COMPUTE-DIRECTION>)>>
471 <DEFINE REVERSE-BC (MODE) #DECL ((MODE) FIX) <NTH ,REVERSE-TABLE .MODE>>
473 <DEFINE ZERO-TEST-GEN (VAR DIRCODE LABEL "OPT" (TYP FIX)
474 "AUX" STATUS? (VADDR <VAR-VALUE-ADDRESS .VAR>) VAC
476 #DECL ((VAR) VARTBL (DIRCODE) FIX (LABEL) ATOM (TYP) <OR ATOM FALSE>)
477 <COND (<NOT .TYP> <SET TYP <VARTBL-DECL .VAR>>)>
478 <COND (<OR <NOT <SET STATUS? <STATUS? .VAR VALUE>>> <NOT .TYP>>
480 <EMIT <COND (<==? .TYP FIX> ,INST-TSTL)
481 (ELSE ,INST-TSTF)> .VADDR>
482 <GEN-TEST-INST .DIRCODE .LABEL .STATUS?>)
484 <COND (<OR <SET TAC <VAR-TYPE-IN-AC? .VAR>>
485 <SET TAC <VAR-TYPE-WORD-IN-AC? .VAR>>
488 <SET TAC <LOAD-VAR .VAR TYPE <> TYPE>>)>
489 <GEN-COMP-INST <MA-REG .TAC>
493 <EMIT ,INST-CMPW <VAR-TYPE-ADDRESS .VAR>
496 <GEN-BRANCH ,INST-BEQL <SET B1 <MAKE-LABEL T>> <>
498 <EMIT ,INST-TSTF .VADDR>
499 <GEN-TEST-INST .DIRCODE .LABEL .STATUS?>
500 <GEN-BRANCH ,INST-BRB <SET B2 <MAKE-LABEL T>> <>
502 <GEN-LABEL .B1 NORMAL>
503 <EMIT ,INST-TSTL .VADDR>
504 <GEN-TEST-INST .DIRCODE .LABEL .STATUS?>
505 <GEN-LABEL .B2 NORMAL>)>)
507 <GEN-TEST-INST .DIRCODE .LABEL .STATUS?>)>>
509 <DEFINE GEN-TEST-INST (DIRCODE LABEL STATUS?)
510 #DECL ((DIRCODE) FIX (LABEL) ATOM (STATUS?) ANY)
511 <GEN-BRANCH <NTH ,BRANCHES <+ .DIRCODE 1>> .LABEL .STATUS?>>
513 <DEFINE GEN-COMP-INST (VAR ADDR "OPT" (SZ LONG) (TYP FIX) "AUX" VADDR)
514 #DECL ((VAC) AC (SZ) ATOM)
515 <EMIT <COND (<==? .SZ LONG>
516 <COND (<==? .TYP FIX> ,INST-CMPL)
518 (<==? .SZ WORD> ,INST-CMPW)
519 (<==? .SZ BYTE> ,INST-CMPB)
520 (ELSE <ERROR "BAD SIZE" .SZ>)>
524 <DEFINE VAR-COMP-GEN (VAR1 VAR2 LABEL DIR "OPT" (TYP FIX) "AUX" VAC)
525 #DECL ((VAR1 VAR2) VARTBL (LABEL) ATOM (DIR) FIX)
526 <COND (<SET VAC <VAR-VALUE-IN-AC? .VAR1>>
527 <VAR-AC-COMP .VAR2 .VAC .LABEL .DIR .TYP>)
528 (<SET VAC <VAR-VALUE-IN-AC? .VAR2>>
529 <VAR-AC-COMP .VAR1 .VAC .LABEL <REVERSE-BC .DIR> .TYP>)
531 <EMIT <COND (<==? .TYP FIX> ,INST-CMPL)(ELSE ,INST-CMPF)>
532 <VAR-VALUE-ADDRESS .VAR1>
533 <VAR-VALUE-ADDRESS .VAR2>>
534 <GEN-TEST-INST .DIR .LABEL <>>)>>
536 <DEFINE VAR-AC-COMP (VAR AC LABEL DIR "OPT" (TYP FIX)
537 "AUX" (VADDR <VAR-VALUE-ADDRESS .VAR>))
538 #DECL ((VAR) VARTBL (AC) AC (LABEL) ATOM (DIR) FIX)
539 <GEN-COMP-INST <MA-REG .AC> .VADDR LONG .TYP>
540 <GEN-TEST-INST .DIR .LABEL <>>>
542 <MSETG 32MIN 2147483647>
544 <MSETG 32MAX <CHTYPE #WORD *020000000001* FIX>>
546 <DEFINE FIX-CONSTANT? (CONST)
548 <COND (<TYPE? .CONST FLOAT> <FLOATCONVERT .CONST>)
549 (<==? <TYPEPRIM <TYPE .CONST>> FIX>
550 <SET CONST <CHTYPE .CONST FIX>>
551 <COND (<==? .CONST <CHTYPE <MIN> FIX>> ,32MIN)
552 (<==? .CONST <CHTYPE <MAX> FIX>> ,32MAX)
554 (<AND <==? <TYPEPRIM <TYPE .CONST>> LIST> <EMPTY? .CONST>> 0)>>
556 <DEFINE FLOATCONVERT (CNS "AUX" RES)
557 #DECL ((CNS) <OR FIX FLOAT>)
558 <COND (<==? .CNS 0.0000000> 0)
566 ; "Biggest possible VAX float"
569 ; "Smallest possible VAX float"
573 <COND (<L? .CNS 0.0000000> <PUTBITS 0 <BITS 1 15> 1>)
575 <SET CNS <CHTYPE <ABS .CNS> FIX>>
576 <COND (<NOT <0? <CHTYPE <ANDB .CNS 4> FIX>>>
577 <SET CNS <+ .CNS 8>>)>
579 <PUTBITS .RES <BITS 8 7> <GET-FIELD .CNS <BITS 8 27>>>>
580 <SET RES <PUTBITS .RES <BITS 16 16>
581 <GET-FIELD .CNS <BITS 16 2>>>>
582 <CHTYPE <PUTBITS .RES <BITS 7> <GET-FIELD .CNS <BITS 7 19>>>
585 <DEFINE FLOAT-IMM (X) #DECL ((X) FIX)
586 <COND (<AND <0? <CHTYPE <ANDB .X *777777736017*> FIX>>
587 <NOT <0? <CHTYPE <ANDB .X *40000*> FIX>>>>
588 <MA-IMM <CHTYPE <GETBITS .X <BITS 6 4>> FIX>>)
591 <DEFINE SUBFIX-GEN (OP1 OP2 DEST "OPTIONAL" (HINT <>))
592 #DECL ((OP1 OP2) <OR FIX VARTBL> (DEST) <OR VARTBL ATOM>)
593 <ARITH-GEN ,INST-SUBL2 ,INST-SUBL3 .OP1 .OP2 .DEST <> ,- FIX>>
595 <DEFINE TYPE-TST-GEN (VAR TNAME DIR DEST "AUX" TAC DCL)
596 #DECL ((VAR) VARTBL (DIR) ATOM (LABEL) <OR ATOM SPEC-LABEL>
597 (TNAME) <OR ATOM VARTBL>)
599 (<AND <SET DCL <VARTBL-DECL .VAR>>
600 <NOT <==? <CLEAN-DECL .TNAME> UNBOUND>>
601 <NOT <==? .TNAME T$UNBOUND>>
602 <NOT <SAFE-TYPE-WORD? .VAR>>>
603 <ERROR "WARNING: TYPE KNOWN" <VARTBL-NAME .VAR>>
604 <COND (<AND <==? .TNAME .DCL> <==? .DIR +>>
605 <GEN-BRANCH ,INST-BBR .DEST <>>)
606 (<AND <N==? .TNAME .DCL> <==? .DIR ->>
607 <GEN-BRANCH ,INST-BBR .DEST <>>)>)
609 <COND (<OR <SET TAC <VAR-TYPE-IN-AC? .VAR>>
610 <SET TAC <VAR-TYPE-WORD-IN-AC? .VAR>>
611 <NOT <MEMQ .TNAME ,TYPE-WORDS>>
614 <SET TAC <LOAD-VAR .VAR TYPE <> TYPE>>)>
615 <COND (<TYPE? .TNAME VARTBL>
616 <GEN-COMP-INST <MA-REG .TAC>
617 <VAR-VALUE-ADDRESS .TNAME>
619 (<GEN-COMP-INST <MA-REG .TAC>
620 <TYPE-CODE .TNAME FIX>
622 (<OR <==? .TNAME T$UNBOUND> <==? <CLEAN-DECL .TNAME> UNBOUND>>
623 <EMIT ,INST-TSTW <VAR-TYPE-ADDRESS .VAR>>
626 <EMIT ,INST-CMPW <VAR-TYPE-ADDRESS .VAR> <TYPE-CODE .TNAME FIX>>
628 <COND (<==? .DIR +> <GEN-BRANCH ,INST-BEQL .DEST <>>)
629 (<GEN-BRANCH ,INST-BNEQ .DEST <>>)>)>
632 <DEFINE MULFIX-GEN (OP1 OP2 DEST "OPTIONAL" (HINT <>))
633 #DECL ((OP1 OP2) <OR FIX VARTBL> (DEST) <OR VARTBL ATOM>)
634 <ARITH-GEN ,INST-MULL2 ,INST-MULL3 .OP1 .OP2 .DEST T ,* FIX>>
638 <COND (<L? .X 0> <SET X <- .X>>)>
639 <REPEAT ((Y 2) (CNT 1))
640 <COND (<==? .Y .X> <RETURN .CNT>)
641 (<G? .Y .X> <RETURN <>>)
642 (<G? <SET CNT <+ .CNT 1>> 31> <RETURN <>>)>
645 <DEFINE DIVFIX-GEN (OP1 OP2 DEST "OPTIONAL" (HINT <>))
646 #DECL ((OP1 OP2) <OR FIX VARTBL> (DEST) <OR VARTBL ATOM>)
647 <ARITH-GEN ,INST-DIVL2 ,INST-DIVL3 .OP1 .OP2 .DEST <> ,/ FIX>>
649 <DEFINE MODFIX-GEN (ITM1 ITM2 RES "OPTIONAL" HINT "AUX" VAC (AC <>)
650 (LAB1 <MAKE-LABEL>) (LAB2 <MAKE-LABEL>))
651 #DECL ((ITM1 ITM2) <OR VARTBL FIX> (RES) <OR ATOM VARTBL>)
652 <SET VAC <GET-AC DOUBLE T>>
653 <COND (<AND <TYPE? .ITM1 FIX>
656 <EMIT ,INST-MOVQ <MA-IMM .ITM1> <MA-REG .VAC>>)
658 <EMIT ,INST-CLRL <MA-REG <NEXT-AC .VAC>>>
659 <LOAD-CONSTANT .VAC .ITM1>
660 <GEN-BRANCH ,INST-BGEQ .LAB1 <>>
661 <EMIT ,INST-MCOML <MA-LIT 0> <MA-REG <NEXT-AC .VAC>>>
662 <EMIT-LABEL .LAB1 T>)
664 <EMIT ,INST-CLRL <MA-REG <NEXT-AC .VAC>>>
665 <LOAD-VAR .ITM1 JUST-VALUE T .VAC>
666 <GEN-BRANCH ,INST-BGEQ .LAB1 <>>
667 <EMIT ,INST-MCOML <MA-LIT 0> <MA-REG <NEXT-AC .VAC>>>
668 <EMIT-LABEL .LAB1 T>)>
670 <COND (<TYPE? .ITM2 FIX> <MA-IMM .ITM2>)
671 (<SET AC <VAR-VALUE-IN-AC? .ITM2>> <MA-REG .AC>)
672 (ELSE <VAR-VALUE-ADDRESS .ITM2>)> ; "Divisor"
673 <MA-REG .VAC> ; "Dividend"
674 <MA-REG .VAC> ; "Quotient"
675 <MA-REG <NEXT-AC .VAC>> ; "Remainder">
676 <EMIT ,INST-TSTL <MA-REG <NEXT-AC .VAC>>>
677 <GEN-BRANCH ,INST-BGEQ .LAB2 <>>
678 <EMIT ,INST-ADDL2 <COND (<TYPE? .ITM2 FIX> <MA-IMM .ITM2>)
680 (T <VAR-VALUE-ADDRESS .ITM2>)>
681 <MA-REG <NEXT-AC .VAC>>>
683 <DEST-DECL <NEXT-AC .VAC> .RES FIX>
686 <DEFINE ADDF-GEN (OP1 OP2 DEST "OPTIONAL" (HINT <>))
687 #DECL ((OP1 OP2) <OR FLOAT FIX VARTBL> (DEST) <OR VARTBL ATOM>)
688 <ARITH-GEN ,INST-ADDF2 ,INST-ADDF3 .OP1 .OP2 .DEST T ,+ FLOAT>>
690 <DEFINE SUBF-GEN (OP1 OP2 DEST "OPTIONAL" (HINT <>))
691 #DECL ((OP1 OP2) <OR FLOAT FIX VARTBL> (DEST) <OR VARTBL ATOM>)
692 <ARITH-GEN ,INST-SUBF2 ,INST-SUBF3 .OP1 .OP2 .DEST <> ,- FLOAT>>
694 <DEFINE MULF-GEN (OP1 OP2 DEST "OPTIONAL" (HINT <>))
695 #DECL ((OP1 OP2) <OR FLOAT FIX VARTBL> (DEST) <OR VARTBL ATOM>)
696 <ARITH-GEN ,INST-MULF2 ,INST-MULF3 .OP1 .OP2 .DEST T ,* FLOAT>>
698 <DEFINE DIVF-GEN (OP1 OP2 DEST "OPTIONAL" (HINT <>))
699 #DECL ((OP1 OP2) <OR FLOAT FIX VARTBL> (DEST) <OR VARTBL ATOM>)
700 <ARITH-GEN ,INST-DIVF2 ,INST-DIVF3 .OP1 .OP2 .DEST <> ,/ FLOAT>>
702 <DEFINE FIX-GEN (VAL1 RES "OPTIONAL" HINT "AUX" VAC)
703 #DECL ((VAL1) VARTBL (RES) <OR ATOM VARTBL>)
704 <COND (<AND <SET VAC <VAR-VALUE-IN-AC? .VAL1>> <AVAILABLE? .VAC>>
705 <EMIT ,INST-CVTFL <MA-REG .VAC> <MA-REG .VAC>>)
708 <COND (.VAC <MA-REG .VAC>)
709 (ELSE <VAR-VALUE-ADDRESS .VAL1>)>
710 <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>)>
711 <DEST-DECL .VAC .RES FIX>>
713 <DEFINE FLOAT-GEN (VAL1 RES "OPTIONAL" HINT "AUX" VAC)
714 #DECL ((VAL1) VARTBL (RES) <OR ATOM VARTBL>)
715 <COND (<AND <SET VAC <VAR-VALUE-IN-AC? .VAL1>> <AVAILABLE? .VAC>>
716 <EMIT ,INST-CVTLF <MA-REG .VAC> <MA-REG .VAC>>)
719 <COND (.VAC <MA-REG .VAC>)
720 (ELSE <VAR-VALUE-ADDRESS .VAL1>)>
721 <MA-REG <SET VAC <GET-AC PREF-VAL T>>>>)>
722 <DEST-DECL .VAC .RES FLOAT>>
724 <DEFINE RANDOM-GEN (VAL1 RES "OPTIONAL" HINT)
725 #DECL ((VAL1) VARTBL (RES) <OR ATOM VARTBL>)
726 <CALL-RTE ,IRANDOM!-MIMOP CALL .RES FLOAT .VAL1>>