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 224 - (view) (download)

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

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