Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/MLRISC/alpha/mltree/alpha.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/alpha/mltree/alpha.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 591 - (view) (download)

1 : monnier 409 (*
2 :     * This is a revamping of the Alpha32 instruction selection module
3 :     * using the new MLTREE and instruction representation. I've dropped
4 :     * the suffix 32 since we now support 64 bit datatypes.
5 :     *
6 :     * -- Allen
7 :     *
8 :     * Notes: places with optimizations are marked ***OPT***
9 :     *)
10 :    
11 :     functor Alpha
12 :     (structure AlphaInstr : ALPHAINSTR
13 :     structure AlphaMLTree : MLTREE
14 :     structure PseudoInstrs : ALPHA_PSEUDO_INSTR
15 : george 555 structure ExtensionComp : MLTREE_EXTENSION_COMP
16 :     where T = AlphaMLTree and I = AlphaInstr
17 : monnier 475 sharing AlphaMLTree.Region = AlphaInstr.Region
18 : george 545 sharing AlphaMLTree.LabelExp = AlphaInstr.LabelExp
19 : monnier 475 sharing PseudoInstrs.I = AlphaInstr
20 :     sharing PseudoInstrs.T = AlphaMLTree
21 : monnier 409
22 :     (* Cost of multiplication in cycles *)
23 :     val multCost : int ref
24 :    
25 :     (* Should we just use the native multiply by a constant? *)
26 :     val useMultByConst : bool ref
27 : george 545
28 :     (* Should we use SUD flags for floating point and generate DEFFREG?
29 :     * This should be set to false for C-like clients but true for SML/NJ.
30 :     *)
31 :     val SMLNJfloatingPoint : bool
32 : leunga 583
33 :     (* Should we use generate special byte/word load instructions
34 :     * like LDBU, LDWU, STB, STW.
35 :     *)
36 :     val byteWordLoadStores : bool ref
37 : monnier 409 ) : MLTREECOMP =
38 :     struct
39 :    
40 :     structure T = AlphaMLTree
41 : monnier 429 structure S = T.Stream
42 : monnier 409 structure R = AlphaMLTree.Region
43 :     structure I = AlphaInstr
44 :     structure C = AlphaInstr.C
45 : george 545 structure LE = I.LabelExp
46 : monnier 409 structure W32 = Word32
47 : monnier 429 structure P = PseudoInstrs
48 : george 545 structure A = MLRiscAnnotations
49 : monnier 409
50 :     (*********************************************************
51 :    
52 :     Trap Shadows, Floating Exceptions, and Denormalized
53 :     Numbers on the DEC Alpha
54 :    
55 :     Andrew W. Appel and Lal George
56 :     Nov 28, 1995
57 :    
58 :     See section 4.7.5.1 of the Alpha Architecture Reference Manual.
59 :    
60 :     The Alpha has imprecise exceptions, meaning that if a floating
61 :     point instruction raises an IEEE exception, the exception may
62 :     not interrupt the processor until several successive instructions have
63 :     completed. ML, on the other hand, may want a "precise" model
64 :     of floating point exceptions.
65 :    
66 :     Furthermore, the Alpha hardware does not support denormalized numbers
67 :     (for "gradual underflow"). Instead, underflow always rounds to zero.
68 :     However, each floating operation (add, mult, etc.) has a trapping
69 :     variant that will raise an exception (imprecisely, of course) on
70 :     underflow; in that case, the instruction will produce a zero result
71 :     AND an exception will occur. In fact, there are several variants
72 :     of each instruction; three variants of MULT are:
73 :    
74 :     MULT s1,s2,d truncate denormalized result to zero; no exception
75 :     MULT/U s1,s2,d truncate denormalized result to zero; raise UNDERFLOW
76 :     MULT/SU s1,s2,d software completion, producing denormalized result
77 :    
78 :     The hardware treats the MULT/U and MULT/SU instructions identically,
79 :     truncating a denormalized result to zero and raising the UNDERFLOW
80 :     exception. But the operating system, on an UNDERFLOW exception,
81 :     examines the faulting instruction to see if it's an /SU form, and if so,
82 :     recalculates s1*s2, puts the right answer in d, and continues,
83 :     all without invoking the user's signal handler.
84 :    
85 :     Because most machines compute with denormalized numbers in hardware,
86 :     to maximize portability of SML programs, we use the MULT/SU form.
87 :     (and ADD/SU, SUB/SU, etc.) But to use this form successfully,
88 :     certain rules have to be followed. Basically, d cannot be the same
89 :     register as s1 or s2, because the opsys needs to be able to
90 :     recalculate the operation using the original contents of s1 and s2,
91 :     and the MULT/SU instruction will overwrite d even if it traps.
92 :    
93 :     More generally, we may want to have a sequence of floating-point
94 :     instructions. The rules for such a sequence are:
95 :    
96 :     1. The sequence should end with a TRAPB (trap barrier) instruction.
97 :     (This could be relaxed somewhat, but certainly a TRAPB would
98 :     be a good idea sometime before the next branch instruction or
99 :     update of an ML reference variable, or any other ML side effect.)
100 :     2. No instruction in the sequence should destroy any operand of itself
101 :     or of any previous instruction in the sequence.
102 :     3. No two instructions in the sequence should write the same destination
103 :     register.
104 :    
105 :     We can achieve these conditions by the following trick in the
106 :     Alpha code generator. Each instruction in the sequence will write
107 :     to a different temporary; this is guaranteed by the translation from
108 :     ML-RISC. At the beginning of the sequence, we will put a special
109 :     pseudo-instruction (we call it DEFFREG) that "defines" the destination
110 :     register of the arithmetic instruction. If there are K arithmetic
111 :     instructions in the sequence, then we'll insert K DEFFREG instructions
112 :     all at the beginning of the sequence.
113 :     Then, each arithop will not only "define" its destination temporary
114 :     but will "use" it as well. When all these instructions are fed to
115 :     the liveness analyzer, the resulting interference graph will then
116 :     have inteference edges satisfying conditions 2 and 3 above.
117 :    
118 :     Of course, DEFFREG doesn't actually generate any code. In our model
119 :     of the Alpha, every instruction generates exactly 4 bytes of code
120 :     except the "span-dependent" ones. Therefore, we'll specify DEFFREG
121 :     as a span-dependent instruction whose minimum and maximum sizes are zero.
122 :    
123 :     At the moment, we do not group arithmetic operations into sequences;
124 :     that is, each arithop will be preceded by a single DEFFREG and
125 :     followed by a TRAPB. To avoid the cost of all those TRAPB's, we
126 :     should improve this when we have time. Warning: Don't put more
127 :     than 31 instructions in the sequence, because they're all required
128 :     to write to different destination registers!
129 :    
130 :     What about multiple traps? For example, suppose a sequence of
131 :     instructions produces an Overflow and a Divide-by-Zero exception?
132 :     ML would like to know only about the earliest trap, but the hardware
133 :     will report BOTH traps to the operating system. However, as long
134 :     as the rules above are followed (and the software-completion versions
135 :     of the arithmetic instructions are used), the operating system will
136 :     have enough information to know which instruction produced the
137 :     trap. It is very probable that the operating system will report ONLY
138 :     the earlier trap to the user process, but I'm not sure.
139 :    
140 :     For a hint about what the operating system is doing in its own
141 :     trap-handler (with software completion), see section 6.3.2 of
142 :     "OpenVMS Alpha Software" (Part II of the Alpha Architecture
143 :     Manual). This stuff should apply to Unix (OSF1) as well as VMS.
144 :    
145 :     ****************************************************************)
146 :    
147 :     fun error msg = MLRiscErrorMsg.error("Alpha",msg)
148 :    
149 : george 545 type instrStream = (I.instruction,C.regmap,C.cellset) T.stream
150 : george 555 type mltreeStream = (T.stm,C.regmap,T.mlrisc list) T.stream
151 : monnier 409
152 :     (*
153 :     * This module is used to simulate operations of non-standard widths.
154 :     *)
155 :     structure Gen = MLTreeGen(structure T = T
156 :     val intTy = 64
157 :     val naturalWidths = [32,64]
158 : monnier 429 datatype rep = SE | ZE | NEITHER
159 :     val rep = SE
160 : monnier 409 )
161 :    
162 :     val zeroR = C.GPReg 31
163 :     val zeroOpn = I.REGop zeroR
164 :    
165 :    
166 :     (*
167 :     * Specialize the modules for multiplication/division
168 :     * by constant optimizations.
169 :     *)
170 :     functor Multiply32 = MLTreeMult
171 :     (structure I = I
172 :     structure T = T
173 :    
174 :     val intTy = 32
175 :    
176 : monnier 429 type arg = {r1:C.cell,r2:C.cell,d:C.cell}
177 :     type argi = {r:C.cell,i:int,d:C.cell}
178 : monnier 409
179 :     fun mov{r,d} = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}
180 :     fun add{r1,r2,d} = I.OPERATE{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}
181 :     (*
182 :     * How to left shift by a constant (32bits)
183 :     *)
184 :     fun slli{r,i=1,d} = [I.OPERATE{oper=I.ADDL,ra=r,rb=I.REGop r,rc=d}]
185 :     | slli{r,i=2,d} = [I.OPERATE{oper=I.S4ADDL,ra=r,rb=zeroOpn,rc=d}]
186 :     | slli{r,i=3,d} = [I.OPERATE{oper=I.S8ADDL,ra=r,rb=zeroOpn,rc=d}]
187 :     | slli{r,i,d} =
188 :     let val tmp = C.newReg()
189 :     in [I.OPERATE{oper=I.SLL,ra=r,rb=I.IMMop i,rc=tmp},
190 :     I.OPERATE{oper=I.SGNXL,ra=tmp,rb=zeroOpn,rc=d}]
191 :     end
192 :    
193 :     (*
194 :     * How to right shift (unsigned) by a constant (32bits)
195 :     *)
196 :     fun srli{r,i,d} =
197 :     let val tmp = C.newReg()
198 :     in [I.OPERATE{oper=I.ZAP,ra=r,rb=I.IMMop 0xf0,rc=tmp},
199 :     I.OPERATE{oper=I.SRL,ra=tmp,rb=I.IMMop i,rc=d}]
200 :     end
201 :    
202 :     (*
203 :     * How to right shift (signed) by a constant (32bits)
204 :     *)
205 :     fun srai{r,i,d} =
206 :     let val tmp = C.newReg()
207 :     in [I.OPERATE{oper=I.SGNXL,ra=r,rb=zeroOpn,rc=tmp},
208 :     I.OPERATE{oper=I.SRA,ra=tmp,rb=I.IMMop i,rc=d}]
209 :     end
210 :     )
211 :    
212 :     functor Multiply64 = MLTreeMult
213 :     (structure I = I
214 :     structure T = T
215 :    
216 :     val intTy = 64
217 :    
218 : monnier 429 type arg = {r1:C.cell,r2:C.cell,d:C.cell}
219 :     type argi = {r:C.cell,i:int,d:C.cell}
220 : monnier 409
221 :     fun mov{r,d} = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}
222 :     fun add{r1,r2,d}= I.OPERATE{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}
223 :     fun slli{r,i,d} = [I.OPERATE{oper=I.SLL,ra=r,rb=I.IMMop i,rc=d}]
224 :     fun srli{r,i,d} = [I.OPERATE{oper=I.SRL,ra=r,rb=I.IMMop i,rc=d}]
225 :     fun srai{r,i,d} = [I.OPERATE{oper=I.SRA,ra=r,rb=I.IMMop i,rc=d}]
226 :     )
227 :    
228 :     (* signed, trapping version of multiply and divide *)
229 :     structure Mult32 = Multiply32
230 :     (val trapping = true
231 :     val multCost = multCost
232 :     fun addv{r1,r2,d} = [I.OPERATEV{oper=I.ADDLV,ra=r1,rb=I.REGop r2,rc=d}]
233 :     fun subv{r1,r2,d} = [I.OPERATEV{oper=I.SUBLV,ra=r1,rb=I.REGop r2,rc=d}]
234 :     val sh1addv = NONE
235 :     val sh2addv = NONE
236 :     val sh3addv = NONE
237 :     )
238 : monnier 429 (val signed = true)
239 : monnier 409
240 : monnier 429 (* non-trapping version of multiply and divide *)
241 :     functor Mul32 = Multiply32
242 : monnier 409 (val trapping = false
243 :     val multCost = multCost
244 :     fun addv{r1,r2,d} = [I.OPERATE{oper=I.ADDL,ra=r1,rb=I.REGop r2,rc=d}]
245 :     fun subv{r1,r2,d} = [I.OPERATE{oper=I.SUBL,ra=r1,rb=I.REGop r2,rc=d}]
246 :     val sh1addv = NONE
247 :     val sh2addv = SOME(fn {r1,r2,d} =>
248 :     [I.OPERATE{oper=I.S4ADDL,ra=r1,rb=I.REGop r2,rc=d}])
249 :     val sh3addv = SOME(fn {r1,r2,d} =>
250 :     [I.OPERATE{oper=I.S8ADDL,ra=r1,rb=I.REGop r2,rc=d}])
251 :     )
252 : monnier 429 structure Mulu32 = Mul32(val signed = false)
253 :     structure Muls32 = Mul32(val signed = true)
254 : monnier 409
255 :     (* signed, trapping version of multiply and divide *)
256 :     structure Mult64 = Multiply64
257 :     (val trapping = true
258 :     val multCost = multCost
259 :     fun addv{r1,r2,d} = [I.OPERATEV{oper=I.ADDQV,ra=r1,rb=I.REGop r2,rc=d}]
260 :     fun subv{r1,r2,d} = [I.OPERATEV{oper=I.SUBQV,ra=r1,rb=I.REGop r2,rc=d}]
261 :     val sh1addv = NONE
262 :     val sh2addv = NONE
263 :     val sh3addv = NONE
264 :     )
265 : monnier 429 (val signed = true)
266 : monnier 409
267 :     (* unsigned, non-trapping version of multiply and divide *)
268 : monnier 429 functor Mul64 = Multiply64
269 : monnier 409 (val trapping = false
270 :     val multCost = multCost
271 :     fun addv{r1,r2,d} = [I.OPERATE{oper=I.ADDQ,ra=r1,rb=I.REGop r2,rc=d}]
272 :     fun subv{r1,r2,d} = [I.OPERATE{oper=I.SUBQ,ra=r1,rb=I.REGop r2,rc=d}]
273 :     val sh1addv = NONE
274 :     val sh2addv = SOME(fn {r1,r2,d} =>
275 :     [I.OPERATE{oper=I.S4ADDQ,ra=r1,rb=I.REGop r2,rc=d}])
276 :     val sh3addv = SOME(fn {r1,r2,d} =>
277 :     [I.OPERATE{oper=I.S8ADDQ,ra=r1,rb=I.REGop r2,rc=d}])
278 :     )
279 : monnier 429 structure Mulu64 = Mul64(val signed = false)
280 :     structure Muls64 = Mul64(val signed = true)
281 : monnier 409
282 :     (*
283 :     * The main stuff
284 :     *)
285 :    
286 :     datatype times4or8 = TIMES1
287 :     | TIMES4
288 :     | TIMES8
289 :     datatype zeroOne = ZERO | ONE | OTHER
290 :     datatype commutative = COMMUTE | NOCOMMUTE
291 :    
292 : leunga 583 val zeroFR = C.FPReg 31
293 :     val zeroEA = I.Direct zeroR
294 :     val zeroT = T.LI 0
295 :     val trapb = [I.TRAPB]
296 :     val zeroImm = I.IMMop 0
297 :    
298 : monnier 409 fun selectInstructions
299 : george 545 (instrStream as
300 :     S.STREAM{emit,beginCluster,endCluster,
301 : monnier 429 defineLabel,entryLabel,pseudoOp,annotation,
302 : monnier 469 exitBlock,phi,alias,comment,...}) =
303 : monnier 409 let
304 :     infix || && << >> ~>>
305 :    
306 :     val op || = W32.orb
307 :     val op && = W32.andb
308 :     val op << = W32.<<
309 :     val op >> = W32.>>
310 :     val op ~>> = W32.~>>
311 :    
312 :     val itow = Word.fromInt
313 :     val wtoi = Word.toIntX
314 :    
315 :     val newReg = C.newReg
316 :     val newFreg = C.newFreg
317 :    
318 :     (* Choose the appropriate rounding mode to generate.
319 :     * This stuff is used to support the alpha32x SML/NJ backend.
320 : monnier 429 *
321 :     *
322 :     * Floating point rounding mode.
323 :     * When this is set to true, we use the /SU rounding mode
324 :     * (chopped towards zero) for floating point arithmetic.
325 :     * This flag is only used to support the old alpha32x backend.
326 :     *
327 :     * Otherwise, we use /SUD. This is the default for SML/NJ.
328 :     *
329 : monnier 409 *)
330 : george 545 val (ADDTX,SUBTX,MULTX,DIVTX) =
331 :     (I.ADDTSUD,I.SUBTSUD,I.MULTSUD,I.DIVTSUD)
332 :     val (ADDSX,SUBSX,MULSX,DIVSX) =
333 :     (I.ADDSSUD,I.SUBSSUD,I.MULSSUD,I.DIVSSUD)
334 : monnier 409
335 :     fun mark'(i,[]) = i
336 :     | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)
337 :     fun mark(i,an) = emit(mark'(i,an))
338 :    
339 :     (* Fit within 16 bits? *)
340 :     fun literal16 n = ~32768 <= n andalso n < 32768
341 :     fun literal16w w =
342 :     let val hi = W32.~>>(w,0wx16)
343 :     in hi = 0w0 orelse (W32.notb hi) = 0w0 end
344 :    
345 :     (* emit an LDA instruction; return the register that holds the value *)
346 :     fun lda(base,I.IMMop 0) = base
347 :     | lda(base,offset) =
348 :     let val r = newReg()
349 :     in emit(I.LDA{r=r, b=base, d=offset}); r end
350 :    
351 :     (* emit load immed *)
352 :     fun loadImmed(n, base, rd, an) =
353 : monnier 469 if n =0 then
354 :     move(base, rd, an)
355 :     else if ~32768 <= n andalso n < 32768 then
356 : monnier 409 mark(I.LDA{r=rd, b=base, d=I.IMMop n},an)
357 :     else
358 :     let val w = itow n
359 :     val hi = Word.~>>(w, 0w16)
360 :     val lo = Word.andb(w, 0w65535)
361 :     val (hi', lo') =
362 :     if lo < 0w32768 then (hi, lo) else (hi+0w1, lo-0w65536)
363 :     val t = lda(base,I.IMMop(wtoi lo'))
364 :     in mark(I.LDAH{r=rd, b=t, d=I.IMMop(wtoi hi')},an)
365 :     end
366 :    
367 :     (* loadImmed32 is used to load int32 and word32 constants.
368 :     * In either case we sign extend the 32-bit value. This is compatible
369 :     * with LDL which sign extends a 32-bit valued memory location.
370 :     *)
371 : monnier 469 and loadImmed32(0w0, base, rd, an) =
372 :     move(base, rd, an)
373 : monnier 409 | loadImmed32(n, base, rd, an) = let
374 :     val low = W32.andb(n, 0w65535) (* unsigned (0 .. 65535) *)
375 :     val high = W32.~>>(n, 0w16) (* signed (~32768 .. 32768] *)
376 :     fun loadimmed(0, high) =
377 :     mark(I.LDAH{r=rd, b=base, d=I.IMMop(high)},an)
378 :     | loadimmed(low, 0) =
379 :     mark(I.LDA{r=rd, b=base, d=I.IMMop(low)},an)
380 :     | loadimmed(low, high) =
381 :     (emit(I.LDA{r=rd, b=base, d=I.IMMop(low)});
382 :     mark(I.LDAH{r=rd, b=rd, d=I.IMMop(high)},an))
383 :     in
384 :     if W32.<(low, 0w32768) then
385 :     loadimmed(W32.toInt low, W32.toIntX high)
386 :     else let (* low = (32768 .. 65535) *)
387 :     val lowsgn = W32.-(low, 0w65536) (* signed (~1 .. ~32768) *)
388 :     val highsgn = W32.+(high, 0w1) (* (~32768 .. 32768) *)
389 :     val ilow = W32.toIntX lowsgn
390 :     val ihigh = W32.toIntX highsgn
391 :     in
392 :     if ihigh <> 32768 then loadimmed(ilow, ihigh)
393 :     else
394 :     let val tmpR1 = newReg()
395 :     val tmpR2 = newReg()
396 : monnier 469 val tmpR3 = newReg()
397 : monnier 409 in
398 :     (* you gotta do what you gotta do! *)
399 : monnier 469 emit(I.LDA{r=tmpR3, b=base, d=I.IMMop(ilow)});
400 :     emit(I.OPERATE{oper=I.ADDQ, ra=zeroR, rb=I.IMMop 1, rc=tmpR1});
401 : monnier 409 emit(I.OPERATE{oper=I.SLL, ra=tmpR1, rb=I.IMMop 31, rc=tmpR2});
402 : monnier 469 mark(I.OPERATE{oper=I.ADDQ, ra=tmpR2, rb=I.REGop tmpR3,
403 :     rc=rd},an)
404 : monnier 409 end
405 :     end
406 :     end
407 :    
408 :     (* emit load immed *)
409 : george 545 and loadConst(c,d,an) = mark(I.LDA{r=d,b=zeroR,d=I.LABop(LE.CONST c)},an)
410 : monnier 409
411 :     (* emit load label *)
412 : monnier 469 and loadLabel(l,d,an) = mark(I.LDA{r=d,b=zeroR,d=I.LABop l},an)
413 : monnier 409
414 :     (* emit a copy *)
415 : monnier 469 and copy(dst,src,an) =
416 : monnier 409 mark(I.COPY{dst=dst,src=src,impl=ref NONE,
417 :     tmp=case dst of
418 :     [_] => NONE | _ => SOME(I.Direct(newReg()))},an)
419 :    
420 :     (* emit a floating point copy *)
421 : monnier 469 and fcopy(dst,src,an) =
422 : monnier 409 mark(I.FCOPY{dst=dst,src=src,impl=ref NONE,
423 :     tmp=case dst of
424 :     [_] => NONE | _ => SOME(I.FDirect(newFreg()))},an)
425 :    
426 : monnier 469 and move(s,d,an) =
427 : monnier 409 if s = d orelse d = zeroR then () else
428 :     mark(I.COPY{dst=[d],src=[s],impl=ref NONE,tmp=NONE},an)
429 :    
430 : monnier 469 and fmove(s,d,an) =
431 : monnier 409 if s = d orelse d = zeroFR then () else
432 :     mark(I.FCOPY{dst=[d],src=[s],impl=ref NONE,tmp=NONE},an)
433 :    
434 :     (* emit an sign extension op *)
435 : monnier 469 and signExt32(r,d) =
436 : monnier 409 emit(I.OPERATE{oper=I.SGNXL,ra=r,rb=zeroOpn,rc=d})
437 :    
438 :     (* emit an commutative arithmetic op *)
439 : monnier 469 and commArith(opcode,a,b,d,an) =
440 : monnier 409 case (opn a,opn b) of
441 :     (I.REGop r,i) => mark(I.OPERATE{oper=opcode,ra=r,rb=i,rc=d},an)
442 :     | (i,I.REGop r) => mark(I.OPERATE{oper=opcode,ra=r,rb=i,rc=d},an)
443 :     | (r,i) => mark(I.OPERATE{oper=opcode,ra=reduceOpn r,rb=i,rc=d},an)
444 :    
445 :     (* emit an arithmetic op *)
446 :     and arith(opcode,a,b,d,an) =
447 :     mark(I.OPERATE{oper=opcode,ra=expr a,rb=opn b,rc=d},an)
448 :     and arith'(opcode,a,b,d,an) =
449 :     let val rb = opn b
450 :     val ra = expr a
451 :     in mark(I.OPERATE{oper=opcode,ra=ra,rb=rb,rc=d},an) end
452 :    
453 :     (* emit a trapping commutative arithmetic op *)
454 :     and commArithTrap(opcode,a,b,d,an) =
455 :     (case (opn a,opn b) of
456 :     (I.REGop r,i) => mark(I.OPERATEV{oper=opcode,ra=r,rb=i,rc=d},an)
457 :     | (i,I.REGop r) => mark(I.OPERATEV{oper=opcode,ra=r,rb=i,rc=d},an)
458 :     | (r,i) => mark(I.OPERATEV{oper=opcode,ra=reduceOpn r,rb=i,rc=d},an);
459 :     emit(I.TRAPB)
460 :     )
461 :    
462 :     (* emit a trapping arithmetic op *)
463 :     and arithTrap(opcode,a,b,d,an) =
464 :     (mark(I.OPERATEV{oper=opcode,ra=expr a,rb=opn b,rc=d},an);
465 :     emit(I.TRAPB)
466 :     )
467 :    
468 :     (* convert an operand into a register *)
469 :     and reduceOpn(I.REGop r) = r
470 :     | reduceOpn(I.IMMop 0) = zeroR
471 :     | reduceOpn opn =
472 :     let val d = newReg()
473 :     in emit(I.OPERATE{oper=I.BIS,ra=zeroR,rb=opn,rc=d}); d end
474 :    
475 :     (* convert an expression into an operand *)
476 :     and opn(T.REG(_,r)) = I.REGop r
477 :     | opn(e as T.LI n) =
478 :     if n <= 255 andalso n >= 0 then I.IMMop n
479 :     else let val tmpR = newReg()
480 :     in loadImmed(n,zeroR,tmpR,[]); I.REGop tmpR end
481 :     | opn(e as T.LI32 w) =
482 :     if w <= 0w255 then I.IMMop(W32.toIntX w)
483 :     else let val tmpR = newReg()
484 :     in loadImmed32(w,zeroR,tmpR,[]); I.REGop tmpR end
485 : george 545 | opn(T.CONST c) = I.LABop(LE.CONST c)
486 : monnier 409 | opn e = I.REGop(expr e)
487 :    
488 : leunga 583 (* compute base+displacement from an expression
489 :     *)
490 : monnier 409 and addr exp =
491 : leunga 583 let fun toLexp(I.IMMop i) = LE.INT i
492 :     | toLexp(I.LABop le) = le
493 :     | toLexp _ = error "addr.toLexp"
494 : monnier 409
495 : leunga 583 fun add(n,I.IMMop m) = I.IMMop(n+m)
496 :     | add(n,I.LABop le) = I.LABop(LE.PLUS(LE.INT n,le))
497 :     | add(n,_) = error "addr.add"
498 :     fun add32(n,disp) = add(W32.toIntX n,disp) (* overflow XXX *)
499 :     fun addC(c,I.IMMop 0) = I.LABop(LE.CONST c)
500 :     | addC(c,disp) = I.LABop(LE.PLUS(LE.CONST c,toLexp disp))
501 :     fun addL(l,I.IMMop 0) = I.LABop l
502 :     | addL(l,disp) = I.LABop(LE.PLUS(l,toLexp disp))
503 :     fun sub(n,I.IMMop m) = I.IMMop(m-n)
504 :     | sub(n,I.LABop le) = I.LABop(LE.MINUS(le,LE.INT n))
505 :     | sub(n,_) = error "addr.sub"
506 :     fun sub32(n,disp) = sub(W32.toIntX n,disp)
507 :     fun subC(c,disp) = I.LABop(LE.MINUS(toLexp disp, LE.CONST c))
508 :     fun subL(l,disp) = I.LABop(LE.MINUS(toLexp disp, l))
509 :    
510 :     (* Should really take into account of the address width XXX *)
511 :     fun fold(T.ADD(_,e,T.LI n),disp) = fold(e, add(n,disp))
512 :     | fold(T.ADD(_,e,T.LI32 n),disp) = fold(e, add32(n,disp))
513 :     | fold(T.ADD(_,e,T.CONST c),disp) = fold(e, addC(c,disp))
514 :     | fold(T.ADD(_,e,T.LABEL l),disp) = fold(e, addL(l,disp))
515 :     | fold(T.ADD(_,T.LI n,e),disp) = fold(e, add(n,disp))
516 :     | fold(T.ADD(_,T.LI32 n, e),disp) = fold(e, add32(n,disp))
517 :     | fold(T.ADD(_,T.CONST n, e),disp) = fold(e, addC(n,disp))
518 :     | fold(T.ADD(_,T.LABEL l, e),disp) = fold(e, addL(l,disp))
519 :     | fold(T.SUB(_,e,T.LI n),disp) = fold(e, sub(n,disp))
520 :     | fold(T.SUB(_,e,T.LI32 n),disp) = fold(e, sub32(n,disp))
521 :     | fold(T.SUB(_,e,T.CONST n),disp) = fold(e, subC(n,disp))
522 :     | fold(T.SUB(_,e,T.LABEL l),disp) = fold(e, subL(l,disp))
523 :     | fold(e,disp) = (expr e,disp)
524 :    
525 :     in makeEA(fold(exp, zeroImm))
526 :     end
527 :    
528 : monnier 409 (* compute base+displacement+small offset *)
529 :     and offset(base,disp as I.IMMop n,off) =
530 :     let val n' = n+off
531 :     in if literal16 n' then (base,I.IMMop n')
532 :     else
533 :     let val tmp = newReg()
534 :     in emit(I.OPERATE{oper=I.ADDQ,ra=base,rb=disp,rc=tmp});
535 :     (tmp,I.IMMop off)
536 :     end
537 :     end
538 : leunga 583 | offset(base,disp as I.LABop le,off) =
539 :     (base, I.LABop(LE.PLUS(le,LE.INT off)))
540 : monnier 409 | offset(base,disp,off) =
541 :     let val tmp = newReg()
542 :     in emit(I.OPERATE{oper=I.ADDQ,ra=base,rb=disp,rc=tmp});
543 :     (tmp,I.IMMop off)
544 :     end
545 :    
546 : leunga 583 (* check if base offset fits within the field *)
547 :     and makeEA(base, off as I.IMMop offset) =
548 :     if ~32768 <= offset andalso offset <= 32767
549 :     then (base, off)
550 : monnier 409 else
551 :     let val tmpR = newReg()
552 :     (* unsigned low 16 bits *)
553 :     val low = wtoi(Word.andb(itow offset, 0wxffff))
554 :     val high = offset div 65536
555 :     val (lowsgn, highsgn) = (* Sign-extend *)
556 :     if low <= 32767 then (low, high) else (low -65536, high+1)
557 :     in
558 :     (emit(I.LDAH{r=tmpR, b=base, d=I.IMMop highsgn});
559 :     (tmpR, I.IMMop lowsgn))
560 :     end
561 : leunga 583 | makeEA(base, offset) = (base, offset)
562 : monnier 409
563 :     (* look for multiply by 4 and 8 of the given type *)
564 :     and times4or8(ty,e) =
565 :     let fun f(t,a,n) = if t = ty then
566 :     if n = 4 then (TIMES4,a)
567 :     else if n = 8 then (TIMES8,a)
568 :     else (TIMES1,e)
569 :     else (TIMES1,e)
570 :     fun g(t,a,n) = if t = ty then
571 :     if n = 0w4 then (TIMES4,a)
572 :     else if n = 0w8 then (TIMES8,a)
573 :     else (TIMES1,e)
574 :     else (TIMES1,e)
575 :     fun u(t,a,n) = if t = ty then
576 :     if n = 2 then (TIMES4,a)
577 :     else if n = 3 then (TIMES8,a)
578 :     else (TIMES1,e)
579 :     else (TIMES1,e)
580 :     fun v(t,a,n) = if t = ty then
581 :     if n = 0w2 then (TIMES4,a)
582 :     else if n = 0w3 then (TIMES8,a)
583 :     else (TIMES1,e)
584 :     else (TIMES1,e)
585 :     in case e of
586 :     T.MULU(t,a,T.LI n) => f(t,a,n)
587 :     | T.MULU(t,a,T.LI32 n) => g(t,a,n)
588 :     | T.MULS(t,T.LI n,a) => f(t,a,n)
589 :     | T.MULS(t,T.LI32 n,a) => g(t,a,n)
590 :     | T.SLL(t,a,T.LI n) => u(t,a,n)
591 :     | T.SLL(t,a,T.LI32 n) => v(t,a,n)
592 :     | _ => (TIMES1,e)
593 :     end
594 :    
595 :     (* generate an add instruction
596 :     * ***OPT*** look for multiply by 4 and 8 and use the S4ADD and S8ADD
597 :     * forms.
598 :     *)
599 :     and plus(ty,add,s4add,s8add,a,b,d,an) =
600 :     (case times4or8(ty,a) of
601 :     (TIMES4,a) => arith(s4add,a,b,d,an)
602 :     | (TIMES8,a) => arith(s8add,a,b,d,an)
603 :     | _ =>
604 :     case times4or8(ty,b) of
605 :     (TIMES4,b) => arith'(s4add,b,a,d,an)
606 :     | (TIMES8,b) => arith'(s8add,b,a,d,an)
607 :     | _ => commArith(add,a,b,d,an)
608 :     )
609 :    
610 :     (* generate a subtract instruction
611 :     * ***OPT*** look for multiply by 4 and 8
612 :     *)
613 :     and minus(ty,sub,s4sub,s8sub,a,b,d,an) =
614 :     (case times4or8(ty,a) of
615 :     (TIMES4,a) => arith(s4sub,a,b,d,an)
616 :     | (TIMES8,a) => arith(s8sub,a,b,d,an)
617 :     | _ =>
618 : monnier 429 if ty = 64 then
619 : monnier 409 (case b of
620 :     (* use LDA to handle subtraction when possible
621 :     * Note: this may have sign extension problems later.
622 :     *)
623 :     T.LI i => (loadImmed(~i,expr a,d,an) handle Overflow =>
624 :     arith(sub,a,b,d,an))
625 :     | _ => arith(sub,a,b,d,an)
626 : monnier 429 ) else arith(sub,a,b,d,an)
627 : monnier 409 )
628 :    
629 :     (* look for special constants *)
630 :     and wordOpn(T.LI n) = SOME(W32.fromInt n)
631 :     | wordOpn(T.LI32 w) = SOME w
632 :     | wordOpn e = NONE
633 :    
634 : monnier 429 (* look for special byte mask constants
635 :     * IMPORTANT: we must ALWAYS keep the sign bit!
636 :     *)
637 :     and byteMask(_,SOME 0wx00000000) = 0xff
638 :     | byteMask(_,SOME 0wx000000ff) = 0xfe
639 :     | byteMask(_,SOME 0wx0000ff00) = 0xfd
640 :     | byteMask(_,SOME 0wx0000ffff) = 0xfc
641 :     | byteMask(_,SOME 0wx00ff0000) = 0xfb
642 :     | byteMask(_,SOME 0wx00ff00ff) = 0xfa
643 :     | byteMask(_,SOME 0wx00ffff00) = 0xf9
644 :     | byteMask(_,SOME 0wx00ffffff) = 0xf8
645 :     | byteMask(ty,SOME 0wxff000000) = if ty = 64 then 0xf7 else 0x07
646 :     | byteMask(ty,SOME 0wxff0000ff) = if ty = 64 then 0xf6 else 0x06
647 :     | byteMask(ty,SOME 0wxff00ff00) = if ty = 64 then 0xf5 else 0x05
648 :     | byteMask(ty,SOME 0wxff00ffff) = if ty = 64 then 0xf4 else 0x04
649 :     | byteMask(ty,SOME 0wxffff0000) = if ty = 64 then 0xf3 else 0x03
650 :     | byteMask(ty,SOME 0wxffff00ff) = if ty = 64 then 0xf2 else 0x02
651 :     | byteMask(ty,SOME 0wxffffff00) = if ty = 64 then 0xf1 else 0x01
652 :     | byteMask(ty,SOME 0wxffffffff) = if ty = 64 then 0xf0 else 0x00
653 :     | byteMask _ = ~1
654 : monnier 409
655 :     (* generate an and instruction
656 :     * look for special masks.
657 :     *)
658 :     and andb(ty,a,b,d,an) =
659 :     case byteMask(ty,wordOpn a) of
660 : monnier 429 ~1 => (case byteMask(ty,wordOpn b) of
661 :     ~1 => commArith(I.AND,a,b,d,an)
662 :     | mask => arith(I.ZAP,a,T.LI mask,d,an)
663 :     )
664 :     | mask => arith(I.ZAP,b,T.LI mask,d,an)
665 : monnier 409
666 :     (* generate sll/sra/srl *)
667 :     and sll32(a,b,d,an) =
668 :     case wordOpn b of
669 :     SOME 0w0 => doExpr(a,d,an)
670 :     | SOME 0w1 =>
671 :     let val r = T.REG(32,expr a) in arith(I.ADDL,r,r,d,an) end
672 :     | SOME 0w2 => arith(I.S4ADDL,a,zeroT,d,an)
673 :     | SOME 0w3 => arith(I.S8ADDL,a,zeroT,d,an)
674 :     | _ => let val t = newReg()
675 :     in arith(I.SLL,a,b,t,an);
676 :     signExt32(t,d)
677 :     end
678 :    
679 :     and sll64(a,b,d,an) =
680 :     case wordOpn b of
681 :     SOME 0w0 => doExpr(a,d,an)
682 :     | SOME 0w1 =>
683 :     let val r = T.REG(64,expr a) in arith(I.ADDQ,r,r,d,an) end
684 :     | SOME 0w2 => arith(I.S4ADDQ,a,zeroT,d,an)
685 :     | SOME 0w3 => arith(I.S8ADDQ,a,zeroT,d,an)
686 :     | _ => arith(I.SLL,a,b,d,an)
687 :    
688 :     and sra32(a,b,d,an) =
689 :     let val ra = expr a
690 :     val rb = opn b
691 :     val t = newReg()
692 : monnier 475 in (* On the alpha, all 32 bit values are already sign extended.
693 :     * So no sign extension is necessary.
694 :     * signExt32(ra,t);
695 :     * mark(I.OPERATE{oper=I.SRA,ra=t,rb=rb,rc=d},an)
696 :     *)
697 :     mark(I.OPERATE{oper=I.SRA,ra=ra,rb=rb,rc=d},an)
698 : monnier 409 end
699 :    
700 :     and sra64(a,b,d,an) =
701 :     mark(I.OPERATE{oper=I.SRA,ra=expr a,rb=opn b,rc=d},an)
702 :    
703 :     and srl32(a,b,d,an) =
704 :     let val ra = expr a
705 :     val rb = opn b
706 :     val t = newReg()
707 :     in emit(I.OPERATE{oper=I.ZAP,ra=ra,rb=I.IMMop 0xf0,rc=t});
708 :     mark(I.OPERATE{oper=I.SRL,ra=t,rb=rb,rc=d},an)
709 :     end
710 :    
711 :     and srl64(a,b,d,an) =
712 :     mark(I.OPERATE{oper=I.SRL,ra=expr a,rb=opn b,rc=d},an)
713 :    
714 :     (*
715 :     * Generic multiply.
716 :     * We first try to use the multiply by constant heuristic
717 :     *)
718 :     and multiply(ty,gen,genConst,e1,e2,rd,trapb,an) =
719 :     let fun nonconst(e1,e2) =
720 :     let val instr =
721 :     case (opn e1,opn e2) of
722 :     (i,I.REGop r) => gen{ra=r,rb=i,rc=rd}
723 :     | (I.REGop r,i) => gen{ra=r,rb=i,rc=rd}
724 :     | (r,i) => gen{ra=reduceOpn r,rb=i,rc=rd}
725 :     in mark'(instr,an)::trapb end
726 :     fun const(e,i) =
727 :     let val r = expr e
728 :     in if !useMultByConst andalso i >= 0 andalso i < 256 then
729 :     mark'(gen{ra=r,rb=I.IMMop i,rc=rd},an)::trapb
730 :     else
731 :     (genConst{r=r,i=i,d=rd}@trapb
732 :     handle _ => nonconst(T.REG(ty,r),T.LI i))
733 :     end
734 :     fun constw(e,i) = const(e,Word32.toInt i)
735 :     handle _ => nonconst(e,T.LI32 i)
736 :     val instrs =
737 :     case (e1,e2) of
738 :     (e1,T.LI i) => const(e1,i)
739 :     | (e1,T.LI32 i) => constw(e1,i)
740 :     | (T.LI i,e2) => const(e2,i)
741 :     | (T.LI32 i,e2) => constw(e2,i)
742 :     | _ => nonconst(e1,e2)
743 :     in app emit instrs
744 :     end
745 :    
746 :     (* Round r towards zero.
747 :     * I generate the following sequence of code, which should get
748 :     * mapped into conditional moves.
749 :     *
750 :     * d <- r + i;
751 :     * d <- if (r > 0) then r else d
752 :     *)
753 : george 545 (*
754 : monnier 409 and roundToZero{ty,r,i,d} =
755 :     (doStmt(T.MV(ty,d,T.ADD(ty,T.REG(ty,r),T.LI i)));
756 :     doStmt(T.MV(ty,d,T.COND(ty,T.CMP(ty,T.GE,T.REG(ty,r),T.LI 0),
757 :     T.REG(ty,r),T.REG(ty,d))))
758 :     )
759 : george 545 *)
760 : monnier 409
761 :     (*
762 :     * Generic division.
763 :     * We first try to use the division by constant heuristic
764 :     *)
765 :     and divide(ty,pseudo,genDiv,e1,e2,rd,an) =
766 :     let fun nonconst(e1,e2) =
767 :     pseudo({ra=expr e1,rb=opn e2,rc=rd},reduceOpn)
768 :    
769 :     fun const(e,i) =
770 :     let val r = expr e
771 : george 545 in genDiv{mode=T.TO_ZERO,stm=doStmt}
772 : monnier 409 {r=r,i=i,d=rd}
773 :     handle _ => nonconst(T.REG(ty,r),T.LI i)
774 :     end
775 :     fun constw(e,i) = const(e,Word32.toInt i)
776 :     handle _ => nonconst(e,T.LI32 i)
777 :     val instrs =
778 :     case e2 of
779 :     T.LI i => const(e1,i)
780 :     | T.LI32 i => constw(e1,i)
781 :     | _ => nonconst(e1,e2)
782 :     in app emit instrs
783 :     end
784 :    
785 :    
786 :     (*
787 :     and multTrap(MULV,ADD,ADDV,e1,e2,rd,an) = (* signed multiply and trap *)
788 :     let val ADD = fn {ra,rb,rc} => I.OPERATE{oper=ADD,ra=ra,rb=rb,rc=rc}
789 :     val ADDV = fn {ra,rb,rc} => I.OPERATEV{oper=ADDV,ra=ra,rb=rb,rc=rc}
790 :     val MULV = fn {ra,rb,rc} => I.OPERATEV{oper=MULV,ra=ra,rb=rb,rc=rc}
791 :     in multiply(MULV,ADD,ADDV,e1,e2,rd,an);
792 :     emit(I.TRAPB)
793 :     end
794 :    
795 :     and mulu(MUL,ADD,e1,e2,rd,an) = (* unsigned multiply *)
796 :     let val ADD = fn {ra,rb,rc} => I.OPERATE{oper=ADD,ra=ra,rb=rb,rc=rc}
797 :     val MUL = fn {ra,rb,rc} => I.OPERATE{oper=MUL,ra=ra,rb=rb,rc=rc}
798 :     in multiply(MUL,ADD,ADD,e1,e2,rd,an)
799 :     end
800 :    
801 :     (* Multiplication *)
802 :     and multiply(MULV, ADD, ADDV, e1, e2, rd, an) =
803 :     let val reg = expr e1
804 :     val opn = opn e2
805 :     fun emitMulvImmed (reg, 0, rd) =
806 :     emit(I.LDA{r=rd, b=zeroR, d=I.IMMop 0})
807 :     | emitMulvImmed (reg, 1, rd) =
808 :     emit(ADD{ra=reg, rb=zeroOpn, rc=rd})
809 :     | emitMulvImmed (reg, multiplier, rd) =
810 :     let fun log2 0w1 = 0 | log2 n = 1 + (log2 (Word.>> (n, 0w1)))
811 :     fun exp2 n = Word.<<(0w1, n)
812 :     fun bitIsSet (x,n) = Word.andb(x,exp2 n) <> 0w0
813 :     fun loop (~1) = ()
814 :     | loop n =
815 :     (if bitIsSet(itow multiplier, itow n) then
816 :     emit(ADDV{ra=reg,rb=I.REGop rd,rc=rd})
817 :     else ();
818 :     if n>0 then
819 :     emit(ADDV{ra=rd,rb=I.REGop rd,rc=rd})
820 :     else ();
821 :     loop (n-1))
822 :     in emit(ADDV{ra=reg, rb=I.REGop reg, rc=rd});
823 :     loop ((log2 (itow multiplier)) - 1)
824 :     end
825 :     in case opn of
826 :     (I.IMMop multiplier) => emitMulvImmed (reg, multiplier, rd)
827 :     | _ => mark(MULV{ra=reg, rb=opn, rc=rd},an)
828 :     (*esac*)
829 :     end
830 :     *)
831 :    
832 :     (* generate pseudo instruction *)
833 :     and pseudo(instr,e1,e2,rc) =
834 :     app emit (instr({ra=expr e1,rb=opn e2,rc=rc}, reduceOpn))
835 :    
836 :     (* generate a load *)
837 :     and load(ldOp,ea,d,mem,an) =
838 :     let val (base,disp) = addr ea
839 :     in mark(I.LOAD{ldOp=ldOp,r=d,b=base,d=disp,mem=mem},an) end
840 :    
841 : leunga 583 (* generate a load and sign extension *)
842 :     and loadSigned(ldOp,bits,ea,rd,mem,an) =
843 :     let val t1 = newReg()
844 :     val t2 = newReg()
845 :     val shift = I.IMMop(64-bits)
846 :     in load(ldOp,ea,t1,mem,an);
847 :     emit(I.OPERATE{oper=I.SLL, ra=t1, rb=shift, rc=t2});
848 :     emit(I.OPERATE{oper=I.SRA, ra=t2, rb=shift, rc=rd})
849 :     end
850 :    
851 : monnier 409 (* generate a load with zero extension *)
852 :     and loadZext(ea,rd,mem,EXT,an) =
853 :     let val (b, d) = addr ea
854 :     val t1 = newReg()
855 :     val _ = mark(I.LOAD{ldOp=I.LDQ_U, r=t1, b=b, d=d, mem=mem},an);
856 :     val t2 = lda(b,d)
857 :     in emit(I.OPERATE{oper=EXT, ra=t1, rb=I.REGop t2, rc=rd}) end
858 :    
859 :     (* generate a load with sign extension *)
860 :     and loadSext(ea,rd,mem,off,EXT,shift,an) =
861 :     let val (b, d) = addr ea
862 :     val (b',d') = offset(b,d,off)
863 :     val t1 = newReg()
864 :     val t2 = newReg()
865 :     val t3 = newReg()
866 :     in mark(I.LOAD{ldOp=I.LDQ_U, r=t1, b=b, d=d, mem=mem},an);
867 :     emit(I.LDA{r=t2, b=b', d=d'});
868 :     emit(I.OPERATE{oper=EXT, ra=t1, rb=I.REGop t2, rc=t3});
869 :     emit(I.OPERATE{oper=I.SRA, ra=t3, rb=I.IMMop shift, rc=rd})
870 :     end
871 :    
872 :     (* generate a load byte with zero extension (page 4-48) *)
873 : leunga 583 and load8(ea,rd,mem,an) =
874 :     if !byteWordLoadStores then load(I.LDBU,ea,rd,mem,an)
875 :     else loadZext(ea,rd,mem,I.EXTBL,an)
876 : monnier 409
877 :     (* generate a load byte with sign extension (page 4-48) *)
878 : leunga 583 and load8s(ea,rd,mem,an) =
879 : leunga 585 if !byteWordLoadStores then load(I.LDB,ea,rd,mem,an)
880 : leunga 583 else loadSext(ea,rd,mem,1,I.EXTQH,56,an)
881 : monnier 409
882 :     (* generate a load 16 bit *)
883 : leunga 583 and load16(ea,rd,mem,an) =
884 :     if !byteWordLoadStores then load(I.LDWU,ea,rd,mem,an)
885 :     else loadZext(ea,rd,mem,I.EXTWL,an)
886 : monnier 409
887 :     (* generate a load 16 bit with sign extension *)
888 : leunga 583 and load16s(ea,rd,mem,an) =
889 : leunga 585 if !byteWordLoadStores then load(I.LDW,ea,rd,mem,an)
890 : leunga 583 else loadSext(ea,rd,mem,2,I.EXTQH,48,an)
891 : monnier 409
892 :     (* generate a load 32 bit with sign extension *)
893 :     and load32s(ea,rd,mem,an) = load(I.LDL,ea,rd,mem,an)
894 :    
895 :     (* generate a floating point load *)
896 :     and fload(ldOp,ea,d,mem,an) =
897 :     let val (base,disp) = addr ea
898 :     in mark(I.FLOAD{ldOp=ldOp,r=d,b=base,d=disp,mem=mem},an) end
899 :    
900 :     (* generate a store *)
901 :     and store(stOp,ea,data,mem,an) =
902 :     let val (base,disp) = addr ea
903 :     in mark(I.STORE{stOp=stOp,r=expr data,b=base,d=disp,mem=mem},an) end
904 :    
905 :     (* generate an store8 or store16 *)
906 :     and storeUnaligned(ea,data,mem,INS,MSK,an) =
907 :     let val (base,disp) = addr ea
908 :     val data = expr data
909 :     val t1 = newReg()
910 :     val t3 = newReg()
911 :     val t4 = newReg()
912 :     val t5 = newReg()
913 :     val _ = emit(I.LOAD{ldOp=I.LDQ_U, r=t1, b=base, d=disp, mem=mem})
914 :     val t2 = lda(base,disp)
915 :     in emit(I.OPERATE{oper=INS, ra=data, rb=I.REGop(t2), rc=t3});
916 :     emit(I.OPERATE{oper=MSK, ra=t1, rb=I.REGop(t2), rc=t4});
917 :     emit(I.OPERATE{oper=I.BIS, ra=t4, rb=I.REGop(t3), rc=t5});
918 :     mark(I.STORE{stOp=I.STQ_U, r=t5, b=base, d=disp, mem=mem},an)
919 :     end
920 :    
921 :     (* generate a store byte *)
922 :     and store8(ea,data,mem,an) =
923 : leunga 585 if !byteWordLoadStores then store(I.STB, ea, data, mem, an)
924 :     else storeUnaligned(ea,data,mem,I.INSBL,I.MSKBL,an)
925 : monnier 409
926 :     (* generate a store16 *)
927 :     and store16(ea,data,mem,an) =
928 : leunga 585 if !byteWordLoadStores then store(I.STW, ea, data, mem, an)
929 :     else storeUnaligned(ea,data,mem,I.INSWL,I.MSKWL,an)
930 : monnier 409
931 : monnier 429 (* generate conversion from floating point to integer *)
932 :     and cvtf2i(pseudo,rounding,e,rd,an) =
933 :     app emit (pseudo{mode=rounding, fs=fexpr e, rd=rd})
934 :    
935 : monnier 409 (* generate an expression and return the register that holds the result *)
936 :     and expr(T.REG(_,r)) = r
937 :     | expr(T.LI 0) = zeroR
938 :     | expr(T.LI32 0w0) = zeroR
939 :     | expr e = let val r = newReg()
940 :     in doExpr(e,r,[]); r end
941 :    
942 :     (* generate an expression that targets register d *)
943 : monnier 429 and doExpr(exp,d,an) =
944 :     case exp of
945 : monnier 409 T.REG(_,r) => move(r,d,an)
946 :     | T.LI n => loadImmed(n,zeroR,d,an)
947 :     | T.LI32 w => loadImmed32(w,zeroR,d,an)
948 :     | T.LABEL l => loadLabel(l,d,an)
949 :     | T.CONST c => loadConst(c,d,an)
950 :    
951 :     (* special optimizations for additions and subtraction
952 :     * Question: using LDA for all widths is not really correct
953 :     * since the result may not fit into the sign extension scheme.
954 :     *)
955 : monnier 429 | T.ADD(64,e,T.LABEL le) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)
956 :     | T.ADD(64,T.LABEL le,e) => mark(I.LDA{r=d,b=expr e,d=I.LABop le},an)
957 : george 545 | T.ADD(64,e,T.CONST c) =>
958 :     mark(I.LDA{r=d,b=expr e,d=I.LABop(LE.CONST c)},an)
959 :     | T.ADD(64,T.CONST c,e) =>
960 :     mark(I.LDA{r=d,b=expr e,d=I.LABop(LE.CONST c)},an)
961 : monnier 429 | T.ADD(64,e,T.LI i) => loadImmed(i, expr e, d, an)
962 :     | T.ADD(64,T.LI i,e) => loadImmed(i, expr e, d, an)
963 :     | T.ADD(64,e,T.LI32 i) => loadImmed32(i, expr e, d, an)
964 :     | T.ADD(64,T.LI32 i,e) => loadImmed32(i, expr e, d, an)
965 : monnier 409 | T.SUB(_,a,(T.LI 0 | T.LI32 0w0)) => doExpr(a,d,an)
966 :    
967 :     (* 32-bit support *)
968 :     | T.ADD(32,a,b) => plus(32,I.ADDL,I.S4ADDL,I.S8ADDL,a,b,d,an)
969 :     | T.SUB(32,a,b) => minus(32,I.SUBL,I.S4SUBL,I.S8SUBL,a,b,d,an)
970 :     | T.ADDT(32,a,b) => commArithTrap(I.ADDLV,a,b,d,an)
971 :     | T.SUBT(32,a,b) => arithTrap(I.SUBLV,a,b,d,an)
972 : monnier 429 | T.MULT(32,a,b) =>
973 : monnier 409 multiply(32,
974 :     fn{ra,rb,rc} => I.OPERATEV{oper=I.MULLV,ra=ra,rb=rb,rc=rc},
975 :     Mult32.multiply,a,b,d,trapb,an)
976 : monnier 429 | T.MULU(32,a,b) =>
977 : monnier 409 multiply(32,
978 :     fn{ra,rb,rc} => I.OPERATE{oper=I.MULL,ra=ra,rb=rb,rc=rc},
979 :     Mulu32.multiply,a,b,d,[],an)
980 : monnier 429 | T.MULS(32,a,b) =>
981 :     multiply(32,
982 :     fn{ra,rb,rc} => I.OPERATE{oper=I.MULL,ra=ra,rb=rb,rc=rc},
983 :     Muls32.multiply,a,b,d,[],an)
984 :     | T.DIVT(32,a,b) => divide(32,P.divlv,Mult32.divide,a,b,d,an)
985 :     | T.DIVU(32,a,b) => divide(32,P.divlu,Mulu32.divide,a,b,d,an)
986 :     | T.DIVS(32,a,b) => divide(32,P.divl,Muls32.divide,a,b,d,an)
987 :     | T.REMT(32,a,b) => pseudo(P.remlv,a,b,d)
988 :     | T.REMU(32,a,b) => pseudo(P.remlu,a,b,d)
989 :     | T.REMS(32,a,b) => pseudo(P.reml,a,b,d)
990 :    
991 : monnier 409 | T.SLL(32,a,b) => sll32(a,b,d,an)
992 :     | T.SRA(32,a,b) => sra32(a,b,d,an)
993 :     | T.SRL(32,a,b) => srl32(a,b,d,an)
994 :    
995 :     (* 64 bit support *)
996 :     | T.ADD(64,a,b) => plus(64,I.ADDQ,I.S4ADDQ,I.S8ADDQ,a,b,d,an)
997 :     | T.SUB(64,a,b) => minus(64,I.SUBQ,I.S4SUBQ,I.S8SUBQ,a,b,d,an)
998 :     | T.ADDT(64,a,b) => commArithTrap(I.ADDQV,a,b,d,an)
999 :     | T.SUBT(64,a,b) => arithTrap(I.SUBQV,a,b,d,an)
1000 : monnier 429 | T.MULT(64,a,b) =>
1001 : monnier 409 multiply(64,
1002 :     fn{ra,rb,rc} => I.OPERATEV{oper=I.MULQV,ra=ra,rb=rb,rc=rc},
1003 :     Mult64.multiply,a,b,d,trapb,an)
1004 : monnier 429 | T.MULU(64,a,b) =>
1005 : monnier 409 multiply(64,
1006 :     fn{ra,rb,rc} => I.OPERATE{oper=I.MULQ,ra=ra,rb=rb,rc=rc},
1007 :     Mulu64.multiply,a,b,d,[],an)
1008 : monnier 429 | T.MULS(64,a,b) =>
1009 :     multiply(64,
1010 :     fn{ra,rb,rc} => I.OPERATE{oper=I.MULQ,ra=ra,rb=rb,rc=rc},
1011 :     Muls64.multiply,a,b,d,[],an)
1012 :     | T.DIVT(64,a,b) => divide(64,P.divqv,Mult64.divide,a,b,d,an)
1013 :     | T.DIVU(64,a,b) => divide(64,P.divqu,Mulu64.divide,a,b,d,an)
1014 :     | T.DIVS(64,a,b) => divide(64,P.divq,Muls64.divide,a,b,d,an)
1015 :     | T.REMT(64,a,b) => pseudo(P.remqv,a,b,d)
1016 :     | T.REMU(64,a,b) => pseudo(P.remqu,a,b,d)
1017 :     | T.REMS(64,a,b) => pseudo(P.remq,a,b,d)
1018 :    
1019 : monnier 409 | T.SLL(64,a,b) => sll64(a,b,d,an)
1020 :     | T.SRA(64,a,b) => sra64(a,b,d,an)
1021 :     | T.SRL(64,a,b) => srl64(a,b,d,an)
1022 :    
1023 :     (* special bit operations with complement *)
1024 :     | T.ANDB(_,a,T.NOTB(_,b)) => arith(I.BIC,a,b,d,an)
1025 :     | T.ORB(_,a,T.NOTB(_,b)) => arith(I.ORNOT,a,b,d,an)
1026 :     | T.XORB(_,a,T.NOTB(_,b)) => commArith(I.EQV,a,b,d,an)
1027 :     | T.ANDB(_,T.NOTB(_,a),b) => arith(I.BIC,b,a,d,an)
1028 :     | T.ORB(_,T.NOTB(_,a),b) => arith(I.ORNOT,b,a,d,an)
1029 :     | T.XORB(_,T.NOTB(_,a),b) => commArith(I.EQV,b,a,d,an)
1030 :     | T.NOTB(_,T.XORB(_,a,b)) => commArith(I.EQV,b,a,d,an)
1031 :    
1032 :     (* bit operations *)
1033 :     | T.ANDB(ty,a,b) => andb(ty,a,b,d,an)
1034 :     | T.XORB(_,a,b) => commArith(I.XOR,a,b,d,an)
1035 :     | T.ORB(_,a,b) => commArith(I.BIS,a,b,d,an)
1036 :     | T.NOTB(_,e) => arith(I.ORNOT,zeroT,e,d,an)
1037 :    
1038 :     (* loads *)
1039 : george 545 | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(8,ea,mem)) => load8s(ea,d,mem,an)
1040 :     | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(16,ea,mem))=> load16s(ea,d,mem,an)
1041 :     | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(32,ea,mem))=> load32s(ea,d,mem,an)
1042 : monnier 409 | T.LOAD(8,ea,mem) => load8(ea,d,mem,an)
1043 :     | T.LOAD(16,ea,mem) => load16(ea,d,mem,an)
1044 : monnier 429 | T.LOAD(32,ea,mem) => load32s(ea,d,mem,an)
1045 : monnier 409 | T.LOAD(64,ea,mem) => load(I.LDQ,ea,d,mem,an)
1046 :    
1047 : monnier 429 (* floating -> int conversion *)
1048 : monnier 475 | T.CVTF2I(ty,rounding,fty,e) =>
1049 :     (case (fty,ty) of
1050 : monnier 429 (32,32) => cvtf2i(P.cvtsl,rounding,e,d,an)
1051 :     | (32,64) => cvtf2i(P.cvtsq,rounding,e,d,an)
1052 :     | (64,32) => cvtf2i(P.cvttl,rounding,e,d,an)
1053 :     | (64,64) => cvtf2i(P.cvttq,rounding,e,d,an)
1054 : george 545 | _ => doExpr(Gen.compileRexp exp,d,an) (* other cases *)
1055 : monnier 429 )
1056 :    
1057 : monnier 409 (* conversion to boolean *)
1058 :     | T.COND(_,T.CMP(ty,cond,e1,e2),T.LI 1,T.LI 0) =>
1059 :     compare(ty,cond,e1,e2,d,an)
1060 :     | T.COND(_,T.CMP(ty,cond,e1,e2),T.LI 0,T.LI 1) =>
1061 : george 545 compare(ty,T.Basis.negateCond cond,e1,e2,d,an)
1062 : monnier 409 | T.COND(_,T.CMP(ty,cond,e1,e2),x,y) =>
1063 :     cmove(ty,cond,e1,e2,x,y,d,an)
1064 :    
1065 : george 545 | T.LET(s,e) => (doStmt s; doExpr(e, d, an))
1066 :     | T.MARK(e,A.MARKREG f) => (f d; doExpr(e,d,an))
1067 :     | T.MARK(e,a) => doExpr(e,d,a::an)
1068 : monnier 475 (* On the alpha: all 32 bit values are already sign extended.
1069 :     * So no sign extension is necessary
1070 :     *)
1071 : george 545 | T.CVTI2I(64, T.SIGN_EXTEND, 32, e) => doExpr(e, d, an)
1072 :     | T.CVTI2I(64, T.ZERO_EXTEND, 32, e) => doExpr(e, d, an)
1073 :    
1074 :     | T.PRED(e, c) => doExpr(e, d, A.CTRLUSE c::an)
1075 : george 555 | T.REXT e => ExtensionComp.compileRext (reducer()) {e=e, an=an, rd=d}
1076 : monnier 429
1077 :     (* Defaults *)
1078 : george 545 | e => doExpr(Gen.compileRexp e,d,an)
1079 : monnier 409
1080 :     (* Hmmm... this is the funky thing described in the comments
1081 :     * in at the top of the file. This should be made parametrizable
1082 :     * for other backends.
1083 :     *)
1084 : george 545 and farith(opcode,opcodeSMLNJ,a,b,d,an) =
1085 : monnier 409 let val fa = fexpr a
1086 :     val fb = fexpr b
1087 : george 545 in if SMLNJfloatingPoint then
1088 :     (emit(I.DEFFREG d);
1089 :     mark(I.FOPERATEV{oper=opcodeSMLNJ,fa=fa,fb=fb,fc=d},an);
1090 :     emit(I.TRAPB)
1091 :     )
1092 :     else mark(I.FOPERATE{oper=opcode,fa=fa,fb=fb,fc=d},an)
1093 : monnier 409 end
1094 :    
1095 : george 545 and farith'(opcode,a,b,d,an) =
1096 :     mark(I.FOPERATE{oper=opcode,fa=fexpr a,fb=fexpr b,fc=d},an)
1097 :    
1098 : monnier 429 and funary(opcode,e,d,an) = mark(I.FUNARY{oper=opcode,fb=fexpr e,fc=d},an)
1099 :    
1100 :    
1101 : monnier 409 (* generate an floating point expression
1102 :     * return the register that holds the result
1103 :     *)
1104 :     and fexpr(T.FREG(_,r)) = r
1105 :     | fexpr e = let val d = newFreg() in doFexpr(e,d,[]); d end
1106 :    
1107 :     (* generate an external floating point operation *)
1108 : monnier 429 and fcvti2f(pseudo,e,fd,an) =
1109 : monnier 409 let val opnd = opn e
1110 : monnier 429 in app emit (pseudo({opnd=opnd, fd=fd}, reduceOpn))
1111 : monnier 409 end
1112 :    
1113 :     (* generate a floating point store *)
1114 :     and fstore(stOp,ea,data,mem,an) =
1115 :     let val (base,disp) = addr ea
1116 :     in mark(I.FSTORE{stOp=stOp,r=fexpr data,b=base,d=disp,mem=mem},an)
1117 :     end
1118 :    
1119 :     (* generate a floating point expression that targets register d *)
1120 :     and doFexpr(e,d,an) =
1121 :     case e of
1122 :     T.FREG(_,f) => fmove(f,d,an)
1123 :    
1124 :     (* single precision support *)
1125 : george 545 | T.FADD(32,a,b) => farith(I.ADDS,ADDSX,a,b,d,an)
1126 :     | T.FSUB(32,a,b) => farith(I.SUBS,SUBSX,a,b,d,an)
1127 :     | T.FMUL(32,a,b) => farith(I.MULS,MULSX,a,b,d,an)
1128 :     | T.FDIV(32,a,b) => farith(I.DIVS,DIVSX,a,b,d,an)
1129 : monnier 409
1130 :     (* double precision support *)
1131 : george 545 | T.FADD(64,a,b) => farith(I.ADDT,ADDTX,a,b,d,an)
1132 :     | T.FSUB(64,a,b) => farith(I.SUBT,SUBTX,a,b,d,an)
1133 :     | T.FMUL(64,a,b) => farith(I.MULT,MULTX,a,b,d,an)
1134 :     | T.FDIV(64,a,b) => farith(I.DIVT,DIVTX,a,b,d,an)
1135 : monnier 409
1136 : george 545 (* copy sign (correct?) XXX *)
1137 :     | T.FCOPYSIGN(_,T.FNEG(_,a),b) => farith'(I.CPYSN,a,b,d,an)
1138 :     | T.FCOPYSIGN(_,a,T.FNEG(_,b)) => farith'(I.CPYSN,a,b,d,an)
1139 :     | T.FNEG(_,T.FCOPYSIGN(_,a,b)) => farith'(I.CPYSN,a,b,d,an)
1140 :     | T.FCOPYSIGN(_,a,b) => farith'(I.CPYS,a,b,d,an)
1141 : monnier 429
1142 : monnier 409 (* generic *)
1143 :     | T.FABS(_,a) =>
1144 :     mark(I.FOPERATE{oper=I.CPYS,fa=zeroFR,fb=fexpr a,fc=d},an)
1145 :     | T.FNEG(_,a) =>
1146 :     let val fs = fexpr a
1147 :     in mark(I.FOPERATE{oper=I.CPYSN,fa=fs,fb=fs,fc=d},an) end
1148 :     | T.FSQRT(_,a) => error "fsqrt"
1149 :    
1150 :     (* loads *)
1151 :     | T.FLOAD(32,ea,mem) => fload(I.LDS,ea,d,mem,an)
1152 :     | T.FLOAD(64,ea,mem) => fload(I.LDT,ea,d,mem,an)
1153 : monnier 429
1154 :     (* floating/floating conversion
1155 :     * Note: it is not necessary to convert single precision
1156 :     * to double on the alpha.
1157 :     *)
1158 : george 545 | T.CVTF2F(fty,fty',e) => (* ignore rounding mode for now *)
1159 : monnier 475 (case (fty,fty') of
1160 : monnier 429 (64,64) => doFexpr(e,d,an)
1161 :     | (64,32) => doFexpr(e,d,an)
1162 :     | (32,32) => doFexpr(e,d,an)
1163 :     | (32,64) => funary(I.CVTTS,e,d,an) (* use normal rounding *)
1164 :     | _ => error "CVTF2F"
1165 :     )
1166 : monnier 409
1167 : monnier 429 (* integer -> floating point conversion *)
1168 : george 545 | T.CVTI2F(fty,ty,e) =>
1169 : monnier 429 let val pseudo =
1170 : monnier 475 case (ty,fty) of
1171 : monnier 429 (ty,32) => if ty <= 32 then P.cvtls else P.cvtqs
1172 :     | (ty,64) => if ty <= 32 then P.cvtlt else P.cvtqt
1173 :     | _ => error "CVTI2F"
1174 :     in fcvti2f(pseudo,e,d,an) end
1175 :    
1176 : george 545 | T.FMARK(e,A.MARKREG f) => (f d; doFexpr(e,d,an))
1177 :     | T.FMARK(e,a) => doFexpr(e,d,a::an)
1178 :     | T.FPRED(e,c) => doFexpr(e, d, A.CTRLUSE c::an)
1179 : george 555 | T.FEXT e => ExtensionComp.compileFext (reducer()) {e=e, fd=d, an=an}
1180 : monnier 409 | _ => error "doFexpr"
1181 :    
1182 :     (* check whether an expression is andb(e,1) *)
1183 :     and isAndb1(T.ANDB(_,e,T.LI 1)) = (true,e)
1184 :     | isAndb1(T.ANDB(_,e,T.LI32 0w1)) = (true,e)
1185 :     | isAndb1(T.ANDB(_,T.LI 1,e)) = (true,e)
1186 :     | isAndb1(T.ANDB(_,T.LI32 0w1,e)) = (true,e)
1187 :     | isAndb1 e = (false,e)
1188 :    
1189 :     and zeroOrOne(T.LI 0) = ZERO
1190 :     | zeroOrOne(T.LI32 0w0) = ZERO
1191 :     | zeroOrOne(T.LI 1) = ONE
1192 :     | zeroOrOne(T.LI32 0w1) = ONE
1193 :     | zeroOrOne _ = OTHER
1194 :    
1195 :     (* compile a branch *)
1196 : george 545 and branch(e,lab,an) =
1197 : monnier 409 case e of
1198 :     T.CMP(ty,cc,e1 as T.LI _,e2) =>
1199 : george 545 branchBS(ty,T.Basis.swapCond cc,e2,e1,lab,an)
1200 : monnier 409 | T.CMP(ty,cc,e1 as T.LI32 _,e2) =>
1201 : george 545 branchBS(ty,T.Basis.swapCond cc,e2,e1,lab,an)
1202 : monnier 409 | T.CMP(ty,cc,e1,e2) => branchBS(ty,cc,e1,e2,lab,an)
1203 : george 545 (* generate an floating point branch *)
1204 :     | T.FCMP(fty,cc,e1,e2) =>
1205 :     let val f1 = fexpr e1
1206 :     val f2 = fexpr e2
1207 :     fun bcc(cmp,br) =
1208 :     let val tmpR = C.newFreg()
1209 :     in emit(I.DEFFREG(tmpR));
1210 :     emit(I.FOPERATE{oper=cmp,fa=f1,fb=f2,fc=tmpR});
1211 :     emit(I.TRAPB);
1212 :     mark(I.FBRANCH{b=br,f=tmpR,lab=lab},an)
1213 :     end
1214 :     fun fall(cmp1, br1, cmp2, br2) =
1215 :     let val tmpR1 = newFreg()
1216 :     val tmpR2 = newFreg()
1217 :     val fallLab = Label.newLabel ""
1218 :     in emit(I.DEFFREG(tmpR1));
1219 :     emit(I.FOPERATE{oper=cmp1, fa=f1, fb=f2, fc=tmpR1});
1220 :     emit(I.TRAPB);
1221 :     mark(I.FBRANCH{b=br1, f=tmpR1, lab=fallLab},an);
1222 :     emit(I.DEFFREG(tmpR2));
1223 :     emit(I.FOPERATE{oper=cmp2, fa=f1, fb=f2, fc=tmpR2});
1224 :     emit(I.TRAPB);
1225 :     mark(I.FBRANCH{b=br2, f=tmpR2, lab=lab},an);
1226 :     defineLabel fallLab
1227 :     end
1228 :     fun bcc2(cmp1, br1, cmp2, br2) =
1229 :     (bcc(cmp1, br1); bcc(cmp2, br2))
1230 :     in case cc of
1231 :     T.== => bcc(I.CMPTEQSU, I.FBNE)
1232 :     | T.?<> => bcc(I.CMPTEQSU, I.FBEQ)
1233 :     | T.? => bcc(I.CMPTUNSU, I.FBNE)
1234 :     | T.<=> => bcc(I.CMPTUNSU, I.FBEQ)
1235 :     | T.> => fall(I.CMPTLESU, I.FBNE, I.CMPTUNSU, I.FBEQ)
1236 :     | T.>= => fall(I.CMPTLTSU, I.FBNE, I.CMPTUNSU, I.FBEQ)
1237 :     | T.?> => bcc(I.CMPTLESU, I.FBEQ)
1238 :     | T.?>= => bcc(I.CMPTLTSU, I.FBEQ)
1239 :     | T.< => bcc(I.CMPTLTSU, I.FBNE)
1240 :     | T.<= => bcc(I.CMPTLESU, I.FBNE)
1241 :     | T.?< => bcc2(I.CMPTLTSU, I.FBNE, I.CMPTUNSU, I.FBNE)
1242 :     | T.?<= => bcc2(I.CMPTLESU, I.FBNE, I.CMPTUNSU, I.FBNE)
1243 :     | T.<> => fall(I.CMPTEQSU, I.FBNE, I.CMPTUNSU, I.FBEQ)
1244 :     | T.?= => bcc2(I.CMPTEQSU, I.FBNE, I.CMPTUNSU, I.FBNE)
1245 :     end
1246 :     | e => mark(I.BRANCH{b=I.BNE,r=ccExpr e,lab=lab},an)
1247 : monnier 409
1248 : george 545 and br(opcode,exp,lab,an) = mark(I.BRANCH{b=opcode,r=expr exp,lab=lab},an)
1249 : monnier 409
1250 :     (* Use the branch on bit set/clear instruction when possible *)
1251 :     and branchBS(ty,cc,a,b,lab,an) =
1252 :     (case (cc,isAndb1 a,zeroOrOne b) of
1253 :     (T.EQ,(true,e),ONE) => br(I.BLBS,e,lab,an)
1254 :     | (T.EQ,(true,e),ZERO) => br(I.BLBC,e,lab,an)
1255 :     | (T.NE,(true,e),ZERO) => br(I.BLBS,e,lab,an)
1256 :     | (T.NE,(true,e),ONE) => br(I.BLBC,e,lab,an)
1257 :     | (cc,_,_) => branchIt(ty,cc,a,b,lab,an)
1258 :     )
1259 :    
1260 :     (* generate a branch instruction.
1261 :     * Check for branch on zero as a special case
1262 :     *)
1263 :     and branchIt(ty,cc,e,T.LI 0,lab,an) = branchIt0(cc,e,lab,an)
1264 :     | branchIt(ty,cc,e,T.LI32 0w0,lab,an) = branchIt0(cc,e,lab,an)
1265 :     | branchIt(ty,cc,e1,e2,lab,an) = branchItOther(ty,cc,e1,e2,lab,an)
1266 :    
1267 :     (* generate a branch instruction.
1268 :     * This function optimizes the special case of comparison with zero.
1269 :     *)
1270 :     and branchIt0(T.EQ,e,lab,an) = br(I.BEQ,e,lab,an)
1271 :     | branchIt0(T.NE,e,lab,an) = br(I.BNE,e,lab,an)
1272 :     | branchIt0(T.GT,e,lab,an) = br(I.BGT,e,lab,an)
1273 :     | branchIt0(T.GE,e,lab,an) = br(I.BGE,e,lab,an)
1274 :     | branchIt0(T.LE,e,lab,an) = br(I.BLE,e,lab,an)
1275 :     | branchIt0(T.LT,e,lab,an) = br(I.BLT,e,lab,an)
1276 :     | branchIt0(T.GTU,e,lab,an) = br(I.BNE,e,lab,an) (* always > 0! *)
1277 :     | branchIt0(T.GEU,e,lab,an) = (* always true! *) goto(lab,an)
1278 :     | branchIt0(T.LTU,e,lab,an) = (* always false! *) ()
1279 :     | branchIt0(T.LEU,e,lab,an) = br(I.BEQ,e,lab,an) (* never < 0! *)
1280 :    
1281 :     (* Generate the operands for unsigned comparisons
1282 :     * Mask out high order bits whenever necessary.
1283 :     *)
1284 :     and unsignedCmpOpnds(ty,e1,e2) =
1285 :     let fun zapHi(r,mask) =
1286 :     let val d = newReg()
1287 :     in emit(I.OPERATE{oper=I.ZAP, ra=r, rb=I.IMMop mask,rc=d});
1288 :     I.REGop d
1289 :     end
1290 :    
1291 :     fun zap(opn as I.REGop r) =
1292 :     (case ty of
1293 :     8 => zapHi(r,0xfd)
1294 :     | 16 => zapHi(r,0xfc)
1295 :     | 32 => zapHi(r,0xf0)
1296 :     | 64 => opn
1297 :     | _ => error "unsignedCmpOpnds"
1298 :     )
1299 :     | zap opn = opn
1300 :     val opn1 = opn e1
1301 :     val opn2 = opn e2
1302 :     in (zap opn1,zap opn2) end
1303 :    
1304 :     (* Generate a branch *)
1305 :     and branchItOther(ty,cond,e1,e2,lab,an) =
1306 :     let val tmpR = newReg()
1307 :     fun signedCmp(cmp,br) =
1308 :     (emit(I.OPERATE{oper=cmp, ra=expr e1, rb=opn e2, rc=tmpR});
1309 : george 545 mark(I.BRANCH{b=br, r=tmpR, lab=lab},an)
1310 : monnier 409 )
1311 :     fun unsignedCmp(ty,cmp,br) =
1312 :     let val (x,y) = unsignedCmpOpnds(ty,e1,e2)
1313 :     in emit(I.OPERATE{oper=cmp,ra=reduceOpn x,rb=y,rc=tmpR});
1314 : george 545 mark(I.BRANCH{b=br, r=tmpR, lab=lab},an)
1315 : monnier 409 end
1316 :     in case cond of
1317 :     T.LT => signedCmp(I.CMPLT,I.BNE)
1318 :     | T.LE => signedCmp(I.CMPLE,I.BNE)
1319 :     | T.GT => signedCmp(I.CMPLE,I.BEQ)
1320 :     | T.GE => signedCmp(I.CMPLT,I.BEQ)
1321 :     | T.EQ => signedCmp(I.CMPEQ,I.BNE)
1322 :     | T.NE => signedCmp(I.CMPEQ,I.BEQ)
1323 :     | T.LTU => unsignedCmp(ty,I.CMPULT,I.BNE)
1324 :     | T.LEU => unsignedCmp(ty,I.CMPULE,I.BNE)
1325 :     | T.GTU => unsignedCmp(ty,I.CMPULE,I.BEQ)
1326 :     | T.GEU => unsignedCmp(ty,I.CMPULT,I.BEQ)
1327 :     end
1328 :    
1329 :     (* This function generates a conditional move:
1330 :     * d = if cond(a,b) then x else y
1331 :     * Apparently, only signed comparisons conditional moves
1332 :     * are supported on the alpha.
1333 :     *)
1334 :     and cmove(ty,cond,a,b,x,y,d,an) =
1335 : george 545 let val tmp = newReg()
1336 :     val _ = doExpr(y,tmp,[]) (* evaluate false case *)
1337 : monnier 409
1338 :     val (cond,a,b) =
1339 :     (* move the immed operand to b *)
1340 :     case a of
1341 : george 545 (T.LI _ | T.LI32 _ | T.CONST _) => (T.Basis.swapCond cond,b,a)
1342 : monnier 409 | _ => (cond,a,b)
1343 :    
1344 :     fun sub(a,(T.LI 0 | T.LI32 0w0)) = expr a
1345 :     | sub(a,b) = expr(T.SUB(ty,a,b))
1346 :    
1347 :     fun cmp(cond,e1,e2) =
1348 : george 545 let val flag = newReg()
1349 :     in compare(ty,cond,e1,e2,flag,[]); flag end
1350 : monnier 409
1351 :     val (oper,ra,x,y) =
1352 :     case (cond,isAndb1 a,zeroOrOne b) of
1353 :     (* low bit set/clear? *)
1354 :     (T.EQ,(true,e),ONE) => (I.CMOVLBS,expr e,x,y)
1355 :     | (T.EQ,(true,e),ZERO) => (I.CMOVLBC,expr e,x,y)
1356 :     | (T.NE,(true,e),ZERO) => (I.CMOVLBS,expr e,x,y)
1357 :     | (T.NE,(true,e),ONE) => (I.CMOVLBC,expr e,x,y)
1358 :     (* signed *)
1359 :     | (T.EQ,_,_) => (I.CMOVEQ,sub(a,b),x,y)
1360 :     | (T.NE,_,_) => (I.CMOVEQ,cmp(T.EQ,a,b),y,x)
1361 :     | (T.GT,_,_) => (I.CMOVGT,sub(a,b),x,y)
1362 :     | (T.GE,_,_) => (I.CMOVGE,sub(a,b),x,y)
1363 :     | (T.LT,_,_) => (I.CMOVLT,sub(a,b),x,y)
1364 :     | (T.LE,_,_) => (I.CMOVLE,sub(a,b),x,y)
1365 :    
1366 :     (* unsigned: do compare then use the condition code *)
1367 :     | (T.LTU,_,_) => (I.CMOVEQ,cmp(T.GEU,a,b),x,y)
1368 :     | (T.LEU,_,_) => (I.CMOVEQ,cmp(T.GTU,a,b),x,y)
1369 :     | (T.GTU,_,_) => (I.CMOVEQ,cmp(T.LEU,a,b),x,y)
1370 :     | (T.GEU,_,_) => (I.CMOVEQ,cmp(T.LTU,a,b),x,y)
1371 : george 545 in mark(I.CMOVE{oper=oper,ra=ra,rb=opn x,rc=tmp},an); (* true case *)
1372 :     move(tmp, d, [])
1373 : monnier 409 end
1374 :    
1375 :    
1376 :     (* This function generates a comparion between e1 and e2 and writes
1377 :     * the result to register d.
1378 :     * It'll mask out the high order 32-bits when performing
1379 :     * unsigned 32-bit integer comparisons.
1380 :     *)
1381 :     and compare(ty,cond,e1,e2,d,an) =
1382 :     let fun signedCmp(oper,a,b,d) =
1383 :     mark(I.OPERATE{oper=oper,ra=expr a,rb=opn b,rc=d},an)
1384 :     fun unsignedCmp(ty,oper,a,b,d) =
1385 :     let val (x,y) = unsignedCmpOpnds(ty,a,b)
1386 :     in mark(I.OPERATE{oper=oper,ra=reduceOpn x,rb=y,rc=d},an)
1387 :     end
1388 :     fun eq(a,b,d) =
1389 :     (case (opn a,opn b) of
1390 :     (a,I.REGop r) =>
1391 :     mark(I.OPERATE{oper=I.CMPEQ,ra=r,rb=a,rc=d},an)
1392 :     | (a,b) =>
1393 :     mark(I.OPERATE{oper=I.CMPEQ,ra=reduceOpn a,rb=b,rc=d},an)
1394 :     )
1395 :     fun neq(a,b,d) =
1396 :     let val tmp = newReg()
1397 :     in eq(a,b,tmp);
1398 :     emit(I.OPERATE{oper=I.CMPEQ,ra=tmp,rb=zeroOpn,rc=d})
1399 :     end
1400 :     val (cond,e1,e2) =
1401 :     case e1 of
1402 :     (T.LI _ | T.LI32 _ | T.CONST _) =>
1403 : george 545 (T.Basis.swapCond cond,e2,e1)
1404 : monnier 409 | _ => (cond,e1,e2)
1405 :     in case cond of
1406 :     T.EQ => eq(e1,e2,d)
1407 :     | T.NE => neq(e1,e2,d)
1408 :     | T.GT => signedCmp(I.CMPLT,e2,e1,d)
1409 :     | T.GE => signedCmp(I.CMPLE,e2,e1,d)
1410 :     | T.LT => signedCmp(I.CMPLT,e1,e2,d)
1411 :     | T.LE => signedCmp(I.CMPLE,e1,e2,d)
1412 :     | T.GTU => unsignedCmp(ty,I.CMPULT,e2,e1,d)
1413 :     | T.GEU => unsignedCmp(ty,I.CMPULE,e2,e1,d)
1414 :     | T.LTU => unsignedCmp(ty,I.CMPULT,e1,e2,d)
1415 :     | T.LEU => unsignedCmp(ty,I.CMPULE,e1,e2,d)
1416 :     end
1417 :    
1418 :     (* generate an unconditional branch *)
1419 : george 545 and goto(lab,an) = mark(I.BRANCH{b=I.BR,r=zeroR,lab=lab},an)
1420 : monnier 409
1421 :     (* generate an call instruction *)
1422 : george 545 and call(ea,flow,def,use,mem,an) =
1423 : monnier 409 let val pv = expr ea
1424 :     val returnPtrR = 26
1425 : george 545 in mark(I.JSR{r=returnPtrR,b=pv,d=0,defs=cellset def,uses=cellset use,
1426 :     mem=mem}, an)
1427 : monnier 409 end
1428 :    
1429 :    
1430 : george 545 and doCCexpr(T.CC(_,r),d,an) = move(r,d,an)
1431 :     | doCCexpr(T.FCC(_,r),d,an) = fmove(r,d,an)
1432 : monnier 409 | doCCexpr(T.CMP(ty,cond,e1,e2),d,an) = compare(ty,cond,e1,e2,d,an)
1433 :     | doCCexpr(T.FCMP(fty,cond,e1,e2),d,an) = error "doCCexpr"
1434 : george 545 | doCCexpr(T.CCMARK(e,A.MARKREG f),d,an) = (f d; doCCexpr(e,d,an))
1435 :     | doCCexpr(T.CCMARK(e,a),d,an) = doCCexpr(e,d,a::an)
1436 : george 555 | doCCexpr(T.CCEXT e,d,an) =
1437 :     ExtensionComp.compileCCext (reducer()) {e=e, ccd=d, an=an}
1438 : george 545 | doCCexpr _ = error "doCCexpr"
1439 : monnier 409
1440 : george 545 and ccExpr(T.CC(_,r)) = r
1441 :     | ccExpr(T.FCC(_,r)) = r
1442 : monnier 409 | ccExpr e = let val d = newReg()
1443 :     in doCCexpr(e,d,[]); d end
1444 :    
1445 :     (* compile a statement *)
1446 :     and stmt(s,an) =
1447 :     case s of
1448 :     T.MV(ty,r,e) => doExpr(e,r,an)
1449 :     | T.FMV(ty,r,e) => doFexpr(e,r,an)
1450 :     | T.CCMV(r,e) => doCCexpr(e,r,an)
1451 :     | T.COPY(ty,dst,src) => copy(dst,src,an)
1452 :     | T.FCOPY(ty,dst,src) => fcopy(dst,src,an)
1453 : george 545 | T.JMP(ctrl,T.LABEL(LE.LABEL lab),_) => goto(lab,an)
1454 :     | T.JMP(ctrl,e,labs) => mark(I.JMPL({r=zeroR,b=expr e,d=0},labs),an)
1455 :     | T.BCC(ctrl,cc,lab) => branch(cc,lab,an)
1456 : leunga 591 | T.CALL{funct,targets,defs,uses,cdefs,cuses,region} =>
1457 :     call(funct,targets,defs,uses,region,an)
1458 : george 545 | T.RET _ => mark(I.RET{r=zeroR,b=26,d=0},an)
1459 : monnier 409 | T.STORE(8,ea,data,mem) => store8(ea,data,mem,an)
1460 :     | T.STORE(16,ea,data,mem) => store16(ea,data,mem,an)
1461 :     | T.STORE(32,ea,data,mem) => store(I.STL,ea,data,mem,an)
1462 :     | T.STORE(64,ea,data,mem) => store(I.STQ,ea,data,mem,an)
1463 :     | T.FSTORE(32,ea,data,mem) => fstore(I.STS,ea,data,mem,an)
1464 :     | T.FSTORE(64,ea,data,mem) => fstore(I.STT,ea,data,mem,an)
1465 : george 545 | T.DEFINE l => defineLabel l
1466 : monnier 409 | T.ANNOTATION(s,a) => stmt(s,a::an)
1467 : george 555 | T.EXT s => ExtensionComp.compileSext (reducer()) {stm=s,an=an}
1468 : george 545 | s => doStmts (Gen.compileStm s)
1469 : monnier 409
1470 : george 545 and reducer() =
1471 :     T.REDUCER{reduceRexp = expr,
1472 :     reduceFexp = fexpr,
1473 :     reduceCCexp = ccExpr,
1474 :     reduceStm = stmt,
1475 :     operand = opn,
1476 :     reduceOperand = reduceOpn,
1477 :     addressOf = addr,
1478 :     emit = mark,
1479 :     instrStream = instrStream,
1480 :     mltreeStream = self()
1481 :     }
1482 :    
1483 : monnier 409 and doStmt s = stmt(s,[])
1484 : george 545 and doStmts ss = app doStmt ss
1485 : monnier 409
1486 : george 545 (* convert mlrisc to cellset:
1487 :     * condition code registers are mapped onto general registers
1488 :     *)
1489 :     and cellset mlrisc =
1490 :     let fun g([],acc) = acc
1491 :     | g(T.GPR(T.REG(_,r))::regs,acc) = g(regs,C.addReg(r,acc))
1492 :     | g(T.FPR(T.FREG(_,f))::regs,acc) = g(regs,C.addFreg(f,acc))
1493 :     | g(T.CCR(T.CC(_,cc))::regs,acc) = g(regs,C.addReg(cc,acc))
1494 :     | g(T.CCR(T.FCC(_,cc))::regs,acc) = g(regs,C.addReg(cc,acc))
1495 :     | g(_::regs, acc) = g(regs, acc)
1496 :     in g(mlrisc, C.empty) end
1497 : monnier 409
1498 : george 545 and self() =
1499 :     S.STREAM
1500 :     { beginCluster= beginCluster,
1501 :     endCluster = endCluster,
1502 :     emit = doStmt,
1503 :     pseudoOp = pseudoOp,
1504 :     defineLabel = defineLabel,
1505 :     entryLabel = entryLabel,
1506 :     comment = comment,
1507 :     annotation = annotation,
1508 :     exitBlock = fn regs => exitBlock(cellset regs),
1509 :     alias = alias,
1510 :     phi = phi
1511 :     }
1512 :     in self()
1513 : monnier 409 end
1514 :    
1515 :     end
1516 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0