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

Parent Directory | Revision Log

---

Revision 248 - (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