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/alpha32/alpha32.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/alpha32/alpha32.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 168 - (view) (download)

1 : monnier 16 (* alpha32.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * generates machine code from the mltree.
6 :     *
7 :     *)
8 :    
9 :     (** NOTE: f29 and f30 are used as temporaries.
10 :     ** r31 is always zero.
11 :     **)
12 :     functor Alpha32
13 :     (structure Alpha32Instr : ALPHA32INSTR
14 : monnier 167 structure Alpha32MLTree : MLTREE where Region = Alpha32Instr.Region
15 :     and Constant = Alpha32Instr.Constant
16 :     structure Flowgen : FLOWGRAPH_GEN where I = Alpha32Instr
17 :     and T = Alpha32MLTree
18 :     and B = Alpha32MLTree.BNames
19 :     structure PseudoInstrs : ALPHA32_PSEUDO_INSTR where I = Alpha32Instr
20 :     (* DBM: sharing/defn conflict:
21 : monnier 16 sharing Alpha32Instr.Region = Alpha32MLTree.Region
22 :     sharing Flowgen.I = PseudoInstrs.I = Alpha32Instr
23 :     sharing Flowgen.T=Alpha32MLTree
24 : monnier 127 sharing Alpha32MLTree.Constant = Alpha32Instr.Constant
25 : monnier 167 sharing Alpha32MLTree.BNames = Flowgen.B
26 :     *)
27 :     ) : MLTREECOMP =
28 : monnier 16 struct
29 :     structure F = Flowgen
30 :     structure T = Alpha32MLTree
31 :     structure R = Alpha32MLTree.Region
32 :     structure I = Alpha32Instr
33 :     structure C = Alpha32Instr.C
34 :     structure LE = LabelExp
35 :     structure W32 = Word32
36 : monnier 106
37 : monnier 16 (*********************************************************
38 :    
39 :     Trap Shadows, Floating Exceptions, and Denormalized
40 :     Numbers on the DEC Alpha
41 :    
42 :     Andrew W. Appel and Lal George
43 :     Nov 28, 1995
44 :    
45 :     See section 4.7.5.1 of the Alpha Architecture Reference Manual.
46 :    
47 :     The Alpha has imprecise exceptions, meaning that if a floating
48 :     point instruction raises an IEEE exception, the exception may
49 :     not interrupt the processor until several successive instructions have
50 :     completed. ML, on the other hand, may want a "precise" model
51 :     of floating point exceptions.
52 :    
53 :     Furthermore, the Alpha hardware does not support denormalized numbers
54 :     (for "gradual underflow"). Instead, underflow always rounds to zero.
55 :     However, each floating operation (add, mult, etc.) has a trapping
56 :     variant that will raise an exception (imprecisely, of course) on
57 :     underflow; in that case, the instruction will produce a zero result
58 :     AND an exception will occur. In fact, there are several variants
59 :     of each instruction; three variants of MULT are:
60 :    
61 :     MULT s1,s2,d truncate denormalized result to zero; no exception
62 :     MULT/U s1,s2,d truncate denormalized result to zero; raise UNDERFLOW
63 :     MULT/SU s1,s2,d software completion, producing denormalized result
64 :    
65 :     The hardware treats the MULT/U and MULT/SU instructions identically,
66 :     truncating a denormalized result to zero and raising the UNDERFLOW
67 :     exception. But the operating system, on an UNDERFLOW exception,
68 :     examines the faulting instruction to see if it's an /SU form, and if so,
69 :     recalculates s1*s2, puts the right answer in d, and continues,
70 :     all without invoking the user's signal handler.
71 :    
72 :     Because most machines compute with denormalized numbers in hardware,
73 :     to maximize portability of SML programs, we use the MULT/SU form.
74 :     (and ADD/SU, SUB/SU, etc.) But to use this form successfully,
75 :     certain rules have to be followed. Basically, d cannot be the same
76 :     register as s1 or s2, because the opsys needs to be able to
77 :     recalculate the operation using the original contents of s1 and s2,
78 :     and the MULT/SU instruction will overwrite d even if it traps.
79 :    
80 :     More generally, we may want to have a sequence of floating-point
81 :     instructions. The rules for such a sequence are:
82 :    
83 :     1. The sequence should end with a TRAPB (trap barrier) instruction.
84 :     (This could be relaxed somewhat, but certainly a TRAPB would
85 :     be a good idea sometime before the next branch instruction or
86 :     update of an ML reference variable, or any other ML side effect.)
87 :     2. No instruction in the sequence should destroy any operand of itself
88 :     or of any previous instruction in the sequence.
89 :     3. No two instructions in the sequence should write the same destination
90 :     register.
91 :    
92 :     We can achieve these conditions by the following trick in the
93 :     Alpha code generator. Each instruction in the sequence will write
94 :     to a different temporary; this is guaranteed by the translation from
95 :     ML-RISC. At the beginning of the sequence, we will put a special
96 :     pseudo-instruction (we call it DEFFREG) that "defines" the destination
97 :     register of the arithmetic instruction. If there are K arithmetic
98 :     instructions in the sequence, then we'll insert K DEFFREG instructions
99 :     all at the beginning of the sequence.
100 :     Then, each arithop will not only "define" its destination temporary
101 :     but will "use" it as well. When all these instructions are fed to
102 :     the liveness analyzer, the resulting interference graph will then
103 :     have inteference edges satisfying conditions 2 and 3 above.
104 :    
105 :     Of course, DEFFREG doesn't actually generate any code. In our model
106 :     of the Alpha, every instruction generates exactly 4 bytes of code
107 :     except the "span-dependent" ones. Therefore, we'll specify DEFFREG
108 :     as a span-dependent instruction whose minimum and maximum sizes are zero.
109 :    
110 :     At the moment, we do not group arithmetic operations into sequences;
111 :     that is, each arithop will be preceded by a single DEFFREG and
112 :     followed by a TRAPB. To avoid the cost of all those TRAPB's, we
113 :     should improve this when we have time. Warning: Don't put more
114 :     than 31 instructions in the sequence, because they're all required
115 :     to write to different destination registers!
116 :    
117 :     What about multiple traps? For example, suppose a sequence of
118 :     instructions produces an Overflow and a Divide-by-Zero exception?
119 :     ML would like to know only about the earliest trap, but the hardware
120 :     will report BOTH traps to the operating system. However, as long
121 :     as the rules above are followed (and the software-completion versions
122 :     of the arithmetic instructions are used), the operating system will
123 :     have enough information to know which instruction produced the
124 :     trap. It is very probable that the operating system will report ONLY
125 :     the earlier trap to the user process, but I'm not sure.
126 :    
127 :     For a hint about what the operating system is doing in its own
128 :     trap-handler (with software completion), see section 6.3.2 of
129 :     "OpenVMS Alpha Software" (Part II of the Alpha Architecture
130 :     Manual). This stuff should apply to Unix (OSF1) as well as VMS.
131 :    
132 :     ****************************************************************)
133 :    
134 :     fun error msg = MLRiscErrorMsg.impossible ("Alpha32." ^ msg)
135 :    
136 :     val itow = Word.fromInt
137 :     val wtoi = Word.toIntX
138 :    
139 : monnier 143 val emitInstr = F.emitInstr
140 : monnier 16 val emit = F.emitInstr
141 :    
142 :     val zeroR = 31
143 :     val zeroOp = I.REGop zeroR
144 :     val zeroEA = I.Direct zeroR
145 :     val argReg0 = 16
146 :    
147 :     val mem = R.memory
148 :    
149 :     fun cond T.LT = I.CC_LT | cond T.LTU = I.CC_LTU
150 :     | cond T.LE = I.CC_LE | cond T.LEU = I.CC_LEU
151 :     | cond T.EQ = I.CC_EQ | cond T.NEQ = I.CC_NEQ
152 :     | cond T.GE = I.CC_GE | cond T.GEU = I.CC_GEU
153 :     | cond T.GT = I.CC_GT | cond T.GTU = I.CC_GTU
154 :    
155 :     fun swapcc I.CC_LT = I.CC_GT | swapcc I.CC_LTU = I.CC_GTU
156 :     | swapcc I.CC_LE = I.CC_GE | swapcc I.CC_LEU = I.CC_GEU
157 :     | swapcc I.CC_EQ = I.CC_EQ | swapcc I.CC_NEQ = I.CC_NEQ
158 :     | swapcc I.CC_GT = I.CC_LT | swapcc I.CC_GEU = I.CC_LEU
159 :     | swapcc I.CC_GE = I.CC_LE | swapcc _ = error "swapcc"
160 :    
161 :     (* NOTE: stack allocation must be multiples of 16 *)
162 :     fun stackAllocate(n) =
163 :     I.OPERATE{oper=I.SUBL, ra=C.stackptrR, rb=I.IMMop n, rc=C.stackptrR}
164 :    
165 :     fun stackDeallocate(n) =
166 :     I.OPERATE{oper=I.ADDL, ra=C.stackptrR, rb=I.IMMop n, rc=C.stackptrR}
167 :    
168 :     fun loadImmed(n, base, rd) =
169 :     if ~32768 <= n andalso n < 32768 then
170 :     emit(I.LDA{r=rd, b=base, d=I.IMMop n})
171 :     else let
172 :     val w = itow n
173 :     val hi = Word.~>>(w, 0w16)
174 :     val lo = Word.andb(w, 0w65535)
175 :     val (hi', lo') =
176 :     if lo < 0w32768 then (hi, lo) else (hi+0w1, lo-0w65536)
177 :     in
178 :     emit(I.LDA{r=rd, b=base, d=I.IMMop(wtoi lo')});
179 :     emit(I.LDAH{r=rd, b=rd, d=I.IMMop(wtoi hi')})
180 :     end
181 :    
182 :     (* loadImmed32 is used to load int32 and word32 constants.
183 :     * In either case we sign extend the 32-bit value. This is compatible
184 :     * with LDL which sign extends a 32-bit valued memory location.
185 :     *)
186 : monnier 123 fun loadImmed32(0w0, base, rd) =
187 :     emit(I.OPERATE{oper=I.ADDL, ra=base, rb=zeroOp, rc=rd})
188 :     | loadImmed32(n, base, rd) = let
189 :     val low = W32.andb(n, 0w65535) (* unsigned (0 .. 65535) *)
190 :     val high = W32.~>>(n, 0w16) (* signed (~32768 .. 32768] *)
191 :     fun loadimmed(0, high) = emit(I.LDAH{r=rd, b=base, d=I.IMMop(high)})
192 :     | loadimmed(low, high) =
193 :     (emit(I.LDA{r=rd, b=base, d=I.IMMop(low)});
194 :     emit(I.LDAH{r=rd, b=rd, d=I.IMMop(high)}))
195 :     in
196 :     if W32.<(low, 0w32768) then loadimmed(W32.toInt low, W32.toIntX high)
197 :     else let (* low = (32768 .. 65535) *)
198 :     val lowsgn = W32.-(low, 0w65536) (* signed (~1 .. ~32768) *)
199 :     val highsgn = W32.+(high, 0w1) (* (~32768 .. 32768) *)
200 :     val ilow = W32.toIntX lowsgn
201 :     val ihigh = W32.toIntX highsgn
202 :     in
203 :     if ihigh <> 32768 then loadimmed(ilow, ihigh)
204 :     else let
205 :     val tmpR = C.newReg()
206 :     in
207 :     (* you gotta do what you gotta do! *)
208 :     emit(I.LDA{r=rd, b=base, d=I.IMMop(ilow)});
209 :     emit(I.OPERATE{oper=I.ADDL, ra=zeroR, rb=I.IMMop 1, rc=tmpR});
210 :     emit(I.OPERATE{oper=I.SLL, ra=tmpR, rb=I.IMMop 31, rc=tmpR});
211 :     emit(I.OPERATE{oper=I.ADDL, ra=tmpR, rb=I.REGop rd, rc=rd})
212 :     end
213 :     end
214 :     end
215 : monnier 16
216 :     fun orderedFArith (exp1, exp2, T.LR) = (fregAction exp1, fregAction exp2)
217 :     | orderedFArith (exp1, exp2, T.RL) = let
218 :     val f2 = fregAction exp2
219 :     in (fregAction exp1, f2)
220 :     end
221 :    
222 :     and stmAction exp = let
223 :     fun fbranch(_, T.FCMP(cc, exp1, exp2, order), lab) = let
224 :     val (f1, f2) = orderedFArith(exp1, exp2, order)
225 :     fun bcc(cmp, br) = let
226 : monnier 106 val tmpR = C.newFreg()
227 : monnier 16 in
228 :     emit(I.DEFFREG(tmpR));
229 :     emit(I.FOPERATE{oper=cmp, fa=f1, fb=f2, fc=tmpR});
230 :     emit(I.TRAPB);
231 :     emit(I.FBRANCH(br, tmpR, lab))
232 :     end
233 :    
234 :     fun fall(cmp1, br1, cmp2, br2) = let
235 : monnier 106 val tmpR1 = C.newFreg()
236 :     val tmpR2 = C.newFreg()
237 : monnier 16 val fallLab = Label.newLabel ""
238 :     in
239 :     emit(I.DEFFREG(tmpR1));
240 :     emit(I.FOPERATE{oper=cmp1, fa=f1, fb=f2, fc=tmpR1});
241 :     emit(I.TRAPB);
242 :     emit(I.FBRANCH(br1, tmpR1, fallLab));
243 :     emit(I.DEFFREG(tmpR2));
244 :     emit(I.FOPERATE{oper=cmp2, fa=f1, fb=f2, fc=tmpR2});
245 :     emit(I.TRAPB);
246 :     emit(I.FBRANCH(br2, tmpR2, lab));
247 :     F.defineLabel fallLab
248 :     end
249 :    
250 :     fun bcc2(cmp1, br1, cmp2, br2) = (bcc(cmp1, br1); bcc(cmp2, br2))
251 :     in
252 :     case cc
253 :     of T.== => bcc(I.CMPTEQ, I.BNE)
254 :     | T.?<> => bcc(I.CMPTEQ, I.BEQ)
255 :     | T.? => bcc(I.CMPTUN, I.BNE)
256 :     | T.<=> => bcc(I.CMPTUN, I.BEQ)
257 :     | T.> => fall(I.CMPTLE, I.BNE, I.CMPTUN, I.BEQ)
258 :     | T.>= => fall(I.CMPTLT, I.BNE, I.CMPTUN, I.BEQ)
259 :     | T.?> => bcc(I.CMPTLE, I.BEQ)
260 :     | T.?>= => bcc(I.CMPTLT, I.BEQ)
261 :     | T.< => bcc(I.CMPTLT, I.BNE)
262 :     | T.<= => bcc(I.CMPTLE, I.BNE)
263 :     | T.?< => bcc2(I.CMPTLT, I.BNE, I.CMPTUN, I.BNE)
264 :     | T.?<= => bcc2(I.CMPTLE, I.BNE, I.CMPTUN, I.BNE)
265 :     | T.<> => fall(I.CMPTEQ, I.BNE, I.CMPTUN, I.BEQ)
266 :     | T.?= => bcc2(I.CMPTEQ, I.BNE, I.CMPTUN, I.BNE)
267 :     end
268 :    
269 :     fun branch(cond, exp1, exp2, lab, order) = let
270 :     fun zapHi r = emit(I.OPERATE{oper=I.ZAP, ra=r, rb=I.IMMop 0xf0, rc=r})
271 : monnier 106 val tmpR = C.newReg()
272 : monnier 16 val (r1, o2) =
273 :     case order
274 :     of T.LR => (regAction exp1, opndAction exp2)
275 :     | T.RL => let val o2' = opndAction exp2
276 :     in
277 :     (regAction(exp1), o2')
278 :     end
279 :     fun emitBr(cmp, br) =
280 :     (emit(I.OPERATE{oper=cmp, ra=r1, rb=o2, rc=tmpR});
281 :     emit(I.BRANCH(br, tmpR, lab)))
282 :     fun emitUnsignedBr(cmp, br) =
283 :     (case (r1, o2)
284 :     of (r1, I.REGop r2) => (zapHi r1; zapHi r2; emitBr(cmp, br))
285 :     | (r1, o2) => (zapHi r1; emitBr(cmp, br))
286 :     (*esac*))
287 :     in
288 :     case cond
289 :     of I.CC_LTU => emitUnsignedBr(I.CMPULT, I.BNE)
290 :     | I.CC_LEU => emitUnsignedBr(I.CMPULE, I.BNE)
291 :     | I.CC_GTU => emitUnsignedBr(I.CMPULE, I.BEQ)
292 :     | I.CC_GEU => emitUnsignedBr(I.CMPULT, I.BEQ)
293 :     | I.CC_LT => emitBr(I.CMPLT, I.BNE)
294 :     | I.CC_LE => emitBr(I.CMPLE, I.BNE)
295 :     | I.CC_GT => emitBr(I.CMPLE, I.BEQ)
296 :     | I.CC_GE => emitBr(I.CMPLT, I.BEQ)
297 :     | I.CC_EQ => emitBr(I.CMPEQ, I.BNE)
298 :     | I.CC_NEQ => emitBr(I.CMPEQ, I.BEQ)
299 :     end
300 : monnier 106 fun copyTmp() = SOME(I.Direct(C.newReg()))
301 :     fun fcopyTmp() = SOME(I.FDirect(C.newFreg()))
302 : monnier 16 in
303 :     case exp
304 :     of T.JMP(T.LABEL(LE.LABEL lab), _) => emit(I.BRANCH(I.BR, zeroR, lab))
305 :     | T.JMP(T.LABEL _, _) => error "JMP(T.LABEL _, _)"
306 :     | T.JMP(exp, labs) =>
307 :     emit(I.JMPL({r=C.asmTmpR, b=regAction exp, d=0}, labs))
308 :     | T.BCC(_, T.CMP(T.NEQ, T.ANDB(exp, T.LI 1), T.LI 0, _), lab) =>
309 :     emit(I.BRANCH(I.BLBS, regAction exp, lab))
310 :     | T.BCC(_, T.CMP(cc, exp, T.LI n, ord), lab) =>
311 :     branch(cond cc, exp, T.LI n, lab, ord)
312 :     | T.BCC(_, T.CMP(cc, T.LI n, exp, ord), lab) =>
313 :     branch(swapcc(cond cc), exp, T.LI n, lab, ord)
314 :     | T.BCC(_, T.CMP(cc, e1, e2, ord), lab) =>
315 :     branch(cond cc, e1, e2, lab, ord)
316 :     | T.BCC(_, e, lab) => emit(I.BRANCH(I.BNE, ccAction e, lab))
317 :     | T.FBCC arg => fbranch arg
318 :     | T.CALL(exp, def, use) => let
319 :     val pv = regAction exp
320 :     val returnPtrR = 26
321 :     fun live([],acc) = acc
322 :     | live(T.GPR(T.REG r)::regs,acc) = live(regs, C.addReg(r,acc))
323 :     | live(T.CCR(T.CC cc)::regs,acc) = live(regs, C.addReg(cc,acc))
324 :     | live(T.FPR(T.FREG f)::regs,acc) = live(regs, C.addFreg(f,acc))
325 :     | live(_::regs, acc) = live(regs, acc)
326 :     in
327 :     emit(I.JSR({r=returnPtrR, b=pv, d=0},
328 :     live(def, C.addReg(returnPtrR, C.empty)),
329 :     live(use, C.addReg(pv, C.empty))))
330 :     end
331 :     | T.RET => emit(I.JMPL({r=zeroR, b=26, d=0}, []))
332 :     | T.STORE8(ea, r, region) => let
333 :     val rs = regAction r
334 :     val (rd, disp) = eaAction ea
335 : monnier 106 val t1 = C.newReg()
336 :     val t2 = C.newReg()
337 :     val t3 = C.newReg()
338 : monnier 16 in
339 :     app emit
340 :     [I.LOAD{ldOp=I.LDQ_U, r=t1, b=rd, d=disp,mem=mem},
341 :     I.LDA{r=t2, b=rd, d=disp},
342 :     I.OPERATE{oper=I.INSBL, ra=rs, rb=I.REGop(t2), rc=t3},
343 :     I.OPERATE{oper=I.MSKBL, ra=t1, rb=I.REGop(t2), rc=t1},
344 :     I.OPERATE{oper=I.BIS, ra=t1, rb=I.REGop(t3), rc=t1},
345 :     I.STORE{stOp=I.STQ_U, r=t1, b=rd, d=disp, mem=mem}]
346 :     end
347 :     | T.STORE32(ea, r, region) => let
348 :     val (b, d) = eaAction ea
349 :     in emit(I.STORE{stOp=I.STL, r=regAction r, b=b, d=d, mem=region})
350 :     end
351 :     | T.STORED(ea, f, region) => let
352 :     val (b, d) = eaAction ea
353 :     in emit(I.FSTORE{stOp=I.STT, r=fregAction f, b=b, d=d, mem=region})
354 :     end
355 :     | T.STORECC(ea, cc, region) => error "stmAction.STORECC"
356 :     | T.MV(rd, exp) => let
357 :     fun move(dst, src) = I.OPERATE{oper=I.BIS, ra=src, rb=zeroOp, rc=dst}
358 :     in
359 :     case exp
360 :     of T.REG(rs) => if rs = rd then () else emit(move(rd, rs))
361 :     | T.LI n => loadImmed(n, zeroR, rd)
362 :     | T.LI32 w => loadImmed32(w, zeroR, rd)
363 :     | _ => let val rs = regActionRd(exp, rd)
364 :     in if rs = rd then () else emit(move(rd,rs))
365 :     end
366 :     (*esac*)
367 :     end
368 :     | T.CCMV(cd, exp) => let
369 :     val cs = case exp of T.CC(r) => r | _ => ccActionCd(exp, cd)
370 :     in
371 :     if cs = cd then ()
372 :     else emit(I.OPERATE{oper=I.BIS, ra=cs, rb=zeroOp, rc=cd})
373 :     end
374 :     | T.FMV(fd, exp) => let
375 :     fun fmove(dst, src) = I.FOPERATE{oper=I.CPYS, fa=src, fb=src, fc=dst}
376 :     in
377 :     case exp
378 :     of T.FREG(fs) =>
379 :     if fs = fd then () else emit(fmove(fd, fs))
380 :     | _ => let
381 :     val fs = fregActionFd(exp, fd)
382 :     in if fs = fd then () else emit(fmove(fd, fs))
383 :     end
384 :     (*esac*)
385 :     end
386 :     | T.COPY(rds as [_], rss) =>
387 :     emit(I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=NONE})
388 :     | T.COPY(rds, rss) =>
389 :     emit(I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=copyTmp()})
390 :     | T.FCOPY(fds as [_], fss)=>
391 :     emit(I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=NONE})
392 :     | T.FCOPY(fds, fss) =>
393 :     emit(I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=fcopyTmp()})
394 :     end
395 :     and ccAction(T.CC r) = r
396 :     | ccAction(e) = ccActionCd(e, C.newCCreg())
397 :    
398 :     and ccActionCd(T.CC r, _) = r
399 :     (* enough for now ... *)
400 :     | ccActionCd(T.CMP(T.GTU, e1, e2, ord), cd) = let
401 :     val (opnd, reg) =
402 :     case ord
403 :     of T.LR => (opndAction e1, regAction e2)
404 :     | T.RL => let
405 :     val r = regAction e2
406 :     in (opndAction e1, r)
407 :     end
408 :     in
409 :     emit(I.OPERATE{oper=I.CMPULT, ra=reg, rb=opnd, rc=cd});
410 :     cd
411 :     end
412 :     | ccActionCd(T.LOADCC _, _) = error "ccAction"
413 :    
414 :     and opndAction (T.LI value) =
415 :     if value <= 255 andalso value >= 0 then I.IMMop value
416 :     else let
417 : monnier 106 val tmpR = C.newReg()
418 : monnier 16 in
419 :     loadImmed (value, zeroR, tmpR);
420 :     I.REGop tmpR
421 :     end
422 :     | opndAction(T.LI32 value) =
423 :     if Word32.<=(value, 0w255) then I.IMMop (Word32.toInt value)
424 :     else let
425 : monnier 106 val tmpR = C.newReg ()
426 : monnier 16 in
427 :     loadImmed32 (value, zeroR, tmpR);
428 :     I.REGop tmpR
429 :     end
430 :     | opndAction(T.CONST const) = I.CONSTop (const)
431 :     | opndAction exp = I.REGop (regAction exp)
432 :    
433 :     and reduceOpnd(I.IMMop i) = let
434 : monnier 106 val rd = C.newReg()
435 : monnier 16 in loadImmed(i, zeroR, rd); rd
436 :     end
437 :     | reduceOpnd(I.REGop rd) = rd
438 :     | reduceOpnd(I.CONSTop c) = regAction(T.CONST c)
439 :     | reduceOpnd(I.LABop le) = regAction(T.LABEL le)
440 :     | reduceOpnd _ = error "reduceOpnd"
441 :    
442 :     and orderedRR(e1, e2, T.LR) = (regAction e1, regAction e2)
443 :     | orderedRR(e1, e2, T.RL) = let
444 :     val r2 = regAction e2
445 :     in (regAction e1, r2)
446 :     end
447 :    
448 :     and regAction (T.REG r) = r
449 : monnier 106 | regAction exp = regActionRd(exp, C.newReg())
450 : monnier 16
451 :     and arithOperands(e1, e2, T.LR) = (regAction e1, opndAction e2)
452 :     | arithOperands(e1, e2, T.RL) = let
453 :     val opnd = opndAction e2
454 :     in (regAction e1, opnd)
455 :     end
456 :    
457 :     and regActionRd(exp, rd) = let
458 :    
459 :     fun orderedArith(oper, arith, e1, e2, ord) = let
460 :     val (reg, opnd) = arithOperands(e1, e2, ord)
461 :     in
462 :     emit(oper{oper=arith, ra=reg, rb=opnd, rc=rd});
463 :     rd
464 :     end
465 :    
466 :     fun commOrderedArith(oper, arith, e1 ,e2, ord) = let
467 :     fun f(e1 as T.LI _, e2) = orderedArith(oper, arith, e2, e1, ord)
468 :     | f(e1 as T.LI32 _, e2) = orderedArith(oper, arith, e2, e1, ord)
469 :     | f(e1, e2) = orderedArith(oper, arith, e1, e2, ord)
470 :     in
471 :     f(e1, e2)
472 :     end
473 :    
474 :    
475 :     fun orderedArithTrap arg = orderedArith arg before emit(I.TRAPB)
476 :     fun commOrderedArithTrap arg = commOrderedArith arg before emit(I.TRAPB)
477 :    
478 :     fun orderedMullTrap (e1, e2, ord, rd) = let
479 :     val (reg, opnd) = case ord
480 :     of T.LR => (regAction e1, opndAction e2)
481 :     | T.RL => let
482 :     val opnd = opndAction e2
483 :     in
484 :     (regAction e1, opnd)
485 :     end
486 :    
487 :     fun emitMulvImmed (reg, 0, rd) =
488 :     emit(I.LDA{r=rd, b=zeroR, d=I.IMMop 0})
489 :     | emitMulvImmed (reg, 1, rd) =
490 :     emit(I.OPERATE{oper=I.ADDL, ra=reg, rb=zeroOp, rc=rd})
491 :     | emitMulvImmed (reg, multiplier, rd) = let
492 :     fun log2 0w1 = 0 | log2 n = 1 + (log2 (Word.>> (n, 0w1)))
493 :    
494 :     fun exp2 n = Word.<<(0w1, n)
495 :    
496 :     fun bitIsSet (x,n) = Word.andb(x,exp2 n) <> 0w0
497 :    
498 :     fun loop (~1) = ()
499 :     | loop n =
500 :     (if bitIsSet(itow multiplier, itow n) then
501 :     emit(I.OPERATEV{oper=I.ADDLV, ra=reg, rb=I.REGop rd, rc=rd})
502 :     else ();
503 :     if n>0 then
504 :     emit(I.OPERATEV{oper=I.ADDLV, ra=rd, rb=I.REGop rd, rc=rd})
505 :     else ();
506 :     loop (n-1))
507 :     in
508 :     emit(I.OPERATEV{oper=I.ADDLV, ra=reg, rb=I.REGop reg, rc=rd});
509 :     loop ((log2 (itow multiplier)) - 1)
510 :     end
511 :     in
512 :     case opnd
513 :     of (I.IMMop multiplier) => emitMulvImmed (reg, multiplier, rd)
514 :     | _ => emit (I.OPERATEV{oper=I.MULLV , ra=reg, rb=opnd, rc=rd})
515 :     (*esac*);
516 :     emit(I.TRAPB);
517 :     rd
518 :     end
519 :    
520 :     fun opndToWord (T.LI i) = SOME (Word32.fromInt i)
521 :     | opndToWord (T.LI32 w) = SOME w
522 :     | opndToWord _ = NONE
523 :     in
524 :     case exp
525 :     of T.LI n => (loadImmed(n, zeroR, rd); rd)
526 :     | T.LI32 w => (loadImmed32(w, zeroR, rd); rd)
527 :     | T.LABEL le => (emit(I.LDA{r=rd, b=zeroR, d=I.LABop le}); rd)
528 :     | T.CONST c => (emit(I.LDA{r=rd, b=zeroR, d=I.CONSTop(c)}); rd)
529 :     | T.ADD(e, T.LABEL le)=>
530 :     (emit(I.LDA{r=rd, b=regAction(e), d=I.LABop(le)}); rd)
531 :     | T.ADD(T.LI i, e) => (loadImmed(i, regAction e, rd); rd)
532 :     | T.ADD(e, T.LI i) => (loadImmed(i, regAction e, rd); rd)
533 :     | T.ADD(T.LI32 i, e) => (loadImmed32(i, regAction e, rd); rd)
534 :     | T.ADD(e, T.LI32 i) => (loadImmed32(i, regAction e, rd); rd)
535 :     | T.ADD(T.CONST c, e) =>
536 :     (emit(I.LDA{r=rd, b=regAction e, d=I.CONSTop c}); rd)
537 :     | T.ADD(e, T.CONST c) =>
538 :     (emit(I.LDA{r=rd, b=regAction e, d=I.CONSTop c}); rd)
539 :     | T.ADD(e1, e2) => commOrderedArith(I.OPERATE, I.ADDL, e1, e2, T.LR)
540 :     | T.SUB(e1, e2, ord) => orderedArith(I.OPERATE, I.SUBL, e1, e2, ord)
541 :     | T.MULU(e1, e2) => commOrderedArith(I.OPERATE, I.MULL, e1, e2, T.LR)
542 :     | T.ADDT(e1, e2) =>
543 :     commOrderedArithTrap(I.OPERATEV, I.ADDLV, e1, e2, T.LR)
544 :     | T.SUBT(e1, e2, ord) => orderedArithTrap(I.OPERATEV, I.SUBLV, e1, e2, ord)
545 :     | T.MULT(e1, e2) => orderedMullTrap(e1, e2, T.LR, rd)
546 :     | T.ANDB(e1, e2) => let
547 :     fun opndToByteMask (SOME (0wx0:Word32.word)) = SOME 0xf
548 :     | opndToByteMask (SOME 0wx000000ff) = SOME 0xe
549 :     | opndToByteMask (SOME 0wx0000ff00) = SOME 0xd
550 :     | opndToByteMask (SOME 0wx0000ffff) = SOME 0xc
551 :     | opndToByteMask (SOME 0wx00ff0000) = SOME 0xb
552 :     | opndToByteMask (SOME 0wx00ff00ff) = SOME 0xa
553 :     | opndToByteMask (SOME 0wx00ffff00) = SOME 0x9
554 :     | opndToByteMask (SOME 0wx00ffffff) = SOME 0x8
555 :     | opndToByteMask (SOME 0wxff000000) = SOME 0x7
556 :     | opndToByteMask (SOME 0wxff0000ff) = SOME 0x6
557 :     | opndToByteMask (SOME 0wxff00ff00) = SOME 0x5
558 :     | opndToByteMask (SOME 0wxff00ffff) = SOME 0x4
559 :     | opndToByteMask (SOME 0wxffff0000) = SOME 0x3
560 :     | opndToByteMask (SOME 0wxffff00ff) = SOME 0x2
561 :     | opndToByteMask (SOME 0wxffffff00) = SOME 0x1
562 :     | opndToByteMask (SOME 0wxffffffff) = SOME 0x0
563 :     | opndToByteMask _ = NONE
564 :    
565 :     val opndToMask = opndToByteMask o opndToWord
566 :     in
567 :     case (opndToMask e1, opndToMask e2) of
568 :     (SOME mask, _) =>
569 :     orderedArith(I.OPERATE, I.ZAP, e2, T.LI mask, T.LR)
570 :     | (_, SOME mask) =>
571 :     orderedArith(I.OPERATE, I.ZAP, e1, T.LI mask, T.LR)
572 :     | _ => commOrderedArith(I.OPERATE, I.AND, e1, e2, T.LR)
573 :     end
574 :     | T.ORB(e1, e2) => commOrderedArith(I.OPERATE, I.BIS, e1, e2, T.LR)
575 :     | T.XORB(e1, e2) => commOrderedArith(I.OPERATE, I.XOR, e1, e2, T.LR)
576 :     | T.SLL(e1, e2, ord) =>
577 :     (case opndToWord e2 of
578 :     SOME 0w1 => let val r = T.REG (regAction e1)
579 :     in orderedArith(I.OPERATE, I.ADDL, r, r, T.LR) end
580 :     | SOME 0w2 => orderedArith(I.OPERATE, I.S4ADDL, e1, T.LI 0, T.LR)
581 :     | SOME 0w3 => orderedArith(I.OPERATE, I.S8ADDL, e1, T.LI 0, T.LR)
582 :     | _ => (orderedArith(I.OPERATE, I.SLL, e1, e2, T.LR);
583 :     emit(I.OPERATE{oper=I.SGNXL, ra=rd, rb=zeroOp, rc=rd});
584 :     rd)
585 :     (*esac*))
586 :     | T.SRA(e1, e2, ord) => let
587 :     val (reg, opnd) = (regAction e1, opndAction e2)
588 :     in
589 :     (* sign extend longword argument *)
590 :     emit(I.OPERATE{oper=I.SGNXL, ra=reg, rb=zeroOp, rc=reg});
591 :     emit(I.OPERATE{oper=I.SRA, ra=reg, rb=opnd, rc=rd});
592 :     rd
593 :     end
594 :     | T.SRL(e1, e2, ord) => let
595 :     val (reg, opnd) = (regAction e1, opndAction e2)
596 :     in
597 :     emit(I.OPERATE{oper=I.ZAP, ra=reg, rb=I.IMMop 0xf0, rc=reg});
598 :     emit(I.OPERATE{oper=I.SRL, ra=reg, rb=opnd, rc=rd});
599 :     rd
600 :     end
601 :     | T.DIVT arg => let
602 :     val (reg, opnd) = arithOperands arg
603 :     in
604 :     app emit (PseudoInstrs.divl({ra=reg, rb=opnd, rc=rd}, reduceOpnd));
605 :     rd
606 :     end
607 :     | T.DIVU arg => let
608 :     val (reg, opnd) = arithOperands arg
609 :     in
610 :     app emit (PseudoInstrs.divlu({ra=reg, rb=opnd, rc=rd}, reduceOpnd));
611 :     rd
612 :     end
613 :     | T.LOAD32(exp, region) => let
614 :     val (b, d) = eaAction exp
615 :     in emit(I.LOAD{ldOp=I.LDL, r=rd, b=b, d=d, mem=region}); rd
616 :     end
617 :     (* Load and sign-extend a byte from a non-aligned address *)
618 :     | T.LOAD8(exp, region) => let
619 : monnier 106 val tmpR0 = C.newReg()
620 :     val tmpR1 = C.newReg()
621 : monnier 16 val (rt, disp) = eaAction exp
622 :     in
623 :     emit(I.LOAD{ldOp=I.LDQ_U, r=tmpR0, b=rt, d=disp, mem=mem});
624 :     emit(I.LDA{r=tmpR1, b=rt, d=disp});
625 :     emit(I.OPERATE{oper=I.EXTBL, ra=tmpR0, rb=I.REGop tmpR1, rc=rd});
626 :     rd
627 :     end
628 :     | T.SEQ(e1, e2) => (stmAction e1; regAction e2)
629 :     | _ => error "regAction"
630 :     end (* regActionRd *)
631 :    
632 :     and eaAction exp = let
633 :     fun makeEA(r, n) =
634 :     if ~32768 <= n andalso n <= 32767 then (r, I.IMMop n)
635 :     else let
636 : monnier 106 val tmpR = C.newReg()
637 : monnier 16 val low = wtoi(Word.andb(itow n, 0w65535))(* unsigned low 16 bits *)
638 :     val high = n div 65536
639 :     val (lowsgn, highsgn) = (* Sign-extend *)
640 :     if low <= 32767 then (low, high) else (low -65536, high+1)
641 :     in
642 :     (emit(I.LDAH{r=tmpR, b=r, d=I.IMMop highsgn});
643 :     (tmpR, I.IMMop lowsgn))
644 :     end
645 :     in
646 :     case exp
647 :     of T.ADD(exp, T.LI n) => makeEA(regAction exp, n)
648 :     | T.ADD(T.LI n, exp) => makeEA(regAction exp, n)
649 :     | T.ADD(T.CONST c, exp) => (regAction exp, I.CONSTop(c))
650 :     | T.ADD(exp, T.CONST c) => (regAction exp, I.CONSTop(c))
651 :     | T.SUB(exp, T.LI n, _) => makeEA(regAction exp, ~n)
652 :     | exp => makeEA(regAction exp, 0)
653 :     end (* eaAction *)
654 :    
655 :     and fregAction (T.FREG f) = f
656 : monnier 106 | fregAction exp = fregActionFd(exp, C.newFreg())
657 : monnier 16
658 :     and fregActionFd(exp, fd) = let
659 :     (* macho comment goes here *)
660 :     fun doFloatArith(farith, e1, e2, fd, order) = let
661 :     val (f1, f2) = orderedFArith(e1, e2, order)
662 :     in
663 :     emit(I.DEFFREG fd);
664 :     emit(I.FOPERATEV{oper=farith, fa=f1, fb=f2, fc=fd});
665 :     emit(I.TRAPB);
666 :     fd
667 :     end
668 :     in
669 :     case exp
670 :     of T.FREG f => f
671 :     | T.FADDD(e1, e2) => doFloatArith(I.ADDT, e1, e2, fd, T.LR)
672 :     | T.FMULD(e1, e2) => doFloatArith(I.MULT, e1, e2, fd, T.LR)
673 :     | T.FSUBD(e1, e2, ord) => doFloatArith(I.SUBT, e1, e2, fd, ord)
674 :     | T.FDIVD(e1, e2, ord) => doFloatArith(I.DIVT, e1, e2, fd, ord)
675 :     | T.FABSD exp =>
676 :     (emit(I.FOPERATE{oper=I.CPYS, fa=zeroR, fb=fregAction exp, fc=fd}); fd)
677 :     | T.FNEGD exp => let
678 :     val fs = fregAction exp
679 :     in
680 :     emit(I.FOPERATE{oper=I.CPYSN, fa=fs, fb=fs, fc=fd}); fd
681 :     end
682 :     | T.CVTI2D exp => let
683 :     val opnd = opndAction exp
684 :     in
685 :     app emit (PseudoInstrs.cvti2d({opnd=opnd, fd=fd},reduceOpnd));
686 :     fd
687 :     end
688 :     | T.LOADD(exp, region) => let
689 :     val (b, d) = eaAction exp
690 :     in emit(I.FLOAD{ldOp=I.LDT, r=fd, b=b, d=d, mem=region}); fd
691 :     end
692 :     | T.FSEQ(e1, e2) => (stmAction e1; fregAction e2)
693 :     end
694 :    
695 :     fun mltreeComp mltree = let
696 :     (* condition code registers are mapped onto general registers *)
697 :     fun cc (T.CCR(T.CC cc)) = T.GPR(T.REG cc)
698 :     | cc x = x
699 :    
700 :     fun mltc(T.PSEUDO_OP pOp) = F.pseudoOp pOp
701 :     | mltc(T.DEFINELABEL lab) = F.defineLabel lab
702 :     | mltc(T.ENTRYLABEL lab) = F.entryLabel lab
703 :     | mltc(T.ORDERED mlts) = F.ordered mlts
704 :     | mltc(T.BEGINCLUSTER) = F.beginCluster()
705 :     | mltc(T.CODE stms) = app stmAction stms
706 : monnier 127 | mltc(T.BLOCK_NAME name) = F.blockName name
707 : monnier 16 | mltc(T.ENDCLUSTER regmap)= F.endCluster regmap
708 :     | mltc(T.ESCAPEBLOCK regs) = F.exitBlock (map cc regs)
709 :     in mltc mltree
710 :     end
711 :    
712 :     val mlriscComp = stmAction
713 :     end
714 :    
715 :    
716 : monnier 167 (*
717 :     * $Log: alpha32.sml,v $
718 :     * Revision 1.6 1998/08/11 14:03:13 george
719 :     * Exposed emitInstr in MLTREECOMP to allow a client to directly
720 :     * inject native instructions into the flowgraph.
721 :     *
722 :     * Revision 1.4 1998/06/05 23:53:57 george
723 :     * Fix for bug 1399 1361
724 :     *
725 :     * Revision 1.3 1998/05/25 15:10:44 george
726 :     * Fixed RCS keywords
727 :     *
728 :     *)

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