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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1117 - (view) (download)

1 : monnier 245 (* hppa.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Bell Laboratories.
4 :     *
5 :     * generates machine code from the mltree.
6 :     *
7 : monnier 411 * This new version has been completely rewritten to take (more) advantage
8 :     * of the new improved instruction set.
9 :     *
10 :     * Please see the README.hppa file for details.
11 :     *
12 :     * -- Allen
13 : monnier 245 *)
14 : monnier 411
15 : monnier 245 functor Hppa
16 :     (structure HppaInstr : HPPAINSTR
17 : george 555 structure ExtensionComp : MLTREE_EXTENSION_COMP
18 : george 933 where I = HppaInstr
19 :     and T = HppaInstr.T
20 : monnier 411 structure MilliCode : HPPA_MILLICODE
21 : george 933 where I = HppaInstr
22 :     structure LabelComp : LABEL_COMP
23 :     where I = HppaInstr
24 :     and T = HppaInstr.T
25 : monnier 411 val costOfMultiply : int ref
26 :     val costOfDivision : int ref
27 :     ) : MLTREECOMP =
28 : monnier 245 struct
29 : monnier 411 structure I = HppaInstr
30 : leunga 775 structure T = I.T
31 : george 984 structure TS = ExtensionComp.TS
32 : george 545 structure C = I.C
33 : george 889 structure CB = CellsBasis
34 : monnier 411 structure MC = MilliCode
35 :     structure LC = LabelComp
36 :     structure Region = I.Region
37 : george 545 structure A = MLRiscAnnotations
38 : george 909 structure CFG = ExtensionComp.CFG
39 : george 545
40 : george 984 type instrStream = (I.instruction, C.cellset, CFG.cfg) TS.stream
41 :     type mltreeStream = (T.stm, T.mlrisc list, CFG.cfg) TS.stream
42 : george 545
43 : monnier 411 structure Gen = MLTreeGen(structure T = T
44 : jhr 1117 structure Cells = C
45 : monnier 411 val intTy = 32
46 :     val naturalWidths = [32]
47 : monnier 429 datatype rep = SE | ZE | NEITHER
48 :     val rep = NEITHER
49 : monnier 411 )
50 : george 1009 fun mkcopy{dst, src, tmp} =
51 :     I.COPY{k=CB.GP, sz=32, dst=dst, src=src, tmp=tmp}
52 :     fun mkfcopy{dst, src, tmp} =
53 :     I.COPY{k=CB.FP, sz=64, dst=dst, src=src, tmp=tmp}
54 : monnier 411 structure W = Word32
55 :     functor Multiply32 = MLTreeMult
56 :     (structure I = I
57 :     structure T = T
58 : george 889 structure CB = CB
59 : monnier 411 val intTy = 32
60 : george 889 type arg = {r1:CB.cell,r2:CB.cell,d:CB.cell}
61 :     type argi = {r:CB.cell,i:int,d:CB.cell}
62 : monnier 245
63 : george 1009 fun mov{r,d} = mkcopy{dst=[d],src=[r],tmp=NONE}
64 : george 1003 fun add{r1,r2,d} = I.arith{a=I.ADD,r1=r1,r2=r2,t=d}
65 :     fun slli{r,i,d} = [I.shift{s=I.ZDEP,r=r,p=31-i,len=32-i,t=d}]
66 :     fun srli{r,i,d} = [I.shift{s=I.EXTRU,r=r,p=31-i,len=32-i,t=d}]
67 :     fun srai{r,i,d} = [I.shift{s=I.EXTRS,r=r,p=31-i,len=32-i,t=d}]
68 : monnier 411 )
69 : monnier 245
70 : monnier 411 (* signed, trapping version of multiply and divide *)
71 :     structure Mult32 = Multiply32
72 :     (val trapping = true
73 :     val multCost = costOfMultiply
74 :     val divCost = costOfDivision
75 : george 1003 fun addv{r1,r2,d} = [I.arith{a=I.ADDO,r1=r1,r2=r2,t=d}]
76 :     fun subv{r1,r2,d} = [I.arith{a=I.SUBO,r1=r1,r2=r2,t=d}]
77 :     val sh1addv = SOME(fn{r1,r2,d} => [I.arith{a=I.SH1ADDO,r1=r1,r2=r2,t=d}])
78 :     val sh2addv = SOME(fn{r1,r2,d} => [I.arith{a=I.SH2ADDO,r1=r1,r2=r2,t=d}])
79 :     val sh3addv = SOME(fn{r1,r2,d} => [I.arith{a=I.SH3ADDO,r1=r1,r2=r2,t=d}])
80 : monnier 411 )
81 : monnier 429 (val signed = true)
82 : monnier 245
83 : monnier 411 (* unsigned, non-trapping version of multiply and divide *)
84 :     structure Mulu32 = Multiply32
85 :     (val trapping = false
86 :     val signed = false
87 :     val multCost = costOfMultiply
88 :     val divCost = costOfDivision
89 : george 1003 fun addv{r1,r2,d} = [I.arith{a=I.ADD,r1=r1,r2=r2,t=d}]
90 :     fun subv{r1,r2,d} = [I.arith{a=I.SUB,r1=r1,r2=r2,t=d}]
91 :     val sh1addv = SOME(fn{r1,r2,d} => [I.arith{a=I.SH1ADDL,r1=r1,r2=r2,t=d}])
92 :     val sh2addv = SOME(fn{r1,r2,d} => [I.arith{a=I.SH2ADDL,r1=r1,r2=r2,t=d}])
93 :     val sh3addv = SOME(fn{r1,r2,d} => [I.arith{a=I.SH3ADDL,r1=r1,r2=r2,t=d}])
94 : monnier 411 )
95 : monnier 429 (val signed = false)
96 : monnier 245
97 : monnier 411 fun error msg = MLRiscErrorMsg.error("Hppa",msg)
98 : monnier 245
99 : george 545 datatype ea = datatype I.addressing_mode
100 : monnier 245
101 : george 761 datatype times248 = TIMES1 | TIMES2 | TIMES4 | TIMES8
102 : monnier 245
103 : george 761 datatype amode =
104 :     AMode of I.addressing_mode
105 : george 889 | DISP of CB.cell * T.I.machine_int
106 : george 761
107 : monnier 245
108 : george 761 (* infinite-precision short cuts. *)
109 :     val int_0 = T.I.int_0
110 :     val int_m16 = T.I.fromInt(32, ~16)
111 :     val int_1024 = T.I.fromInt(32, 1024)
112 :     val int_m1024 = T.I.fromInt(32, ~1024)
113 :     val int_8192 = T.I.fromInt(32, 8192)
114 :     val int_m8192 = T.I.fromInt(32, ~8192)
115 :    
116 :     fun LI i = T.LI(T.I.fromInt(32, i))
117 :     fun toInt mi = T.I.toInt(32, mi)
118 :     fun toInt32 mi = T.I.toInt32(32, mi)
119 :     fun toWord mi = T.I.toWord(32, mi)
120 :     fun toWord32 mi = T.I.toWord32(32, mi)
121 :     fun EQ(x,y) = T.I.EQ(32, x, y)
122 :     fun LT(x,y) = T.I.LT(32, x, y)
123 :     fun GE(x,y) = T.I.GE(32, x, y)
124 :    
125 :    
126 : monnier 411 fun selectInstructions
127 : george 545 (instrStream as
128 : george 1003 TS.S.STREAM{emit=emitInstruction, defineLabel, entryLabel, getAnnotations,
129 : monnier 429 beginCluster, endCluster, annotation,
130 : leunga 744 exitBlock, pseudoOp, comment, ...}) =
131 : monnier 411 let
132 :     (* operand type and effective addresss *)
133 :    
134 :     val newReg = C.newReg
135 :     val newFreg = C.newFreg
136 :     val CRReg = C.Reg C.CR
137 : leunga 744 val zeroR = C.r0
138 :     val zeroF = C.f0
139 : monnier 411 val zeroEA = I.Direct zeroR
140 :     val zeroT = T.REG(32,zeroR)
141 :     val zeroImmed = I.IMMED 0
142 : george 545 val zeroOpn = zeroImmed
143 : monnier 245
144 : george 1003 val emit = emitInstruction o I.INSTR
145 : monnier 245
146 : george 1003 local
147 :     fun f(i,[]) = i
148 :     | f(i, a::an) = f (I.ANNOTATION{i=i, a=a}, an)
149 :     in
150 :     fun mark(i, an) = emitInstruction(f(I.INSTR i, an))
151 :     fun mark'(i, an) = emitInstruction(f(i, an))
152 :     end
153 :    
154 :     val ldLabelEA = LC.ldLabelEA emitInstruction
155 :     val ldLabelOpnd = LC.ldLabelOpnd emitInstruction
156 :    
157 : monnier 411 (* Check whether an expression is being multiplied by 2, 4, or 8 *)
158 : george 761 local
159 :     fun mul(mi,e, exp) =
160 :     if EQ(mi, T.I.int_2) then (TIMES2, e)
161 :     else if EQ(mi, T.I.int_4) then (TIMES4, e)
162 :     else if EQ(mi, T.I.int_8) then (TIMES8, e)
163 :     else (TIMES1, exp)
164 :     in
165 :     fun times(exp) =
166 :     (case exp
167 :     of T.MULU(_, e, T.LI mi) => mul(mi, e, exp)
168 :     | T.MULU(_, T.LI mi, e) => mul(mi, e, exp)
169 :     | T.SLL(_, e, T.LI mi) =>
170 :     if EQ(mi, T.I.int_1) then (TIMES2, e)
171 :     else if EQ(mi, T.I.int_2) then (TIMES4, e)
172 :     else if EQ(mi, T.I.int_3) then (TIMES8, e)
173 :     else (TIMES1, exp)
174 :     | _ => (TIMES1, exp)
175 :     (*esac*))
176 : monnier 245
177 : george 761 (* trapping version of the above *)
178 :     fun timest(exp as T.MULT(_, e, T.LI mi)) = mul(mi, e, exp)
179 :     | timest(exp as T.MULT(_, T.LI mi, e)) = mul(mi, e, exp)
180 :     | timest e = (TIMES1, e)
181 :     end (*local*)
182 : monnier 245
183 : george 761 fun im5 n = LT(n,T.I.int_16) andalso GE(n, int_m16)
184 :     fun im11 n = LT(n, int_1024) andalso GE(n, int_m1024)
185 :     fun im14 n = LT(n, int_8192) andalso GE(n, int_m8192)
186 : monnier 245
187 : monnier 411 (* Split values into 11 low bits and 21 high bits *)
188 :     fun split11w w =
189 :     {hi = Word32.toIntX(Word32.~>>(w,0w11)),
190 :     lo = Word32.toIntX(Word32.andb(w,0wx7ff))}
191 : george 761 fun split11 n = split11w(toWord32 n)
192 : monnier 411
193 :     (* load immediate *)
194 :     fun loadImmed(n,t,an) =
195 :     if im14 n
196 : george 761 then mark(I.LDO{i=I.IMMED(toInt n),b=zeroR,t=t},an)
197 : monnier 411 else let val {hi,lo} = split11 n
198 :     val tmp = newReg()
199 :     in emit(I.LDIL{i=I.IMMED hi,t=tmp});
200 :     mark(I.LDO{i=I.IMMED lo,b=tmp,t=t},an)
201 :     end
202 :    
203 :     (* generate code to load a immediate constant *)
204 : leunga 775 fun immed (n: T.I.machine_int) =
205 :     let val t = newReg() in loadImmed(n,t,[]); t end
206 : monnier 411
207 :     (* load constant *)
208 : george 545 fun loadConst(c,t,an) =
209 : leunga 775 mark(I.LDO{b=zeroR,i=I.LabExp(c,I.F),t=t},an) (* XXX *)
210 : monnier 411
211 :     (* convert an operand into a register *)
212 :     fun reduceOpn i =
213 :     let val t = newReg()
214 : leunga 744 in emit(I.LDO{i=i,b=zeroR,t=t}); t end
215 : monnier 411
216 :     (* emit parallel copies *)
217 :     fun copy(dst,src,an) =
218 : george 1009 mark'(mkcopy{dst=dst,src=src,
219 :     tmp=case dst of [_] => NONE | _ => SOME(I.Direct(newReg()))},an)
220 : monnier 411 fun fcopy(dst,src,an) =
221 : george 1009 mark'(mkfcopy{dst=dst,src=src,
222 :     tmp=case dst of [_] => NONE | _ => SOME(I.FDirect(newFreg()))},an)
223 : monnier 411
224 :     (* move register s to register t *)
225 :     fun move(s,t,an) =
226 : george 889 if CB.sameColor(s,t) orelse CB.registerId t = 0 then ()
227 :     else if CB.registerId s = 0 then
228 : monnier 411 mark(I.LDO{i=zeroImmed,b=zeroR,t=t},an)
229 : george 1009 else mark'(mkcopy{src=[s],dst=[t],tmp=NONE},an)
230 : monnier 411
231 :     (* move floating point register s to register t *)
232 :     fun fmove(s,t,an) =
233 : george 889 if CB.sameColor(s,t) then ()
234 : george 1009 else mark'(mkfcopy{src=[s],dst=[t],tmp=NONE},an)
235 : monnier 411
236 :     (* generate millicode function call *)
237 :     fun milliCall(milliFn, e1, e2, rd) =
238 :     let val rs = expr e1
239 :     val rt = expr e2
240 : george 1003 in app emitInstruction (milliFn{rs=rs,rt=rt,rd=rd}) end
241 : monnier 411
242 :     (* emit an arithmetic op with possible immediate mode
243 :     * The immed operand is the first operand on the HPPA! Arrrrggggghhhh!
244 :     *)
245 :     and immedArith(a,ai,e1,e2,t,an) =
246 :     case (opn e1,expr e2) of
247 : george 545 (I.REG r1,r2) => mark(I.ARITH{a=a,r1=r1,r2=r2,t=t},an)
248 :     | (i,r) => mark(I.ARITHI{ai=ai,r=r,i=i,t=t},an)
249 : monnier 411
250 :     (* emit a commutative arithmetic op with immediate mode *)
251 :     and commImmedArith(a,ai,e1,e2,t,an) =
252 :     case (opn e1,opn e2) of
253 : george 545 (I.REG r1,I.REG r2) => mark(I.ARITH{a=a,r1=r1,r2=r2,t=t},an)
254 :     | (I.REG r,i) => mark(I.ARITHI{ai=ai,r=r,i=i,t=t},an)
255 :     | (i,I.REG r) => mark(I.ARITHI{ai=ai,r=r,i=i,t=t},an)
256 :     | (i,j) => mark(I.ARITHI{ai=ai,r=reduceOpn i,i=j,t=t},an)
257 : monnier 411
258 :     (* emit an arithmetic op *)
259 :     and arith(a,e1,e2,t,an) =
260 :     mark(I.ARITH{a=a,r1=expr e1,r2=expr e2,t=t},an)
261 :    
262 :     (* emit an unary floating point op *)
263 :     and funary(a,e,t,an) = mark(I.FUNARY{fu=a,f=fexpr e,t=t},an)
264 :    
265 :     (* emit an conversion floating point op *)
266 :     and fcnv(a,e,t,an) = mark(I.FCNV{fcnv=a,f=fexpr e,t=t},an)
267 :    
268 :     (* emit a binary floating point op *)
269 :     and farith(a,e1,e2,t,an) =
270 :     mark(I.FARITH{fa=a,r1=fexpr e1,r2=fexpr e2,t=t},an)
271 :    
272 :     (* convert an expression into an addressing mode
273 :     * scale is the size of the data being addressed.
274 : george 761 *
275 :     * Return the addressing mode and an infinite precision immediate
276 :     * in the case of DISPea.
277 : monnier 411 *)
278 : george 761 and addr(scale,T.ADD(_,e,T.LI n)) = DISP(expr e, n)
279 : leunga 775 | addr(scale,T.ADD(_,e,c as T.CONST _)) =
280 :     AMode(DISPea(expr e,I.LabExp(c,I.F)))
281 : monnier 411 | addr(scale,T.ADD(ty,i as T.LI _,e)) = addr(scale,T.ADD(ty,e,i))
282 : leunga 775 | addr(scale,T.ADD(_,c as T.CONST _,e)) =
283 :     AMode(DISPea(expr e,I.LabExp(c,I.F)))
284 :     | addr(scale,T.ADD(_,e,T.LABEXP le)) =
285 : monnier 411 let val rs = expr e
286 : leunga 744 val (rt, opnd) = ldLabelEA le
287 : george 889 in case (CB.registerId rt, opnd) of
288 : george 761 (0, opnd) => AMode(DISPea(rs,opnd))
289 :     | (_,I.IMMED 0) => AMode(INDXea(rs,rt))
290 : leunga 744 | (_,opnd) =>
291 : monnier 411 let val tmp = newReg()
292 :     in emit(I.ARITH{a=I.ADD,r1=rs,r2=rt,t=tmp});
293 : george 761 AMode(DISPea(tmp,opnd))
294 : monnier 411 end
295 :     end
296 : leunga 775 | addr(scale,T.ADD(t,e1 as T.LABEXP l,e2)) = addr(scale,T.ADD(t,e2,e1))
297 : monnier 411 | addr(scale,T.ADD(_,e1,e2)) =
298 :     let (* check for special multiply add sequence
299 :     * here, e1 is is scaled
300 :     *)
301 :     fun scaleIndexed(actualScale,opcode,e1,e2) =
302 :     if actualScale = scale then (* can we use scaled indexing mode?*)
303 :     let val x = expr e1
304 :     val b = expr e2
305 : george 761 in AMode(INDXSCALEDea(b,x))
306 : monnier 411 end
307 :     else (* no, use the SHnADD operator, then *)
308 :     let val tmp = newReg()
309 :     in emit(I.ARITH{a=opcode,r1=expr e1,r2=expr e2,t=tmp});
310 : george 761 AMode(DISPea(tmp,zeroImmed))
311 : monnier 411 end
312 :     in case times e1 of
313 :     (TIMES2,e1) => scaleIndexed(16,I.SH1ADD,e1,e2)
314 :     | (TIMES4,e1) => scaleIndexed(32,I.SH2ADD,e1,e2)
315 :     | (TIMES8,e1) => scaleIndexed(64,I.SH3ADD,e1,e2)
316 :     | _ =>
317 : george 761 case times e2 of
318 :     (TIMES2,e2) => scaleIndexed(16,I.SH1ADD,e2,e1)
319 :     | (TIMES4,e2) => scaleIndexed(32,I.SH2ADD,e2,e1)
320 :     | (TIMES8,e2) => scaleIndexed(64,I.SH3ADD,e2,e1)
321 :     | _ => AMode(INDXea(expr e1,expr e2))
322 : monnier 411 end
323 : george 761 | addr(scale,T.SUB(ty,e,T.LI n)) = addr(scale,T.ADD(ty,e,T.LI(T.I.NEGT(32,n))))
324 : leunga 775 | addr(scale,T.LABEXP lexp) = AMode(DISPea(ldLabelEA(lexp)))
325 :     | addr(scale,ea) = AMode(DISPea(expr ea,zeroImmed))
326 : monnier 411
327 :     (* emit an integer load
328 :     * li - load immediate,
329 :     * l - load indexed
330 :     * ls - load indexed with scaling
331 :     * r1 is base r2 is x
332 :     *)
333 :     and load(scale,li,l,ls,ea,t,mem,an) =
334 : george 761 case addr(scale,ea)
335 :     of DISP(r, off) =>
336 : monnier 411 if im14 off then
337 : george 761 mark(I.LOADI{li=li,r=r,i=I.IMMED(toInt off),t=t,mem=mem},an)
338 : monnier 411 else
339 :     mark(I.LOAD{l=l,r1=r,r2=immed off,t=t,mem=mem},an)
340 : george 761 | AMode(DISPea(r,i)) => mark(I.LOADI{li=li,r=r,i=i,t=t,mem=mem},an)
341 :     | AMode(INDXea(r1,r2)) => mark(I.LOAD{l=l,r1=r1,r2=r2,t=t,mem=mem},an)
342 :     | AMode(INDXSCALEDea(b,x)) => mark(I.LOAD{l=ls,r1=b,r2=x,t=t,mem=mem},an)
343 : monnier 411
344 :     (* emit an integer store *)
345 :     and store(st,ea,r,mem,an) =
346 :     let val (b,d) =
347 : george 761 case addr(0,ea)
348 :     of DISP(b, disp) =>
349 :     if im14 disp then (b,I.IMMED(toInt disp) )
350 : monnier 411 else let val {hi,lo} = split11 disp
351 :     val tmp1 = newReg()
352 :     val tmp2 = newReg()
353 :     in emit(I.LDIL{i=I.IMMED hi,t=tmp1});
354 :     emit(I.ARITH{a=I.ADD,r1=b,r2=tmp1,t=tmp2});
355 :     (tmp2,I.IMMED lo)
356 :     end
357 : george 761 | AMode(DISPea bd) => bd
358 :     | AMode(INDXea(r1,r2)) =>
359 : monnier 411 let val tmp = newReg()
360 :     in emit(I.ARITH{a=I.ADD,r1=r1,r2=r2,t=tmp});
361 :     (tmp,I.IMMED 0)
362 :     end
363 : george 761 | AMode(INDXSCALEDea _) => error "store"
364 : monnier 411 in mark(I.STORE{st=st,b=b,d=d,r=r,mem=mem},an) end
365 :    
366 :     (* emit a floating point load *)
367 :     and fload(scale,fl,flx,flxs,ea,t,mem,an) =
368 :     case addr(scale,ea) of
369 : george 761 AMode(INDXea(b,x)) => mark(I.FLOADX{flx=flx,b=b,x=x,t=t,mem=mem},an)
370 :     | AMode(INDXSCALEDea(b,x)) =>
371 : monnier 411 mark(I.FLOADX{flx=flxs,b=b,x=x,t=t,mem=mem},an)
372 : george 761 | AMode(DISPea(b,d)) =>
373 : monnier 411 let val tmp = newReg()
374 :     in emit(I.ARITHI{ai=I.ADDI,r=b,i=d,t=tmp});
375 :     mark(I.FLOADX{flx=flx,b=tmp,x=zeroR,t=t,mem=mem},an)
376 :     end
377 : george 761 | DISP(b, d) =>
378 :     if im5 d then
379 :     mark(I.FLOAD{fl=fl,b=b,d=toInt d,t=t,mem=mem},an)
380 :     else
381 :     mark(I.FLOADX{flx=flx,b=b,x=immed d,t=t,mem=mem},an)
382 : monnier 245
383 : monnier 411 (* emit a floating point store *)
384 :     and fstore(scale,fst,fstx,fstxs,ea,data,mem,an) =
385 :     let val r = fexpr data
386 :     in case addr(scale,ea) of
387 : george 761 DISP(b, d) =>
388 :     if im5 d then
389 :     mark(I.FSTORE{fst=fst,b=b,d=(toInt d),r=r,mem=mem},an)
390 : monnier 411 else mark(I.FSTOREX{fstx=fstx,b=b,x=immed d,r=r,mem=mem},an)
391 : george 761 | AMode(DISPea(b,d)) =>
392 : monnier 411 let val tmp = newReg()
393 :     in emit(I.ARITHI{ai=I.ADDI,r=b,i=d,t=tmp});
394 :     mark(I.FSTORE{fst=I.FSTDS,b=tmp,d=0,r=r,mem=mem},an)
395 :     end
396 : george 761 | AMode(INDXea(b,x)) =>
397 : monnier 411 mark(I.FSTOREX{fstx=fstx,b=b,x=x,r=r,mem=mem},an)
398 : george 761 | AMode(INDXSCALEDea(b,x)) =>
399 : monnier 411 mark(I.FSTOREX{fstx=fstxs,b=b,x=x,r=r,mem=mem},an)
400 :     end
401 :    
402 :     (* emit an integer branch instruction *)
403 :    
404 :     (* generate a branch *)
405 : george 545 and branch(T.CMP(ty,cc,T.LI n,e),lab,an) = (* optimize cmp immed *)
406 : monnier 411 emitBranchCmpWithImmed(ty,cc,n,e,lab,an)
407 : george 545 | branch(T.CMP(ty,cc,e1,e2 as T.LI _),lab,an) = (* commute *)
408 :     branch(T.CMP(ty,T.Basis.swapCond cc,e2,e1),lab,an)
409 :     | branch(T.CMP(ty,cc,a,b),lab,an) = (* do the usual *)
410 : monnier 411 emitBranch(ty,cc,expr a,expr b,lab,an)
411 : george 545 | branch(T.FCMP(fty,cc,a,b),lab,an) =
412 :     let val f1 = fexpr a
413 :     val f2 = fexpr b
414 : george 909 val fallThrough = Label.anon()
415 : george 545 fun fcond T.== = I.!=
416 :     | fcond T.?<> = I.==
417 :     | fcond T.? = I.<=>
418 :     | fcond T.<=> = I.?
419 :     | fcond T.> = I.?<=
420 :     | fcond T.>= = I.?<
421 :     | fcond T.?> = I.<=
422 :     | fcond T.?>= = I.<
423 :     | fcond T.< = I.?>=
424 :     | fcond T.<= = I.?>
425 :     | fcond T.?< = I.>=
426 :     | fcond T.?<= = I.>
427 :     | fcond T.<> = I.?=
428 :     | fcond T.?= = I.<>
429 :     | fcond _ = error "fcond"
430 :     in mark(I.FBRANCH{cc=fcond cc,f1=f1,f2=f2,t=lab,f=fallThrough,
431 :     fmt=getFmt a,n=true,long=false},an);
432 :     defineLabel fallThrough
433 :     end
434 :     | branch(e,lab,an) = error "branch: what is the semantics?"
435 : monnier 245
436 : monnier 411 (* generate a branch cmp with immed *)
437 :     and emitBranchCmpWithImmed(ty,cc,n,e2 as T.ANDB(_,e,T.LI mask),t,an) =
438 : george 761 emitBranchOnBit(ty,cc,n,e2,e,toWord32 mask,t,an)
439 : monnier 411 | emitBranchCmpWithImmed(ty,cc,n,e2 as T.ANDB(_,T.LI mask,e),t,an) =
440 : george 761 emitBranchOnBit(ty,cc,n,e2,e,toWord32 mask,t,an)
441 : monnier 411 | emitBranchCmpWithImmed(ty,cc,n,e2,t,an) =
442 :     emitBranchI(ty,cc,n,e2,t,an)
443 :    
444 :     (* generate a branch on bit *)
445 :     and emitBranchOnBit(ty,cc,n,e2,e,mask,t,an) =
446 :     let fun isPowerOf2 w = W.andb(w,w-0w1) = 0w0
447 :     fun log w =
448 :     let fun f(0w1,n) = n
449 :     | f(w,n) = f(W.>>(w,0w1),n+1)
450 :     in f(w,0) end
451 : george 761 val n' = toWord32 n
452 : monnier 411 in if (n' = 0w0 orelse n' = mask) andalso
453 :     (cc = T.EQ orelse cc = T.NE) andalso
454 :     (mask > 0w0 andalso isPowerOf2 mask) then (* bit test! *)
455 :     let val bc =
456 :     case (cc,n') of
457 :     (T.EQ,0w0) => I.BCLR (* bit is 0 *)
458 :     | (T.EQ,_) => I.BSET (* bit is 1 *)
459 :     | (T.NE,0w0) => I.BSET (* bit is 1 *)
460 :     | (T.NE,_) => I.BCLR (* bit is 0 *)
461 :     | _ => error "emitBranchOnBit"
462 : george 909 val f = Label.anon()
463 : monnier 411 val bit = 31 - log mask
464 :     in mark(I.BB{bc=bc,r=expr e,p=bit,t=t,f=f,
465 :     n=false, nop=true},an);
466 :     defineLabel f
467 :     end
468 :     else
469 :     emitBranchI(ty,cc,n,e2,t,an)
470 : monnier 245 end
471 : monnier 411
472 :     (* generate a branch cmp with immediate *)
473 :     and emitBranchI(ty,cc,n,e2,t,an) =
474 :     let val r2 = expr e2
475 :     in if im5 n then
476 : george 909 let val f = Label.anon()
477 : monnier 411 val (cmpi,bc) =
478 :     case cc of
479 :     T.LT => (I.COMIBT, I.LT)
480 :     | T.LE => (I.COMIBT, I.LE)
481 :     | T.GT => (I.COMIBF, I.LE)
482 :     | T.GE => (I.COMIBF, I.LT)
483 :     | T.EQ => (I.COMIBT, I.EQ)
484 :     | T.LTU => (I.COMIBT, I.LTU)
485 :     | T.LEU => (I.COMIBT, I.LEU)
486 :     | T.GEU => (I.COMIBF, I.LTU)
487 :     | T.GTU => (I.COMIBF, I.LEU)
488 :     | T.NE => (I.COMIBF, I.EQ)
489 : leunga 744 | _ => error "emitBranchI"
490 : george 761 in mark(I.BCONDI{cmpi=cmpi,bc=bc,i=toInt(n),r2=r2,t=t,f=f,
491 : monnier 411 n=false, nop=true},an);
492 :     defineLabel f
493 :     end
494 :     else emitBranch(ty,cc,immed n,r2,t,an)
495 :     end
496 : monnier 245
497 : monnier 411 (* generate a branch *)
498 :     and emitBranch(ty,cond,r1,r2,t,an) =
499 : george 909 let val f = Label.anon()
500 : monnier 411 val (cmp,bc,r1,r2) =
501 :     case cond of
502 :     T.LT => (I.COMBT, I.LT, r1, r2)
503 :     | T.LE => (I.COMBT, I.LE, r1, r2)
504 :     | T.GT => (I.COMBT, I.LT, r2, r1)
505 :     | T.GE => (I.COMBT, I.LE, r2, r1)
506 :     | T.EQ => (I.COMBT, I.EQ, r1, r2)
507 :     | T.LTU => (I.COMBT, I.LTU, r1, r2)
508 :     | T.LEU => (I.COMBT, I.LEU, r1, r2)
509 :     | T.GEU => (I.COMBT, I.LEU, r2, r1)
510 :     | T.GTU => (I.COMBT, I.LTU, r2, r1)
511 :     | T.NE => (I.COMBF, I.EQ, r1, r2)
512 : leunga 744 | _ => error "emitBranch"
513 : monnier 411 in mark(I.BCOND{cmp=cmp,bc=bc,r1=r1,r2=r2,t=t,f=f,
514 :     n=false,nop=true},an);
515 :     defineLabel f
516 :     end
517 : monnier 245
518 : monnier 411 and getFmt e =
519 : leunga 624 case Gen.Size.fsize e of
520 : monnier 411 32 => I.SGL
521 :     | 64 => I.DBL
522 :     | 128 => I.QUAD
523 :     | _ => error "getFmt"
524 : monnier 245
525 : george 545 and goto(l,an) = mark(I.B{lab=l,n=true},an)
526 :    
527 : monnier 411 (* generate code for a statement *)
528 :     and stmt(T.MV(32,t,e),an) = doExpr(e,t,an)
529 :     | stmt(T.FMV(64,t,e),an) = doFexpr(e,t,an)
530 :     | stmt(T.CCMV(t,e),an) = doCCexpr(e,t,an)
531 :     | stmt(T.COPY(32,dst,src),an) = copy(dst,src,an)
532 :     | stmt(T.FCOPY(64,dst,src),an) = fcopy(dst,src,an)
533 : leunga 775 | stmt(T.JMP(T.LABEL l,_),an) = goto(l,an)
534 : leunga 744 | stmt(T.JMP(ea,labs),an) = jmp(ea,labs,an)
535 : blume 839 | stmt(s as T.CALL { pops=0, ...},an) = call(s,an)
536 :     | stmt(T.CALL _, _) = error "pops<>0 not implemented"
537 : leunga 744 | stmt(T.RET _,an) =
538 :     mark(I.BV{labs=[],x=zeroR,b=C.returnPtr,n=true},an)
539 : monnier 411 | stmt(T.STORE(8,ea,t,mem),an) = store(I.STB,ea,expr t,mem,an)
540 :     | stmt(T.STORE(16,ea,t,mem),an) = store(I.STH,ea,expr t,mem,an)
541 :     | stmt(T.STORE(32,ea,t,mem),an) = store(I.STW,ea,expr t,mem,an)
542 :     | stmt(T.FSTORE(32,ea,t,mem),an) =
543 :     fstore(32,I.FSTWS,I.FSTWX,I.FSTWX_S,ea,t,mem,an)
544 :     | stmt(T.FSTORE(64,ea,t,mem),an) =
545 :     fstore(64,I.FSTDS,I.FSTDX,I.FSTDX_S,ea,t,mem,an)
546 : leunga 744 | stmt(T.BCC(cc,lab),an) = branch(cc,lab,an)
547 : george 545 | stmt(T.DEFINE l,_) = defineLabel l
548 : monnier 411 | stmt(T.ANNOTATION(i,a),an) = stmt(i,a::an)
549 : george 555 | stmt(T.EXT s,an) =
550 :     ExtensionComp.compileSext (reducer()) {stm=s, an=an}
551 : george 545 | stmt(s,_) = doStmts(Gen.compileStm s)
552 : monnier 245
553 : monnier 411 and doStmt s = stmt(s,[])
554 : george 545 and doStmts ss = app doStmt ss
555 : monnier 245
556 : george 761 and jmp(e,labs,an) = let
557 :     fun disp(r, i) = let
558 :     val b = newReg()
559 :     in emit(I.ARITHI{ai=I.ADDI, i=i, r=r, t=b});
560 :     (b, zeroR)
561 :     end
562 :    
563 :     val (b,x) =
564 : monnier 411 case addr(32,e) of
565 : george 761 DISP(b, i) =>
566 :     if T.I.isZero(i) then (b, zeroR) else disp(b, I.IMMED(toInt i))
567 :     | AMode(DISPea(r,i)) => disp(r, i)
568 :     | AMode(INDXea(r1,r2)) => let val b=newReg()
569 : monnier 411 in emit(I.ARITH{a=I.ADD,r1=r1,r2=r2,t=b});
570 : leunga 744 (b,zeroR)
571 : monnier 411 end
572 : george 761 | AMode(INDXSCALEDea(b,x)) => (b,x)
573 : monnier 411 in mark(I.BV{b=b,x=x,n=true,labs=labs},an) end
574 : monnier 245
575 : george 1003 and call(s,an) = let val reduce = {stm=doStmt, rexp=expr, emit=emitInstruction}
576 : monnier 411 in LC.doCall(reduce,s) end
577 : monnier 245
578 : monnier 411 (* Optimize addition *)
579 :     and plus(times,sh1add,sh2add,sh3add,add,addi,a,b,t,an) =
580 :     case times a of
581 :     (TIMES2,a) => arith(sh1add,a,b,t,an)
582 :     | (TIMES4,a) => arith(sh2add,a,b,t,an)
583 :     | (TIMES8,a) => arith(sh3add,a,b,t,an)
584 :     | _ =>
585 :     case times b of
586 :     (TIMES2,b) => arith(sh1add,b,a,t,an)
587 :     | (TIMES4,b) => arith(sh2add,b,a,t,an)
588 :     | (TIMES8,b) => arith(sh3add,b,a,t,an)
589 :     | _ => commImmedArith(add,addi,a,b,t,an)
590 : monnier 245
591 : monnier 411 (* Round to zero for division:
592 :     * d <- r + i
593 :     * d <- if r >= 0 then r else d
594 :     *)
595 : george 545 and divu32 x = Mulu32.divide{mode=T.TO_ZERO,stm=doStmt} x
596 :     and divt32 x = Mult32.divide{mode=T.TO_ZERO,stm=doStmt} x
597 : monnier 411
598 :     and muldiv(ty,genConst,milliFn,a,b,t,commute,an) =
599 :     let fun const(a,i) =
600 :     let val r = expr a
601 : george 1003 in app emitInstruction (genConst{r=r,i=toInt i,d=t})
602 : monnier 411 handle _ => milliCall(milliFn,T.REG(ty,r),T.LI i,t)
603 :     end
604 :     in case (commute,a,b) of
605 :     (_,a,T.LI i) => const(a,i)
606 :     | (true,T.LI i,a) => const(a,i)
607 :     | (_,a,b) => milliCall(milliFn,a,b,t)
608 :     end
609 : monnier 245
610 : monnier 411 (* compile shift *)
611 : george 761 and shift(immedShift,varShift,e,T.LI n,t,an) = let
612 :     val n = toInt n
613 :     in
614 : monnier 411 if n < 0 orelse n > 31 then error "shift"
615 :     else mark(I.SHIFT{s=immedShift,r=expr e,p=31-n,len=32-n,t=t},an)
616 : george 761 end
617 : monnier 411 | shift(immedShift,varShift,e1,e2,t,an) =
618 :     let val r1 = expr e1
619 :     val r2 = expr e2
620 :     val tmp = newReg()
621 :     in emit(I.ARITHI{ai=I.SUBI, i=I.IMMED 31, r=r2, t=tmp});
622 :     emit(I.MTCTL{r=tmp, t=CRReg 11});
623 :     mark(I.SHIFTV{sv=varShift,r=r1,len=32, t=t},an)
624 :     end
625 : monnier 245
626 : george 555 (* Generate a COMCLR_LDO/COMICLR_LDO instruction sequence:
627 : monnier 411 * COMCLR,cond r1, r2, t1
628 :     * LDO i(b), t2
629 :     *
630 :     * Note:
631 :     * t <- if cond(r1,r2) then i else 0 can be mapped into:
632 :     *
633 :     * COMCLR,cond r1, r2, t
634 :     * LDO i(0), t
635 :     *
636 :     * if cond(r1,r2) then t <- e can be mapped into:
637 :     *
638 :     * t' <- e
639 :     * COMCLR,cond r1, r2, 0
640 :     * LDO 0(t'), t
641 :     *
642 :     * t <- if cond(r1,r2) then e1 else e2 can be mapped into:
643 :     *
644 :     * t <- e2
645 :     * t' <- e1
646 :     * COMCLR,cond r1, r2, 0
647 :     * LDO 0(t'), t
648 :     *)
649 : george 555 and comclr(cond,x,y,yes,no,t,an) =
650 :     let val (cond, i1, r2) =
651 :     case (opn x, opn y) of
652 :     (x, I.REG r2) => (cond, x, r2)
653 :     | (I.REG r1, y) => (T.Basis.swapCond cond, y, r1)
654 :     | (x, y) => (cond, x, reduceOpn y)
655 :     val cc = case cond of
656 : monnier 411 T.LT => I.GE
657 :     | T.LE => I.GT
658 :     | T.GT => I.LE
659 :     | T.GE => I.LT
660 :     | T.EQ => I.NE
661 :     | T.LTU => I.GEU
662 :     | T.LEU => I.GTU
663 :     | T.GEU => I.LTU
664 :     | T.GTU => I.LEU
665 :     | T.NE => I.EQ
666 : leunga 744 | _ => error "comclr"
667 : george 545 val tmp = newReg()
668 : monnier 411 val (b,i) =
669 : george 761 case yes
670 :     of T.LI n => if im14 n then (zeroR, toInt(n)) else
671 : monnier 411 let val {hi,lo} = split11 n
672 :     val b = newReg()
673 :     in emit(I.LDIL{i=I.IMMED hi,t=b}); (b,lo) end
674 : george 761 | e => (expr e, 0)
675 :     (*esac*)
676 :    
677 : monnier 411 val t1 =
678 : george 761 case no
679 :     of T.LI z => (* false case is zero *)
680 :     if T.I.isZero(z) then tmp else (doExpr(no,tmp,[]); zeroR)
681 :     | _ => (doExpr(no,tmp,[]); zeroR) (* move false case to tmp *)
682 :     (*esac*)
683 : george 555
684 :     val instr =
685 :     case i1 of
686 :     I.REG r1 =>
687 :     I.COMCLR_LDO{cc=cc,r1=r1,r2=r2,b=b,i=i,t1=t1,t2=tmp}
688 :     | _ => I.COMICLR_LDO{cc=cc,i1=i1,r2=r2,b=b,i2=i,t1=t1,t2=tmp}
689 :     in mark(instr, an);
690 : george 545 move(tmp, t, [])
691 : monnier 411 end
692 : monnier 245
693 : monnier 411 (* convert an expression into a register *)
694 : george 761 and expr(exp) = let
695 :     fun comp() = let
696 :     val t = newReg()
697 :     in doExpr(exp, t, []); t
698 :     end
699 :     in
700 :     case exp
701 :     of T.REG(_, r) => r
702 :     | T.LI z => if T.I.isZero(z) then zeroR else comp()
703 :     | _ => comp()
704 :     end
705 : monnier 411
706 :     (* compute an integer expression and put the result in register t *)
707 :     and doExpr(e,t,an) =
708 :     case e of
709 :     T.REG(_,r) => move(r,t,an)
710 :     | T.LI n => loadImmed(n,t,an)
711 : leunga 775 | T.LABEXP le =>
712 : monnier 411 (case ldLabelOpnd{label=le,pref=SOME t} of
713 : george 545 I.REG r => move(r,t,an)
714 :     | opnd => mark(I.LDO{i=opnd,b=zeroR,t=t},an)
715 : monnier 411 )
716 : leunga 775 | T.CONST _ => loadConst(e,t,an)
717 :     | T.LABEL _ => loadConst(e,t,an)
718 : monnier 411 | T.ADD(_,a,b) => plus(times,
719 :     I.SH1ADDL,I.SH2ADDL,I.SH3ADDL,I.ADD,I.ADDI,
720 :     a,b,t,an)
721 : george 761 | T.SUB(_,a,T.LI mi) =>
722 :     if T.I.isZero(mi) then doExpr(a,t,an)
723 :     else commImmedArith(I.ADD,I.ADDI,a,T.LI(T.I.NEGT(32,mi)),t,an)
724 : monnier 411 | T.SUB(_,a,b) => immedArith(I.SUB,I.SUBI,a,b,t,an)
725 :     | T.ADDT(_,a,b) => plus(timest,
726 :     I.SH1ADDO,I.SH2ADDO,I.SH3ADDO,I.ADDO,I.ADDIO,
727 :     a,b,t,an)
728 : leunga 579 | T.SUBT(_,a,T.LI n) =>
729 : george 761 commImmedArith(I.ADDO,I.ADDIO,a,T.LI(T.I.NEGT(32,n)),t,an)
730 : monnier 411 | T.SUBT(_,a,b) => immedArith(I.SUBO,I.SUBIO,a,b,t,an)
731 : monnier 245
732 : monnier 411 | T.ANDB(_,a,T.NOTB(_,b)) => arith(I.ANDCM,a,b,t,an)
733 :     | T.ANDB(_,T.NOTB(_,a),b) => arith(I.ANDCM,b,a,t,an)
734 :     | T.ANDB(_,a,b) => arith(I.AND,a,b,t,an)
735 :     | T.ORB(_,a,b) => arith(I.OR,a,b,t,an)
736 :     | T.XORB(_,a,b) => arith(I.XOR,a,b,t,an)
737 : monnier 245
738 : monnier 411 | T.SLL(_,a,b) => shift(I.ZDEP,I.ZVDEP,a,b,t,an)
739 :     | T.SRL(_,a,b) => shift(I.EXTRU,I.VEXTRU,a,b,t,an)
740 :     | T.SRA(_,a,b) => shift(I.EXTRS,I.VEXTRS,a,b,t,an)
741 :     | T.MULU(32,a,b) => muldiv(32,Mulu32.multiply,MC.mulu,a,b,t,true,an)
742 :     | T.MULT(32,a,b) => muldiv(32,Mult32.multiply,MC.mulo,a,b,t,true,an)
743 :     | T.DIVU(32,a,b) => muldiv(32,divu32,MC.divu,a,b,t,false,an)
744 :     | T.DIVT(32,a,b) => muldiv(32,divt32,MC.divo,a,b,t,false,an)
745 : monnier 245
746 : monnier 411 | T.LOAD(8,ea,mem) => load(8,I.LDB,I.LDBX,I.LDBX,ea,t,mem,an)
747 :     | T.LOAD(16,ea,mem) => load(16,I.LDH,I.LDHX,I.LDHX_S,ea,t,mem,an)
748 :     | T.LOAD(32,ea,mem) => load(32,I.LDW,I.LDWX,I.LDWX_S,ea,t,mem,an)
749 : monnier 245
750 : george 555 | T.COND(_,T.CMP(_,cond,x,y),yes,no) => comclr(cond,x,y,yes,no,t,an)
751 : george 545 | T.LET(s,e) => (doStmt s; doExpr(e, t, an))
752 :     | T.MARK(e,A.MARKREG f) => (f t; doExpr(e,t,an))
753 :     | T.MARK(e,a) => doExpr(e,t,a::an)
754 :     | T.PRED(e,c) => doExpr(e,t,A.CTRLUSE c::an)
755 : george 555 | T.REXT e =>
756 :     ExtensionComp.compileRext (reducer()) {e=e, rd=t, an=an}
757 : george 545 | e => doExpr(Gen.compileRexp e,t,an)
758 : monnier 411
759 :     (* convert an expression into a floating point register *)
760 :     and fexpr(T.FREG(_,r)) = r
761 :     | fexpr e = let val t = newFreg()
762 :     in doFexpr(e,t,[]); t end
763 : monnier 245
764 : monnier 411 (* compute a floating point expression and put the result in t *)
765 :     and doFexpr(e,t,an) =
766 :     case e of
767 :     (* single precision *)
768 :     T.FREG(32,r) => fmove(r,t,an)
769 :     | T.FLOAD(32,ea,mem) =>
770 :     fload(32,I.FLDWS,I.FLDWX,I.FLDWX_S,ea,t,mem,an)
771 :     | T.FADD(32,a,b) => farith(I.FADD_S,a,b,t,an)
772 :     | T.FSUB(32,a,b) => farith(I.FSUB_S,a,b,t,an)
773 :     | T.FMUL(32,a,b) => farith(I.FMPY_S,a,b,t,an)
774 :     | T.FDIV(32,a,b) => farith(I.FDIV_S,a,b,t,an)
775 :     | T.FABS(32,a) => funary(I.FABS_S,a,t,an)
776 :     | T.FSQRT(32,a) => funary(I.FSQRT_S,a,t,an)
777 :    
778 :     (* double precision *)
779 :     | T.FREG(64,r) => fmove(r,t,an)
780 :     | T.FLOAD(64,ea,mem) =>
781 :     fload(64,I.FLDDS,I.FLDDX,I.FLDDX_S,ea,t,mem,an)
782 :     | T.FADD(64,a,b) => farith(I.FADD_D,a,b,t,an)
783 :     | T.FSUB(64,a,b) => farith(I.FSUB_D,a,b,t,an)
784 :     | T.FMUL(64,a,b) => farith(I.FMPY_D,a,b,t,an)
785 :     | T.FDIV(64,a,b) => farith(I.FDIV_D,a,b,t,an)
786 :     | T.FABS(64,a) => funary(I.FABS_D,a,t,an)
787 :     | T.FSQRT(64,a) => funary(I.FSQRT_D,a,t,an)
788 : monnier 245
789 : monnier 411 (* conversions *)
790 : george 545 | T.CVTF2F(fty,fty',e) =>
791 :     (case (fty,fty') of
792 :     (64,32) => fcnv(I.FCNVFF_SD,e,t,an)
793 :     | (32,64) => fcnv(I.FCNVFF_DS,e,t,an)
794 :     | (32,32) => doFexpr(e,t,an)
795 :     | (64,64) => doFexpr(e,t,an)
796 : monnier 411 | _ => error "CVTF2F"
797 :     )
798 : george 1003 | T.CVTI2F(32,_,e) => app emitInstruction (MilliCode.cvti2s{rs=expr e,fd=t})
799 :     | T.CVTI2F(64,_,e) => app emitInstruction (MilliCode.cvti2d{rs=expr e,fd=t})
800 : monnier 245
801 : monnier 411 (* negation is implemented as subtraction *)
802 :     | T.FNEG(ty,a) => doFexpr(T.FSUB(ty,T.FREG(ty,zeroF),a),t,an)
803 : monnier 245
804 : george 545 | T.FMARK(e,A.MARKREG f) => (f t; doFexpr(e,t,an))
805 :     | T.FMARK(e,a) => doFexpr(e,t,a::an)
806 :     | T.FPRED(e,c) => doFexpr(e,t,A.CTRLUSE c::an)
807 : george 555 | T.FEXT e =>
808 :     ExtensionComp.compileFext (reducer()) {e=e, fd=t, an=an}
809 : george 545 | e => error "doFexpr"
810 : monnier 411
811 : george 545 and doCCexpr(T.CC(_,r),t,an) = move(r,t,an)
812 :     | doCCexpr(T.FCC(_,r),t,an) = move(r,t,an)
813 : monnier 411 | doCCexpr(T.CMP(ty,cond,e1,e2),t,an) = error "doCCexpr"
814 : george 545 | doCCexpr(T.CCMARK(e,A.MARKREG f),t,an) = (f t; doCCexpr(e,t,an))
815 :     | doCCexpr(T.CCMARK(e,a),t,an) = doCCexpr(e,t,a::an)
816 : george 555 | doCCexpr(T.CCEXT e,t,an) =
817 :     ExtensionComp.compileCCext (reducer()) {e=e,ccd=t,an=an}
818 : monnier 411 | doCCexpr e = error "doCCexpr"
819 :    
820 : george 545 and ccExpr(T.CC(_,r)) = r
821 :     | ccExpr(T.FCC(_,r)) = r
822 : monnier 411 | ccExpr e = let val t = newReg() in doCCexpr(e,t,[]); t end
823 : monnier 245
824 : monnier 411 (* convert an expression into an operand *)
825 : leunga 775 and opn(c as T.CONST _) = I.LabExp(c,I.F)
826 :     | opn(l as T.LABEL _) = I.LabExp(l,I.F)
827 :     | opn(T.LABEXP le) = ldLabelOpnd{label=le,pref=NONE}
828 :     | opn(e as T.LI n) = if im11 n then I.IMMED(toInt n)
829 :     else I.REG(expr e)
830 :     | opn e = I.REG(expr e)
831 : george 545
832 : george 761 and addrOf e =
833 :     case addr(0, e)
834 :     of AMode mode => mode
835 :     | DISP(r, mi) => DISPea(r, I.IMMED(toInt mi))
836 :    
837 : george 545 and reducer() =
838 : george 984 TS.REDUCER{reduceRexp = expr,
839 :     reduceFexp = fexpr,
840 :     reduceCCexp = ccExpr,
841 :     reduceStm = stmt,
842 :     operand = opn,
843 :     reduceOperand = reduceOpn,
844 :     addressOf = addrOf,
845 : george 1003 emit = mark',
846 : george 984 instrStream = instrStream,
847 :     mltreeStream = self()
848 : george 545 }
849 : monnier 411
850 : george 545 (* convert mlrisc to cellset:
851 :     * condition code registers are mapped onto general registers
852 :     *)
853 :     and cellset mlrisc =
854 :     let fun g([],acc) = acc
855 :     | g(T.GPR(T.REG(_,r))::regs,acc) = g(regs,C.addReg(r,acc))
856 :     | g(T.FPR(T.FREG(_,f))::regs,acc) = g(regs,C.addFreg(f,acc))
857 :     | g(T.CCR(T.CC(_,cc))::regs,acc) = g(regs,C.addReg(cc,acc))
858 :     | g(_::regs, acc) = g(regs, acc)
859 :     in g(mlrisc, C.empty) end
860 :    
861 :     and self() =
862 : george 984 TS.S.STREAM
863 : leunga 815 { beginCluster = beginCluster,
864 :     endCluster = endCluster,
865 :     emit = doStmt,
866 :     pseudoOp = pseudoOp,
867 :     defineLabel = defineLabel,
868 :     entryLabel = entryLabel,
869 :     comment = comment,
870 :     annotation = annotation,
871 :     getAnnotations = getAnnotations,
872 :     exitBlock = fn regs => exitBlock(cellset regs)
873 : george 545 }
874 :     in self()
875 : monnier 411 end
876 : monnier 429
877 : monnier 411
878 :     end

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