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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 143 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/hppa/hppa.sml

1 : monnier 16 (* hppa.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Bell Laboratories.
4 :     *
5 :     * generates machine code from the mltree.
6 :     *
7 :     *)
8 :     functor Hppa
9 :     (structure Flowgen : FLOWGRAPH_GEN
10 :     structure HppaInstr : HPPAINSTR
11 :     structure HppaMLTree : MLTREE
12 :     structure MilliCode : HPPA_MILLICODE
13 :     structure LabelComp : LABEL_COMP
14 :    
15 :     sharing Flowgen.I = MilliCode.I = LabelComp.I = HppaInstr
16 :     sharing Flowgen.T = LabelComp.T = HppaMLTree
17 :     sharing HppaMLTree.Region = HppaInstr.Region
18 : monnier 127 sharing HppaMLTree.Constant = HppaInstr.Constant
19 :     sharing HppaMLTree.BNames = Flowgen.B) : MLTREECOMP =
20 : monnier 16 struct
21 :     structure I = HppaInstr
22 :     structure F = Flowgen
23 :     structure T = HppaMLTree
24 :     structure C = HppaCells
25 :     structure MC = MilliCode
26 :     structure LC = LabelComp
27 :     structure Region = I.Region
28 :    
29 :     structure M = struct
30 :     (* runtime system dependent constants. *)
31 :     val float64TmpOffset = 0 (* must be < 16 *)
32 :     val float32TmpOffset = float64TmpOffset (* must be < 16 *)
33 :     val cvti2dOffset = ~4
34 :     end
35 :    
36 :     fun error msg = MLRiscErrorMsg.impossible ("Hppa." ^ msg)
37 :    
38 :     val itow = Word.fromInt
39 :    
40 : monnier 143 val emitInstr = F.emitInstr
41 : monnier 16 val emit = F.emitInstr
42 :     val ldLabelEA = LC.ldLabelEA emit
43 :     val ldLabelOpnd = LC.ldLabelOpnd emit
44 :    
45 :     datatype ea = DISPea of int * I.operand | INDXea of int * int
46 :    
47 :     (* integer ranges *)
48 :     fun im5 n = n < 16 andalso n >= ~16
49 :     fun im11 n = n < 1024 andalso n >= ~1024
50 :     fun im14 n = n < 8192 andalso n >= ~8192
51 :    
52 :     fun split n = let
53 :     val w = Word.fromInt(n)
54 :     in
55 :     (Word.toIntX(Word.~>>(w, 0w11)), Word.toIntX(Word.andb(w, 0wx7ff)))
56 :     end
57 :    
58 :     val zeroR = 0
59 :     val zeroEA = I.Direct(zeroR)
60 :    
61 :     fun emitMove(src, dst) = emit(I.ARITH{a=I.OR, r1=src, r2=zeroR, t=dst})
62 :    
63 :     fun loadImmedRd(n, rd) =
64 :     if im14 n then (emit(I.LDO{i=I.IMMED n, b=0, t=rd}); rd)
65 :     else let
66 :     val (hi, lo) = split n
67 : monnier 106 val tmpR = C.newReg()
68 : monnier 16 in
69 :     emit(I.LDIL{i=I.IMMED hi, t=tmpR});
70 :     emit(I.LDO{i=I.IMMED lo, b=tmpR, t=rd});
71 :     rd
72 :     end
73 :    
74 : monnier 106 fun loadImmed n = loadImmedRd(n, C.newReg())
75 : monnier 16
76 :     fun loadWord32Rd(w, rd) = let
77 :     val toInt = Word32.toIntX
78 :     in
79 :     if Word32.<(w, 0w8192) then emit(I.LDO{i=I.IMMED(toInt w), b=0, t=rd})
80 :     else let
81 : monnier 106 val tmpR = C.newReg()
82 : monnier 16 val hi = Word32.~>>(w, 0w11)
83 :     val lo = Word32.andb(w, 0wx7ff)
84 :     in
85 :     emit(I.LDIL{i=I.IMMED(toInt hi), t=tmpR});
86 :     emit(I.LDO{i=I.IMMED(toInt lo), b=tmpR, t=rd})
87 :     end;
88 :     rd
89 :     end
90 : monnier 106 fun loadWord32 w = loadWord32Rd(w, C.newReg())
91 : monnier 16
92 :     fun milliCall(milliFn, exp1, exp2, ord, rd) = let
93 :     val (rs, rt) = orderedRR(exp1, exp2, ord)
94 :     in app emit (milliFn{rs=rs, rt=rt, rd=rd}); rd
95 :     end
96 :    
97 :     and orderedRR(exp1, exp2, T.LR) = (regAction exp1, regAction exp2)
98 :     | orderedRR(exp1, exp2, T.RL) = let val r2 = regAction exp2
99 :     in
100 :     (regAction exp1, r2)
101 :     end
102 :    
103 :     and orderedFF(exp1, exp2, T.LR) = (fregAction exp1, fregAction exp2)
104 :     | orderedFF(exp1, exp2, T.RL) = let val f2 = fregAction exp2
105 :     in (fregAction exp1, f2)
106 :     end
107 :    
108 :     and eaAction(T.ADD(exp, T.LI n)) = DISPea(regAction exp, I.IMMED n)
109 :     | eaAction(T.ADD(T.LI n, exp)) = DISPea(regAction exp, I.IMMED n)
110 :     | eaAction(T.ADD(exp, T.CONST c)) = DISPea(regAction exp, I.ConstOp c)
111 :     | eaAction(T.ADD(T.CONST c, exp)) = DISPea(regAction exp, I.ConstOp c)
112 :     | eaAction(T.ADD(e1 as T.LABEL _, e2)) = eaAction(T.ADD(e2, e1))
113 :     | eaAction(T.ADD(e, T.LABEL le)) = let
114 :     val rs = regAction(e)
115 :     in
116 :     case ldLabelEA(le)
117 :     of (0, opnd) => DISPea(rs, opnd)
118 :     | (rt, I.IMMED 0) => INDXea(rs, rt)
119 :     | (rt, opnd) => let
120 :     val tmpR = C.newReg()
121 :     in
122 :     emit(I.ARITH{a=I.ADD, r1=rs, r2=rt, t=tmpR});
123 :     DISPea(tmpR, opnd)
124 :     end
125 :     end
126 :     | eaAction(T.ADD(exp1, exp2)) = INDXea(regAction exp1, regAction exp2)
127 :     | eaAction(T.SUB(exp, T.LI n, _)) = DISPea(regAction exp, I.IMMED(~n))
128 :     | eaAction(T.LABEL lexp) = DISPea(ldLabelEA(lexp))
129 :     | eaAction exp = DISPea(regAction exp, I.IMMED 0)
130 :    
131 :     and stmAction exp = let
132 :     fun store(ea, reg, instr, mem) = let
133 :     val (b, d) =
134 :     case eaAction ea
135 :     of DISPea (bd as (base, I.IMMED disp)) =>
136 :     if im14 disp then bd
137 :     else let
138 :     val (hi21, lo11) = split disp
139 : monnier 106 val tmpR1 = C.newReg()
140 :     val tmpR2 = C.newReg()
141 : monnier 16 in
142 :     emit(I.LDIL{i=I.IMMED hi21, t=tmpR1});
143 :     emit(I.ARITH{a=I.ADD, r1=base, r2=tmpR1, t=tmpR2});
144 :     (tmpR2, I.IMMED lo11)
145 :     end
146 :     | DISPea bd => bd
147 :     | INDXea(r1,r2) => let
148 : monnier 106 val t = C.newReg()
149 : monnier 16 in
150 :     emit (I.ARITH {a=I.ADD, r1=r1, r2=r2, t=t});
151 :     (t, I.IMMED 0)
152 :     end
153 :     in emit (I.STORE {st=instr, b=b, d=d, r=regAction reg, mem=mem})
154 :     end
155 :    
156 :     fun fstore(ea, freg, mem) = let
157 :     val r = fregAction freg
158 :     in
159 :     case eaAction ea
160 :     of DISPea(b, I.IMMED d) =>
161 :     if im5 d then
162 :     emit(I.FSTORE {fst=I.FSTDS, b=b, d=d, r=r, mem=mem})
163 :     else
164 :     emit(I.FSTOREX{fstx=I.FSTDX, b=b, x=loadImmed d, r=r, mem=mem})
165 :     | DISPea(b, d) => let
166 : monnier 106 val tmpR = C.newReg()
167 : monnier 16 in
168 :     emit(I.ARITHI{ai=I.ADDI, r=b, i=d, t=tmpR});
169 :     emit(I.FSTORE{fst=I.FSTDS, b=tmpR, d=0, r=r, mem=mem})
170 :     end
171 :     | INDXea(b,x) => emit(I.FSTOREX{fstx=I.FSTDX, b=b, x=x, r=r, mem=mem})
172 :     end
173 :    
174 :     fun branch(bc, r1, r2, t) = let
175 :     val flab = Label.newLabel ""
176 :     fun emitBranch(cmp, ic, r1, r2) =
177 :     (emit(I.BCOND{cmp=cmp, bc=ic, r1=r1, r2=r2, t=t, f=flab, n=true});
178 :     F.defineLabel flab)
179 :     in
180 :     (case bc
181 :     of T.LT => emitBranch(I.COMBT, I.LT, r1, r2)
182 :     | T.LE => emitBranch(I.COMBT, I.LE, r1, r2)
183 :     | T.GT => emitBranch(I.COMBT, I.LT, r2, r1)
184 :     | T.GE => emitBranch(I.COMBT, I.LE, r2, r1)
185 :     | T.EQ => emitBranch(I.COMBT, I.EQ, r1, r2)
186 :     | T.LTU => emitBranch(I.COMBT, I.LTU, r1, r2)
187 :     | T.LEU => emitBranch(I.COMBT, I.LEU, r1, r2)
188 :     | T.GEU => emitBranch(I.COMBT, I.LEU, r2, r1)
189 :     | T.GTU => emitBranch(I.COMBT, I.LTU, r2, r1)
190 :     | T.NEQ => emitBranch(I.COMBF, I.EQ, r1, r2)
191 :     (*esac*))
192 :     end
193 : monnier 106 fun copyTmp() = SOME(I.Direct(C.newReg()))
194 :     fun fcopyTmp() = SOME(I.FDirect(C.newFreg()))
195 : monnier 16
196 :     val reduce={stm=stmAction, rexp=regAction, emit=emit}
197 :     val returnPtr = 2
198 :     in
199 :     case exp
200 :     of T.MV(rd, exp) =>
201 :     (case exp
202 :     of T.REG(rs) => if rd = rs then () else emitMove(rs, rd)
203 :     | T.LI n => (loadImmedRd(n, rd); ())
204 :     | T.LI32 w => (loadWord32Rd(w, rd); ())
205 :     | _ => let val rs = regActionRd(exp, rd)
206 :     in if rs = rd then () else emitMove(rs, rd)
207 :     end
208 :     (*esac*))
209 :     | T.FMV(fd, exp) => let
210 :     fun fmove(src,dst) = I.FUNARY{fu=I.FCPY, f=src, t=dst}
211 :     in
212 :     case exp
213 :     of T.FREG(fs) =>
214 :     if fs = fd then () else emit(fmove(fs, fd))
215 :     | _ => let val fs = fregActionFd(exp, fd)
216 :     in if fs = fd then () else emit(fmove(fs, fd))
217 :     end
218 :     (*esac*)
219 :     end
220 :     | T.CCMV(cd, exp) => let
221 :     val cs = case exp of T.CC(r) => r | _ => ccActionCd(exp, cd)
222 :     in if cs=cd then () else emitMove(cs, cd)
223 :     end
224 :    
225 :     | T.COPY(rds as [_], rss) =>
226 :     emit(I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=NONE})
227 :     | T.COPY(rds, rss) =>
228 :     emit(I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=copyTmp()})
229 :     | T.FCOPY(fds as [_], fss)=>
230 :     emit(I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=NONE})
231 :     | T.FCOPY(fds, fss) =>
232 :     emit(I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=fcopyTmp()})
233 :    
234 :     | T.JMP _ => LC.doJmp(reduce, exp)
235 :     | T.CALL _ => LC.doCall(reduce, exp)
236 :     | T.RET => emit(I.BV{labs=[], x=0, b=returnPtr, n=true})
237 :     | T.STORE8(ea, r, region) => store(ea, r, I.STB, region)
238 :     | T.STORE32(ea, r, region) => store(ea, r, I.STW, region)
239 :     | T.STORED(ea, f, region) => fstore(ea, f, region)
240 :     | T.STORECC(ea, cc, region) => error "stmAction.STORECC"
241 :     | T.BCC(_, T.CMP(cc, exp, T.LI n, ord), lab) => let
242 :     val r = regAction exp
243 :     in
244 :     if im5 n then let
245 :     val flab = Label.newLabel ""
246 :     fun emitBranch(cmpi, ic) =
247 :     (emit(I.BCONDI{cmpi=cmpi,bc=ic,i=n,r2=r,t=lab,f=flab, n=true});
248 :     F.defineLabel flab)
249 :     in
250 :     case cc
251 :     of T.LT => emitBranch(I.COMIBF, I.LE)
252 :     | T.LE => emitBranch(I.COMIBF, I.LT)
253 :     | T.GT => emitBranch(I.COMIBT, I.LT)
254 :     | T.GE => emitBranch(I.COMIBT, I.LE)
255 :     | T.EQ => emitBranch(I.COMIBT, I.EQ)
256 :     | T.LTU => emitBranch(I.COMIBF, I.LEU)
257 :     | T.LEU => emitBranch(I.COMIBF, I.LTU)
258 :     | T.GEU => emitBranch(I.COMIBT, I.LEU)
259 :     | T.GTU => emitBranch(I.COMIBT, I.LTU)
260 :     | T.NEQ => emitBranch(I.COMIBF, I.EQ)
261 :     end
262 :     else
263 :     branch(cc, r, loadImmed n, lab)
264 :     end
265 :     | T.BCC(_, T.CMP(cc, exp1, exp2, order), lab) => let
266 :     val (r1, r2) = orderedRR(exp1, exp2, order)
267 :     in
268 :     branch(cc, r1, r2, lab)
269 :     end
270 :     | T.BCC(_, e, lab) => let
271 :     val cc = ccAction e
272 :     val flab = Label.newLabel""
273 :     in
274 :     emit(I.BCOND{cmp=I.COMBT, bc=I.EQ, r1=cc, r2=zeroR,
275 :     t=lab, f=flab, n=true});
276 :     F.defineLabel flab
277 :     end
278 :     | T.FBCC(_, T.FCMP(cc, exp1, exp2, order), lab) => let
279 :     val (f1,f2) = orderedFF(exp1, exp2, order)
280 :     val fallThrough = Label.newLabel ""
281 :     fun fcond T.== = I.!=
282 :     | fcond T.?<> = I.==
283 :     | fcond T.? = I.<=>
284 :     | fcond T.<=> = I.?
285 :     | fcond T.> = I.?<=
286 :     | fcond T.>= = I.?<
287 :     | fcond T.?> = I.<=
288 :     | fcond T.?>= = I.<
289 :     | fcond T.< = I.?>=
290 :     | fcond T.<= = I.?>
291 :     | fcond T.?< = I.>=
292 :     | fcond T.?<= = I.>
293 :     | fcond T.<> = I.?=
294 :     | fcond T.?= = I.<>
295 :     in
296 :     emit(I.FCMP(fcond cc, f1, f2));
297 :     emit(I.FTEST);
298 :     emit(I.FBCC{t=lab, f=fallThrough, n=true});
299 :     F.defineLabel fallThrough
300 :     end
301 :     end
302 :    
303 :     (* condition code registers are implemented using
304 :     * general purpose registers.
305 :     *)
306 :     and ccAction(T.CC r) = r
307 :     | ccAction e = ccActionCd(e, C.newCCreg())
308 :    
309 :     and ccActionCd(T.CC r, _) = r
310 :     | ccActionCd(T.CMP(cond, exp1, exp2, order), rd) = let
311 :     val (r1, r2) = orderedRR(exp1, exp2, order)
312 :     in
313 :     case cond
314 :     of T.GTU =>
315 :     (emit(I.COMCLR{cc=I.GTU, r1=r1, r2=r2, t=rd});
316 :     emit(I.LDO{i=I.IMMED 1, b=0, t=rd}))
317 :     (* enough for now *)
318 :     | _ => error "ccAction.CMP"
319 :     (*esac*);
320 :     rd
321 :     end
322 :     | ccActionCd(T.FCMP _, _) = error "ccAction:FCMP"
323 :     | ccActionCd(T.LOADCC _, _) = error "ccAction:LOADCC"
324 :    
325 :     and regAction(T.REG r) = r
326 : monnier 106 | regAction exp = regActionRd(exp, C.newReg())
327 : monnier 16
328 :     and regActionRd(exp, rd) = let
329 :     datatype opnd = REG of int | OPND of I.operand
330 :    
331 :     fun opndAction(T.LI n) =
332 :     if im11 n then OPND(I.IMMED n) else REG(loadImmed n)
333 :     | opndAction(T.LI32 w) =
334 :     if Word32.<=(w, 0w1024) then OPND(I.IMMED(Word32.toInt w))
335 :     else REG(loadWord32 w)
336 :     | opndAction(T.CONST c) = OPND(I.ConstOp c)
337 :     | opndAction(T.LABEL le) =
338 :     (case ldLabelOpnd{label=le, pref=NONE}
339 :     of LC.REG r => REG r
340 :     | LC.OPND opnd => OPND opnd
341 :     (*esac*))
342 :     | opndAction exp = REG(regAction exp)
343 :    
344 :     fun immedArith(exp1, exp2, order, immdOp, arithOp) = let
345 :     val (opnd, r2) =
346 :     case order
347 :     of T.LR => (opndAction exp1, regAction exp2)
348 :     | T.RL => let val opnd' = opndAction exp1
349 :     in
350 :     (opnd', regAction exp2)
351 :     end
352 :     in
353 :     case opnd
354 :     of REG r1 => emit(I.ARITH{a=arithOp, r1=r1, r2=r2, t=rd})
355 :     | OPND opnd => emit(I.ARITHI{ai=immdOp, r=r2, i=opnd, t=rd})
356 :     (*esac*);
357 :     rd
358 :     end (* immedArith *)
359 :    
360 :     fun commImmedArith(arg as (exp1, exp2, ord, immdOp, arithOp)) =
361 :     (case exp2
362 :     of (T.LI _ | T.LI32 _ | T.CONST _ | T.LABEL _ )=>
363 :     immedArith(exp2, exp1, ord, immdOp, arithOp)
364 :     | _ => immedArith arg
365 :     (*esac*))
366 :    
367 :     local
368 :     fun shift (immdSht, varSht) = let
369 :     fun f(exp, T.LI n, _) =
370 :     if n < 0 orelse n > 31 then error "regActionRd:shift"
371 :     else let
372 :     val rs = regAction exp
373 :     in
374 :     emit(I.SHIFT{s=immdSht, r=rs, p=31-n, len=32-n, t=rd});
375 :     rd
376 :     end
377 :     | f(exp1, exp2, order) = let
378 :     val (r1, r2) = orderedRR(exp1, exp2, order)
379 : monnier 106 val tmp = C.newReg()
380 : monnier 16 in
381 :     emit(I.ARITHI{ai=I.SUBI, i=I.IMMED 31, r=r2, t=tmp});
382 :     emit(I.MTCTL{r=tmp, t=11});
383 :     emit(I.SHIFTV{sv=varSht, r=r1, len=32, t=rd});
384 :     rd
385 :     end
386 :     in
387 :     f
388 :     end
389 :     in
390 :     val sll = shift (I.ZDEP, I.ZVDEP)
391 :     val srl = shift (I.EXTRU, I.VEXTRU)
392 :     val sra = shift (I.EXTRS, I.VEXTRS)
393 :     end
394 :    
395 :     fun arith(exp1, exp2, oper) =
396 :     (emit(I.ARITH{a=oper, r1=regAction exp1, r2=regAction exp2, t=rd});
397 :     rd)
398 :    
399 :     fun load(ea, rd, instri, instrx, mem) =
400 :     (case eaAction ea
401 :     of DISPea(b, I.IMMED d) =>
402 :     if im14 d then
403 :     emit(I.LOADI{li=instri, i=I.IMMED d, r=b, t=rd, mem=mem})
404 :     else
405 :     emit(I.LOAD{l=instrx, r1=b, r2=loadImmed d, t=rd, mem=mem})
406 :     | DISPea(b, d) =>
407 :     emit(I.LOADI{li=instri, i=d, r=b, t=rd, mem=mem})
408 :     | INDXea(b,x) =>
409 :     emit(I.LOAD{l=instrx, r1=b, r2=x, t=rd, mem=mem})
410 :     (*esac*);
411 :     rd)
412 :    
413 :     val reduce = {stm=stmAction, rexp=regAction, emit=emit}
414 :     in
415 :     case exp
416 :     of T.LI n => (loadImmedRd(n, rd); rd)
417 :     | T.LI32 w => (loadWord32Rd(w, rd); rd)
418 :     | T.CONST c => (emit(I.LDO{i=I.ConstOp(c), b=0, t=rd}); rd)
419 :     | T.LABEL le =>
420 :     (case ldLabelOpnd{label=le, pref=SOME(rd)}
421 :     of LC.REG rs => if rd=rs then () else emitMove(rs, rd)
422 :     | LC.OPND opnd => emit(I.LDO{i=opnd, b=zeroR, t=rd})
423 :     (*esac*);
424 :     rd)
425 :     | T.ADD(exp1, exp2) => commImmedArith(exp1, exp2, T.LR, I.ADDI, I.ADD)
426 :     | T.ADDT(e1, e2) => commImmedArith(e1, e2, T.LR, I.ADDIO, I.ADDO)
427 :     | T.SUB(e, T.LI n, _) => immedArith(T.LI(~n), e, T.LR, I.ADDIO, I.ADDO)
428 :     | T.SUBT(e, T.LI n, _) => immedArith(T.LI(~n), e, T.LR, I.ADDIO, I.ADDO)
429 :     | T.SUB(exp1, exp2, ord) => immedArith(exp1, exp2, ord, I.SUBI, I.SUB)
430 :     | T.SUBT(exp1, exp2, ord) => immedArith(exp1, exp2, ord, I.SUBIO, I.SUBO)
431 :     | T.SLL arg => sll arg
432 :     | T.SRL arg => srl arg
433 :     | T.SRA arg => sra arg
434 :     | T.ANDB(exp1, exp2) => arith(exp1, exp2, I.AND)
435 :     | T.ORB(exp1, exp2) => arith(exp1, exp2, I.OR)
436 :     | T.XORB(exp1, exp2) => arith(exp1, exp2, I.XOR)
437 :     | T.DIVU(exp1, exp2, ord)=> milliCall(MC.divu, exp1, exp2, ord, rd)
438 :     | T.DIVT(exp1, exp2, ord)=> milliCall(MC.divo, exp1, exp2, ord, rd)
439 :     | T.MULT(exp1, exp2) => milliCall(MC.mulo, exp1, exp2, T.LR, rd)
440 :     | T.MULU(exp1, exp2) => milliCall(MC.mulu, exp1, exp2, T.LR, rd)
441 :     | T.LOAD8(ea, region) => load(ea, rd, I.LDB, I.LDBX, region)
442 :     | T.LOAD32(ea, region) => load(ea, rd, I.LDW, I.LDWX, region)
443 :     | T.SEQ(exp1, exp2) => (stmAction exp1; regAction exp2)
444 :     | _ => error "regActionRd: missing rules"
445 :     end (* regActionRd *)
446 :    
447 :     and fregAction (T.FREG f) = f
448 : monnier 106 | fregAction exp = fregActionFd(exp, C.newFreg())
449 : monnier 16
450 :     and fregActionFd(exp, fd) = let
451 :     fun orderedFarith(exp1, exp2, ord, arithOp) = let
452 :     val (f1, f2) = orderedFF(exp1, exp2, ord)
453 :     in
454 :     emit(I.FARITH{fa=arithOp, r1=f1, r2=f2, t=fd});
455 :     fd
456 :     end
457 :    
458 :     in
459 :     case exp
460 :     of T.LOADD(ea, region) =>
461 :     (case eaAction ea
462 :     of INDXea(r1, r2) =>
463 :     emit(I.FLOADX{flx=I.FLDDX, b=r1, x=r2, t=fd, mem=region})
464 :     | DISPea(r, I.IMMED n) =>
465 :     if im5 n then
466 :     emit(I.FLOAD{fl=I.FLDDS, b=r, d=n, t=fd, mem=region})
467 :     else
468 :     emit(I.FLOADX{flx=I.FLDDX, b=r, x=loadImmed n, t=fd,
469 :     mem=region})
470 :     | DISPea(r,d) => let
471 : monnier 106 val tmpR = C.newReg()
472 : monnier 16 in
473 :     emit(I.ARITHI{ai=I.ADDI, r=r, i=d, t=tmpR});
474 :     emit(I.FLOADX{flx=I.FLDDX, b=tmpR, x=zeroR, t=fd,mem=region})
475 :     end
476 :     (*esac*);
477 :     fd)
478 :     | T.FADDD(exp1, exp2) => orderedFarith(exp1, exp2, T.LR, I.FADD)
479 :     | T.FSUBD(exp1, exp2, ord) => orderedFarith(exp1, exp2, ord, I.FSUB)
480 :     | T.FMULD(exp1, exp2) => orderedFarith(exp1, exp2, T.LR, I.FMPY)
481 :     | T.FDIVD(exp1, exp2, ord) => orderedFarith(exp1, exp2, ord, I.FDIV)
482 :     | T.FABSD exp => (emit(I.FUNARY{fu=I.FABS, f=fregAction exp, t=fd}); fd)
483 :     | T.FNEGD exp => (emit(I.FARITH{fa=I.FSUB, r1=0, r2=fregAction exp, t=fd}); fd)
484 :     | T.CVTI2D exp =>
485 :     (emit(I.STORE{st=I.STW, b=C.stackptrR, d=I.IMMED M.cvti2dOffset,
486 :     r=regAction exp, mem=Region.stack});
487 :     emit(I.FLOAD{fl=I.FLDWS, b=C.stackptrR, d=M.cvti2dOffset, t=fd,
488 :     mem=Region.stack});
489 :     emit(I.FUNARY{fu=I.FCNVXF, f=fd, t=fd});
490 :     fd)
491 :     | T.FSEQ(e1, e2) => (stmAction e1; fregAction e2)
492 :     | _ => error "fregAction: missing rule"
493 :     end
494 :    
495 :     and mltreeComp mltree = let
496 :     (* condition code registers are mapped onto general registers *)
497 :     fun cc (T.CCR(T.CC cc)) = T.GPR(T.REG cc)
498 :     | cc x = x
499 :    
500 :     fun mltc(T.PSEUDO_OP pOp) = F.pseudoOp pOp
501 :     | mltc(T.DEFINELABEL lab) = F.defineLabel lab
502 :     | mltc(T.ENTRYLABEL lab) = F.entryLabel lab
503 :     | mltc(T.ORDERED mlts) = F.ordered mlts
504 :     | mltc(T.BEGINCLUSTER) = F.beginCluster()
505 :     | mltc(T.CODE stms) = app stmAction stms
506 : monnier 127 | mltc(T.BLOCK_NAME name) = F.blockName name
507 : monnier 16 | mltc(T.ENDCLUSTER regmap)= F.endCluster regmap
508 :     | mltc(T.ESCAPEBLOCK regs) = F.exitBlock (map cc regs)
509 :     in mltc mltree
510 :     end
511 :    
512 :     val mlriscComp = stmAction
513 :     end
514 :    

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