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/branches/SMLNJ/src/MLRISC/ppc/mltree/ppc.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/MLRISC/ppc/mltree/ppc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 429 - (view) (download)

1 : monnier 411 (*
2 :     * I've substantially modified this code generator to support the new MLTREE.
3 :     * Please see the file README.hppa for the ugly details.
4 :     *
5 :     * -- Allen
6 :     *)
7 :    
8 : monnier 247 functor PPC
9 :     (structure PPCInstr : PPCINSTR
10 :     structure PPCMLTree : MLTREE
11 :     where Region = PPCInstr.Region
12 :     and Constant = PPCInstr.Constant
13 : monnier 411 and type cond = MLTreeBasis.cond
14 :     and type fcond = MLTreeBasis.fcond
15 :     and type ext = MLTreeBasis.ext
16 :     and type rounding_mode = MLTreeBasis.rounding_mode
17 : monnier 247 structure PseudoInstrs : PPC_PSEUDO_INSTR
18 :     where I = PPCInstr
19 : monnier 411
20 :     (*
21 :     * Support 64 bit mode?
22 :     * This should be set to false for SML/NJ
23 :     *)
24 :     val bit64mode : bool
25 :    
26 :     (*
27 :     * Cost of multiplication in cycles
28 :     *)
29 :     val multCost : int ref
30 : monnier 247 ) : MLTREECOMP =
31 :     struct
32 : monnier 411 structure I = PPCInstr
33 :     structure T = PPCMLTree
34 : monnier 429 structure S = T.Stream
35 : monnier 411 structure C = PPCInstr.C
36 :     structure LE = LabelExp
37 : monnier 247 structure W32 = Word32
38 :    
39 : monnier 411 fun error msg = MLRiscErrorMsg.error("PPC",msg)
40 : monnier 247
41 : monnier 411 structure Gen = MLTreeGen
42 :     (structure T = T
43 :     val (intTy,naturalWidths) = if bit64mode then (64,[32,64]) else (32,[32])
44 : monnier 429 datatype rep = SE | ZE | NEITHER
45 :     val rep = NEITHER
46 : monnier 411 )
47 : monnier 247
48 : monnier 411 (*
49 :     * Special instructions
50 :     *)
51 :     fun MTLR r = I.MTSPR{rs=r, spr=C.lr}
52 :     fun MFLR r = I.MFSPR{rt=r, spr=C.lr}
53 :     val CR0 = C.Reg C.CC 0
54 :     val RET = I.BCLR{bo=I.ALWAYS, bf=CR0, bit=I.LT, LK=false, labels=[]}
55 :     fun SLLI32{r,i,d} =
56 :     I.ROTATEI{oper=I.RLWINM,ra=d,rs=r,sh=I.ImmedOp i,mb=0,me=SOME(31-i)}
57 :     fun SRLI32{r,i,d} =
58 :     I.ROTATEI{oper=I.RLWINM,ra=d,rs=r,sh=I.ImmedOp(32-i),mb=i,me=SOME(31)}
59 : monnier 247
60 : monnier 411 val _ = if C.lr = 80 then () else error "LR must be encoded as 80!"
61 : monnier 247
62 : monnier 411 (*
63 :     * Integer multiplication
64 :     *)
65 :     functor Multiply32 = MLTreeMult
66 :     (structure I = I
67 :     structure T = T
68 :     val intTy = 32
69 : monnier 429 type arg = {r1:C.cell,r2:C.cell,d:C.cell}
70 :     type argi = {r:C.cell,i:int,d:C.cell}
71 : monnier 247
72 : monnier 411 fun mov{r,d} = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}
73 :     fun add{r1,r2,d}= I.ARITH{oper=I.ADD,ra=r1,rb=r2,rt=d,Rc=false,OE=false}
74 :     fun slli{r,i,d} = [SLLI32{r=r,i=i,d=d}]
75 :     fun srli{r,i,d} = [SRLI32{r=r,i=i,d=d}]
76 :     fun srai{r,i,d} = [I.ARITHI{oper=I.SRAWI,rt=d,ra=r,im=I.ImmedOp i}]
77 :     )
78 : monnier 247
79 : monnier 411 structure Mulu32 = Multiply32
80 :     (val trapping = false
81 :     val multCost = multCost
82 :     fun addv{r1,r2,d}=[I.ARITH{oper=I.ADD,ra=r1,rb=r2,rt=d,Rc=false,OE=false}]
83 :     fun subv{r1,r2,d}=[I.ARITH{oper=I.SUBF,ra=r2,rb=r1,rt=d,Rc=false,OE=false}]
84 :     val sh1addv = NONE
85 :     val sh2addv = NONE
86 :     val sh3addv = NONE
87 :     )
88 : monnier 429 (val signed = false)
89 : monnier 247
90 : monnier 411 structure Mult32 = Multiply32
91 :     (val trapping = true
92 :     val multCost = multCost
93 :     fun addv{r1,r2,d} = error "Mult32.addv"
94 :     fun subv{r1,r2,d} = error "Mult32.subv"
95 :     val sh1addv = NONE
96 :     val sh2addv = NONE
97 :     val sh3addv = NONE
98 :     )
99 : monnier 429 (val signed = true)
100 : monnier 247
101 : monnier 411 fun selectInstructions
102 : monnier 429 (S.STREAM{emit,comment,
103 :     defineLabel,entryLabel,blockName,pseudoOp,annotation,
104 :     beginCluster,endCluster,exitBlock,phi,alias,...}) =
105 :     let (* mark an instruction with annotations *)
106 : monnier 411 fun mark'(instr,[]) = instr
107 :     | mark'(instr,a::an) = mark'(I.ANNOTATION{i=instr,a=a},an)
108 :     fun mark(instr,an) = emit(mark'(instr,an))
109 : monnier 247
110 : monnier 411 (* Label where trap is generated.
111 :     * For overflow trapping instructions, we generate a branch
112 :     * to this label.
113 :     *)
114 :     val trapLabel : Label.label option ref = ref NONE
115 : monnier 247
116 : monnier 411 val newReg = C.newReg
117 :     val newFreg = C.newFreg
118 :     val newCCreg = C.newCell C.CC
119 : monnier 247
120 : monnier 411 fun signed16 i = ~32768 <= i andalso i < 32768
121 :     fun signed12 i = ~2048 <= i andalso i < 2048
122 :     fun unsigned16 i = 0 <= i andalso i < 65536
123 :     fun unsigned5 i = 0 <= i andalso i < 32
124 :     fun unsigned6 i = 0 <= i andalso i < 64
125 : monnier 247
126 : monnier 411 fun move(rs,rd,an) =
127 :     if rs=rd then ()
128 :     else mark(I.COPY{dst=[rd],src=[rs],impl=ref NONE,tmp=NONE},an)
129 : monnier 247
130 : monnier 411 fun fmove(fs,fd,an) =
131 :     if fs=fd then ()
132 :     else mark(I.FCOPY{dst=[fd],src=[fs],impl=ref NONE,tmp=NONE},an)
133 : monnier 247
134 : monnier 411 fun ccmove(ccs,ccd,an) =
135 :     if ccd = ccs then () else mark(I.MCRF{bf=ccd, bfa=ccs},an)
136 : monnier 247
137 : monnier 411 fun copy(dst, src, an) =
138 :     mark(I.COPY{dst=dst, src=src, impl=ref NONE,
139 :     tmp=case dst of [_] => NONE
140 :     | _ => SOME(I.Direct(newReg()))},an)
141 :     fun fcopy(dst, src, an) =
142 :     mark(I.FCOPY{dst=dst, src=src, impl=ref NONE,
143 :     tmp=case dst of [_] => NONE
144 :     | _ => SOME(I.FDirect(newFreg()))},an)
145 :    
146 :     fun emitBranch{bo, bf, bit, addr, LK} =
147 :     let val fallThrLab = Label.newLabel""
148 :     val fallThrOpnd = I.LabelOp(LE.LABEL fallThrLab)
149 : monnier 247 in
150 : monnier 411 emit(I.BC{bo=bo, bf=bf, bit=bit, addr=addr, LK=LK, fall=fallThrOpnd});
151 :     defineLabel fallThrLab
152 : monnier 247 end
153 :    
154 : monnier 411 fun split n =
155 :     let val wtoi = Word.toIntX
156 :     val w = Word.fromInt n
157 :     val hi = Word.~>>(w, 0w16)
158 :     val lo = Word.andb(w, 0w65535)
159 :     val (high, low) = if lo < 0w32768 then (hi, lo)
160 :     else (hi+0w1, lo-0w65536)
161 :     in (wtoi high, wtoi low) end
162 : monnier 247
163 : monnier 411 fun loadImmedHiLo(0, lo, rt, an) =
164 :     mark(I.ARITHI{oper=I.ADDI, rt=rt, ra=0, im=I.ImmedOp lo}, an)
165 :     | loadImmedHiLo(hi, lo, rt, an) =
166 :     (mark(I.ARITHI{oper=I.ADDIS, rt=rt, ra=0, im=I.ImmedOp hi}, an);
167 :     if lo = 0 then ()
168 :     else emit(I.ARITHI{oper=I.ADDI, rt=rt, ra=rt, im=I.ImmedOp lo}))
169 : monnier 247
170 : monnier 411 fun loadImmed(n, rt, an) =
171 :     if signed16 n then
172 :     mark(I.ARITHI{oper=I.ADDI, rt=rt, ra=0 , im=I.ImmedOp n}, an)
173 :     else let val (hi, lo) = split n
174 :     in loadImmedHiLo(hi, lo, rt, an) end
175 : monnier 247
176 : monnier 411 fun loadImmedw(w, rt, an) =
177 :     let val wtoi = Word32.toIntX
178 :     in if w < 0w32768 then
179 :     mark(I.ARITHI{oper=I.ADDI,rt=rt,ra=0,im=I.ImmedOp(wtoi w)}, an)
180 :     else
181 :     let val hi = Word32.~>>(w, 0w16)
182 :     val lo = Word32.andb(w, 0w65535)
183 :     val (high, low) =
184 :     if lo < 0w32768 then (hi, lo) else (hi+0w1, lo-0w65536)
185 :     in loadImmedHiLo(wtoi high, wtoi low, rt, an)
186 :     end
187 :     end
188 : monnier 247
189 : monnier 411 fun loadLabel(lexp, rt, an) =
190 :     mark(I.ARITHI{oper=I.ADDI, rt=rt, ra=0, im=I.LabelOp lexp}, an)
191 :    
192 :     fun loadConst(c, rt, an) =
193 :     mark(I.ARITHI{oper=I.ADDI, rt=rt, ra=0, im=I.ConstOp c}, an)
194 :    
195 :     fun immedOpnd range (e1, e2 as T.LI i) =
196 :     (expr e1, if range i then I.ImmedOp i else I.RegOp(expr e2))
197 :     | immedOpnd _ (e1, T.CONST c) = (expr e1, I.ConstOp c)
198 :     | immedOpnd _ (e1, T.LABEL lexp) = (expr e1, I.LabelOp lexp)
199 :     | immedOpnd range (e1, e2 as T.LI32 w) =
200 :     let fun opnd2() = I.RegOp(expr e2)
201 :     in (expr e1,
202 :     let val i = Word32.toIntX w
203 :     in if range i then I.ImmedOp i else opnd2()
204 :     end handle Overflow => opnd2())
205 :     end
206 :     | immedOpnd _ (e1, e2) = (expr e1, I.RegOp(expr e2))
207 :    
208 :     and commImmedOpnd range (e1 as T.LI _, e2) =
209 :     immedOpnd range (e2, e1)
210 :     | commImmedOpnd range (e1 as T.CONST _, e2) =
211 :     immedOpnd range (e2, e1)
212 :     | commImmedOpnd range (e1 as T.LABEL _, e2) =
213 :     immedOpnd range (e2, e1)
214 :     | commImmedOpnd range arg = immedOpnd range arg
215 :    
216 :     and eCommImm range (oper, operi, e1, e2, rt, an) =
217 :     (case commImmedOpnd range (e1, e2)
218 :     of (ra, I.RegOp rb) =>
219 :     mark(I.ARITH{oper=oper, ra=ra, rb=rb, rt=rt, Rc=false, OE=false},an)
220 :     | (ra, opnd) =>
221 :     mark(I.ARITHI{oper=operi, ra=ra, im=opnd, rt=rt},an)
222 :     (*esac*))
223 :    
224 :     (*
225 :     * Compute a base/displacement effective address
226 :     *)
227 :     and addr(size,T.ADD(_, e, T.LI i)) =
228 :     let val ra = expr e
229 :     in if size i then (ra, I.ImmedOp i) else
230 :     let val (hi, lo) = split i
231 :     val tmpR = newReg()
232 :     in emit(I.ARITHI{oper=I.ADDIS, rt=tmpR, ra=ra, im=I.ImmedOp hi});
233 :     (tmpR, I.ImmedOp lo)
234 :     end
235 :     end
236 :     | addr(size,T.ADD(ty, T.LI i, e)) = addr(size,T.ADD(ty, e, T.LI i))
237 :     | addr(size,exp as T.SUB(ty, e, T.LI i)) =
238 :     (addr(size,T.ADD(ty, e, T.LI (~i)))
239 :     handle Overflow => (expr exp, I.ImmedOp 0))
240 :     | addr(size,T.ADD(_, e1, e2)) = (expr e1, I.RegOp (expr e2))
241 :     | addr(size,e) = (expr e, I.ImmedOp 0)
242 :    
243 :     (*
244 :     * Translate a statement, and annotate it
245 :     *)
246 :     and stmt(T.MV(_, rd, e),an) = doExpr(e, rd, an)
247 :     | stmt(T.FMV(_, fd, e),an) = doFexpr(e, fd, an)
248 :     | stmt(T.CCMV(ccd, ccexp), an) = doCCexpr(ccexp, ccd, an)
249 :     | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)
250 :     | stmt(T.FCOPY(_, dst, src), an) = fcopy(dst, src, an)
251 :     | stmt(T.JMP(T.LABEL lexp, labs),an) =
252 :     mark(I.B{addr=I.LabelOp lexp, LK=false},an)
253 :     | stmt(T.JMP(rexp, labs),an) =
254 :     let val rs = expr(rexp)
255 :     in emit(MTLR(rs));
256 :     mark(I.BCLR{bo=I.ALWAYS,bf=CR0,bit=I.LT,LK=false,labels=labs},an)
257 :     end
258 :     | stmt(T.CALL(rexp, defs, uses, mem), an) =
259 :     let val addCCreg = C.addCell C.CC
260 :     fun live([],acc) = acc
261 :     | live(T.GPR(T.REG(_,r))::regs,acc) = live(regs,C.addReg(r,acc))
262 :     | live(T.CCR(T.CC cc)::regs,acc) = live(regs,addCCreg(cc,acc))
263 :     | live(T.FPR(T.FREG(_,f))::regs,acc) = live(regs,C.addFreg(f,acc))
264 :     | live(_::regs, acc) = live(regs, acc)
265 :     val defs=live(defs,C.empty)
266 :     val uses=live(uses,C.empty)
267 :     in emit(MTLR(expr rexp));
268 :     mark(I.CALL{def=defs, use=uses, mem=mem}, an)
269 :     end
270 :     | stmt(T.RET,an) = mark(RET,an)
271 :     | stmt(T.STORE(ty,ea,data,mem),an) = store(ty,ea,data,mem,an)
272 :     | stmt(T.FSTORE(ty,ea,data,mem),an) = fstore(ty,ea,data,mem,an)
273 :     | stmt(T.BCC(_, T.CMP(_, _, T.LI _, T.LI _), _),_) = error "BCC"
274 :     | stmt(T.BCC(cc, T.CMP(ty, _, T.ANDB(_, e1, e2), T.LI 0), lab),an) =
275 :     (case commImmedOpnd unsigned16 (e1, e2)
276 :     of (ra, I.RegOp rb) =>
277 :     emit(I.ARITH{oper=I.AND, ra=ra, rb=rb, rt=newReg(),
278 :     Rc=true, OE=false})
279 :     | (ra, opnd) =>
280 :     emit(I.ARITHI{oper=I.ANDI_Rc, ra=ra, im=opnd, rt=newReg()})
281 :     (*esac*);
282 :     stmt(T.BCC(cc, T.CC CR0, lab),an))
283 :     | stmt(T.BCC(cc, T.CMP(ty, _, e1 as T.LI _, e2), lab), an) =
284 :     let val cc' = MLTreeUtil.swapCond cc
285 :     in stmt(T.BCC(cc', T.CMP(ty, cc', e2, e1), lab), an)
286 :     end
287 :     | stmt(T.BCC(_, cmp as T.CMP(ty, cond, _, _), lab), an) =
288 :     let val ccreg = if true then CR0 else newCCreg() (* XXX *)
289 :     val (bo, cf) =
290 :     (case cond of
291 :     T.LT => (I.TRUE, I.LT)
292 :     | T.LE => (I.FALSE, I.GT)
293 :     | T.EQ => (I.TRUE, I.EQ)
294 :     | T.NE => (I.FALSE, I.EQ)
295 :     | T.GT => (I.TRUE, I.GT)
296 :     | T.GE => (I.FALSE, I.LT)
297 :     | T.LTU => (I.TRUE, I.LT)
298 :     | T.LEU => (I.FALSE, I.GT)
299 :     | T.GTU => (I.TRUE, I.GT)
300 :     | T.GEU => (I.FALSE, I.LT)
301 :     (*esac*))
302 :     val addr = I.LabelOp(LE.LABEL lab)
303 :     in doCCexpr(cmp, ccreg, []);
304 :     emitBranch{bo=bo, bf=ccreg, bit=cf, addr=addr, LK=false}
305 :     end
306 :     | stmt(T.BCC(cc, T.CC cr, lab), an) =
307 :     let val addr=I.LabelOp(LE.LABEL lab)
308 :     fun branch(bo, bit) =
309 :     emitBranch{bo=bo, bf=cr, bit=bit, addr=addr, LK=false}
310 :     in case cc of
311 :     T.EQ => branch(I.TRUE, I.EQ)
312 :     | T.NE => branch(I.FALSE, I.EQ)
313 :     | (T.LT | T.LTU) => branch(I.TRUE, I.LT)
314 :     | (T.LE | T.LEU) => branch(I.FALSE, I.GT)
315 :     | (T.GE | T.GEU) => branch(I.FALSE, I.LT)
316 :     | (T.GT | T.GTU) => branch(I.TRUE, I.GT)
317 :     end
318 :     | stmt(T.FBCC(_, cmp as T.FCMP(fty, cond, _, _), lab),an) =
319 :     let val ccreg = if true then CR0 else newCCreg() (* XXX *)
320 :     val labOp = I.LabelOp(LE.LABEL lab)
321 :     fun branch(bo, bf, bit) =
322 :     emitBranch{bo=bo, bf=bf, bit=bit, addr=labOp, LK=false}
323 :     fun test2bits(bit1, bit2) =
324 :     let val ba=(ccreg, bit1)
325 :     val bb=(ccreg, bit2)
326 :     val bt=(ccreg, I.FL)
327 :     in emit(I.CCARITH{oper=I.CROR, bt=bt, ba=ba, bb=bb});
328 :     branch(I.TRUE, ccreg, I.FL)
329 :     end
330 :     in doCCexpr(cmp, ccreg, []);
331 :     case cond of
332 :     T.== => branch(I.TRUE, ccreg, I.FE)
333 :     | T.?<> => branch(I.FALSE, ccreg, I.FE)
334 :     | T.? => branch(I.TRUE, ccreg, I.FU)
335 :     | T.<=> => branch(I.FALSE, ccreg, I.FU)
336 :     | T.> => branch(I.TRUE, ccreg, I.FG)
337 :     | T.>= => test2bits(I.FG, I.FE)
338 :     | T.?> => test2bits(I.FU, I.FG)
339 :     | T.?>= => branch(I.FALSE, ccreg, I.FL)
340 :     | T.< => branch(I.TRUE, ccreg, I.FL)
341 :     | T.<= => test2bits(I.FL, I.FE)
342 :     | T.?< => test2bits(I.FU, I.FL)
343 :     | T.?<= => branch(I.FALSE, ccreg, I.FG)
344 :     | T.<> => test2bits(I.FL, I.FG)
345 :     | T.?= => test2bits(I.FU, I.FE)
346 :     (*esac*)
347 :     end
348 :    
349 :     | stmt(T.ANNOTATION(s,a),an) = stmt(s,a::an)
350 :     | stmt _ = error "stmt"
351 :    
352 :     and doStmt(s) = stmt(s,[])
353 :    
354 :     (* Emit an integer store *)
355 :     and store(ty, ea, data, mem, an) =
356 :     let val (st,size) = case (ty,Gen.size ea) of
357 :     (8,32) => (I.STB,signed16)
358 :     | (8,64) => (I.STBE,signed12)
359 :     | (16,32) => (I.STH,signed16)
360 :     | (16,64) => (I.STHE,signed12)
361 :     | (32,32) => (I.STW,signed16)
362 :     | (32,64) => (I.STWE,signed12)
363 :     | (64,64) => (I.STDE,signed12)
364 :     | _ => error "store"
365 :     val (r, disp) = addr(size,ea)
366 :     in mark(I.ST{st=st, rs=expr data, ra=r, d=disp, mem=mem}, an) end
367 :    
368 :     (* Emit a floating point store *)
369 :     and fstore(ty, ea, data, mem, an) =
370 :     let val (st,size) = case (ty,Gen.size ea) of
371 :     (32,32) => (I.STFS,signed16)
372 :     | (32,64) => (I.STFSE,signed12)
373 :     | (64,32) => (I.STFD,signed16)
374 :     | (64,64) => (I.STFDE,signed12)
375 :     | _ => error "fstore"
376 :     val (r, disp) = addr(size,ea)
377 :     in mark(I.STF{st=st,fs=fexpr data, ra=r, d=disp, mem=mem},an) end
378 : monnier 247
379 : monnier 411 and subfImmed(i, ra, rt, an) =
380 :     if signed16 i then
381 :     mark(I.ARITHI{oper=I.SUBFIC, rt=rt, ra=ra, im=I.ImmedOp i}, an)
382 :     else
383 :     mark(I.ARITH{oper=I.SUBF, rt=rt, ra=ra, rb=expr(T.LI i),
384 :     Rc=false, OE=false}, an)
385 :    
386 :     (* Generate an arithmetic instruction *)
387 :     and arith(oper, e1, e2, rt, an) =
388 :     mark(I.ARITH{oper=oper,ra=expr e1,rb=expr e2,rt=rt,OE=false,Rc=false},
389 :     an)
390 :    
391 :     (* Generate a trapping instruction *)
392 :     and arithTrapping(oper, e1, e2, rt, an) =
393 :     let val ra = expr e1 val rb = expr e2
394 :     in mark(I.ARITH{oper=oper,ra=ra,rb=rb,rt=rt,OE=true,Rc=true},an);
395 :     overflowTrap()
396 :     end
397 : monnier 247
398 : monnier 411 (* Generate an overflow trap *)
399 :     and overflowTrap() =
400 :     let val label = case !trapLabel of
401 :     NONE => let val l = Label.newLabel ""
402 :     in trapLabel := SOME l; l end
403 :     | SOME l => l
404 :     in emitBranch{bo=I.TRUE, bf=CR0, bit=I.SO, LK=false,
405 :     addr=I.LabelOp(LE.LABEL label)}
406 :     end
407 :    
408 :     (* Generate a load and annotate the instruction *)
409 :     and load(ld32, ld64, ea, mem, rt, an) =
410 :     let val (ld,size) =
411 :     if bit64mode andalso Gen.size ea = 64
412 :     then (ld64,signed12)
413 :     else (ld32,signed16)
414 :     val (r, disp) = addr(size,ea)
415 :     in mark(I.L{ld=ld, rt=rt, ra=r, d=disp, mem=mem},an)
416 :     end
417 :    
418 :     (* Generate a SRA shift operation and annotate the instruction *)
419 :     and sra(oper, operi, e1, e2, rt, an) =
420 :     case immedOpnd unsigned5 (e1, e2) of
421 :     (ra, I.RegOp rb) =>
422 :     mark(I.ARITH{oper=oper,rt=rt,ra=ra,rb=rb,Rc=false,OE=false},an)
423 :     | (ra, rb) =>
424 :     mark(I.ARITHI{oper=operi, rt=rt, ra=ra, im=rb},an)
425 :    
426 :     (* Generate a SRL shift operation and annotate the instruction *)
427 :     and srl32(e1, e2, rt, an) =
428 :     case immedOpnd unsigned5 (e1, e2) of
429 :     (ra, I.ImmedOp n) =>
430 :     mark(SRLI32{r=ra,i=n,d=rt},an)
431 :     | (ra, rb) =>
432 :     mark(I.ARITH{oper=I.SRW,rt=rt,ra=ra,rb=reduceOpn rb,
433 :     Rc=false,OE=false},an)
434 :    
435 :     and sll32(e1, e2, rt, an) =
436 :     case immedOpnd unsigned5 (e1, e2) of
437 :     (ra, rb as I.ImmedOp n) =>
438 :     mark(SLLI32{r=ra,i=n,d=rt},an)
439 :     | (ra, rb) =>
440 :     mark(I.ARITH{oper=I.SLW,rt=rt,ra=ra,rb=reduceOpn rb,
441 :     Rc=false,OE=false},an)
442 :    
443 :     (* Generate a subtract operation *)
444 :     and subtract(ty, e1, e2 as T.LI i, rt, an) =
445 :     (doExpr(T.ADD(ty, e1, T.LI (~i)), rt, an)
446 :     handle Overflow =>
447 :     mark(I.ARITH{oper=I.SUBF, rt=rt, ra=expr e2,
448 :     rb=expr e1, OE=false, Rc=false}, an)
449 :     )
450 :     | subtract(ty, T.LI i, e2, rt, an) = subfImmed(i, expr e2, rt, an)
451 :     | subtract(ty, T.CONST c, e2, rt, an) =
452 :     mark(I.ARITHI{oper=I.SUBFIC,rt=rt,ra=expr e2,im=I.ConstOp c},an)
453 :     | subtract(ty, T.LI32 w, e2, rt, an) =
454 :     subfImmed(Word32.toIntX w, expr e2, rt, an)
455 :     | subtract(ty, e1, e2, rt, an) =
456 :     let val rb = expr e1 val ra = expr e2
457 :     in mark(I.ARITH{oper=I.SUBF,rt=rt,ra=ra,rb=rb,Rc=false,OE=false},an)
458 :     end
459 :    
460 :     (* Generate optimized multiplication code *)
461 :     and multiply(ty,oper,operi,genMult,e1,e2,rt,an) =
462 :     let fun nonconst(e1,e2) =
463 :     [mark'(
464 :     case commImmedOpnd signed16 (e1,e2) of
465 :     (ra,I.RegOp rb) =>
466 :     I.ARITH{oper=oper,ra=ra,rb=rb,rt=rt,OE=false,Rc=false}
467 :     | (ra,im) => I.ARITHI{oper=operi,ra=ra,im=im,rt=rt},
468 :     an)]
469 :     fun const(e,i) =
470 :     let val r = expr e
471 :     in genMult{r=r,i=i,d=rt}
472 :     handle _ => nonconst(T.REG(ty,r),T.LI i)
473 :     end
474 :     fun constw(e,i) = const(e,Word32.toInt i)
475 :     handle _ => nonconst(e,T.LI32 i)
476 :     val instrs =
477 :     case (e1,e2) of
478 :     (_,T.LI i) => const(e1,i)
479 :     | (_,T.LI32 i) => constw(e1,i)
480 :     | (T.LI i,_) => const(e2,i)
481 :     | (T.LI32 i,_) => constw(e2,i)
482 :     | _ => nonconst(e1,e2)
483 :     in app emit instrs end
484 :    
485 :     and divu32 x = Mulu32.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
486 :    
487 :     and divt32 x = Mult32.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
488 :    
489 :     and roundToZero{ty,r,i,d} =
490 :     let val L = Label.newLabel ""
491 :     val dReg = T.REG(ty,d)
492 :     in stmt(T.MV(ty,d,T.REG(ty,r)),[]);
493 :     stmt(T.BCC(T.GE,T.CMP(ty,T.GE,dReg,T.LI 0),L),[]);
494 :     stmt(T.MV(ty,d,T.ADD(ty,dReg,T.LI i)),[]);
495 :     defineLabel L
496 : monnier 247 end
497 :    
498 : monnier 411 (* Generate optimized division code *)
499 :     and divide(ty,oper,genDiv,e1,e2,rt,overflow,an) =
500 :     let fun nonconst(e1,e2) =
501 :     (mark(I.ARITH{oper=oper,ra=expr e1,rb=expr e2,rt=rt,
502 :     OE=overflow,Rc=overflow},an);
503 :     if overflow then overflowTrap() else ()
504 :     )
505 :     fun const(e,i) =
506 :     let val r = expr e
507 :     in app emit (genDiv{r=r,i=i,d=rt})
508 :     handle _ => nonconst(T.REG(ty,r),T.LI i)
509 :     end
510 :     fun constw(e,i) = const(e,Word32.toInt i)
511 :     handle _ => nonconst(e,T.LI32 i)
512 :     in case (e1,e2) of
513 :     (_,T.LI i) => const(e1,i)
514 :     | (_,T.LI32 i) => constw(e1,i)
515 :     | _ => nonconst(e1,e2)
516 :     end
517 : monnier 247
518 : monnier 411 (* Reduce an operand into a register *)
519 :     and reduceOpn(I.RegOp r) = r
520 :     | reduceOpn opn =
521 :     let val rt = newReg()
522 :     in emit(I.ARITHI{oper=I.ADDI, rt=rt, ra=0, im=opn});
523 :     rt
524 : monnier 247 end
525 :    
526 : monnier 411 (* Reduce an expression, and returns the register that holds
527 :     * the value.
528 :     *)
529 :     and expr(rexp as T.REG(_,80)) =
530 :     let val rt = newReg()
531 :     in doExpr(rexp, rt, []); rt end
532 :     | expr(T.REG(_,r)) = r
533 :     | expr(rexp) =
534 :     let val rt = newReg()
535 :     in doExpr(rexp, rt, []); rt end
536 :    
537 :     (* doExpr(e, rt, an) --
538 :     * reduce the expression e, assigns it to rd,
539 :     * and annotate the expression with an
540 :     *)
541 :     and doExpr(e, 80, an) =
542 :     let val rt = newReg() in doExpr(e,rt,[]); mark(MTLR rt,an) end
543 :     | doExpr(e, rt, an) =
544 :     case e of
545 :     T.REG(_,80) => mark(MFLR rt,an)
546 :     | T.REG(_,rs) => move(rs,rt,an)
547 :     | T.LI i => loadImmed(i, rt, an)
548 :     | T.LI32 w => loadImmedw(w, rt, an)
549 :     | T.LABEL lexp => loadLabel(lexp, rt, an)
550 :     | T.CONST c => loadConst(c, rt, an)
551 : monnier 247
552 : monnier 411 (* All data widths *)
553 :     | T.ADD(_, e1, e2) => eCommImm signed16 (I.ADD,I.ADDI,e1,e2,rt,an)
554 :     | T.SUB(ty, e1, e2) => subtract(ty, e1, e2, rt, an)
555 : monnier 247
556 : monnier 411 (* Special PPC bit operations *)
557 :     | T.ANDB(_,e1,T.NOTB(_,e2)) => arith(I.ANDC,e1,e2,rt,an)
558 :     | T.ORB(_,e1,T.NOTB(_,e2)) => arith(I.ORC,e1,e2,rt,an)
559 :     | T.XORB(_,e1,T.NOTB(_,e2)) => arith(I.EQV,e1,e2,rt,an)
560 :     | T.ANDB(_,T.NOTB(_,e1),e2) => arith(I.ANDC,e2,e1,rt,an)
561 :     | T.ORB(_,T.NOTB(_,e1),e2) => arith(I.ORC,e2,e1,rt,an)
562 :     | T.XORB(_,T.NOTB(_,e1),e2) => arith(I.EQV,e2,e1,rt,an)
563 :     | T.NOTB(_,T.ANDB(_,e1,e2)) => arith(I.NAND,e1,e2,rt,an)
564 :     | T.NOTB(_,T.ORB(_,e1,e2)) => arith(I.NOR,e1,e2,rt,an)
565 :     | T.NOTB(_,T.XORB(_,e1,e2)) => arith(I.EQV,e1,e2,rt,an)
566 : monnier 247
567 : monnier 411 | T.ANDB(_, e1, e2) =>
568 :     eCommImm unsigned16(I.AND,I.ANDI_Rc,e1,e2,rt,an)
569 :     | T.ORB(_, e1, e2) => eCommImm unsigned16(I.OR,I.ORI,e1,e2,rt,an)
570 :     | T.XORB(_, e1, e2) => eCommImm unsigned16(I.XOR,I.XORI,e1,e2,rt,an)
571 : monnier 247
572 : monnier 411 (* 32 bit support *)
573 :     | T.MULU(32, e1, e2) => multiply(32,I.MULLW,I.MULLI,
574 :     Mulu32.multiply,e1,e2,rt,an)
575 :     | T.DIVU(32, e1, e2) => divide(32,I.DIVWU,divu32,e1,e2,rt,false,an)
576 :     | T.ADDT(32, e1, e2) => arithTrapping(I.ADD, e1, e2, rt, an)
577 :     | T.SUBT(32, e1, e2) => arithTrapping(I.SUBF, e2, e1, rt, an)
578 :     | T.MULT(32, e1, e2) => arithTrapping(I.MULLW, e1, e2, rt, an)
579 :     | T.DIVT(32, e1, e2) => divide(32,I.DIVW,divt32,e1,e2,rt,true,an)
580 :    
581 :     | T.SRA(32, e1, e2) => sra(I.SRAW, I.SRAWI, e1, e2, rt, an)
582 :     | T.SRL(32, e1, e2) => srl32(e1, e2, rt, an)
583 :     | T.SLL(32, e1, e2) => sll32(e1, e2, rt, an)
584 :    
585 :     (* 64 bit support *)
586 :     | T.SRA(64, e1, e2) => sra(I.SRAD, I.SRADI, e1, e2, rt, an)
587 :     (*| T.SRL(64, e1, e2) => srl(32, I.SRD, I.RLDINM, e1, e2, rt, an)
588 :     | T.SLL(64, e1, e2) => sll(32, I.SLD, I.RLDINM, e1, e2, rt, an)*)
589 : monnier 247
590 : monnier 411 (* loads *)
591 :     | T.LOAD(8,ea,mem) => load(I.LBZ,I.LBZE,ea,mem,rt,an)
592 :     | T.LOAD(16,ea, mem) => load(I.LHZ,I.LHZE,ea,mem,rt,an)
593 :     | T.LOAD(32,ea, mem) => load(I.LWZ,I.LWZE,ea,mem,rt,an)
594 :     | T.LOAD(64,ea, mem) => load(I.LDE,I.LDE,ea,mem,rt,an)
595 :    
596 :     (* Conditional expression *)
597 :     | T.COND exp =>
598 :     Gen.compileCond{exp=exp,stm=stmt,defineLabel=defineLabel,
599 :     annotations=an,rd=rt}
600 : monnier 247
601 : monnier 411 (* Misc *)
602 :     | T.SEQ(stm, e) => (stmt(stm,[]); doExpr(e, rt, an))
603 :     | T.MARK(e, a) => doExpr(e, rt, a::an)
604 :     | e => doExpr(Gen.compile e,rt,an)
605 :    
606 :     (* Generate a floating point load *)
607 :     and fload(ld32, ld64, ea, mem, ft, an) =
608 :     let val (ld,size) =
609 :     if bit64mode andalso Gen.size ea = 64 then (ld64,signed12)
610 :     else (ld32,signed16)
611 :     val (r, disp) = addr(size,ea)
612 :     in mark(I.LF{ld=ld, ft=ft, ra=r, d=disp, mem=mem}, an) end
613 :    
614 :     (* Generate a floating-point binary operation *)
615 :     and fbinary(oper, e1, e2, ft, an) =
616 :     mark(I.FARITH{oper=oper,fa=fexpr e1,fb=fexpr e2,ft=ft,Rc=false}, an)
617 :    
618 :     (* Generate a floating-point 3-operand operation
619 :     * These are of the form
620 :     * +/- e1 * e3 +/- e2
621 :     *)
622 :     and f3(oper, e1, e2, e3, ft, an) =
623 :     mark(I.FARITH3{oper=oper,fa=fexpr e1,fb=fexpr e2,fc=fexpr e3,
624 :     ft=ft,Rc=false}, an)
625 :    
626 :     (* Generate a floating-point unary operation *)
627 :     and funary(oper, e, ft, an) =
628 :     mark(I.FUNARY{oper=oper, ft=ft, fb=fexpr e, Rc=false}, an)
629 :    
630 :     (* Reduce the expression fexp, return the register that holds
631 :     * the value.
632 :     *)
633 :     and fexpr(T.FREG(_,f)) = f
634 :     | fexpr(e) =
635 :     let val ft = newFreg()
636 :     in doFexpr(e, ft, []); ft end
637 :    
638 :     (* doExpr(fexp, ft, an) --
639 :     * reduce the expression fexp, and assigns
640 :     * it to ft. Also annotate fexp.
641 :     *)
642 :     and doFexpr(e, ft, an) =
643 :     case e of
644 :     T.FREG(_,fs) => fmove(fs,ft,an)
645 :    
646 :     (* Single precision support *)
647 :     | T.FLOAD(32, ea, mem) => fload(I.LFS,I.LFSE,ea,mem,ft,an)
648 :    
649 :     (* special 3 operand floating point arithmetic *)
650 :     | T.FADD(32,T.FMUL(32,a,c),b) => f3(I.FMADDS,a,b,c,ft,an)
651 :     | T.FADD(32,b,T.FMUL(32,a,c)) => f3(I.FMADDS,a,b,c,ft,an)
652 :     | T.FSUB(32,T.FMUL(32,a,c),b) => f3(I.FMSUBS,a,b,c,ft,an)
653 :     | T.FSUB(32,b,T.FMUL(32,a,c)) => f3(I.FNMADDS,a,b,c,ft,an)
654 :     | T.FNEG(32,T.FADD(32,T.FMUL(32,a,c),b)) => f3(I.FNMSUBS,a,b,c,ft,an)
655 :     | T.FNEG(32,T.FADD(32,b,T.FMUL(32,a,c))) => f3(I.FNMSUBS,a,b,c,ft,an)
656 :     | T.FSUB(32,T.FNEG(32,T.FMUL(32,a,c)),b) => f3(I.FNMSUBS,a,b,c,ft,an)
657 :    
658 :     | T.FADD(32, e1, e2) => fbinary(I.FADDS, e1, e2, ft, an)
659 :     | T.FSUB(32, e1, e2) => fbinary(I.FSUBS, e1, e2, ft, an)
660 :     | T.FMUL(32, e1, e2) => fbinary(I.FMULS, e1, e2, ft, an)
661 :     | T.FDIV(32, e1, e2) => fbinary(I.FDIVS, e1, e2, ft, an)
662 :    
663 :     (* Double precision support *)
664 :     | T.FLOAD(64, ea, mem) => fload(I.LFD,I.LFDE,ea,mem,ft,an)
665 :    
666 :     (* special 3 operand floating point arithmetic *)
667 :     | T.FADD(64,T.FMUL(64,a,c),b) => f3(I.FMADD,a,b,c,ft,an)
668 :     | T.FADD(64,b,T.FMUL(64,a,c)) => f3(I.FMADD,a,b,c,ft,an)
669 :     | T.FSUB(64,T.FMUL(64,a,c),b) => f3(I.FMSUB,a,b,c,ft,an)
670 :     | T.FSUB(64,b,T.FMUL(64,a,c)) => f3(I.FNMADD,a,b,c,ft,an)
671 :     | T.FNEG(64,T.FADD(64,T.FMUL(64,a,c),b)) => f3(I.FNMSUB,a,b,c,ft,an)
672 :     | T.FNEG(64,T.FADD(64,b,T.FMUL(64,a,c))) => f3(I.FNMSUB,a,b,c,ft,an)
673 :     | T.FSUB(64,T.FNEG(64,T.FMUL(64,a,c)),b) => f3(I.FNMSUB,a,b,c,ft,an)
674 :    
675 :     | T.FADD(64, e1, e2) => fbinary(I.FADD, e1, e2, ft, an)
676 :     | T.FSUB(64, e1, e2) => fbinary(I.FSUB, e1, e2, ft, an)
677 :     | T.FMUL(64, e1, e2) => fbinary(I.FMUL, e1, e2, ft, an)
678 :     | T.FDIV(64, e1, e2) => fbinary(I.FDIV, e1, e2, ft, an)
679 :     | T.CVTI2F(64,_,e) => app emit (PseudoInstrs.cvti2d{reg=expr e,fd=ft})
680 :    
681 :     (* Single/double precision support *)
682 :     | T.FABS((32|64), e) => funary(I.FABS, e, ft, an)
683 :     | T.FNEG((32|64), e) => funary(I.FNEG, e, ft, an)
684 :    
685 :     (* Misc *)
686 :     | T.FSEQ(stm, e) => (doStmt stm; doFexpr(e, ft, an))
687 :     | T.FMARK(e, a) => doFexpr(e, ft, a::an)
688 :     | _ => error "doFexpr"
689 :    
690 :     and ccExpr(T.CC cc) = cc
691 :     | ccExpr(ccexp) =
692 :     let val cc = newCCreg()
693 :     in doCCexpr(ccexp,cc,[]); cc end
694 :    
695 :     (* Reduce an condition expression, and assigns the result to ccd *)
696 :     and doCCexpr(ccexp, ccd, an) =
697 :     case ccexp of
698 :     T.CMP(ty, cc, e1, e2) =>
699 :     let val (opnds, cmp) =
700 :     case cc of
701 :     (T.LT | T.LE | T.EQ | T.NE | T.GT | T.GE) =>
702 :     (immedOpnd signed16, I.CMP)
703 :     | _ => (immedOpnd unsigned16, I.CMPL)
704 :     val (opndA, opndB) = opnds(e1, e2)
705 :     val l = case ty of
706 :     32 => false
707 :     | 64 => true
708 :     | _ => error "doCCexpr"
709 :     in mark(I.COMPARE{cmp=cmp, l=l, bf=ccd, ra=opndA, rb=opndB},an)
710 :     end
711 :     | T.FCMP(fty, fcc, e1, e2) =>
712 :     mark(I.FCOMPARE{cmp=I.FCMPU, bf=ccd, fa=fexpr e1, fb=fexpr e2},an)
713 :     | T.CC cc => ccmove(cc,ccd,an)
714 :     | T.CCMARK(cc,a) => doCCexpr(cc,ccd,a::an)
715 :     | _ => error "doCCexpr: Not implemented"
716 :    
717 :     and emitTrap() = emit(I.TW{to=31,ra=0,si=I.ImmedOp 0})
718 :    
719 : monnier 429 val beginCluster = fn _ => (trapLabel := NONE; beginCluster(0))
720 :     val endCluster = fn a =>
721 : monnier 411 (case !trapLabel of
722 :     SOME label =>
723 :     (defineLabel label; emitTrap(); trapLabel := NONE)
724 :     | NONE => ();
725 : monnier 429 endCluster a)
726 :     in S.STREAM
727 :     { beginCluster = beginCluster,
728 :     endCluster = endCluster,
729 :     emit = doStmt,
730 :     pseudoOp = pseudoOp,
731 :     defineLabel = defineLabel,
732 :     entryLabel = entryLabel,
733 :     blockName = blockName,
734 :     comment = comment,
735 :     annotation = annotation,
736 :     exitBlock = exitBlock,
737 :     alias = alias,
738 :     phi = phi
739 : monnier 411 }
740 :     end
741 :    
742 : monnier 247 end
743 :    

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