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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1183 - (view) (download)

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

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