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

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