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 /MLRISC/trunk/amd64/mltree/amd64-gen.sml
ViewVC logotype

Annotation of /MLRISC/trunk/amd64/mltree/amd64-gen.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4862 - (view) (download)

1 : mrainey 2619 (* amd64-gen.sml
2 : jhr 4290 *
3 :     * COPYRIGHT (c) 2016 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 :     *
6 : mrainey 2619 * Translate MLRISC trees into AMD64 instructions.
7 :     *)
8 :    
9 :     functor AMD64Gen (
10 : jhr 4290
11 : mrainey 2619 structure I : AMD64INSTR
12 :     structure MLTreeUtils : MLTREE_UTILS
13 :     where T = I.T
14 :     structure ExtensionComp : MLTREE_EXTENSION_COMP
15 : mrainey 2808 where I = I and T = I.T
16 : mrainey 2619
17 : jhr 4290 (* Take a number of bits and returns an rexp that points to a literal with the high bit set.
18 : mrainey 2829 * We need this literal value for floating-point negation and absolute value (at least
19 :     * until SSE4).
20 :     *)
21 : jhr 4290 val signBit : int -> MLTreeUtils.T.rexp
22 : mrainey 2829 (* Same as signBit, except the high bit is zero and the low bits are 1s. *)
23 : jhr 4290 val negateSignBit : int -> MLTreeUtils.T.rexp
24 :    
25 : mrainey 2929 (* guaranteeing that floats are stored at 16-byte aligned addresses reduces the number of instructions *)
26 :     val floats16ByteAligned : bool
27 : jhr 4290
28 : mrainey 2808 ) : MLTREECOMP = struct
29 :    
30 : mrainey 2619 structure TS = ExtensionComp.TS
31 :     structure T = I.T
32 :     structure I = I
33 :     structure CFG = ExtensionComp.CFG
34 :     structure C = I.C
35 :     structure CB = CellsBasis
36 :     structure A = MLRiscAnnotations
37 :     structure TRS = MLTreeSize (structure T = T
38 :     val intTy = 64)
39 :     structure Shuffle = Shuffle (I)
40 :     structure O = AMD64Opcodes (structure I = I)
41 :     structure Gen = MLTreeGen (
42 :     structure T = T
43 :     structure Cells = C
44 :     val intTy = 64
45 :     val naturalWidths = [32, 64]
46 :     datatype rep = SE | ZE | NEITHER
47 :     val rep = NEITHER)
48 :     structure W32 = Word32
49 :    
50 :     fun error msg = MLRiscErrorMsg.error ("AMD64Gen", msg)
51 :    
52 :     type instrStream = (I.instruction,C.cellset,CFG.cfg) TS.stream
53 :     type mltreeStream = (T.stm,T.mlrisc list,CFG.cfg) TS.stream
54 :    
55 :     (* label where a trap is generated -- one per cluster *)
56 :     val trapLabel = ref (NONE: (I.instruction * Label.label) option)
57 :    
58 :     fun gpr (ty, r) = I.Direct (ty, r)
59 :     val fpr = I.FDirect
60 : jhr 4290
61 : mrainey 2619 fun rax ty = I.Direct(ty,C.rax)
62 :     fun rcx ty = I.Direct(ty,C.rcx)
63 :     fun rdx ty = I.Direct(ty,C.rdx)
64 :    
65 : mrainey 4239 fun signExtend ty = if ty = 64 then I.CQTO else I.CLTD
66 :    
67 : mrainey 2619 val readonly = I.Region.readonly
68 :    
69 :     val newReg = C.newReg
70 :     val newFreg = C.newFreg
71 :    
72 :     (* convert mlrisc to cellset: *)
73 : jhr 4290 fun cellset mlrisc = let
74 :     val addCCReg = CB.CellSet.add
75 : mrainey 2619 fun g([],acc) = acc
76 :     | g(T.GPR(T.REG(_,r))::regs,acc) = g(regs,C.addReg(r,acc))
77 :     | g(T.FPR(T.FREG(_,f))::regs,acc) = g(regs,C.addFreg(f,acc))
78 :     | g(T.CCR(T.CC(_,cc))::regs,acc) = g(regs,addCCReg(cc,acc))
79 :     | g(T.CCR(T.FCC(_,cc))::regs,acc) = g(regs,addCCReg(cc,acc))
80 :     | g(_::regs, acc) = g(regs, acc)
81 : jhr 4290 in
82 :     g(mlrisc, C.empty)
83 : mrainey 2619 end
84 : jhr 4290
85 : jhr 4862 (* conversions to fixed-precision integers*)
86 : mrainey 2619 fun toInt32 i = T.I.toInt32(32, i)
87 : mrainey 2947 fun toInt64 i = T.I.toInt64(64, i)
88 : mrainey 2789
89 : jhr 4862 (* QUESTION: what about negative numbers? *)
90 :     fun fitsIn32Bits (z : IntInf.int) = (z < 0x80000000)
91 : mrainey 2928
92 : mrainey 2789 fun move64 (src, dst) = I.move {mvOp=I.MOVABSQ, src=src, dst=dst}
93 : jhr 4290
94 : mrainey 2619 (* analyze for power-of-two-ness *)
95 : jhr 4862 fun analyze i' = let
96 :     val i = toInt32 i'
97 :     in
98 :     let val (isneg, a, w) =
99 :     if i >= 0 then (false, i, T.I.toWord32 (32, i'))
100 :     else (true, ~i, T.I.toWord32 (32, T.I.NEG (32, i')))
101 :     fun log2 (0w1, p) = p
102 :     | log2 (w, p) = log2 (W32.>> (w, 0w1), p + 1)
103 :     in
104 :     if w > 0w1 andalso W32.andb (w - 0w1, w) = 0w0 then
105 :     (i, SOME (isneg, a,
106 :     T.LI (T.I.fromInt32 (32, log2 (w, 0)))))
107 :     else (i, NONE)
108 :     end handle _ => (i, NONE)
109 :     end
110 : mrainey 2619
111 :     (* translate MLTREE condition codes to amd64 condition codes *)
112 :     fun cond T.LT = I.LT | cond T.LTU = I.B
113 :     | cond T.LE = I.LE | cond T.LEU = I.BE
114 :     | cond T.EQ = I.EQ | cond T.NE = I.NE
115 :     | cond T.GE = I.GE | cond T.GEU = I.AE
116 :     | cond T.GT = I.GT | cond T.GTU = I.A
117 :     | cond cc = error(concat["cond(", T.Basis.condToString cc, ")"])
118 :    
119 :     (* Is the expression zero? *)
120 :     fun isZero(T.LI z) = z = 0
121 :     | isZero(T.MARK(e,a)) = isZero e
122 :     | isZero _ = false
123 :     fun setZeroBit(T.ANDB _) = true
124 :     | setZeroBit(T.ORB _) = true
125 :     | setZeroBit(T.XORB _) = true
126 :     | setZeroBit(T.SRA _) = true
127 :     | setZeroBit(T.SRL _) = true
128 :     | setZeroBit(T.SLL _) = true
129 :     | setZeroBit(T.SUB _) = true
130 :     | setZeroBit(T.ADDT _) = true
131 :     | setZeroBit(T.SUBT _) = true
132 :     | setZeroBit(T.MARK(e, _)) = setZeroBit e
133 :     | setZeroBit _ = false
134 : jhr 4290
135 : mrainey 2619 fun setZeroBit2(T.ANDB _) = true
136 :     | setZeroBit2(T.ORB _) = true
137 :     | setZeroBit2(T.XORB _) = true
138 :     | setZeroBit2(T.SRA _) = true
139 :     | setZeroBit2(T.SRL _) = true
140 :     | setZeroBit2(T.SLL _) = true
141 :     | setZeroBit2(T.ADD(_, _, _)) = true (* can't use leal! *)
142 :     | setZeroBit2(T.SUB _) = true
143 :     | setZeroBit2(T.ADDT _) = true
144 :     | setZeroBit2(T.SUBT _) = true
145 :     | setZeroBit2(T.MARK(e, _)) = setZeroBit2 e
146 :     | setZeroBit2 _ = false
147 :    
148 : jhr 4290 and isMemOpnd opnd = (case opnd
149 : mrainey 2619 of I.Displace _ => true
150 : jhr 4290 | I.Indexed _ => true
151 :     | I.LabelEA _ => true
152 : mrainey 2619 | I.FDirect f => true
153 :     | _ => false
154 :     (* end case *))
155 :    
156 : jhr 2772 fun selectInstructions (instrStream as TS.S.STREAM{
157 : mrainey 2619 emit=emitInstr, defineLabel, entryLabel, pseudoOp, annotation,
158 : jhr 4290 getAnnotations, beginCluster, endCluster, exitBlock,
159 : jhr 2772 comment, ...
160 :     }) = let
161 : mrainey 2619 val emit = emitInstr o I.INSTR
162 :     val emits = app emitInstr
163 : jhr 4290 (* mark an expression with a list of annotations *)
164 : mrainey 2619 fun mark' (i, []) = emitInstr i
165 : jhr 4290 | mark' (i, a::an) = mark'(I.ANNOTATION{i=i,a=a},an)
166 : mrainey 2619 (* annotate an expression and emit it *)
167 :     fun mark (i, an) = mark' (I.INSTR i, an)
168 :    
169 :     (* move with annotation *)
170 :     fun move' (ty, dst as I.Direct (_, s), src as I.Direct (_, d), an) =
171 :     if CB.sameColor (s, d)
172 :     then ()
173 :     else mark' (I.COPY {k=CB.GP, sz=ty, src=[s], dst=[d], tmp=NONE}, an)
174 : mrainey 2769 | move' (ty, I.Immed 0, dst as I.Direct _, an) =
175 : mrainey 2619 mark' (I.binary {binOp=O.xorOp ty, src=dst, dst=dst}, an)
176 : mrainey 2791 | move' (ty, src as I.ImmedLabel _ , dst as I.Direct _, an) = emitInstr (move64 (src, dst))
177 : mrainey 2776 | move' (ty, src as I.ImmedLabel _ , dst, an) = let
178 :     val tmp = newReg ()
179 :     val tmpR = I.Direct (64, tmp)
180 : jhr 4290 in
181 : mrainey 2789 emitInstr (move64 (src, tmpR));
182 : mrainey 2776 mark' (I.move {mvOp=I.MOVQ, src=tmpR, dst=dst}, an)
183 : jhr 4290 end
184 : mrainey 2619 | move' (ty, src, dst, an) =
185 :     mark' (I.move {mvOp=O.movOp ty, src=src, dst=dst}, an)
186 :     (* move with annotation *)
187 :     fun move (ty, src, dst) = move' (ty, src, dst, [])
188 :    
189 :     fun zero (ty, dst) = emit (I.BINARY{binOp=O.xorOp ty, src=dst, dst=dst})
190 :    
191 :     fun copy (ty, [], [], an) = ()
192 :     | copy (ty, dst, src, an) = let
193 :     fun mvInstr {dst=I.Direct (_,rd), src=I.Direct (_,rs)} =
194 :     if CB.sameColor (rd, rs)
195 :     then []
196 :     else [I.COPY {k=CB.GP, sz=ty, dst=[rd], src=[rs], tmp=NONE}]
197 :     | mvInstr {dst, src} = [I.move {mvOp=O.movOp ty, src=src, dst=dst}]
198 :     val stms = Shuffle.shuffle {mvInstr=mvInstr, ea=fn r => gpr (ty, r)}
199 :     {tmp=SOME (I.Direct (ty, newReg ())), dst=dst, src=src}
200 :     in
201 :     emits stms
202 :     end (* copy *)
203 : jhr 4290
204 : mrainey 2619 (* Add an overflow trap *)
205 : jhr 4290 fun trap() = let
206 :     val jmp = (case !trapLabel
207 :     of NONE => let
208 : mrainey 2619 val label = Label.label "trap" ()
209 :     val jmp = I.ANNOTATION{i=I.jcc{cond=I.O,
210 :     opnd=I.ImmedLabel(T.LABEL label)},
211 :     a=MLRiscAnnotations.BRANCHPROB (Probability.unlikely)}
212 : jhr 4290 in
213 :     trapLabel := SOME(jmp, label);
214 :     jmp
215 : mrainey 2619 end
216 :     | SOME(jmp, _) => jmp
217 :     (* end case *))
218 : jhr 4290 in
219 :     emitInstr jmp
220 : mrainey 2619 end (* trap *)
221 :    
222 :     exception EA
223 :    
224 : jhr 4290 fun address' ty (ea, mem) = let
225 : mrainey 2619 fun makeAddressingMode (NONE, NONE, _, disp) = disp
226 : jhr 4290 | makeAddressingMode(SOME base, NONE, _, disp) =
227 : mrainey 2619 I.Displace{base=base, disp=disp, mem=mem}
228 : jhr 4290 | makeAddressingMode(base, SOME index, scale, disp) =
229 : mrainey 2619 I.Indexed{base=base, index=index, scale=scale,
230 :     disp=disp, mem=mem}
231 :    
232 : jhr 4290 (* Keep building a bigger and bigger effective address expressions
233 : mrainey 2619 * The input is a list of trees
234 :     * b -- base
235 :     * i -- index
236 :     * s -- scale
237 :     * d -- immed displacement
238 : jhr 4290 *)
239 : mrainey 2619 fun doEA([], b, i, s, d) = makeAddressingMode(b, i, s, d)
240 : jhr 4290 | doEA(t::trees, b, i, s, d) = (case t
241 : mrainey 2619 of T.LI n => doEAImmed(trees, toInt32 n, b, i, s, d)
242 :     | T.CONST _ => doEALabel(trees, t, b, i, s, d)
243 :     | T.LABEL _ => doEALabel(trees, t, b, i, s, d)
244 :     | T.LABEXP le => doEALabel(trees, le, b, i, s, d)
245 : jhr 4290 | T.ADD(ty, t1, t2 as T.REG(_,r)) =>
246 : mrainey 2619 doEA(t1::t2::trees, b, i, s, d)
247 :     | T.ADD(ty, t1, t2) => doEA(t1::t2::trees, b, i, s, d)
248 : jhr 4290 | T.SUB(ty, t1, T.LI n) =>
249 : mrainey 2619 doEA(t1::T.LI(T.I.NEG(ty,n))::trees, b, i, s, d)
250 :     | T.SLL(ty, t1, T.LI n) => let
251 :     val n = T.I.toInt(ty, n)
252 : jhr 4290 in
253 : mrainey 2619 case n
254 :     of 0 => displace(trees, t1, b, i, s, d)
255 :     | 1 => indexed(trees, t1, t, 1, b, i, s, d)
256 :     | 2 => indexed(trees, t1, t, 2, b, i, s, d)
257 :     | 3 => indexed(trees, t1, t, 3, b, i, s, d)
258 :     | _ => displace(trees, t, b, i, s, d)
259 :     end
260 :     | t => displace(trees, t, b, i, s, d)
261 :     (* esac *))
262 :    
263 :     (* Add an immed constant *)
264 :     and doEAImmed(trees, 0, b, i, s, d) = doEA(trees, b, i, s, d)
265 : jhr 4290 | doEAImmed(trees, n, b, i, s, I.Immed m) =
266 : mrainey 2619 doEA(trees, b, i, s, I.Immed(n+m))
267 : jhr 4290 | doEAImmed(trees, n, b, i, s, I.ImmedLabel le) =
268 :     doEA(trees, b, i, s,
269 : mrainey 2791 I.ImmedLabel(T.ADD(ty,le,T.LI(T.I.fromInt32(ty, n)))))
270 : mrainey 2619 | doEAImmed(trees, n, b, i, s, _) = error "doEAImmed"
271 : mrainey 2789
272 :     (* Add a label expression.
273 : mrainey 2791 * NOTE: Labels in the AMD64 can be 64 bits, but operands can only handle 32-bit constants.
274 : mrainey 2789 * We have to spill label expressions to temporaries to be correct.
275 :     * TODO: eliminate the extra register-register move from genExpr
276 :     *)
277 : jhr 3801 (* Added below pattern to stop infinite loop where (genExpr le)
278 :     below called addition and addition called address again. *)
279 :     and doEALabel (trees, le, SOME base, i, s, I.Immed 0) = let
280 :     val r = newReg ()
281 :     val _ = expr (le, r, [])
282 :     val _ = mark (I.BINARY{binOp=(O.addOp ty), src=operand ty (T.REG(ty,base)), dst=operand ty (T.REG(ty,r))}, [])
283 :     in
284 :     doEA(trees, SOME r, i, s, I.Immed 0)
285 :     end
286 :     | doEALabel (trees, le, b, i, s, d) = let
287 : mrainey 2789 val le = (case b
288 :     of NONE => le
289 : mrainey 2791 | SOME base => T.ADD (ty, T.REG (ty, base), le)
290 : mrainey 2789 (* end case *))
291 :     in
292 :     (case d
293 : mrainey 2791 of I.Immed 0 => doEA(trees, SOME (genExpr le), i, s, I.Immed 0)
294 : jhr 4290 | I.Immed m => (doEA (trees,
295 :     SOME (genExpr (T.ADD (ty, le, T.LI(T.I.fromInt32(ty, m))))),
296 : mrainey 2789 i, s, I.Immed 0)
297 :     handle Overflow => error "doEALabel: constant too large")
298 : jhr 4290 | I.ImmedLabel le' => doEA (trees,
299 : mrainey 2791 SOME (genExpr (T.ADD (ty, le', le))),
300 : mrainey 2789 i, s, I.Immed 0)
301 :     | _ => error "doEALabel"
302 :     (* end case *))
303 :     end
304 :    
305 : mrainey 2619 (* generate code for tree and ensure that it is not in %rsp *)
306 : jhr 4290 and exprNotRsp tree = let
307 : mrainey 2619 val r = genExpr tree
308 : jhr 4290 in
309 :     if CB.sameColor(r, C.rsp) then let
310 : mrainey 2619 val tmp = newReg()
311 : jhr 4290 in
312 :     move(ty, I.Direct (ty,r), I.Direct (ty,tmp));
313 :     tmp
314 : mrainey 2619 end
315 :     else r
316 :     end
317 :    
318 :     (* Add a base register *)
319 :     and displace(trees, t, NONE, i, s, d) = (* no base yet *)
320 :     doEA(trees, SOME(genExpr t), i, s, d)
321 :     | displace(trees, t, b as SOME base, NONE, _, d) = (* no index *)
322 :     (* make t the index, but make sure that it is not %rsp! *)
323 :     let val i = genExpr t
324 :     in if CB.sameColor(i, C.rsp) then
325 :     (* swap base and index *)
326 :     if CB.sameColor(base, C.rsp) then
327 :     doEA(trees, SOME i, b, 0, d)
328 :     else (* base and index = %rsp! *)
329 :     let val index = newReg()
330 : jhr 4290 in
331 : mrainey 2619 move(ty, I.Direct (ty,i), I.Direct (ty,index));
332 :     doEA(trees, b, SOME index, 0, d)
333 :     end
334 :     else doEA(trees, b, SOME i, 0, d)
335 :     end
336 : jhr 4290 | displace(trees, t, SOME base, i, s, d) = (* base and index *)
337 : mrainey 2619 let val b = genExpr (T.ADD(ty,T.REG(ty,base),t))
338 : jhr 4290 in
339 :     doEA(trees, SOME b, i, s, d)
340 : mrainey 2619 end
341 : jhr 4290
342 : mrainey 2619 (* Add an indexed register *)
343 :     and indexed(trees, t, t0, scale, b, NONE, _, d) = (* no index yet *)
344 :     doEA(trees, b, SOME(exprNotRsp t), scale, d)
345 :     | indexed(trees, _, t0, _, NONE, i, s, d) = (* no base *)
346 :     doEA(trees, SOME(genExpr t0), i, s, d)
347 :     | indexed(trees, _, t0, _, SOME base, i, s, d) = (*base and index*)
348 :     let val b = genExpr (T.ADD(ty, t0, T.REG(ty, base)))
349 : jhr 4290 in
350 :     doEA(trees, SOME b, i, s, d)
351 : mrainey 2619 end
352 : jhr 4290 in
353 : mrainey 2619 case doEA ([ea], NONE, NONE, 0, I.Immed 0)
354 :     of I.Immed _ => raise EA
355 : mrainey 2947 | I.ImmedLabel le => I.Displace {base=genExpr le, disp=I.Immed 0, mem=mem} (* I.LabelEA le*)
356 : mrainey 2619 | ea => ea
357 :     end (* address' *)
358 :    
359 :     and address (ea, mem) = address' 64 (ea, mem)
360 :    
361 : mrainey 3049 (* load the label into a temp register. this operation is necessary, since most instructions
362 :     * can only handle 32-bit immediates *)
363 : jhr 4290 and loadLabel src = let
364 : mrainey 3049 val tmp = newReg ()
365 :     val tmpR = I.Direct (64, tmp)
366 : jhr 4290 in
367 : mrainey 3049 emitInstr (move64 (src, tmpR));
368 :     tmpR
369 :     end
370 :    
371 : mrainey 2619 (* reduce an expression into an operand *)
372 : mrainey 2928 and operand ty (T.LI i) = if (fitsIn32Bits i)
373 : jhr 4290 then I.Immed (toInt32 i)
374 : mrainey 2928 else let
375 :     (* i is a 64-bit operand *)
376 :     val dstR = newReg ()
377 :     val dst = I.Direct (ty, dstR)
378 : mrainey 2947 val i' = T.I.signed (64, i)
379 : mrainey 2928 in
380 : mrainey 2947 move (ty, I.Immed64 (Int64.fromLarge i'), dst);
381 : mrainey 2928 dst
382 :     end
383 : mrainey 3049 | operand _ (x as (T.CONST _ | T.LABEL _)) = loadLabel (I.ImmedLabel x)
384 :     | operand _ (T.LABEXP le) = loadLabel (I.ImmedLabel le)
385 : mrainey 2619 | operand _ (T.REG(ty,r)) = gpr (ty, r)
386 :     | operand _ (T.LOAD(ty,ea,mem)) = address (ea, mem)
387 :     | operand ty t = I.Direct(ty, genExpr t)
388 :    
389 : mrainey 3049 and immedLabel lab = I.ImmedLabel(T.LABEL lab)
390 :    
391 : mrainey 2619 (* ensure that the operand is either an immed or register *)
392 :     and immedOrReg(ty, opnd as I.Displace _) = moveToReg (ty, opnd)
393 :     | immedOrReg(ty, opnd as I.Indexed _) = moveToReg (ty, opnd)
394 :     | immedOrReg(ty, opnd as I.LabelEA _) = moveToReg (ty, opnd)
395 :     | immedOrReg (ty, opnd) = opnd
396 :    
397 : mrainey 3049 and regOrMem (ty, opnd as (I.Immed _ | I.ImmedLabel _)) = moveToReg (ty, opnd)
398 :     | regOrMem (ty, opnd) = opnd
399 : mrainey 2619
400 :     and getExpr (exp as T.REG(_, rd)) = rd
401 :     | getExpr exp = genExpr exp
402 :    
403 :     and moveToReg (ty, opnd) = let
404 :     val dst = I.Direct (ty, newReg ())
405 :     in
406 :     move (ty, opnd, dst);
407 :     dst
408 :     end
409 : jhr 4290
410 : mrainey 2619 and isImmediate(I.Immed _) = true
411 : mrainey 3049 (* | isImmediate(I.ImmedLabel _) = true *)
412 : mrainey 2619 | isImmediate _ = false
413 :    
414 :     and genExpr' e = let
415 :     val r = newReg ()
416 :     in
417 :     expr (e, r, []);
418 :     r
419 :     end
420 :     (* generate an expression, and return its result in a register *)
421 :     and genExpr (T.REG (_, r)) = r
422 :     | genExpr e = genExpr' e
423 :    
424 :     and expr' (ty, e, dst, an) = let
425 :     val dstOpnd = gpr (ty, dst)
426 :     fun equalDst (I.Direct (_,r)) = CB.sameColor(r, dst)
427 :     | equalDst _ = false
428 :     fun dstMustBeReg f = f (dst, dstOpnd)
429 : mrainey 2956 fun genLoad (mvOp, ea, mem) = dstMustBeReg (fn (_, dst) =>
430 : mrainey 2619 mark (I.MOVE {mvOp=mvOp, src=address (ea, mem), dst=dst},an))
431 : jhr 4290 fun unknownExp exp = expr (Gen.compileRexp exp, dst, an)
432 :    
433 : mrainey 2619 (* Generate a unary operator *)
434 : jhr 4290 fun unary(ty, unOp, e) = let
435 : mrainey 2619 val opnd = operand ty e
436 : jhr 4290 in
437 :     if isMemOpnd opnd then let
438 : mrainey 2619 val tmp = I.Direct(ty, newReg())
439 : jhr 4290 in
440 :     move(ty, opnd, tmp);
441 : mrainey 2619 move(ty, tmp, dstOpnd)
442 : jhr 4290 end
443 : mrainey 2619 else move(ty, opnd, dstOpnd);
444 :     mark(I.UNARY{unOp=unOp ty, opnd=dstOpnd}, an)
445 :     end
446 : jhr 4290
447 : mrainey 2619 fun genBinary (ty, binOp, opnd1, opnd2) =
448 :     if (isMemOpnd opnd1 orelse isMemOpnd opnd2) orelse
449 : jhr 4290 equalDst(opnd2) then let
450 : mrainey 2619 val tmpR = newReg()
451 :     val tmp = I.Direct (ty,tmpR)
452 : jhr 4290 in
453 : mrainey 2619 move (ty, opnd1, tmp);
454 :     mark (I.BINARY{binOp=binOp ty, src=opnd2, dst=tmp}, an);
455 :     move (ty, tmp, dstOpnd)
456 : jhr 4290 end
457 : mrainey 2619 else (move (ty, opnd1, dstOpnd);
458 :     mark(I.BINARY{binOp=binOp ty, src=opnd2, dst=dstOpnd}, an))
459 :     (* generate a binary operator that may commute *)
460 : jhr 4290 fun binaryComm (ty, binOp, e1, e2) = let
461 :     val (opnd1, opnd2) = (case (operand ty e1, operand ty e2)
462 : mrainey 2619 of (x as I.Immed _, y) => (y, x)
463 :     | (x as I.ImmedLabel _, y) => (y, x)
464 :     | (x, y as I.Direct _) => (y, x)
465 :     | (x, y) => (x, y)
466 :     (* end case *))
467 : jhr 4290 in
468 :     genBinary(ty, binOp, opnd1, opnd2)
469 : mrainey 2619 end
470 :     (* Generate a binary operator; non-commutative *)
471 : jhr 4290 fun binary(ty, binOp, e1, e2) =
472 : mrainey 2619 genBinary(ty, binOp, operand ty e1, operand ty e2)
473 :     (* Add n to dst *)
474 : jhr 4290 fun addN (addOp, n) = let
475 : mrainey 2619 val n = operand ty n
476 : jhr 4290 in
477 :     mark (I.BINARY{binOp=addOp, src=n, dst=dstOpnd}, an)
478 : mrainey 2619 end
479 :     (* Generate addition *)
480 : jhr 4290 fun addition(ty, e1, e2) = (case e1
481 :     of T.REG(_,rs) =>
482 :     if CB.sameColor(rs,dst)
483 : mrainey 2619 then addN (O.addOp ty, e2)
484 :     else addition1 (ty, e1,e2)
485 :     | _ => addition1(ty, e1,e2)
486 :     (* end case *))
487 : jhr 4290 and addition1 (ty, e1, e2) = (case e2
488 :     of T.REG(_,rs) =>
489 :     if CB.sameColor(rs,dst)
490 :     then addN (O.addOp ty, e1)
491 : mrainey 2619 else addition2(ty, e1,e2)
492 : jhr 4290 | _ => addition2 (ty, e1,e2)
493 : mrainey 2619 (* end case *))
494 :     and addition2 (ty, e1, e2) =
495 :     (dstMustBeReg(fn (dstR, _) => (case ty
496 : jhr 4290 of 32 => mark(I.LEAL{r32=dstR,
497 : mrainey 2619 addr=address' 32 (e, readonly)}, an)
498 : jhr 4290 | 64 => mark(I.LEAQ{r64=dstR,
499 : mrainey 2619 addr=address' 64 (e, readonly)}, an)
500 :     (* end case*)))
501 :     handle EA => binaryComm(ty, O.addOp, e1, e2))
502 :    
503 :     (* the shift amount must be a constant or in %rcx *)
504 : jhr 4290 fun shift(ty, opcode, e1, e2) = let
505 : mrainey 2619 val (opnd1, opnd2) = (operand ty e1, operand ty e2)
506 : jhr 4290 in
507 :     (case opnd2
508 : mrainey 2619 of I.Immed _ => genBinary(ty, opcode, opnd1, opnd2)
509 : jhr 4290 | _ =>
510 :     if equalDst(opnd2) then
511 : mrainey 2619 let val tmpR = newReg()
512 :     val tmp = I.Direct (ty,tmpR)
513 : jhr 4290 in
514 : mrainey 2619 move(ty, opnd1, tmp);
515 :     move(ty, opnd2, rcx ty);
516 :     mark(I.BINARY{binOp=opcode ty, src=rcx ty,
517 :     dst=tmp},an);
518 :     move(ty, tmp, dstOpnd)
519 :     end
520 :     else
521 :     (move(ty, opnd1, dstOpnd);
522 :     move(ty, opnd2, rcx ty);
523 :     mark(I.BINARY{binOp=opcode ty, src=rcx ty,
524 :     dst=dstOpnd},an))
525 :     (* end case *))
526 :     end
527 :    
528 :     (* division with rounding towards negative infinity *)
529 :     fun divinf0 (ty, overflow, e1, e2) = let
530 :     val o1 = operand ty e1
531 :     val o2 = operand ty e2
532 :     val l = Label.anon ()
533 :     in
534 :     move (ty, o1, rax ty);
535 : mrainey 4239 emit (signExtend ty);
536 : jhr 4290 mark (I.MULTDIV { multDivOp = O.idivOp ty,
537 : mrainey 2619 src = regOrMem (ty, o2) },
538 :     an);
539 :     if overflow then trap() else ();
540 :     app emit [(O.cmpOp ty) { lsrc = rdx ty, rsrc = I.Immed 0 },
541 :     I.JCC { cond = I.EQ, opnd = immedLabel l },
542 :     I.BINARY { binOp = O.xorOp ty,
543 :     src = regOrMem (ty, o2),
544 :     dst = rdx ty },
545 :     I.JCC { cond = I.GE, opnd = immedLabel l },
546 :     I.UNARY { unOp = O.decOp ty, opnd = rax ty }];
547 :     defineLabel l;
548 :     move (ty, rax ty, dstOpnd)
549 :     end
550 :    
551 :     (* Division by a power of two when rounding to neginf is the
552 :     * same as an arithmetic right shift. *)
553 :     fun divinf (ty, overflow, e1, e2 as T.LI n') =
554 :     (case analyze n' of
555 :     (_, NONE) => divinf0 (ty, overflow, e1, e2)
556 :     | (_, SOME (false, _, p)) =>
557 :     shift (ty, O.sarOp, T.REG (ty, getExpr e1), p)
558 :     | (_, SOME (true, _, p)) => let
559 :     val reg = getExpr e1
560 :     in
561 : jhr 4290 emit(I.UNARY { unOp = O.negOp ty,
562 : mrainey 2619 opnd = I.Direct (ty,reg) });
563 :     shift (ty, O.sarOp, T.REG (ty, reg), p)
564 :     end)
565 :     | divinf (ty, overflow, e1, e2) = divinf0 (ty, overflow, e1, e2)
566 :    
567 :     fun reminf0 (ty, e1, e2) = let
568 :     val o1 = operand ty e1
569 :     val o2 = operand ty e2
570 :     val l = Label.anon ()
571 :     in
572 :     move (ty, o1, rax ty);
573 : mrainey 4239 emit (signExtend ty);
574 : jhr 4290 mark (I.MULTDIV { multDivOp = O.idiv1Op ty,
575 : mrainey 2619 src = regOrMem (ty, o2) },
576 :     an);
577 :     app emit [(O.cmpOp ty) { lsrc = rdx ty, rsrc = I.Immed 0 },
578 :     I.JCC { cond = I.EQ, opnd = immedLabel l }];
579 :     move (ty, rdx ty, rax ty);
580 :     app emit [I.BINARY { binOp = O.xorOp ty,
581 :     src = regOrMem (ty, o2), dst = rax ty },
582 :     I.JCC { cond = I.GE, opnd = immedLabel l },
583 :     I.BINARY { binOp = O.addOp ty,
584 :     src = regOrMem (ty, o2), dst = rdx ty }];
585 :     defineLabel l;
586 :     move (ty, rdx ty, dstOpnd)
587 :     end
588 :    
589 : jhr 4290 (* n mod (power-of-2) corrrsponds to a bitmask (AND).
590 : mrainey 2619 * If the power is negative, then we must first negate
591 :     * the argument and then again negate the result. *)
592 :     fun reminf (ty, e1, e2 as T.LI n') =
593 :     (case analyze n' of
594 :     (_, NONE) => reminf0 (ty, e1, e2)
595 :     | (_, SOME (false, a, _)) =>
596 :     binaryComm (ty, O.andOp, e1,
597 :     T.LI (T.I.fromInt32 (ty, a - 1)))
598 :     | (_, SOME (true, a, _)) => let
599 :     val r1 = getExpr e1
600 :     val o1 = I.Direct (ty,r1)
601 :     in
602 :     emit (I.UNARY { unOp = O.negOp ty, opnd = o1 });
603 :     emit (I.BINARY { binOp = O.andOp ty,
604 :     src = I.Immed (a - 1),
605 :     dst = o1 });
606 :     unary (ty, O.negOp, T.REG (ty, r1))
607 :     end)
608 :     | reminf (ty, e1, e2) = reminf0 (ty, e1, e2)
609 :    
610 :     (* Division or remainder: divisor must be in %rdx:%rax pair *)
611 :     fun divrem(ty, signed, overflow, e1, e2, resultReg) =
612 :     let val (opnd1, opnd2) = (operand ty e1, operand ty e2)
613 :     val _ = move(ty, opnd1, rax ty)
614 : mrainey 4239 val oper = if signed then (emit(signExtend ty); O.idiv1Op ty)
615 : mrainey 2619 else (zero (ty, rdx ty); O.div1Op ty)
616 :     in mark(I.MULTDIV{multDivOp=oper, src=regOrMem (ty, opnd2)},an);
617 :     move(ty, resultReg, dstOpnd);
618 :     if overflow then trap() else ()
619 :     end
620 :    
621 : jhr 4290 (* Optimize the special case for division *)
622 : mrainey 2619 fun divide (ty, signed, overflow, e1, e2 as T.LI n') =
623 :     (case analyze n' of
624 :     (n, SOME (isneg, a, p)) =>
625 :     if signed then
626 :     let val label = Label.anon ()
627 :     val reg1 = getExpr e1
628 :     val opnd1 = I.Direct (ty,reg1)
629 :     in
630 :     if isneg then
631 :     emit (I.UNARY { unOp = O.negOp ty,
632 :     opnd = opnd1 })
633 :     else if setZeroBit e1 then ()
634 :     else emit (O.cmpOp ty { lsrc = opnd1,
635 :     rsrc = I.Immed 0 });
636 :     emit (I.JCC { cond = I.GE,
637 :     opnd = immedLabel label });
638 :     emit (if a = 2 then
639 :     I.UNARY { unOp = O.incOp ty,
640 :     opnd = opnd1 }
641 :     else
642 :     I.BINARY { binOp = O.addOp ty,
643 :     src = I.Immed (a - 1),
644 :     dst = opnd1 });
645 :     defineLabel label;
646 :     shift (ty, O.sarOp, T.REG (ty, reg1), p)
647 :     end
648 :     else shift (ty, O.shrOp, e1, p)
649 :     | (n, NONE) =>
650 :     divrem(ty, signed, overflow andalso (n = ~1 orelse n = 0),
651 :     e1, e2, rax ty))
652 :     | divide (ty, signed, overflow, e1, e2) =
653 :     divrem (ty, signed, overflow, e1, e2, rax ty)
654 :    
655 :     (* rem never causes overflow *)
656 :     fun rem (ty, signed, e1, e2 as T.LI n') =
657 :     (case analyze n' of
658 :     (n, SOME (isneg, a, _)) =>
659 :     if signed then
660 :     (* The following logic should work uniformely
661 :     * for both isneg and not isneg. It only uses
662 :     * the absolute value (a) of the divisor.
663 :     * Here is the formula:
664 :     * let p be a power of two and a = abs(p):
665 :     *
666 :     * x % p = x - ((x < 0 ? x + a - 1 : x) & (-a))
667 :     *
668 :     * (That's what GCC seems to do.)
669 :     *)
670 :     let val r1 = getExpr e1
671 :     val o1 = I.Direct (ty,r1)
672 :     val rt = newReg ()
673 :     val tmp = I.Direct (ty,rt)
674 :     val l = Label.anon ()
675 :     in
676 :     move (ty, o1, tmp);
677 :     if setZeroBit e1 then ()
678 :     else emit ((O.cmpOp ty) { lsrc = o1,
679 :     rsrc = I.Immed 0 });
680 :     emit (I.JCC { cond = I.GE,
681 :     opnd = immedLabel l });
682 :     emit (I.BINARY { binOp = O.addOp ty,
683 :     src = I.Immed (a - 1),
684 :     dst = tmp });
685 :     defineLabel l;
686 :     emit (I.BINARY { binOp = O.andOp ty,
687 :     src = I.Immed (~a),
688 :     dst = tmp });
689 :     binary (ty, O.subOp, T.REG (ty, r1), T.REG (ty, rt))
690 :     end
691 :     else
692 :     if isneg then
693 :     (* this is really strange... *)
694 :     divrem (ty, false, false, e1, e2, rdx ty)
695 :     else
696 :     binaryComm (ty, O.andOp, e1,
697 :     T.LI (T.I.fromInt32 (ty, n - 1)))
698 :     | (_, NONE) => divrem (ty, signed, false, e1, e2, rdx ty))
699 :     | rem(ty, signed, e1, e2) =
700 :     divrem(ty, signed, false, e1, e2, rdx ty)
701 :    
702 :    
703 :     (* unsigned integer multiplication *)
704 : jhr 4290 fun uMultiply0 (ty, e1, e2) =
705 : mrainey 2619 (* note e2 can never be (I.Direct rdx) *)
706 :     (move(ty, operand ty e1, rax ty);
707 : jhr 4290 mark(I.MULTDIV{multDivOp=O.mul1Op ty,
708 : mrainey 2619 src=regOrMem(ty, operand ty e2)},an);
709 :     move(ty, rax ty, dstOpnd)
710 :     )
711 : jhr 4290
712 : mrainey 2619 fun uMultiply (ty, e1, e2 as T.LI n') =
713 :     (case analyze n' of
714 :     (_, SOME (false, _, p)) => shift (ty, O.shlOp, e1, p)
715 :     | _ => uMultiply0 (ty, e1, e2))
716 :     | uMultiply (ty, e1 as T.LI _, e2) = uMultiply (ty, e2, e1)
717 :     | uMultiply (ty, e1, e2) = uMultiply0 (ty, e1, e2)
718 :    
719 : jhr 4290 (* signed integer multiplication:
720 :     * The only forms that are allowed that also sets the
721 : mrainey 2619 * OF and CF flags are:
722 :     *
723 :     * (dst) (src1) (src2)
724 : mrainey 2793 * imul r64, r64/m64, imm8
725 : jhr 4290 * (dst) (src)
726 : mrainey 2793 * imul r64, imm8
727 :     * imul r64, imm32
728 :     * imul r64, r32/m64
729 : mrainey 2619 * Note: destination must be a register!
730 :     *)
731 : jhr 4290 fun multiply (ty, e1, e2) =
732 : mrainey 2619 dstMustBeReg(fn (dst, dstOpnd) =>
733 :     let fun doit(i1 as I.Immed _, i2 as I.Immed _) =
734 :     (move(ty, i1, dstOpnd);
735 :     mark(I.BINARY{binOp=O.imulOp ty, dst=dstOpnd, src=i2},an))
736 :     | doit(rm, i2 as I.Immed _) = doit(i2, rm)
737 :     | doit(imm as I.Immed(i), rm) =
738 :     (case ty
739 :     of 32 => mark(I.MUL3{dst=dst, src1=rm, src2=i},an)
740 :     | 64 => mark(I.MULQ3{dst=dst, src1=rm, src2=i},an)
741 :     (* esac *))
742 :     | doit(r1 as I.Direct _, r2 as I.Direct _) =
743 :     (move(ty, r1, dstOpnd);
744 :     mark(I.BINARY{binOp=O.imulOp ty, dst=dstOpnd, src=r2},an))
745 :     | doit(r1 as I.Direct _, rm) =
746 :     (move(ty, r1, dstOpnd);
747 :     mark(I.BINARY{binOp=O.imulOp ty, dst=dstOpnd, src=rm},an))
748 :     | doit(rm, r as I.Direct _) = doit(r, rm)
749 :     | doit(rm1, rm2) =
750 :     if equalDst rm2 then
751 :     let val tmpR = newReg()
752 :     val tmp = I.Direct (ty,tmpR)
753 :     in move(ty, rm1, tmp);
754 :     mark(I.BINARY{binOp=O.imulOp ty, dst=tmp, src=rm2},an);
755 :     move(ty, tmp, dstOpnd)
756 :     end
757 :     else
758 :     (move(ty, rm1, dstOpnd);
759 :     mark(I.BINARY{binOp=O.imulOp ty, dst=dstOpnd, src=rm2},an)
760 :     )
761 :     val (opnd1, opnd2) = (operand ty e1, operand ty e2)
762 :     in doit(opnd1, opnd2)
763 :     end
764 :     )
765 :    
766 :     fun multiply_notrap (ty, e1, e2 as T.LI n') =
767 :     (case analyze n' of
768 :     (_, SOME (isneg, _, p)) => let
769 :     val r1 = getExpr e1
770 :     val o1 = I.Direct (ty,r1)
771 :     in
772 :     if isneg then
773 :     emit (I.UNARY { unOp = O.negOp ty, opnd = o1 })
774 :     else ();
775 :     shift (ty, O.shlOp, T.REG (ty, r1), p)
776 :     end
777 :     | _ => multiply (ty, e1, e2))
778 :     | multiply_notrap (ty, e1 as T.LI _, e2) = multiply_notrap (ty, e2, e1)
779 :     | multiply_notrap (ty, e1, e2) = multiply (ty, e1, e2)
780 :    
781 : mrainey 2783 (* NOTE: cmovcc encodes its operand lengths implicitly in the operand names: i.e.,
782 : jhr 4290 * cmove %rax, %rbx
783 : mrainey 2783 * *)
784 : mrainey 2781 fun cmovcc (tyCond, tyCmp, cc, t1, t2, y, n) = let
785 :     fun gen (dstR, _) = let
786 :     val _ = expr' (tyCond, n, dstR, []) (* false branch *)
787 : mrainey 2783 val src = regOrMem (tyCond, operand tyCond y) (* yes branch (note the ordering ) *)
788 : mrainey 2781 val cc = cmp (true, tyCmp, cc, t1, t2, []) (* compare *)
789 :     in
790 :     mark (I.CMOV {cond=cond cc, src=src, dst=dstR}, an)
791 :     end
792 :     in
793 :     dstMustBeReg gen
794 :     end
795 :    
796 : mrainey 2829 (* conditional move for float comparisons *)
797 : mrainey 2826 fun fcmovcc (tyCond, fty, cc, t1, t2, y, n) = dstMustBeReg (fn (dstR, _) => let
798 :     val _ = expr' (tyCond, n, dstR, []) (* false branch *)
799 :     val src = regOrMem (tyCond, operand tyCond y) (* true branch *)
800 : jhr 4290 fun j cc = mark (I.CMOV {cond=cc, src=src, dst=dstR}, an)
801 : mrainey 2826 in
802 :     fbranch' (fty, cc, t1, t2, j)
803 :     end)
804 :    
805 : mrainey 2619 in
806 :     (case e
807 :     of T.REG (ty, r) => move' (ty, gpr (ty, r), dstOpnd, an)
808 : mrainey 2928 | T.LI z => if (fitsIn32Bits z)
809 :     then move' (ty, I.Immed (toInt32 z), dstOpnd, an)
810 : mrainey 2947 else mark' (move64 (I.Immed64(toInt64 z), dstOpnd), an)
811 : jhr 4290 | (T.CONST _ | T.LABEL _) =>
812 : mrainey 2619 move' (ty, I.ImmedLabel e, dstOpnd, an)
813 :     | T.LABEXP le => move' (ty, I.ImmedLabel le, dstOpnd, an)
814 :     (* arithmetic operations *)
815 : jhr 4290 | T.ADD(ty, e1, e2 as T.LI n) => let
816 : mrainey 2619 val n = toInt32 n
817 : jhr 4290 in
818 :     case n
819 : mrainey 2619 of 1 => unary(ty, O.incOp, e1)
820 :     | ~1 => unary(ty, O.decOp, e1)
821 :     | _ => addition (ty, e1, e2)
822 :     end
823 : jhr 4290 | T.ADD(ty, e1 as T.LI n, e2) => let
824 : mrainey 2619 val n = toInt32 n
825 :     in
826 : jhr 4290 case n
827 : mrainey 2619 of 1 => unary(ty, O.incOp, e2)
828 :     | ~1 => unary(ty, O.decOp, e2)
829 :     | _ => addition (ty, e1, e2)
830 :     end
831 :     | T.ADD(ty, e1, e2) => addition (ty, e1, e2)
832 : jhr 4290 | T.SUB(ty, e1, e2 as T.LI n) => let
833 : mrainey 2619 val n = toInt32 n
834 :     in
835 :     case n
836 :     of 0 => expr' (ty, e1, dst, an)
837 :     | 1 => unary(ty, O.decOp, e1)
838 :     | ~1 => unary(ty, O.incOp, e1)
839 :     | _ => binary(ty, O.subOp, e1, e2)
840 :     end
841 : jhr 4290 | T.SUB(ty, e1 as T.LI n, e2) =>
842 : mrainey 2619 if n = 0 then unary(ty, O.negOp, e2)
843 :     else binary(ty, O.subOp, e1, e2)
844 :     | T.SUB(ty, e1, e2) => binary(ty, O.subOp, e1, e2)
845 :     (* unsigned *)
846 :     | T.MULU(ty, x, y) => uMultiply(ty, x, y)
847 :     | T.DIVU(ty, x, y) => divide(ty, false, false, x, y)
848 :     | T.REMU(ty, x, y) => rem(ty, false, x, y)
849 :     (* signed *)
850 :     | T.MULS(ty, x, y) => multiply_notrap (ty, x, y)
851 : jhr 4290 | T.DIVS(T.DIV_TO_ZERO, ty, x, y) =>
852 : mrainey 2619 divide(ty, true, false, x, y)
853 :     | T.DIVS(T.DIV_TO_NEGINF, ty, x, y) => divinf (ty, false, x, y)
854 :     | T.REMS(T.DIV_TO_ZERO, ty, x, y) => rem(ty, true, x, y)
855 :     | T.REMS(T.DIV_TO_NEGINF, ty, x, y) => reminf (ty, x, y)
856 :     (* trapping *)
857 :     | T.ADDT(ty, x, y) => (binaryComm(ty, O.addOp, x, y); trap())
858 :     | T.SUBT(ty, x, y) => (binary(ty, O.subOp, x, y); trap())
859 :     | T.MULT(ty, x, y) => (multiply (ty, x, y); trap ())
860 : jhr 4290 | T.DIVT(T.DIV_TO_ZERO, ty, x, y) =>
861 : mrainey 2619 divide(ty, true, true, x, y)
862 :     | T.DIVT(T.DIV_TO_NEGINF, ty, x, y) => divinf (ty, true, x, y)
863 :     (* bitwise operations *)
864 :     | T.ANDB(ty, x, y) => binaryComm(ty, O.andOp, x, y)
865 :     | T.ORB(ty, x, y) => binaryComm(ty, O.orOp, x, y)
866 :     | T.XORB(ty, x, y) => binaryComm(ty, O.xorOp, x, y)
867 :     | T.NOTB(ty, x) => unary(ty, O.notOp, x)
868 :     | T.SRA(ty, x, y) => shift(ty, O.sarOp, x, y)
869 :     | T.SRL(ty, x, y) => shift(ty, O.shrOp, x, y)
870 :     | T.SLL(ty, x, y) => shift(ty, O.shlOp, x, y)
871 :     (* loads *)
872 :     | T.LOAD (8, ea, mem) => genLoad (O.loadZXOp (8, 64), ea, mem)
873 :     | T.LOAD (16, ea, mem) => genLoad (O.loadZXOp (16, 64), ea, mem)
874 :     | T.LOAD (32, ea, mem) => genLoad (I.MOVL, ea, mem)
875 :     | T.LOAD (64, ea, mem) => genLoad (I.MOVQ, ea, mem)
876 :     (* sign-extended loads *)
877 : mrainey 3172 | T.SX (tTy, fTy, x) =>
878 : mrainey 3179 mark (I.MOVE {mvOp=O.loadSXOp (fTy, tTy), src=regOrMem(fTy, operand fTy x), dst=I.Direct(tTy, dst)},an)
879 : mrainey 3165 (* there is no movslq instruction, but movl suffices. *)
880 : jhr 4290 | T.ZX(64, 32, e) =>
881 : mrainey 2957 mark (I.MOVE {mvOp=I.MOVL, src=operand 32 e, dst=I.Direct(32, dst)},an)
882 : mrainey 2619 (* zero-extended loads *)
883 : jhr 4290 | T.ZX(tTy, fTy, e) =>
884 : mrainey 3179 mark (I.MOVE {mvOp=O.loadZXOp (fTy, tTy), src=regOrMem(fTy, operand fTy e), dst=I.Direct(tTy, dst)},an)
885 : mrainey 2956 | T.CVTF2I (ty, roundingMd, fty, fExp) => let
886 : mrainey 2947 (* FIXME: handle the rounding mode *)
887 :     val mvOp = (case (fty, ty)
888 : jhr 4290 of (64, 32) => I.CVTSD2SI
889 : mrainey 2947 | (32, 32) => I.CVTSS2SI
890 :     | (64, 64) => I.CVTSD2SIQ
891 :     | (32, 64) => I.CVTSS2SIQ
892 :     (* end case *))
893 :     in
894 :     mark' (I.move {mvOp=mvOp, src=foperand(fty, fExp), dst=dstOpnd}, an)
895 :     end
896 : jhr 4290 | T.COND (tyCond, T.CMP (tyCmp, cc, t1, t2), y, n) =>
897 : mrainey 2781 cmovcc (tyCond, tyCmp, cc, t1, t2, y, n)
898 : mrainey 2826 | T.COND (tyCond, T.FCMP (fty, cc, t1, t2), y, n) =>
899 :     fcmovcc (tyCond, fty, cc, t1, t2, y, n)
900 : mrainey 2783 | T.NEG (ty, x) => unary (ty, O.negOp, x)
901 : mrainey 2619 | T.LET (s, e) => (stmt s; expr (e, dst, an))
902 : mrainey 2826 | T.MARK (e, A.MARKREG f) => (f dst; expr' (ty, e, dst, an))
903 :     | T.MARK (e, a) => expr' (ty, e, dst, a :: an)
904 :     | T.PRED (e, c) => expr' (ty, e, dst, A.CTRLUSE c :: an)
905 : mrainey 2829 | _ => raise Fail("Unsupported rexp: " ^ MLTreeUtils.rexpToString e)
906 : mrainey 2619 (* end case *))
907 : jhr 4290 end (* expr' *)
908 : mrainey 2619
909 :     and expr (e, dst, an) = expr' (TRS.size e, e, dst, an)
910 : jhr 4290
911 : mrainey 2619 and fcopy (fty, ds, rs, an) = let
912 : jhr 4290 fun mvInstr {dst, src} =
913 : mrainey 2619 [I.fmove {fmvOp=O.fmovOp fty, dst=dst, src=src}]
914 : mrainey 2998 (* eliminate unnecessary copies *)
915 :     val (ds, rs) = ListPair.unzip (List.filter (not o CB.sameColor) (ListPair.zip (ds, rs)))
916 :     val stms = Shuffle.shuffle {mvInstr=mvInstr, ea=fpr} {dst=ds, src=rs, tmp=NONE}
917 : mrainey 2619 in
918 :     emits stms
919 : jhr 4290 end
920 : mrainey 2619
921 :     (* put a floating-point expression into a register *)
922 : mrainey 2631 and fexpToReg (fty, e) = (case e
923 : mrainey 2619 of T.FREG (fty', r) => r
924 : mrainey 2631 | e => let
925 : mrainey 2619 val r = newFreg ()
926 :     in
927 :     fexpr (fty, r, e, []);
928 :     r
929 :     end
930 : mrainey 2631 (* end case *))
931 : mrainey 2619
932 :     (* put a floating-point expression into an operand *)
933 :     and foperand (fty, e) = (case e
934 :     of T.FLOAD (fty, ea, mem) => address (ea, mem)
935 : mrainey 2631 | T.FREG (fty, r) => I.FDirect r
936 : mrainey 2619 | e => I.FDirect (fexpToReg (fty, e))
937 :     (* end case *))
938 :    
939 : mrainey 2929 and falignedOperand (fty, e) = if floats16ByteAligned
940 :     then foperand (fty, e)
941 :     else I.FDirect (fexpToReg (fty, e))
942 :    
943 : jhr 4290 (* SSE binary ops
944 : mrainey 2843 * (src) (dst)
945 :     * binOp freg/m64, freg
946 :     *)
947 : mrainey 2619 and fbinop (fty, binOp, a, b, d, an) = let
948 : mrainey 2843 (* try to move memory operands to src rather than dst if binOp is commutative *)
949 :     val (a, b) = (case (binOp, a, b)
950 : jhr 4290 of ( (I.ADDSS | I.ADDSD | I.MULSS | I.MULSD | I.XORPS | I.XORPD | I.ANDPS | I.ANDPD | I.ORPS | I.ORPD),
951 : mrainey 2843 T.FLOAD _,
952 :     T.FREG _) => (b, a)
953 :     | _ => (a, b)
954 :     (* end case *))
955 :     val src = foperand (fty, b)
956 : mrainey 2619 in
957 : mrainey 2631 fexpr (fty, d, a, []);
958 : mrainey 2843 mark (I.FBINOP {binOp=binOp, dst=d, src=src}, an)
959 : mrainey 2619 end
960 : jhr 4290
961 : mrainey 2638 and fsqrt (fty, d, a, an) = let
962 : mrainey 2929 val s = falignedOperand (fty, a)
963 : mrainey 2927 (* TODO: allow the source operand to be a memory location
964 :     * val aOpnd = foperand (fty, a)
965 :     *)
966 : mrainey 2638 val oper = (case fty
967 :     of 32 => I.FSQRTS
968 :     | 64 => I.FSQRTD
969 :     | _ => error "fsqrt"
970 :     (* end case *))
971 :     in
972 : mrainey 2929 mark (oper {src=s, dst=I.FDirect d}, an)
973 : mrainey 2638 end
974 : jhr 4290
975 : mrainey 2619 and convertf2f (fromTy, toTy, e, d, an) = let
976 :     val fmvOp = (case (fromTy, toTy)
977 :     of (32, 64) => I.CVTSS2SD
978 :     | (64, 32) => I.CVTSD2SS
979 :     | _ => error "convertf2f"
980 :     (* end case *))
981 :     in
982 : mrainey 2791 mark (I.FMOVE {fmvOp=fmvOp, dst=I.FDirect d, src=foperand (fromTy, e)}, an)
983 : mrainey 2619 end (* convertf2f *)
984 :    
985 :     and converti2f (fty, ty, e, d, an) = let
986 :     val fmvOp = (case (ty, fty)
987 :     of (32, 32) => I.CVTSI2SS
988 :     | (32, 64) => I.CVTSI2SD
989 :     | (64, 32) => I.CVTSI2SSQ
990 :     | (64, 64) => I.CVTSI2SDQ
991 :     (* end case *))
992 : mrainey 2791 val src = regOrMem (ty, operand ty e)
993 : mrainey 2619 in
994 : mrainey 2791 mark (I.FMOVE {fmvOp=fmvOp, dst=I.FDirect d, src=src}, an)
995 : mrainey 2619 end (* converti2f *)
996 :    
997 : mrainey 2826 and fexpr (fty, d, e, an) = ( (*floatingPointUsed := true;*)
998 : mrainey 2619 case e
999 : mrainey 2998 of T.FREG (_, r) => fcopy (fty, [d], [r], an)
1000 : mrainey 2619 (* binary operators *)
1001 :     | T.FADD (_, a, b) => fbinop (fty, O.faddOp fty, a, b, d, an)
1002 :     | T.FSUB (_, a, b) => fbinop (fty, O.fsubOp fty, a, b, d, an)
1003 :     | T.FMUL (_, a, b) => fbinop (fty, O.fmulOp fty, a, b, d, an)
1004 :     | T.FDIV (_, a, b) => fbinop (fty, O.fdivOp fty, a, b, d, an)
1005 :     (* unary operators *)
1006 : jhr 4290 | T.FNEG (_, a) => let
1007 : mrainey 2808 val fop = (case fty
1008 :     of 32 => I.XORPS
1009 :     | 64 => I.XORPD
1010 :     (* end case *))
1011 :     val r = newFreg ()
1012 : mrainey 2929 val s = falignedOperand (fty, a)
1013 : jhr 4290 in
1014 :     (* Two old versions of this code: pre-r3081 and r3081+
1015 : mrainey 2808 fload (fty, T.LABEL l, I.Region.memory, r, an);
1016 : jhr 4290 fload (fty, T.ADD (64, T.REG (64, C.rsp), T.LI 208), I.Region.memory, r, an);
1017 : jhr 3801 *)
1018 : jhr 4290 fload (fty, signBit fty, I.Region.memory, r, an);
1019 : mrainey 2929 mark (I.FBINOP {binOp=fop, dst=r, src=s}, an);
1020 : mrainey 2808 fcopy (fty, [d], [r], an)
1021 :     end
1022 : jhr 4290 | T.FABS (_, a) => let
1023 : mrainey 2829 val fop = (case fty
1024 :     of 32 => I.ANDPS
1025 :     | 64 => I.ANDPD
1026 :     (* end case *))
1027 :     val r = newFreg ()
1028 : mrainey 2929 val s = falignedOperand (fty, a)
1029 : jhr 4290 in
1030 :     (* Two old versions of this code: pre-r3081 and r3081+
1031 : mrainey 2829 fload (fty, T.LABEL l, I.Region.memory, r, an);
1032 : jhr 4290 fload (fty, T.ADD (64, T.REG (64, C.rsp), T.LI 216), I.Region.memory, r, an);
1033 : jhr 3801 *)
1034 : jhr 4290 fload (fty, negateSignBit fty, I.Region.memory, r, an);
1035 : mrainey 2929 mark (I.FBINOP {binOp=fop, dst=r, src=s}, an);
1036 : mrainey 2829 fcopy (fty, [d], [r], an)
1037 :     end
1038 : mrainey 2638 | T.FSQRT (fty, a) => fsqrt (fty, d, a, an)
1039 : mrainey 2619 (* conversions *)
1040 :     | T.CVTF2F (fTy, tTy, e) => convertf2f (fTy, tTy, e, d, an)
1041 :     | T.CVTI2F (fty, ty, e) => converti2f (fty, ty, e, d, an)
1042 :     (* load *)
1043 :     | T.FLOAD (fty, ea, mem) => fload (fty, ea, mem, d, an)
1044 :     (* misc *)
1045 :     | T.FMARK (e, A.MARKREG f) => (f d; fexpr (fty, d, e, an))
1046 :     | T.FMARK (e, a) => fexpr (fty, d, e, a::an)
1047 :     | T.FPRED (e, c) => fexpr (fty, d, e, A.CTRLUSE c::an)
1048 : jhr 4290 | T.FEXT fexp => ExtensionComp.compileFext (reducer()) {e=fexp, fd=d, an=an}
1049 : mrainey 2619 | _ => error "fexpr"
1050 :     (* end case *))
1051 :    
1052 :     and fload (fty, ea, mem, d, an) = mark (
1053 : jhr 4290 I.FMOVE {fmvOp=O.fmovOp fty, dst=I.FDirect d,
1054 : mrainey 2619 src=address (ea, mem)}, an)
1055 :    
1056 :     and fstore (fty, ea, mem, e, an) = mark (
1057 :     I.FMOVE {fmvOp=O.fmovOp fty, dst=address (ea, mem),
1058 :     src=I.FDirect (fexpToReg (fty, e))}, an)
1059 : jhr 4290
1060 :     and call (ea, flow, def, use, mem, cutsTo, an, pops) = let
1061 : mrainey 2619 fun return(set, []) = set
1062 : jhr 4290 | return(set, a::an) = (case #peek A.RETURN_ARG a
1063 : mrainey 2619 of SOME r => return(CB.CellSet.add(r, set), an)
1064 :     | NONE => return(set, an)
1065 :     (* end case *))
1066 : jhr 3278 val dst = (case ea
1067 :     of T.LABEL lab => I.ImmedLabel ea
1068 :     | T.LABEXP le => I.ImmedLabel le
1069 :     | _ => operand 64 ea
1070 :     (* end case *))
1071 : mrainey 2619 in
1072 : jhr 3278 mark(I.CALL{
1073 :     opnd=dst, defs=cellset def, uses=cellset use,
1074 :     return=return (C.empty, an), cutsTo=cutsTo, mem=mem,
1075 :     pops=pops
1076 :     }, an)
1077 : mrainey 2619 end (* call *)
1078 :    
1079 : jhr 4290 and jmp (lexp as T.LABEL lab, labs, an) =
1080 : mrainey 2619 mark (I.JMP (I.ImmedLabel lexp, [lab]), an)
1081 :     | jmp (T.LABEXP le, labs, an) = mark (I.JMP (I.ImmedLabel le, labs), an)
1082 :     | jmp (ea, labs, an) = mark (I.JMP (operand 64 ea, labs), an)
1083 :    
1084 : jhr 4290 and doStore ty (ea, d, mem, an) =
1085 : mrainey 2619 move' (ty, immedOrReg (ty, operand ty d), address (ea, mem), an)
1086 :    
1087 :     and binaryMem(ty, binOp, src, dst, mem, an) =
1088 :     mark(I.BINARY{binOp=binOp, src=immedOrReg(ty, operand ty src),
1089 :     dst=address (dst,mem)}, an)
1090 :     and unaryMem(ty, unOp, opnd, mem, an) =
1091 :     mark(I.UNARY{unOp=unOp, opnd=address (opnd,mem)}, an)
1092 :     and isOne(T.LI n) = n = 1
1093 :     | isOne _ = false
1094 :    
1095 : jhr 4290 and store (ty, ea, d, mem,
1096 :     {INC,DEC,ADD,SUB,NOT,NEG,SHL,SHR,SAR,OR,AND,XOR, ...} : O.opcodes,
1097 : mrainey 2619 doStore, an) = let
1098 :     fun default () = doStore (ea, d, mem, an)
1099 : jhr 4290 fun binary1 (t, t', unary, binary, ea', x) =
1100 : mrainey 2619 if t = ty andalso t' = ty then
1101 :     if MLTreeUtils.eqRexp(ea, ea') then
1102 :     if isOne x then unaryMem(ty, unary, ea, mem, an)
1103 :     else binaryMem(ty, binary, x, ea, mem, an)
1104 :     else default()
1105 :     else default()
1106 : jhr 4290 fun unary(t,unOp, ea') =
1107 : mrainey 2619 if t = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1108 :     unaryMem(ty, unOp, ea, mem, an)
1109 : jhr 4290 else default()
1110 : mrainey 2619 fun binary(t,t',binOp,ea',x) =
1111 :     if t = ty andalso t' = ty andalso
1112 :     MLTreeUtils.eqRexp(ea, ea') then
1113 :     binaryMem(ty, binOp, x, ea, mem, an)
1114 :     else default()
1115 : jhr 4290 fun binaryCom1(t,unOp,binOp,x,y) =
1116 :     if t = ty then let
1117 :     fun again() = (case y
1118 : mrainey 2619 of T.LOAD(ty',ea',_) =>
1119 :     if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1120 :     if isOne x then unaryMem(ty, unOp, ea, mem, an)
1121 :     else binaryMem(ty, binOp,x,ea,mem,an)
1122 :     else default()
1123 :     | _ => default()
1124 :     (* end case *))
1125 : jhr 4290 in
1126 :     (case x
1127 :     of T.LOAD(ty',ea',_) => if ty' = ty
1128 : mrainey 2619 andalso MLTreeUtils.eqRexp(ea, ea') then
1129 :     if isOne y then unaryMem(ty, unOp, ea, mem, an)
1130 :     else binaryMem(ty, binOp,y,ea,mem,an)
1131 :     else again()
1132 :     | _ => again()
1133 :     (* end case *))
1134 : jhr 4290 end
1135 : mrainey 2619 else default()
1136 :     fun binaryCom(t,binOp,x,y) = if t = ty then
1137 : jhr 4290 let fun again() = (case y
1138 : mrainey 2619 of T.LOAD(ty',ea',_) =>
1139 :     if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1140 :     binaryMem(ty, binOp,x,ea,mem,an)
1141 :     else default()
1142 :     | _ => default()
1143 :     (* end case *))
1144 : jhr 4290 in
1145 :     (case x
1146 : mrainey 2619 of T.LOAD(ty',ea',_) =>
1147 :     if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1148 :     binaryMem(ty, binOp,y,ea,mem,an)
1149 :     else again()
1150 :     | _ => again()
1151 :     (* end case *))
1152 : jhr 4290 end
1153 : mrainey 2619 else default()
1154 :     in
1155 :     (case d
1156 :     of T.ADD(t,x,y) => binaryCom1(t,INC,ADD,x,y)
1157 :     | T.SUB(t,T.LOAD(t',ea',_),x) => binary1(t,t',DEC,SUB,ea',x)
1158 :     | T.ORB(t,x,y) => binaryCom(t,OR,x,y)
1159 :     | T.ANDB(t,x,y) => binaryCom(t,AND,x,y)
1160 :     | T.XORB(t,x,y) => binaryCom(t,XOR,x,y)
1161 :     | T.SLL(t,T.LOAD(t',ea',_),x) => binary(t,t',SHL,ea',x)
1162 :     | T.SRL(t,T.LOAD(t',ea',_),x) => binary(t,t',SHR,ea',x)
1163 :     | T.SRA(t,T.LOAD(t',ea',_),x) => binary(t,t',SAR,ea',x)
1164 :     | T.NEG(t,T.LOAD(t',ea',_)) => unary(t,NEG,ea')
1165 :     | T.NOTB (t, T.LOAD(t',ea',_)) => unary(t,NOT,ea')
1166 :     | _ => default ()
1167 :     (* end case *))
1168 :     end (* store *)
1169 :    
1170 : mrainey 2791 (* floating-point branch for
1171 :     * if (t1 fcc t2)
1172 :     * goto lab
1173 :     *)
1174 : mrainey 2619 and fbranch (fty, fcc, t1, t2, lab, an) = let
1175 :     fun j cc = mark (I.JCC {cond=cc, opnd=immedLabel lab}, an)
1176 :     in
1177 :     fbranch' (fty, fcc, t1, t2, j)
1178 :     end
1179 : jhr 4290
1180 : mrainey 2887 and fbranch' (fty, fcc, x, y, j) = let
1181 : mrainey 2619 fun branch fcc = (case fcc
1182 : mrainey 2829 of T.== => j I.EQ
1183 :     | T.?<> => (j I.P; j I.NE)
1184 : mrainey 2619 | T.? => j I.P
1185 :     | T.<=> => j I.NP
1186 : mrainey 2827 | T.> => j I.A
1187 : mrainey 2829 | T.?<= => (j I.P; j I.BE)
1188 : mrainey 2619 | T.>= => j I.AE
1189 : mrainey 2829 | T.?< => (j I.P; j I.BE)
1190 : mrainey 2827 | T.< => j I.B
1191 : mrainey 2829 | T.?>= => (j I.P; j I.AE)
1192 : mrainey 2619 | T.<= => j I.BE
1193 : mrainey 2829 | T.?> => (j I.P; j I.A)
1194 : mrainey 2619 | T.<> => j I.NE
1195 : mrainey 2836 | T.?= => j I.EQ
1196 : mrainey 2619 | _ => error(concat[
1197 :     "fbranch(", T.Basis.fcondToString fcc, ")"])
1198 : mrainey 2826 (* end case *))
1199 : mrainey 2791 (* compare for condition (x op y)
1200 : jhr 4290 *
1201 : mrainey 2791 * (y) (x)
1202 :     * ucomiss/d xmm1/m32, xmm2
1203 :     *)
1204 : mrainey 2619 fun compare () = let
1205 : mrainey 2927 val x = foperand (fty, x)
1206 :     val y = foperand (fty, y)
1207 : mrainey 2887 fun cmp (x, y, fcc) = (
1208 :     emit (I.FCOM {comOp=O.ucomOp fty, src=y, dst=x});
1209 : mrainey 2619 fcc)
1210 :     in
1211 : mrainey 2887 (case (x, y)
1212 :     of (I.FDirect xReg, I.FDirect _) => cmp (xReg, y, fcc)
1213 :     | (mem, I.FDirect yReg) =>
1214 :     cmp (yReg, x, T.Basis.swapFcond fcc)
1215 :     | (I.FDirect xReg, mem) => cmp (xReg, y, fcc)
1216 : mrainey 2619 | _ => let
1217 : mrainey 2887 val xReg = newFreg ()
1218 :     val xTmp = I.FDirect xReg
1219 : mrainey 2619 in
1220 : mrainey 2887 emit (I.FMOVE {fmvOp=O.fmovOp fty, src=x, dst=xTmp});
1221 :     cmp (xReg, y, fcc)
1222 : mrainey 2619 end
1223 : mrainey 2827 (* end case *))
1224 : mrainey 2619 end (* compare *)
1225 :     in
1226 :     branch (compare ())
1227 :     end (* fbranch' *)
1228 :    
1229 :     (* %eflags <- src *)
1230 :     and moveToEflags src =
1231 :     if CB.sameColor(src, C.eflags) then ()
1232 :     else (move(32, I.Direct (32,src), rax 32); emit(I.LAHF))
1233 : jhr 4290
1234 :     (* dst <- %eflags *)
1235 : mrainey 2619 and moveFromEflags dst =
1236 :     if CB.sameColor(dst, C.eflags) then ()
1237 :     else (emit(I.SAHF); move(32, rax 32, I.Direct (32,dst)))
1238 :    
1239 :     (* Emit a test.
1240 :     * The available modes are
1241 :     * r/m, r
1242 :     * r/m, imm
1243 : jhr 4290 * On selecting the right instruction: TESTQ/TESTL/TESTW/TESTB.
1244 : mrainey 2619 * When anding an operand with a constant
1245 :     * that fits within 8 (or 16) bits, it is possible to use TESTB,
1246 : jhr 4290 * (or TESTW) instead of TESTL. Because amd64 is little endian,
1247 : mrainey 2619 * this works for memory operands too. However, with TESTB, it is
1248 : jhr 4290 * not possible to use registers other than
1249 : mrainey 2619 * AL, CL, BL, DL, and AH, CH, BH, DH. So, the best way is to
1250 :     * perform register allocation first, and if the operand registers
1251 : jhr 4290 * are one of RAX, RCX, RBX, or RDX, replace the TESTL instruction
1252 : mrainey 2619 * by TESTB.
1253 :     *)
1254 : jhr 4290 and test(ty, testopcode, a, b, an) = let
1255 : mrainey 2619 val (_, opnd1, opnd2) = commuteComparison(ty, T.EQ, true, a, b)
1256 :     (* translate r, r/m => r/m, r *)
1257 : jhr 4290 val (opnd1, opnd2) =
1258 : mrainey 2619 if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)
1259 : jhr 4290 in
1260 : mrainey 2619 mark (testopcode {lsrc=opnd1, rsrc=opnd2}, an)
1261 :     end
1262 : jhr 4290
1263 : mrainey 2619 (* generate a real comparison; return the real cc used *)
1264 : jhr 4290 and genCmp(ty, swapable, cc, a, b, an) =
1265 : mrainey 2619 let val (cc, opnd1, opnd2) = commuteComparison(ty, cc, swapable, a, b)
1266 : jhr 4290 in
1267 :     (case ty
1268 : mrainey 2619 of 8 => mark(I.CMPB{lsrc=opnd1, rsrc=opnd2}, an)
1269 :     | 16 => mark(I.CMPW{lsrc=opnd1, rsrc=opnd2}, an)
1270 :     | 32 => mark(I.CMPL{lsrc=opnd1, rsrc=opnd2}, an)
1271 :     | 64 => mark(I.CMPQ{lsrc=opnd1, rsrc=opnd2}, an)
1272 :     (* esac *));
1273 : jhr 4290 cc
1274 : mrainey 2619 end
1275 :    
1276 :     (* Give a and b which are the operands to a comparison (or test)
1277 :     * Return the appropriate condition code and operands.
1278 :     * The available modes are:
1279 :     * r/m, imm
1280 :     * r/m, r
1281 :     * r, r/m
1282 :     *)
1283 : jhr 4290 and commuteComparison(ty, cc, swapable, a, b) = let
1284 : mrainey 2619 val (opnd1, opnd2) = (operand ty a, operand ty b)
1285 :     in (* Try to fold in the operands whenever possible *)
1286 : jhr 4290 (case (isImmediate opnd1, isImmediate opnd2)
1287 : mrainey 2619 of (true, true) => (cc, moveToReg (ty, opnd1), opnd2)
1288 : jhr 4290 | (true, false) =>
1289 : mrainey 2619 if swapable then (T.Basis.swapCond cc, opnd2, opnd1)
1290 :     else (cc, moveToReg (ty, opnd1), opnd2)
1291 :     | (false, true) => (cc, opnd1, opnd2)
1292 : jhr 4290 | (false, false) => (case (opnd1, opnd2)
1293 : mrainey 2619 of (_, I.Direct _) => (cc, opnd1, opnd2)
1294 :     | (I.Direct _, _) => (cc, opnd1, opnd2)
1295 :     | (_, _) => (cc, moveToReg (ty, opnd1), opnd2)
1296 :     (* end case *))
1297 :     (* end case *))
1298 :     end (* commuteComparison *)
1299 :    
1300 : jhr 4290 (* generate a condition code expression
1301 :     * The zero is for setting the condition code!
1302 : mrainey 2619 * I have no idea why this is used.
1303 :     *)
1304 :     and doCCexpr(T.CMP(ty, cc, t1, t2), dst, an) = (
1305 : jhr 4290 cmp(false, ty, cc, t1, t2, an);
1306 : mrainey 2619 moveFromEflags dst)
1307 : jhr 4290 | doCCexpr(T.CC(cond,rs), dst, an) =
1308 :     if CB.sameColor(rs,C.eflags) orelse CB.sameColor(dst,C.eflags)
1309 : mrainey 2619 then (moveToEflags rs; moveFromEflags dst)
1310 :     else move'(64, I.Direct (64,rs), I.Direct (64,dst), an)
1311 :     | doCCexpr(T.CCMARK(e,A.MARKREG f),dst,an) = (f dst; doCCexpr(e,dst,an))
1312 :     | doCCexpr(T.CCMARK(e,a), dst, an) = doCCexpr(e,dst,a::an)
1313 : jhr 4290 | doCCexpr(T.CCEXT e, cd, an) =
1314 :     ExtensionComp.compileCCext (reducer()) {e=e, ccd=cd, an=an}
1315 : mrainey 2619 | doCCexpr _ = error "doCCexpr"
1316 :    
1317 :     (* Compare an expression with zero.
1318 :     * On the amd64, TEST is superior to AND for doing the same thing,
1319 :     * since it doesn't need to write out the result in a register.
1320 :     *)
1321 : jhr 4290 and cmpWithZero(cc as (T.EQ | T.NE), e as T.ANDB(ty, a, b), an) =
1322 :     (case ty
1323 : mrainey 2631 of 8 => test(ty, I.TESTB, a, b, an)
1324 : mrainey 2619 | 16 => test(ty, I.TESTW, a, b, an)
1325 :     | 32 => test(ty, I.TESTL, a, b, an)
1326 :     | 64 => test(ty, I.TESTQ, a, b, an)
1327 : jhr 4290 | _ => expr (e, newReg(), an);
1328 :     cc)
1329 : mrainey 2619 | cmpWithZero(cc, e, an) = (expr (e, newReg(), an); cc)
1330 : jhr 4290
1331 : mrainey 2619 (* generate a comparison and sets the condition code;
1332 :     * return the actual cc used. If the flag swapable is true,
1333 : jhr 4290 * we can also reorder the operands.
1334 : mrainey 2619 *)
1335 : jhr 4290 and cmp (swapable, ty, cc, t1, t2, an) =
1336 : mrainey 2619 (* == and <> can be always be reordered *)
1337 :     let val swapable = swapable orelse cc = T.EQ orelse cc = T.NE
1338 :     in (* Sometimes the comparison is not necessary because
1339 : jhr 4290 * the bits are already set!
1340 : mrainey 2619 *)
1341 : jhr 4290 if isZero t1 andalso setZeroBit2 t2 then
1342 : mrainey 2619 if swapable then
1343 :     cmpWithZero(T.Basis.swapCond cc, t2, an)
1344 :     else (* can't reorder the comparison! *)
1345 :     genCmp(ty, false, cc, t1, t2, an)
1346 : jhr 4290 else if isZero t2 andalso setZeroBit2 t1 then
1347 : mrainey 2619 cmpWithZero(cc, t1, an)
1348 : jhr 4290 else genCmp(ty, swapable, cc, t1, t2, an)
1349 : mrainey 2619 end
1350 :    
1351 :     and branch (T.CMP(ty, cc, t1, t2), lab, an) = let
1352 : jhr 4290 val cc = cmp (true, ty, cc, t1, t2, [])
1353 :     in
1354 :     mark (I.JCC{cond=cond cc, opnd=immedLabel lab}, an)
1355 : mrainey 2619 end
1356 : jhr 4290 | branch (T.FCMP(fty, fcc, t1, t2), lab, an) =
1357 : mrainey 2619 fbranch (fty, fcc, t1, t2, lab, an)
1358 :     | branch (ccexp, lab, an) = (
1359 :     doCCexpr(ccexp, C.eflags, []);
1360 :     mark(I.JCC{cond=cond(Gen.condOf ccexp), opnd=immedLabel lab}, an))
1361 :    
1362 :     and stmt' (s, an) = (case s
1363 :     of T.MV (ty, d, e) => expr' (ty, e, d, an)
1364 :     | T.FMV (fty, d, e) => fexpr (fty, d, e, an)
1365 : mrainey 2791 | T.CCMV (ccd, e) => doCCexpr (e, ccd, an)
1366 : mrainey 2619 | T.COPY (ty, dst, src) => copy (ty, dst, src, an)
1367 :     | T.FCOPY (fty, dst, src) => fcopy (fty, dst, src, an)
1368 :     | T.JMP (e, labs) => jmp (e, labs, an)
1369 :     | T.CALL {funct, targets, defs, uses, region, pops, ...} =>
1370 :     call (funct, targets, defs, uses, region, [], an, pops)
1371 :     | T.FLOW_TO(T.CALL{funct, targets, defs, uses, region, pops, ...},
1372 :     cutTo) =>
1373 :     call (funct, targets, defs, uses, region, cutTo, an, pops)
1374 :     | T.RET _ => mark (I.RET NONE, an)
1375 : jhr 4290 | T.STORE (ty, ea, d, mem) =>
1376 : mrainey 2619 store (ty, ea, d, mem, O.opcodes ty, doStore ty, an)
1377 :     | T.FSTORE (fty, ea, e, mem) => fstore (fty, ea, mem, e, an)
1378 :     | T.BCC(cc, lab) => branch (cc, lab, an)
1379 :     | T.DEFINE l => defineLabel l
1380 :     | T.LIVE s => mark' (I.LIVE{regs=cellset s,spilled=C.empty},an)
1381 :     | T.KILL s => mark' (I.KILL{regs=cellset s,spilled=C.empty},an)
1382 : jhr 4290 | T.ANNOTATION(s, a) => stmt' (s, a::an)
1383 : mrainey 2619 | T.EXT s =>
1384 : jhr 4290 ExtensionComp.compileSext (reducer ()) {stm=s, an=an}
1385 : mrainey 2619 | s => app stmt (Gen.compileStm s)
1386 :     (* end case *))
1387 : jhr 4290 and stmt s = stmt' (s, [])
1388 : mrainey 2619
1389 : jhr 2772 and beginCluster' _ = (
1390 : mrainey 2619 trapLabel := NONE;
1391 :     beginCluster 0)
1392 : jhr 2772
1393 :     and endCluster' a = (
1394 : mrainey 2619 (case !trapLabel
1395 :     of NONE => ()
1396 :     | SOME(_, lab) => (defineLabel lab; emit I.INTO)
1397 :     (* end case *));
1398 :     (* If floating point has been used allocate an extra
1399 :     * register just in case we didn't use any explicit register *)
1400 : mrainey 2826 ignore (newFreg ());
1401 : mrainey 2619 endCluster a)
1402 :    
1403 : jhr 2772 and ccExpr e = error "ccExpr"
1404 :    
1405 :     and reduceOpnd (I.Direct(ty, r)) = r
1406 :     | reduceOpnd opnd = let
1407 :     val dst = newReg()
1408 :     in
1409 :     move(64, opnd, I.Direct(64, dst)); dst
1410 :     end
1411 :    
1412 :     and reducer () = TS.REDUCER{
1413 : mrainey 2791 reduceRexp = genExpr,
1414 :     reduceFexp = fn e => fexpToReg (64, e),
1415 : jhr 2772 reduceCCexp = ccExpr,
1416 :     reduceStm = stmt',
1417 :     operand = operand 64,
1418 :     reduceOperand = reduceOpnd,
1419 :     addressOf = fn e => address(e, I.Region.memory), (*XXX*)
1420 :     emit = mark',
1421 : jhr 4290 instrStream = instrStream,
1422 : jhr 2772 mltreeStream = self()
1423 :     }
1424 :    
1425 :     and self () = TS.S.STREAM {
1426 : mrainey 2619 beginCluster=beginCluster',
1427 :     endCluster=endCluster',
1428 :     emit=stmt,
1429 :     pseudoOp=pseudoOp,
1430 :     defineLabel=defineLabel,
1431 :     entryLabel=entryLabel,
1432 :     comment=comment,
1433 :     annotation=annotation,
1434 :     getAnnotations=getAnnotations,
1435 :     exitBlock=exitBlock o cellset}
1436 :     in
1437 :     self ()
1438 :     end (* selectInstructions *)
1439 :    
1440 : mrainey 2769 end (* AMD64Gen *)

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