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

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