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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 475 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/x86/mltree/x86.sml

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

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