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/branches/SMLNJ/src/MLRISC/x86/mltree/x86.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/MLRISC/x86/mltree/x86.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 247 - (view) (download)

1 : monnier 247 (* X86.sml -- pattern matching version of x86 instruction set generation.
2 :     *
3 :     * COPYRIGHT (c) 1998 Bell Laboratories.
4 :     *
5 :     *)
6 :     functor X86
7 :     (structure X86Instr : X86INSTR
8 :     structure X86MLTree : MLTREE
9 :     where Region = X86Instr.Region
10 :     and Constant = X86Instr.Constant
11 :     structure Flowgen : FLOWGRAPH_GEN
12 :     where I = X86Instr and T = X86MLTree and B = X86MLTree.BNames
13 :     val tempMem : X86Instr.operand) : MLTREECOMP =
14 :     struct
15 :     structure F = Flowgen
16 :     structure T = X86MLTree
17 :     structure I = X86Instr
18 :     structure C = X86Cells
19 :    
20 :     structure W32 = Word32
21 :     structure LE = LabelExp
22 :    
23 :     fun error msg = MLRiscErrorMsg.impossible ("X86." ^ msg)
24 :    
25 :     (* label where a trap is generated -- one per cluster *)
26 :     val trapLabel = ref (NONE: Label.label option)
27 :    
28 :     val emitInstr = F.emitInstr
29 :     val emit = F.emitInstr
30 :     val newReg = C.newReg
31 :     val newFreg = C.newFreg
32 :    
33 :     (* conversions *)
34 :     val itow = Word.fromInt
35 :     val wtoi = Word.toInt
36 :     val toInt32 = Int32.fromLarge o Int.toLarge
37 :    
38 :     (* One day, this is going to bite us when precision(LargeInt)>32 *)
39 :     val wToInt32 = Int32.fromLarge o Word32.toLargeIntX
40 :    
41 :     (* some useful registers *)
42 :     val eax = I.Direct(C.eax)
43 :     val ecx = I.Direct(C.ecx)
44 :     val edx = I.Direct(C.edx)
45 :    
46 :     fun immed8 n = Int32.>=(n, ~256) andalso Int32.<(n,256)
47 :     fun immedLabel lab = I.ImmedLabel(LE.LABEL lab)
48 :    
49 :     fun move(src as I.Direct s, dst as I.Direct d) =
50 :     if s=d then ()
51 :     else emit(I.COPY{dst=[d], src=[s], tmp=NONE})
52 :     | move(src, dst) = emit(I.MOVE{mvOp=I.MOVL, src=src, dst=dst})
53 :    
54 :     fun moveToReg opnd = let
55 :     val dst = I.Direct(newReg())
56 :     in move(opnd, dst); dst
57 :     end
58 :    
59 :     (* ensure that the operand is either an immed or register *)
60 :     fun immedOrReg opnd =
61 :     case opnd
62 :     of I.Displace _ => moveToReg opnd
63 :     | I.Indexed _ => moveToReg opnd
64 :     | _ => opnd
65 :     (*esac*)
66 :    
67 :     fun isImmediate(I.Immed _) = true
68 :     | isImmediate(I.ImmedLabel _) = true
69 :     | isImmediate(I.Const _) = true
70 :     | isImmediate(I.LabelEA _) = true
71 :     | isImmediate _ = false
72 :    
73 :     fun regOrMem opnd = if isImmediate opnd then moveToReg opnd else opnd
74 :    
75 :    
76 :     fun rexp(T.REG r) = ["r" ^ Int.toString r]
77 :     | rexp(T.LI i) = ["LI"]
78 :     | rexp(T.LI32 i32) = ["LI32"]
79 :     | rexp(T.LABEL le) = ["LABEL"]
80 :     | rexp(T.CONST c) = ["CONST"]
81 :    
82 :     | rexp(T.ADD (e1, e2)) = ["ADD("] @ rexp e1 @ (","::rexp e2) @ [")"]
83 :     | rexp(T.SUB (e1, e2, _)) = ["SUB"]
84 :     | rexp(T.MULU (e1, e2)) = ["MULU"]
85 :     | rexp(T.DIVU (e1, e2, _)) = ["DIVU"]
86 :    
87 :     | rexp(T.ADDT (e1, e2)) = ["ADDT"]
88 :     | rexp(T.MULT (e1, e2)) = ["MULT"]
89 :     | rexp(T.SUBT (e1, e2, _)) = ["SUBT"]
90 :     | rexp(T.DIVT (e1, e2, _)) = ["DIVT"]
91 :    
92 :     | rexp(T.LOAD8 (e, _)) = ["LOAD8("] @ rexp e @ [")"]
93 :     | rexp(T.LOAD32 (e, _)) = ["LOAD32"]
94 :    
95 :     | rexp(T.ANDB (e1, e2)) = ["AND"]
96 :     | rexp(T.ORB (e1, e2)) = ["OR"]
97 :     | rexp(T.XORB (e1, e2)) = ["XOR"]
98 :    
99 :     | rexp(T.SRA (e1, e2, _)) = ["SRA("] @ rexp e1 @ (","::rexp e2) @ [")"]
100 :     | rexp(T.SRL (e1, e2, _)) = ["SRL"]
101 :     | rexp(T.SLL (e1, e2, _)) = ["SLL"]
102 :    
103 :     | rexp(T.SEQ(s, e)) = ["SEQ("] @ stm s @ ("," :: rexp e) @ [")"]
104 :    
105 :     and stm s =
106 :     (case s
107 :     of T.MV(r, e) => ["MV(", Int.toString r] @ (",":: rexp e) @ [")"]
108 :     | T.FMV _ => ["FMV"]
109 :     | T.COPY _ => ["COPY"]
110 :     | T.FCOPY _ => ["FCOPY"]
111 :     | T.JMP _ => ["JMP"]
112 :     | T.CALL _ => ["CALL"]
113 :     | T.RET => ["RET"]
114 :     | T.STORE8 _ => ["STORE8"]
115 :     | T.STORE32 _ => ["STORE32"]
116 :     | T.STORED _ => ["STORED"]
117 :     | T.STORECC _ => ["STORECC"]
118 :     | T.BCC _ => ["BCC"]
119 :     | T.FBCC _ => ["FBCC"]
120 :     (*esac*))
121 :    
122 :     fun prMLRisc s = print(concat(stm s))
123 :    
124 :    
125 :    
126 :     exception EA
127 :    
128 :     (* return an index computation *)
129 :     fun index(arg as (T.SLL(t, T.LI n, _))) =
130 :     if n > 0 andalso n <= 3 then {index=reduceReg t, scale=n}
131 :     else {index=reduceReg arg, scale=0}
132 :     | index t = {index=reduceReg t, scale=0}
133 :    
134 :     (* return effective address *)
135 :     and ea eatree = let
136 :     (* Need to ensure that the scale register is never %esp *)
137 :     fun doImmed(n, I.Immed(k)) = (I.Immed(k+toInt32 n) handle Overflow => raise EA)
138 :     | doImmed(n, I.ImmedLabel le) = I.ImmedLabel(LE.PLUS(le, LE.CONST n))
139 :     | doImmed(n, I.Const c) =
140 :     I.Displace{base=reduceReg(T.CONST c), disp=I.Immed(toInt32 n)}
141 :    
142 :     fun doConst(c, I.Immed(0)) = I.Const c
143 :     | doConst(c, d) = I.Displace{base=reduceReg(T.CONST c), disp=d}
144 :    
145 :     fun doLabel(le, I.Immed(0)) = I.ImmedLabel le
146 :     | doLabel(le, I.Immed(n)) = I.ImmedLabel(LE.PLUS(le, LE.CONST(Int32.toInt n)))
147 :     | doLabel(le, I.Const c) =
148 :     I.Displace{base=reduceReg(T.CONST c), disp=I.ImmedLabel le}
149 :    
150 :     fun newDisp(n, combine, I.Displace{base, disp}) =
151 :     I.Displace{base=base, disp=combine(n, disp)}
152 :     | newDisp(n, combine, I.Indexed{base, index, scale, disp}) =
153 :     I.Indexed{base=base, index=index, scale=scale, disp=combine(n, disp)}
154 :     | newDisp(n, combine, disp) = combine(n, disp)
155 :    
156 :     fun combineBase(tree, base) =
157 :     SOME(case base
158 :     of NONE => reduceReg tree
159 :     | SOME base => reduceReg(T.ADD(T.REG base, tree))
160 :     (*esac*))
161 :    
162 :     (* keep building a bigger and bigger effective address expressions *)
163 :     fun doEA(T.LI n, mode) = newDisp(n, doImmed, mode)
164 :     | doEA(T.LABEL le, mode) = newDisp(le, doLabel, mode)
165 :     | doEA(T.CONST c, mode) = newDisp(c, doConst, mode)
166 :     | doEA(t0 as T.SLL(t, T.LI scale, _), mode) =
167 :     if scale >= 1 andalso scale <= 3 then
168 :     (case mode
169 :     of I.Displace{base, disp} =>
170 :     I.Indexed
171 :     {base=SOME base, index=reduceReg t, scale=scale, disp=disp}
172 :     | I.Indexed{base, index, scale, disp} =>
173 :     I.Indexed{base=combineBase(t0,base),
174 :     index=index, scale=scale, disp=disp}
175 :     | disp =>
176 :     I.Indexed{base=NONE, index=reduceReg t, scale=scale, disp=disp}
177 :     (*esac*))
178 :     else
179 :     (case mode
180 :     of I.Displace{base, disp} =>
181 :     I.Displace{base=Option.valOf(combineBase(t0, SOME base)), disp=disp}
182 :     | I.Indexed{base, index, scale, disp} =>
183 :     I.Indexed{base=combineBase(t0, base),
184 :     index=index, scale=scale, disp=disp}
185 :     | disp => I.Displace{base=reduceReg(t0), disp=disp}
186 :     (*esac*))
187 :     | doEA(T.ADD(t1, t2 as T.REG _), mode) = doEA(t1, doEA(t2, mode))
188 :     | doEA(T.ADD(t1, t2), mode) = doEA(t2, doEA(t1, mode))
189 :     | doEA(T.SUB(t1, T.LI n, _), mode) = doEA(T.ADD(t1, T.LI (~n)), mode)
190 :     | doEA(t, I.Indexed{base, index, scale, disp}) =
191 :     I.Indexed{base=combineBase(t, base), index=index, scale=scale, disp=disp}
192 :     | doEA(T.REG r, I.Displace{base, disp}) =
193 :     I.Indexed{base=SOME base, index=r, scale=0, disp=disp}
194 :     | doEA(t, I.Displace{base, disp}) =
195 :     I.Indexed{base=SOME base, index=reduceReg t, scale=0, disp=disp}
196 :     | doEA(t, immed) = I.Displace{base=reduceReg t, disp=immed}
197 :     in
198 :     case doEA(eatree, I.Immed 0)
199 :     of I.Immed _ => raise EA
200 :     | I.ImmedLabel le => I.LabelEA le
201 :     | ea => ea
202 :     end (* ea *)
203 :    
204 :     and operand(T.LI i) = I.Immed(toInt32 i)
205 :     | operand(T.LI32 w) = I.Immed(wToInt32 w)
206 :     | operand(T.CONST c) = I.Const c
207 :     | operand(T.LABEL lab) = I.ImmedLabel lab
208 :     | operand(T.REG r) = I.Direct r
209 :     | operand(T.LOAD32(t, _)) = ea t
210 :     | operand(t) = I.Direct(reduceReg(t))
211 :    
212 :     (* operand with preferred target *)
213 :     and operandRd(T.LI i, _) = I.Immed (toInt32 i)
214 :     | operandRd(T.LI32 w, _) = I.Immed(wToInt32 w)
215 :     | operandRd(T.REG r, _) = I.Direct r
216 :     | operandRd(T.LOAD32(t,_), _) = ea t
217 :     | operandRd(t, rd) = I.Direct(reduceRegRd(t, rd))
218 :    
219 :     (* evaluate left-to-right or right-to-left *)
220 :     and ordered(e1, e2, T.LR) = (operand e1, operand e2)
221 :     | ordered(e1, e2, T.RL) = let
222 :     val opnd2 = operand e2
223 :     in (operand e1, opnd2)
224 :     end
225 :    
226 :     and cond T.LT = I.LT | cond T.LTU = I.B
227 :     | cond T.LE = I.LE | cond T.LEU = I.BE
228 :     | cond T.EQ = I.EQ | cond T.NEQ = I.NE
229 :     | cond T.GE = I.GE | cond T.GEU = I.AE
230 :     | cond T.GT = I.GT | cond T.GTU = I.A
231 :    
232 :     (* reduce an MLRISC statement tree *)
233 :     and reduceStm(T.MV(rd, exp)) = let
234 :     fun mv src = emit(I.MOVE{mvOp=I.MOVL, src=src, dst=I.Direct rd})
235 :     in
236 :     case operandRd(exp, rd)
237 :     of opnd as I.Direct rd' => if rd'=rd then () else mv opnd
238 :     | opnd => mv opnd
239 :     end
240 :     | reduceStm(T.FMV(fd, T.FREG fs)) =
241 :     if fs=fd then () else emit(I.COPY{dst=[fd], src=[fs], tmp=NONE})
242 :     | reduceStm(T.FMV(fd, T.LOADD(t, _))) =
243 :     (emit(I.FLD(ea t)); emit(I.FSTP(I.FDirect fd)))
244 :     | reduceStm(T.FMV(fd, e)) = (reduceFexp e; emit(I.FSTP(I.FDirect fd)))
245 :     | reduceStm(T.CCMV(0, exp)) = reduceCC(exp, 0)
246 :     | reduceStm(T.CCMV _) = error "reduceStm: CCMV"
247 :     | reduceStm(T.COPY(dst as [_], src)) =
248 :     emit(I.COPY{dst=dst, src=src, tmp=NONE})
249 :     | reduceStm(T.COPY(dst, src)) =
250 :     emit(I.COPY{dst=dst, src=src, tmp=SOME(I.Direct(newReg()))})
251 :     | reduceStm(T.FCOPY(dst, src)) =
252 :     emit(I.FCOPY{dst=dst, src=src, tmp=SOME(I.FDirect(newFreg()))})
253 :     | reduceStm(T.JMP(T.LABEL lexp, labs)) = emit(I.JMP(I.ImmedLabel lexp, labs))
254 :     | reduceStm(T.JMP(exp, labs)) = emit(I.JMP (operand exp, labs))
255 :     | reduceStm(T.CALL(t,def,use)) = let
256 :     val addCCreg = C.addCell C.CC
257 :     fun addList([], acc) = acc
258 :     | addList(T.GPR(T.REG r)::regs, acc) = addList(regs, C.addReg(r, acc))
259 :     | addList(T.FPR(T.FREG r)::regs, acc) = addList(regs, C.addFreg(r, acc))
260 :     | addList(T.CCR(T.CC cc)::regs, acc) = addList(regs, addCCreg(cc, acc))
261 :     | addList(_::regs, acc) = addList(regs, acc)
262 :     in
263 :     emit(I.CALL(operand t, addList(def,C.empty), addList(use,C.empty)))
264 :     end
265 :     | reduceStm(T.RET) = emit(I.RET)
266 :     | reduceStm(T.STORE8(t1, t2, ord)) = let
267 :     val opnd = immedOrReg(operand t2)
268 :     val src =
269 :     (case opnd
270 :     of I.Direct r => if r = C.eax then opnd else (move(opnd, eax); eax)
271 :     | _ => opnd
272 :     (*esac*))
273 :     in emit(I.MOVE{mvOp=I.MOVB, src=src, dst=ea t1})
274 :     end
275 :     | reduceStm(T.STORE32(t1, t2, _)) = move(immedOrReg(operand t2), ea t1)
276 :     | reduceStm(T.STORED(t1, t2, _)) =
277 :     (case t2
278 :     of T.FREG fs => emit(I.FLD(I.FDirect fs))
279 :     | e => reduceFexp e
280 :     (*esac*);
281 :     emit(I.FSTP(ea t1)))
282 :     | reduceStm(T.STORECC _) = error "stmAction: STORECC"
283 :     | reduceStm(T.BCC(_, T.CMP(cc as (T.EQ | T.NEQ), t1, T.LI 0, _), lab)) = let
284 :     val opnd1 = operand t1
285 :     fun jcc() = emit(I.JCC{cond=cond cc, opnd=immedLabel lab})
286 :     in
287 :     case t1
288 :     of T.ANDB _ => jcc()
289 :     | T.ORB _ => jcc()
290 :     | T.XORB _ => jcc()
291 :     | T.SRA _ => jcc()
292 :     | T.SRL _ => jcc()
293 :     | T.SLL _ => jcc()
294 :     | _ => (emit(I.CMP{lsrc=opnd1, rsrc=I.Immed 0}); jcc())
295 :     end
296 :     | reduceStm(T.BCC(_, T.CMP(cc, t1, t2, ord), lab)) = let
297 :     fun swapcc T.LT = T.GT | swapcc T.LTU = T.GTU
298 :     | swapcc T.LE = T.GE | swapcc T.LEU = T.GEU
299 :     | swapcc T.EQ = T.EQ | swapcc T.NEQ = T.NEQ
300 :     | swapcc T.GE = T.LE | swapcc T.GEU = T.LEU
301 :     | swapcc T.GT = T.LT | swapcc T.GTU = T.LTU
302 :    
303 :     fun cmpAndBranch(cc, opnd1, opnd2) =
304 :     (emit(I.CMP{lsrc=opnd1, rsrc=opnd2});
305 :     emit(I.JCC{cond=cond cc, opnd=immedLabel lab}))
306 :    
307 :    
308 :     val (opnd1, opnd2) = ordered(t1, t2, ord)
309 :     in
310 :     if isImmediate opnd1 andalso isImmediate opnd2 then
311 :     cmpAndBranch(cc, moveToReg opnd1, opnd2)
312 :     else if isImmediate opnd1 then
313 :     cmpAndBranch(swapcc cc, opnd2, opnd1)
314 :     else if isImmediate opnd2 then
315 :     cmpAndBranch(cc, opnd1, opnd2)
316 :     else case (opnd1, opnd2)
317 :     of (_, I.Direct _) => cmpAndBranch(cc, opnd1, opnd2)
318 :     | (I.Direct _, _) => cmpAndBranch(cc, opnd1, opnd2)
319 :     | _ => cmpAndBranch(cc, moveToReg opnd1, opnd2)
320 :     (*esac*)
321 :     end
322 :     | reduceStm(T.BCC(cc, T.CC(0), lab)) =
323 :     emit(I.JCC{cond=cond cc, opnd=immedLabel lab})
324 :     | reduceStm(T.BCC _) = error "reduceStm: BCC"
325 :     | reduceStm(T.FBCC(_, T.FCMP(fcc, t1, t2, ord), lab)) = let
326 :     fun compare() = let
327 :     fun ignoreOrder (T.FREG _) = true
328 :     | ignoreOrder (T.LOADD _) = true
329 :     | ignoreOrder _ = false
330 :     fun t2t1 () = (reduceFexp t2; reduceFexp t1)
331 :     in
332 :     if ignoreOrder t1 orelse ignoreOrder t2 then t2t1()
333 :     else
334 :     (case ord
335 :     of T.RL => t2t1()
336 :     | T.LR => (reduceFexp t1; reduceFexp t2; emit(I.FXCH))
337 :     (*esac*));
338 :     emit(I.FUCOMPP)
339 :     end
340 :     fun branch() = let
341 :     val eax = I.Direct C.eax
342 :     fun andil i = emit(I.BINARY{binOp=I.AND, src=I.Immed(i), dst=eax})
343 :     fun xoril i = emit(I.BINARY{binOp=I.XOR, src=I.Immed(i), dst=eax})
344 :     fun cmpil i = emit(I.CMP{rsrc=I.Immed(i), lsrc=eax})
345 :     fun j(cc, lab) = emit(I.JCC{cond=cc, opnd=immedLabel lab})
346 :     fun sahf() = emit(I.SAHF)
347 :     in
348 :     case fcc
349 :     of T.== => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))
350 :     | T.?<> => (andil 0x4400; xoril 0x4000; j(I.NE, lab))
351 :     | T.? => (sahf(); j(I.P,lab))
352 :     | T.<=> => (sahf(); j(I.NP,lab))
353 :     | T.> => (andil 0x4500; j(I.EQ,lab))
354 :     | T.?<= => (andil 0x4500; j(I.NE,lab))
355 :     | T.>= => (andil 0x500; j(I.EQ,lab))
356 :     | T.?< => (andil 0x500; j(I.NE,lab))
357 :     | T.< => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))
358 :     | T.?>= => (andil 0x4500; cmpil 0x100; j(I.NE,lab))
359 :     | T.<= => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);
360 :     cmpil 0x4000; j(I.EQ,lab))
361 :     | T.?> => (sahf(); j(I.P,lab); andil 0x4100; j(I.EQ,lab))
362 :     | T.<> => (andil 0x4400; j(I.EQ,lab))
363 :     | T.?= => (andil 0x4400; j(I.NE,lab))
364 :     (*esac*)
365 :     end
366 :     in compare(); emit I.FNSTSW; branch()
367 :     end
368 :     | reduceStm(T.FBCC _) = error "reduceStm: FBCC"
369 :    
370 :     and reduceCC(T.CMP(_, t1, t2, ord), 0) = let
371 :     val (opnd1, opnd2) = ordered(t1, t2, ord)
372 :     in
373 :     emit(I.CMP(
374 :     case (opnd1, opnd2)
375 :     of (I.Immed _, _) => {lsrc=moveToReg opnd1, rsrc=opnd2}
376 :     | (I.ImmedLabel _, _) => {lsrc=moveToReg opnd1, rsrc=opnd2}
377 :     | (I.Const _, _) => {lsrc=moveToReg opnd1, rsrc=opnd2}
378 :     | (I.Direct _, _) => {lsrc=opnd1, rsrc=opnd2}
379 :     | (_, I.Direct _) => {lsrc=opnd1, rsrc=opnd2}
380 :     | _ => {lsrc=moveToReg opnd1, rsrc=opnd2}))
381 :     end
382 :     | reduceCC _ = error "reduceCC"
383 :    
384 :    
385 :     and reduceReg(T.REG rd) = rd
386 :     | reduceReg(exp) = reduceRegRd(exp, newReg())
387 :    
388 :     (* reduce to the register rd where possible.*)
389 :     and reduceRegRd(exp, rd) = let
390 :     val opndRd = I.Direct(rd)
391 :    
392 :     fun binary(comm, oper, e1, e2, order) = let
393 :     fun emit2addr (opnd1, opnd2) =
394 :     (move(opnd1, opndRd);
395 :     emit(I.BINARY{binOp=oper, dst=opndRd, src=opnd2});
396 :     rd)
397 :     fun commute(opnd1 as I.Immed _, opnd2) = (opnd2, opnd1)
398 :     | commute(opnd1 as I.ImmedLabel _, opnd2) = (opnd2, opnd1)
399 :     | commute(opnd1 as I.Const _, opnd2) = (opnd2, opnd1)
400 :     | commute(opnd1, opnd2 as I.Direct _) = (opnd2, opnd1)
401 :     | commute arg = arg
402 :    
403 :     val opnds = ordered(e1, e2, order)
404 :     in emit2addr(if comm then commute opnds else opnds)
405 :     end (*binary*)
406 :    
407 :     fun unary(oper, exp) =
408 :     (move(operand exp, opndRd);
409 :     emit(I.UNARY{unOp=oper, opnd=opndRd});
410 :     rd)
411 :    
412 :     (* The shift count can be either an immediate or the ECX register *)
413 :     fun shift(oper, e1, e2, order) = let
414 :     val (opnd1, opnd2) = ordered(e1, e2, order)
415 :     in
416 :     move(opnd1, opndRd);
417 :     case opnd2
418 :     of I.Immed _ => emit(I.BINARY{binOp=oper, src=opnd2, dst=opndRd})
419 :     | _ => (move(opnd2, ecx);
420 :     emit(I.BINARY{binOp=oper, src=ecx, dst=opndRd}))
421 :     (*esac*);
422 :     rd
423 :     end (* shift *)
424 :    
425 :     (* Divisor must be in EDX:EAX *)
426 :     fun divide(oper, signed, e1, e2, order) = let
427 :     val (opnd1, opnd2) = ordered(e1, e2, order)
428 :     in
429 :     move(opnd1, eax);
430 :     if signed then emit(I.CDQ) else move(I.Immed(0), edx);
431 :     emit(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2});
432 :     move(eax, opndRd);
433 :     rd
434 :     end
435 :    
436 :     (* unsigned integer multiplication *)
437 :     fun uMultiply(e1, e2) =
438 :     (* note e2 can never be (I.Direct edx) *)
439 :     (move(operand e1, eax);
440 :     emit(I.MULTDIV{multDivOp=I.UMUL, src=regOrMem(operand e2)});
441 :     move(eax, opndRd);
442 :     rd)
443 :    
444 :     (* signed integer multiplication *)
445 :    
446 :     (* The only forms that are allowed that also sets the
447 :     * OF and CF flags are:
448 :     *
449 :     * imul r32, r32/m32, imm8
450 :     * imul r32, imm8
451 :     * imul r32, imm32
452 :     *)
453 :     fun multiply(e1, e2) = let
454 :     fun doit(i1 as I.Immed _, i2 as I.Immed _) =
455 :     (move(i1, opndRd);
456 :     emit(I.MUL3{dst=rd, src1=i2, src2=NONE}))
457 :     | doit(rm, i2 as I.Immed _) = doit(i2, rm)
458 :     | doit(imm as I.Immed(i), rm) =
459 :     emit(I.MUL3{dst=rd, src1=rm, src2=SOME i})
460 :     | doit(r1 as I.Direct _, r2 as I.Direct _) =
461 :     (move(r1, opndRd);
462 :     emit(I.MUL3{dst=rd, src1=r2, src2=NONE}))
463 :     | doit(r1 as I.Direct _, rm) =
464 :     (move(r1, opndRd);
465 :     emit(I.MUL3{dst=rd, src1=rm, src2=NONE}))
466 :     | doit(rm, r as I.Direct _) = doit(r, rm)
467 :     | doit(rm1, rm2) =
468 :     (move(rm1, opndRd);
469 :     emit(I.MUL3{dst=rd, src1=rm2, src2=NONE}))
470 :     in doit(ordered(e1, e2, T.LR))
471 :     end
472 :    
473 :     fun trap() =
474 :     (case !trapLabel
475 :     of NONE => (trapLabel := SOME(Label.newLabel "trap"); trap())
476 :     | SOME lab => emit(I.JCC{cond=I.O, opnd=I.ImmedLabel(LE.LABEL lab)})
477 :     (*esac*))
478 :     in
479 :     case exp
480 :     of T.REG rs => (move(I.Direct rs, opndRd); rd)
481 :     | T.LI n => (move(I.Immed(toInt32 n), opndRd); rd)
482 :     | T.LI32 w => (move(I.Immed(wToInt32 w), opndRd); rd)
483 :     | T.CONST c => (move(I.Const c, opndRd); rd)
484 :     | T.LABEL lab => (move(I.ImmedLabel lab, opndRd); rd)
485 :     | T.ADD(e, T.LI 1) => unary(I.INC, e)
486 :     | T.ADD(e, T.LI32 0w1) => unary(I.INC, e)
487 :     | T.ADD(e, T.LI ~1) => unary(I.DEC, e)
488 :     | T.ADD(e1, e2) =>
489 :     ((emit(I.LEA{r32=rd, addr=ea(exp)}); rd)
490 :     handle EA => binary(true, I.ADD, e1, e2, T.LR))
491 :     | T.SUB(e, T.LI 1, _) => unary(I.DEC, e)
492 :     | T.SUB(e, T.LI32 0w1, _) => unary(I.DEC, e)
493 :     | T.SUB(e, T.LI ~1, _) => unary(I.INC, e)
494 :     | T.SUB(e1, e2, ord) => binary(false, I.SUB, e1, e2, ord)
495 :     | T.MULU(e1, e2) => uMultiply(e1, e2)
496 :     | T.DIVU(e1, e2, ord) => (divide(I.UDIV, false, e1, e2, ord))
497 :     | T.ADDT(e1, e2) => (binary(true,I.ADD,e1,e2,T.LR); trap(); rd)
498 :     | T.MULT(e1, e2) => (multiply(e1, e2); trap(); rd)
499 :     | T.SUBT(e1, e2, ord) =>
500 :     (binary(false,I.SUB,e1,e2,ord); trap(); rd)
501 :     | T.DIVT(e1, e2, ord) =>
502 :     (divide(I.IDIV, true, e1, e2, ord); trap(); rd)
503 :     | T.LOAD32(exp, _) => (move(ea exp, opndRd); rd)
504 :     | T.LOAD8(exp, _) =>
505 :     (emit(I.MOVE{mvOp=I.MOVZX, src=ea exp, dst=opndRd}); rd)
506 :     | T.ANDB(e1, e2) => binary(true, I.AND, e1, e2, T.LR)
507 :     | T.ORB(e1, e2) => binary(true, I.OR, e1, e2, T.LR)
508 :     | T.XORB(e1, e2) => binary(true, I.XOR, e1, e2, T.LR)
509 :     | T.SRA(e1, e2, ord) => shift(I.SAR, e1, e2, ord)
510 :     | T.SRL(e1, e2, ord) => shift(I.SHR, e1, e2, ord)
511 :     | T.SLL(e1, e2, ord) => shift(I.SHL, e1, e2, ord)
512 :     | T.SEQ(stm, rexp) => (reduceStm stm; reduceRegRd(rexp, rd))
513 :     end (* reduceRegRd *)
514 :    
515 :     and reduceFexp(fexp) = let
516 :     val ST = I.FDirect 0
517 :     val ST1 = I.FDirect 1
518 :    
519 :     datatype su_numbers =
520 :     LEAF of int
521 :     | BINARY of int * su_numbers * su_numbers
522 :     | UNARY of int * su_numbers
523 :    
524 :     fun label(LEAF n) = n
525 :     | label(BINARY(n, _, _)) = n
526 :     | label(UNARY(n, _)) = n
527 :    
528 :     datatype direction = LEFT | RIGHT
529 :    
530 :     (* Generate tree of sethi-ullman numbers *)
531 :     fun suBinary(t1, t2) = let
532 :     val su1 = suNumbering(t1, LEFT)
533 :     val su2 = suNumbering(t2, RIGHT)
534 :     val n1 = label su1
535 :     val n2 = label su2
536 :     in BINARY(if n1=n2 then n1+1 else Int.max(n1, n2), su1, su2)
537 :     end
538 :    
539 :     and suUnary(t) = let
540 :     val su = suNumbering(t, LEFT)
541 :     in UNARY(label su, su)
542 :     end
543 :    
544 :     and suNumbering(T.FREG _, LEFT) = LEAF 1
545 :     | suNumbering(T.FREG _, RIGHT) = LEAF 0
546 :     | suNumbering(T.LOADD _, LEFT) = LEAF 1
547 :     | suNumbering(T.LOADD _, RIGHT) = LEAF 0
548 :     | suNumbering(T.FADDD(t1, t2), _) = suBinary(t1, t2)
549 :     | suNumbering(T.FMULD(t1, t2), _) = suBinary(t1, t2)
550 :     | suNumbering(T.FSUBD(t1, t2, _), _) = suBinary(t1, t2)
551 :     | suNumbering(T.FDIVD(t1, t2, _), _) = suBinary(t1, t2)
552 :     | suNumbering(T.FABSD t, _) = suUnary(t)
553 :     | suNumbering(T.FNEGD t, _) = suUnary(t)
554 :     | suNumbering(T.CVTI2D t, _) = UNARY(1, LEAF 0)
555 :    
556 :     fun leafEA(T.FREG f) = I.FDirect f
557 :     | leafEA(T.LOADD(t, _)) = ea t
558 :     | leafEA _ = error "leafEA"
559 :    
560 :     fun cvti2d(t) = let
561 :     val opnd = operand t
562 :     fun doMemOpnd () =
563 :     (emit(I.MOVE{mvOp=I.MOVL, src=opnd, dst=tempMem});
564 :     emit(I.FILD tempMem))
565 :     in
566 :     case opnd
567 :     of I.Direct _ => doMemOpnd()
568 :     | I.Immed _ => doMemOpnd()
569 :     | _ => emit(I.FILD opnd)
570 :     end
571 :    
572 :     (* traverse expression and su-number tree *)
573 :     fun gencode(_, LEAF 0) = ()
574 :     | gencode(f, LEAF 1) = emit(I.FLD(leafEA f))
575 :     | gencode(t, BINARY(_, su1, LEAF 0)) = let
576 :     fun doit(oper, t1, t2) =
577 :     (gencode(t1, su1);
578 :     emit(I.FBINARY{binOp=oper, src=leafEA t2, dst=ST}))
579 :     in
580 :     case t
581 :     of T.FADDD(t1, t2) => doit(I.FADD, t1, t2)
582 :     | T.FMULD(t1, t2) => doit(I.FMUL, t1, t2)
583 :     | T.FSUBD(t1, t2, _) => doit(I.FSUB, t1, t2)
584 :     | T.FDIVD(t1, t2, _) => doit(I.FDIV, t1, t2)
585 :     end
586 :     | gencode(fexp, BINARY(_, su1, su2)) = let
587 :     fun doit(t1, t2, oper, operP, operRP) = let
588 :     (* oper[P] => ST(1) := ST oper ST(1); [pop]
589 :     * operR[P] => ST(1) := ST(1) oper ST; [pop]
590 :     *)
591 :     val n1 = label su1
592 :     val n2 = label su2
593 :     in
594 :     if n1 < n2 andalso n1 <= 7 then
595 :     (gencode(t2, su2);
596 :     gencode(t1, su1);
597 :     emit(I.FBINARY{binOp=operP, src=ST, dst=ST1}))
598 :     else if n2 <= n1 andalso n2 <= 7 then
599 :     (gencode(t1, su1);
600 :     gencode(t2, su2);
601 :     emit(I.FBINARY{binOp=operRP, src=ST, dst=ST1}))
602 :     else let (* both labels > 7 *)
603 :     val fs = I.FDirect(newFreg())
604 :     in
605 :     gencode (t2, su2);
606 :     emit(I.FSTP fs);
607 :     gencode (t1, su1);
608 :     emit(I.FBINARY{binOp=oper, src=fs, dst=ST})
609 :     end
610 :     end
611 :     in
612 :     case fexp
613 :     of T.FADDD(t1, t2) => doit(t1, t2, I.FADD, I.FADDP, I.FADDP)
614 :     | T.FMULD(t1, t2) => doit(t1, t2, I.FMUL, I.FMULP, I.FMULP)
615 :     | T.FSUBD(t1, t2, _) => doit(t1, t2, I.FSUB, I.FSUBP, I.FSUBRP)
616 :     | T.FDIVD(t1, t2, _) => doit(t1, t2, I.FDIV, I.FDIVP, I.FDIVRP)
617 :     end
618 :     | gencode(fexp, UNARY(_, LEAF 0)) =
619 :     (case fexp
620 :     of T.FABSD t => (emit(I.FLD(leafEA t)); emit(I.FUNARY(I.FABS)))
621 :     | T.FNEGD t => (emit(I.FLD(leafEA t)); emit(I.FUNARY(I.FCHS)))
622 :     | T.CVTI2D t => cvti2d(t)
623 :     (*esac*))
624 :     | gencode(fexp, UNARY(_, su)) = let
625 :     fun doit(oper, t) = (gencode(t, su); emit(I.FUNARY(oper)))
626 :     in
627 :     case fexp
628 :     of T.FABSD t => doit(I.FABS, t)
629 :     | T.FNEGD t => doit(I.FCHS, t)
630 :     | T.CVTI2D _ => error "gencode:UNARY:cvti2d"
631 :     end
632 :    
633 :     val labels = suNumbering(fexp, LEFT)
634 :     in gencode(fexp, labels)
635 :     end (*reduceFexp*)
636 :    
637 :     fun mltreeComp mltree = let
638 :     fun mltc(T.PSEUDO_OP pOp) = F.pseudoOp pOp
639 :     | mltc(T.DEFINELABEL lab) = F.defineLabel lab
640 :     | mltc(T.ENTRYLABEL lab) = F.entryLabel lab
641 :     | mltc(T.ORDERED mlts) = F.ordered mlts
642 :     | mltc(T.BEGINCLUSTER) = (F.beginCluster(); trapLabel := NONE)
643 :     | mltc(T.CODE stms) = app reduceStm stms
644 :     | mltc(T.BLOCK_NAME name) = F.blockName name
645 :     | mltc(T.ENDCLUSTER regmap) =
646 :     (case !trapLabel
647 :     of NONE => ()
648 :     | SOME lab => (F.defineLabel lab; emit(I.INTO))
649 :     (*esac*);
650 :     F.endCluster regmap)
651 :     | mltc(T.ESCAPEBLOCK regs) = F.exitBlock regs
652 :     in mltc mltree
653 :     end
654 :    
655 :     val mlriscComp = reduceStm
656 :     end

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