Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/MLRISC/x86/mltree/x86.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 545, Thu Feb 24 13:56:44 2000 UTC revision 1156, Thu Mar 21 22:01:11 2002 UTC
# Line 1  Line 1 
1  (* X86.sml -- pattern matching version of x86 instruction set generation.  (* x86.sml
2   *   *
3   * COPYRIGHT (c) 1998 Bell Laboratories.   * COPYRIGHT (c) 1998 Bell Laboratories.
4   *   *
# Line 22  Line 22 
22   *  5.  Generate testl/testb instead of andl whenever appropriate.  This   *  5.  Generate testl/testb instead of andl whenever appropriate.  This
23   *      is recommended by the Intel Optimization Guide and seems to improve   *      is recommended by the Intel Optimization Guide and seems to improve
24   *      boxity tests on SML/NJ.   *      boxity tests on SML/NJ.
25     *
26     * More changes for floating point:
27     *  A new mode is implemented which generates pseudo 3-address instructions
28     * for floating point.  These instructions are register allocated the
29     * normal way, with the virtual registers mapped onto a set of pseudo
30     * %fp registers.  These registers are then mapped onto the %st registers
31     * with a new postprocessing phase.
32     *
33   * -- Allen   * -- Allen
34   *)   *)
35  local  local
36     val rewriteMemReg = true (* should we rewrite memRegs *)     val rewriteMemReg = true (* should we rewrite memRegs *)
37       val enableFastFPMode = true (* set this to false to disable the mode *)
38  in  in
39    
40  functor X86  functor X86
41    (structure X86Instr : X86INSTR    (structure X86Instr : X86INSTR
42     structure X86MLTree : MLTREE     structure MLTreeUtils : MLTREE_UTILS
43    (* structure PseudoInstrs : X86_PSEUDO_INSTR *)                          where T = X86Instr.T
44       sharing X86MLTree.Region = X86Instr.Region     structure ExtensionComp : MLTREE_EXTENSION_COMP
45       sharing X86MLTree.LabelExp = X86Instr.LabelExp                          where I = X86Instr and T = X86Instr.T
46       (* sharing PseudoInstrs.I = X86Instr     structure MLTreeStream : MLTREE_STREAM
47       sharing PseudoInstrs.T = X86MLTree *)                          where T = ExtensionComp.T
48      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII
49      val arch : arch ref      val arch : arch ref
50      val tempMem : X86Instr.operand (* temporary for CVTI2F *)      val cvti2f :
51      (* val memRegsUsed : word ref *)    (* bit mask of memRegs used *)           {ty: X86Instr.T.ty,
52              src: X86Instr.operand,
53                 (* source operand, guaranteed to be non-memory! *)
54              an: Annotations.annotations ref (* cluster annotations *)
55             } ->
56             {instrs : X86Instr.instruction list,(* the instructions *)
57              tempMem: X86Instr.operand,         (* temporary for CVTI2F *)
58              cleanup: X86Instr.instruction list (* cleanup code *)
59             }
60        (* When the following flag is set, we allocate floating point registers
61         * directly on the floating point stack
62         *)
63        val fast_floating_point : bool ref
64    ) : sig include MLTREECOMP    ) : sig include MLTREECOMP
65            val rewriteMemReg : bool            val rewriteMemReg : bool
66        end =        end =
67  struct  struct
   structure T = X86MLTree  
   structure S = T.Stream  
68    structure I = X86Instr    structure I = X86Instr
69      structure T = I.T
70      structure TS = ExtensionComp.TS
71    structure C = I.C    structure C = I.C
72    structure Shuffle = Shuffle(I)    structure Shuffle = Shuffle(I)
73    structure W32 = Word32    structure W32 = Word32
   structure LE = I.LabelExp  
74    structure A = MLRiscAnnotations    structure A = MLRiscAnnotations
75      structure CFG = ExtensionComp.CFG
76      structure CB = CellsBasis
77    
78      type instrStream = (I.instruction,C.cellset,CFG.cfg) TS.stream
79      type mltreeStream = (T.stm,T.mlrisc list,CFG.cfg) TS.stream
80    
81    type instrStream = (I.instruction,C.regmap,C.cellset) T.stream    datatype kind = REAL | INTEGER
   type ('s,'r,'f,'c) mltreeStream =  
      (('s,'r,'f,'c) T.stm,C.regmap,('s,'r,'f,'c) T.mlrisc list) T.stream  
   type ('s,'r,'f,'c) reducer =  
      (I.instruction,C.regmap,C.cellset,I.operand,I.addressing_mode,'s,'r,'f,'c)  
        T.reducer  
   type ('s,'r,'f,'c) extender =  
      (I.instruction,C.regmap,C.cellset,I.operand,I.addressing_mode,'s,'r,'f,'c)  
        T.extender  
82    
83    structure Gen = MLTreeGen    structure Gen = MLTreeGen
84       (structure T = T       (structure T = T
85          structure Cells = C
86        val intTy = 32        val intTy = 32
87        val naturalWidths = [32]        val naturalWidths = [32]
88        datatype rep = SE | ZE | NEITHER        datatype rep = SE | ZE | NEITHER
# Line 77  Line 95 
95     * If this is on, we can avoid doing RewritePseudo phase entirely.     * If this is on, we can avoid doing RewritePseudo phase entirely.
96     *)     *)
97    val rewriteMemReg = rewriteMemReg    val rewriteMemReg = rewriteMemReg
98    fun isMemReg r = rewriteMemReg andalso r >= 8 andalso r < 32  
99      (* The following hardcoded *)
100      fun isMemReg r = rewriteMemReg andalso
101                       let val r = CB.registerNum r
102                       in  r >= 8 andalso r < 32
103                       end
104      fun isFMemReg r = if enableFastFPMode andalso !fast_floating_point
105                        then let val r = CB.registerNum r
106                             in r >= 8 andalso r < 32 end
107                        else true
108      val isAnyFMemReg = List.exists (fn r =>
109                                      let val r = CB.registerNum r
110                                      in  r >= 8 andalso r < 32 end
111                                     )
112    
113      val ST0 = C.ST 0
114      val ST7 = C.ST 7
115      val one = T.I.int_1
116    
117      val opcodes8 = {INC=I.INCB,DEC=I.DECB,ADD=I.ADDB,SUB=I.SUBB,
118                      NOT=I.NOTB,NEG=I.NEGB,
119                      SHL=I.SHLB,SHR=I.SHRB,SAR=I.SARB,
120                      OR=I.ORB,AND=I.ANDB,XOR=I.XORB}
121      val opcodes16 = {INC=I.INCW,DEC=I.DECW,ADD=I.ADDW,SUB=I.SUBW,
122                       NOT=I.NOTW,NEG=I.NEGW,
123                       SHL=I.SHLW,SHR=I.SHRW,SAR=I.SARW,
124                       OR=I.ORW,AND=I.ANDW,XOR=I.XORW}
125      val opcodes32 = {INC=I.INCL,DEC=I.DECL,ADD=I.ADDL,SUB=I.SUBL,
126                       NOT=I.NOTL,NEG=I.NEGL,
127                       SHL=I.SHLL,SHR=I.SHRL,SAR=I.SARL,
128                       OR=I.ORL,AND=I.ANDL,XOR=I.XORL}
129    
130    (*    (*
131     * The code generator     * The code generator
132     *)     *)
133    fun selectInstructions    fun selectInstructions
        (T.EXTENDER{compileStm,compileRexp,compileFexp,compileCCexp,...})  
134         (instrStream as         (instrStream as
135          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,          TS.S.STREAM{emit=emitInstruction,defineLabel,entryLabel,pseudoOp,
136                   beginCluster,endCluster,exitBlock,alias,phi,comment,...}) =                      annotation,getAnnotations,beginCluster,endCluster,exitBlock,comment,...}) =
137    let exception EA    let
138          val emit = emitInstruction o I.INSTR
139          exception EA
140    
141        (* label where a trap is generated -- one per cluster *)        (* label where a trap is generated -- one per cluster *)
142        val trapLabel = ref (NONE: (I.instruction * Label.label) option)        val trapLabel = ref (NONE: (I.instruction * Label.label) option)
143    
144          (* flag floating point generation *)
145          val floatingPointUsed = ref false
146    
147        (* effective address of an integer register *)        (* effective address of an integer register *)
148        fun IntReg r = if isMemReg r then MemReg r else I.Direct r        fun IntReg r = if isMemReg r then I.MemReg r else I.Direct r
149        and MemReg r =        and RealReg r = if isFMemReg r then I.FDirect r else I.FPR r
           ((* memRegsUsed := Word.orb(!memRegsUsed,  
                             Word.<<(0w1, Word.fromInt r-0w8)); *)  
            I.MemReg r  
           )  
150    
151        (* Add an overflow trap *)        (* Add an overflow trap *)
152        fun trap() =        fun trap() =
153        let val jmp =        let
154              val jmp =
155              case !trapLabel of              case !trapLabel of
156                NONE => let val label = Label.newLabel "trap"                NONE => let val label = Label.label "trap" ()
157                            val jmp   = I.JCC{cond=I.O,                            val jmp   =
158                                              opnd=I.ImmedLabel(LE.LABEL label)}                                I.ANNOTATION{i=I.jcc{cond=I.O,
159                                                       opnd=I.ImmedLabel(T.LABEL label)},
160                                               a=MLRiscAnnotations.BRANCHPROB (Probability.unlikely)}
161                        in  trapLabel := SOME(jmp, label); jmp end                        in  trapLabel := SOME(jmp, label); jmp end
162              | SOME(jmp, _) => jmp              | SOME(jmp, _) => jmp
163        in  emit jmp end        in  emitInstruction jmp end
164    
165        val newReg  = C.newReg        val newReg  = C.newReg
166        val newFreg = C.newFreg        val newFreg = C.newFreg
167    
168          fun fsize 32 = I.FP32
169            | fsize 64 = I.FP64
170            | fsize 80 = I.FP80
171            | fsize _  = error "fsize"
172    
173        (* mark an expression with a list of annotations *)        (* mark an expression with a list of annotations *)
174        fun mark'(i,[]) = i        fun mark'(i,[]) = emitInstruction(i)
175          | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)          | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)
176    
177        (* annotate an expression and emit it *)        (* annotate an expression and emit it *)
178        fun mark(i,an) = emit(mark'(i,an))        fun mark(i,an) = mark'(I.INSTR i,an)
179    
180          val emits = app emitInstruction
181    
182        (* emit parallel copies for integers        (* emit parallel copies for integers
183         * Translates parallel copies that involve memregs into         * Translates parallel copies that involve memregs into
# Line 128  Line 186 
186        fun copy([], [], an) = ()        fun copy([], [], an) = ()
187          | copy(dst, src, an) =          | copy(dst, src, an) =
188            let fun mvInstr{dst as I.MemReg rd, src as I.MemReg rs} =            let fun mvInstr{dst as I.MemReg rd, src as I.MemReg rs} =
189                    if rd = rs then [] else                    if CB.sameColor(rd,rs) then [] else
190                    let val tmpR = I.Direct(newReg())                    let val tmpR = I.Direct(newReg())
191                    in  [I.MOVE{mvOp=I.MOVL, src=src, dst=tmpR},                    in  [I.move{mvOp=I.MOVL, src=src, dst=tmpR},
192                         I.MOVE{mvOp=I.MOVL, src=tmpR, dst=dst}]                         I.move{mvOp=I.MOVL, src=tmpR, dst=dst}]
193                    end                    end
194                  | mvInstr{dst=I.Direct rd, src=I.Direct rs} =                  | mvInstr{dst=I.Direct rd, src=I.Direct rs} =
195                      if rd = rs then []                      if CB.sameColor(rd,rs) then []
196                      else [I.COPY{dst=[rd], src=[rs], tmp=NONE}]                      else [I.COPY{k=CB.GP, sz=32, dst=[rd], src=[rs], tmp=NONE}]
197                  | mvInstr{dst, src} = [I.MOVE{mvOp=I.MOVL, src=src, dst=dst}]                  | mvInstr{dst, src} = [I.move{mvOp=I.MOVL, src=src, dst=dst}]
198            in            in
199               app emit (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}               emits (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}
200                 {regmap=fn r => r, tmp=SOME(I.Direct(newReg())),                 {tmp=SOME(I.Direct(newReg())),
201                  dst=dst, src=src})                  dst=dst, src=src})
202            end            end
203    
204        (* conversions *)        (* conversions *)
205        val itow = Word.fromInt        val itow = Word.fromInt
206        val wtoi = Word.toInt        val wtoi = Word.toInt
207        fun toInt32 i = Int32.fromLarge(Int.toLarge i)        fun toInt32 i = T.I.toInt32(32, i)
208        val w32toi32 = Word32.toLargeIntX        val w32toi32 = Word32.toLargeIntX
209        val i32tow32 = Word32.fromLargeInt        val i32tow32 = Word32.fromLargeInt
210    
# Line 158  Line 216 
216        val ecx = I.Direct(C.ecx)        val ecx = I.Direct(C.ecx)
217        val edx = I.Direct(C.edx)        val edx = I.Direct(C.edx)
218    
219        fun immedLabel lab = I.ImmedLabel(LE.LABEL lab)        fun immedLabel lab = I.ImmedLabel(T.LABEL lab)
220    
221        (* Is the expression zero? *)        (* Is the expression zero? *)
222        fun isZero(T.LI 0) = true        fun isZero(T.LI z) = T.I.isZero z
         | isZero(T.LI32 0w0) = true  
223          | isZero(T.MARK(e,a)) = isZero e          | isZero(T.MARK(e,a)) = isZero e
224          | isZero _ = false          | isZero _ = false
225         (* Does the expression set the zero bit?         (* Does the expression set the zero bit?
# Line 174  Line 231 
231          | setZeroBit(T.SRA _)      = true          | setZeroBit(T.SRA _)      = true
232          | setZeroBit(T.SRL _)      = true          | setZeroBit(T.SRL _)      = true
233          | setZeroBit(T.SLL _)      = true          | setZeroBit(T.SLL _)      = true
234            | setZeroBit(T.SUB _)      = true
235            | setZeroBit(T.ADDT _)     = true
236            | setZeroBit(T.SUBT _)     = true
237          | setZeroBit(T.MARK(e, _)) = setZeroBit e          | setZeroBit(T.MARK(e, _)) = setZeroBit e
238          | setZeroBit _             = false          | setZeroBit _             = false
239    
240        (* emit parallel copies for floating point *)        fun setZeroBit2(T.ANDB _)     = true
241        fun fcopy(fty, [], [], _) = ()          | setZeroBit2(T.ORB _)      = true
242          | fcopy(fty, dst as [_], src as [_], an) =          | setZeroBit2(T.XORB _)     = true
243              mark(I.FCOPY{dst=dst,src=src,tmp=NONE}, an)          | setZeroBit2(T.SRA _)      = true
244          | fcopy(fty, dst, src, an) =          | setZeroBit2(T.SRL _)      = true
245              mark(I.FCOPY{dst=dst,src=src,tmp=SOME(I.FDirect(newFreg()))}, an)          | setZeroBit2(T.SLL _)      = true
246            | setZeroBit2(T.ADD(32, _, _)) = true (* can't use leal! *)
247            | setZeroBit2(T.SUB _)      = true
248            | setZeroBit2(T.ADDT _)     = true
249            | setZeroBit2(T.SUBT _)     = true
250            | setZeroBit2(T.MARK(e, _)) = setZeroBit2 e
251            | setZeroBit2 _             = false
252    
253          (* emit parallel copies for floating point
254           * Normal version.
255           *)
256          fun fcopy'(fty, [], [], _) = ()
257            | fcopy'(fty, dst as [_], src as [_], an) =
258                mark'(I.COPY{k=CB.FP, sz=fty, dst=dst,src=src,tmp=NONE}, an)
259            | fcopy'(fty, dst, src, an) =
260                mark'(I.COPY{k=CB.FP, sz=fty, dst=dst,src=src,tmp=SOME(I.FDirect(newFreg()))}, an)
261    
262          (* emit parallel copies for floating point.
263           * Fast version.
264           * Translates parallel copies that involve memregs into
265           * individual copies.
266           *)
267    
268          fun fcopy''(fty, [], [], _) = ()
269            | fcopy''(fty, dst, src, an) =
270              if true orelse isAnyFMemReg dst orelse isAnyFMemReg src then
271              let val fsize = fsize fty
272                  fun mvInstr{dst, src} = [I.fmove{fsize=fsize, src=src, dst=dst}]
273              in
274                  emits (Shuffle.shuffle{mvInstr=mvInstr, ea=RealReg}
275                    {tmp=case dst of
276                           [_] => NONE
277                         |  _  => SOME(I.FPR(newReg())),
278                     dst=dst, src=src})
279              end
280              else
281                mark'(I.COPY{k=CB.FP, sz=fty, dst=dst,
282                            src=src,tmp=
283                             case dst of
284                               [_] => NONE
285                             | _   => SOME(I.FPR(newFreg()))}, an)
286    
287          fun fcopy x = if enableFastFPMode andalso !fast_floating_point
288                        then fcopy'' x else fcopy' x
289    
290        (* Translates MLTREE condition code to x86 condition code *)        (* Translates MLTREE condition code to x86 condition code *)
291        fun cond T.LT = I.LT | cond T.LTU = I.B        fun cond T.LT = I.LT | cond T.LTU = I.B
# Line 190  Line 293 
293          | cond T.EQ = I.EQ | cond T.NE  = I.NE          | cond T.EQ = I.EQ | cond T.NE  = I.NE
294          | cond T.GE = I.GE | cond T.GEU = I.AE          | cond T.GE = I.GE | cond T.GEU = I.AE
295          | cond T.GT = I.GT | cond T.GTU = I.A          | cond T.GT = I.GT | cond T.GTU = I.A
296            | cond cc = error(concat["cond(", T.Basis.condToString cc, ")"])
297    
298          fun zero dst = emit(I.BINARY{binOp=I.XORL, src=dst, dst=dst})
299    
300        (* Move and annotate *)        (* Move and annotate *)
301        fun move'(src as I.Direct s, dst as I.Direct d, an) =        fun move'(src as I.Direct s, dst as I.Direct d, an) =
302            if s=d then ()            if CB.sameColor(s,d) then ()
303            else mark(I.COPY{dst=[d], src=[s], tmp=NONE}, an)            else mark'(I.COPY{k=CB.GP, sz=32, dst=[d], src=[s], tmp=NONE}, an)
304            | move'(I.Immed 0, dst as I.Direct d, an) =
305                mark(I.BINARY{binOp=I.XORL, src=dst, dst=dst}, an)
306          | move'(src, dst, an) = mark(I.MOVE{mvOp=I.MOVL, src=src, dst=dst}, an)          | move'(src, dst, an) = mark(I.MOVE{mvOp=I.MOVL, src=src, dst=dst}, an)
307    
308        (* Move only! *)        (* Move only! *)
309        fun move(src, dst) = move'(src, dst, [])        fun move(src, dst) = move'(src, dst, [])
310    
       fun zero dst = emit(I.BINARY{binOp=I.XORL, src=dst, dst=dst})  
   
311        val readonly = I.Region.readonly        val readonly = I.Region.readonly
312    
313        (*        (*
314         * Compute an effective address.  This is a new version         * Compute an effective address.
315         *)         *)
316        fun address(ea, mem) =        fun address(ea, mem) = let
       let (* tricky way to negate without overflow! *)  
           fun neg32 w = Word32.notb w + 0w1  
   
317            (* Keep building a bigger and bigger effective address expressions            (* Keep building a bigger and bigger effective address expressions
318             * The input is a list of trees             * The input is a list of trees
319             * b -- base             * b -- base
# Line 221  Line 324 
324            fun doEA([], b, i, s, d) = makeAddressingMode(b, i, s, d)            fun doEA([], b, i, s, d) = makeAddressingMode(b, i, s, d)
325              | doEA(t::trees, b, i, s, d) =              | doEA(t::trees, b, i, s, d) =
326                (case t of                (case t of
327                   T.LI n   => doEAImmed(trees, n, b, i, s, d)                   T.LI n   => doEAImmed(trees, toInt32 n, b, i, s, d)
328                 | T.LI32 n => doEAImmedw(trees, n, b, i, s, d)                 | T.CONST _ => doEALabel(trees, t, b, i, s, d)
329                 | T.CONST c => doEALabel(trees, LE.CONST c, b, i, s, d)                 | T.LABEL _ => doEALabel(trees, t, b, i, s, d)
330                 | T.LABEL le => doEALabel(trees, le, b, i, s, d)                 | T.LABEXP le => doEALabel(trees, le, b, i, s, d)
331                 | T.ADD(32, t1, t2 as T.REG(_,r)) =>                 | T.ADD(32, t1, t2 as T.REG(_,r)) =>
332                      if isMemReg r then doEA(t2::t1::trees, b, i, s, d)                      if isMemReg r then doEA(t2::t1::trees, b, i, s, d)
333                      else doEA(t1::t2::trees, b, i, s, d)                      else doEA(t1::t2::trees, b, i, s, d)
334                 | T.ADD(32, t1, t2) => doEA(t1::t2::trees, b, i, s, d)                 | T.ADD(32, t1, t2) => doEA(t1::t2::trees, b, i, s, d)
335                 | T.SUB(32, t1, T.LI n) =>                 | T.SUB(32, t1, T.LI n) =>
336                      (* can't overflow here *)                      doEA(t1::T.LI(T.I.NEG(32,n))::trees, b, i, s, d)
337                      doEA(t1::T.LI32(neg32(Word32.fromInt n))::trees, b, i, s, d)                 | T.SLL(32, t1, T.LI n) => let
338                 | T.SUB(32, t1, T.LI32 n) =>                      val n = T.I.toInt(32, n)
339                      doEA(t1::T.LI32(neg32 n)::trees, b, i, s, d)                   in
340                 | T.SLL(32, t1, T.LI 0) => displace(trees, t1, b, i, s, d)                     case n
341                 | T.SLL(32, t1, T.LI 1) => indexed(trees, t1, t, 1, b, i, s, d)                     of 0 => displace(trees, t1, b, i, s, d)
342                 | T.SLL(32, t1, T.LI 2) => indexed(trees, t1, t, 2, b, i, s, d)                      | 1 => indexed(trees, t1, t, 1, b, i, s, d)
343                 | T.SLL(32, t1, T.LI 3) => indexed(trees, t1, t, 3, b, i, s, d)                      | 2 => indexed(trees, t1, t, 2, b, i, s, d)
344                 | T.SLL(32, t1, T.LI32 0w0) => displace(trees, t1, b, i, s, d)                      | 3 => indexed(trees, t1, t, 3, b, i, s, d)
345                 | T.SLL(32, t1, T.LI32 0w1) => indexed(trees,t1,t,1,b,i,s,d)                      | _ => displace(trees, t, b, i, s, d)
346                 | T.SLL(32, t1, T.LI32 0w2) => indexed(trees,t1,t,2,b,i,s,d)                   end
                | T.SLL(32, t1, T.LI32 0w3) => indexed(trees,t1,t,3,b,i,s,d)  
347                 | t => displace(trees, t, b, i, s, d)                 | t => displace(trees, t, b, i, s, d)
348                )                )
349    
350            (* Add an immed constant *)            (* Add an immed constant *)
351            and doEAImmed(trees, 0, b, i, s, d) = doEA(trees, b, i, s, d)            and doEAImmed(trees, 0, b, i, s, d) = doEA(trees, b, i, s, d)
352              | doEAImmed(trees, n, b, i, s, I.Immed m) =              | doEAImmed(trees, n, b, i, s, I.Immed m) =
353                   doEA(trees, b, i, s, (* no overflow! *)                   doEA(trees, b, i, s, I.Immed(n+m))
                        I.Immed(w32toi32(Word32.fromInt n + i32tow32 m)))  
354              | doEAImmed(trees, n, b, i, s, I.ImmedLabel le) =              | doEAImmed(trees, n, b, i, s, I.ImmedLabel le) =
                  doEA(trees, b, i, s, I.ImmedLabel(LE.PLUS(le,LE.INT n)))  
             | doEAImmed(trees, n, b, i, s, _) = error "doEAImmed"  
   
           (* Add an immed32 constant *)  
           and doEAImmedw(trees, 0w0, b, i, s, d) = doEA(trees, b, i, s, d)  
             | doEAImmedw(trees, n, b, i, s, I.Immed m) =  
                  (* no overflow! *)  
                  doEA(trees, b, i, s, I.Immed(w32toi32(i32tow32 m + n)))  
             | doEAImmedw(trees, n, b, i, s, I.ImmedLabel le) =  
355                   doEA(trees, b, i, s,                   doEA(trees, b, i, s,
356                        I.ImmedLabel(LE.PLUS(le,LE.INT(Word32.toIntX n)))                        I.ImmedLabel(T.ADD(32,le,T.LI(T.I.fromInt32(32, n)))))
357                        handle Overflow => error "doEAImmedw: constant too large")              | doEAImmed(trees, n, b, i, s, _) = error "doEAImmed"
             | doEAImmedw(trees, n, b, i, s, _) = error "doEAImmedw"  
358    
359            (* Add a label expression *)            (* Add a label expression *)
360            and doEALabel(trees, le, b, i, s, I.Immed 0) =            and doEALabel(trees, le, b, i, s, I.Immed 0) =
361                   doEA(trees, b, i, s, I.ImmedLabel le)                   doEA(trees, b, i, s, I.ImmedLabel le)
362              | doEALabel(trees, le, b, i, s, I.Immed m) =              | doEALabel(trees, le, b, i, s, I.Immed m) =
363                   doEA(trees, b, i, s,                   doEA(trees, b, i, s,
364                        I.ImmedLabel(LE.PLUS(le,LE.INT(Int32.toInt m)))                        I.ImmedLabel(T.ADD(32,le,T.LI(T.I.fromInt32(32, m))))
365                        handle Overflow => error "doEALabel: constant too large")                        handle Overflow => error "doEALabel: constant too large")
366              | doEALabel(trees, le, b, i, s, I.ImmedLabel le') =              | doEALabel(trees, le, b, i, s, I.ImmedLabel le') =
367                   doEA(trees, b, i, s, I.ImmedLabel(LE.PLUS(le,le')))                   doEA(trees, b, i, s, I.ImmedLabel(T.ADD(32,le,le')))
368              | doEALabel(trees, le, b, i, s, _) = error "doEALabel"              | doEALabel(trees, le, b, i, s, _) = error "doEALabel"
369    
370            and makeAddressingMode(NONE, NONE, _, disp) = disp            and makeAddressingMode(NONE, NONE, _, disp) = disp
# Line 286  Line 377 
377            (* generate code for tree and ensure that it is not in %esp *)            (* generate code for tree and ensure that it is not in %esp *)
378            and exprNotEsp tree =            and exprNotEsp tree =
379                let val r = expr tree                let val r = expr tree
380                in  if r = C.esp then                in  if CB.sameColor(r, C.esp) then
381                       let val tmp = newReg()                       let val tmp = newReg()
382                       in  move(I.Direct r, I.Direct tmp); tmp end                       in  move(I.Direct r, I.Direct tmp); tmp end
383                    else r                    else r
# Line 298  Line 389 
389              | displace(trees, t, b as SOME base, NONE, _, d) = (* no index *)              | displace(trees, t, b as SOME base, NONE, _, d) = (* no index *)
390                (* make t the index, but make sure that it is not %esp! *)                (* make t the index, but make sure that it is not %esp! *)
391                let val i = expr t                let val i = expr t
392                in  if i = C.esp then                in  if CB.sameColor(i, C.esp) then
393                      (* swap base and index *)                      (* swap base and index *)
394                      if base <> C.esp then                      if CB.sameColor(base, C.esp) then
395                         doEA(trees, SOME i, b, 0, d)                         doEA(trees, SOME i, b, 0, d)
396                      else  (* base and index = %esp! *)                      else  (* base and index = %esp! *)
397                         let val index = newReg()                         let val index = newReg()
# Line 330  Line 421 
421        end (* address *)        end (* address *)
422    
423            (* reduce an expression into an operand *)            (* reduce an expression into an operand *)
424        and operand(T.LI i) = I.Immed(toInt32 i)        and operand(T.LI i) = I.Immed(toInt32(i))
425          | operand(T.LI32 w) = I.Immed(wToInt32 w)          | operand(x as (T.CONST _ | T.LABEL _)) = I.ImmedLabel x
426          | operand(T.CONST c) = I.ImmedLabel(LE.CONST c)          | operand(T.LABEXP le) = I.ImmedLabel le
         | operand(T.LABEL lab) = I.ImmedLabel lab  
427          | operand(T.REG(_,r)) = IntReg r          | operand(T.REG(_,r)) = IntReg r
428          | operand(T.LOAD(32,ea,mem)) = address(ea, mem)          | operand(T.LOAD(32,ea,mem)) = address(ea, mem)
429          | operand(t) = I.Direct(expr t)          | operand(t) = I.Direct(expr t)
# Line 368  Line 458 
458            | I.Indexed _  => true            | I.Indexed _  => true
459            | I.MemReg _   => true            | I.MemReg _   => true
460            | I.LabelEA _  => true            | I.LabelEA _  => true
461              | I.FDirect f  => true
462            | _            => false            | _            => false
463            )            )
464    
# Line 375  Line 466 
466            * Compute an integer expression and put the result in            * Compute an integer expression and put the result in
467            * the destination register rd.            * the destination register rd.
468            *)            *)
469        and doExpr(exp, rd : I.C.cell, an) =        and doExpr(exp, rd : CB.cell, an) =
470            let val rdOpnd = IntReg rd            let val rdOpnd = IntReg rd
471    
472                fun equalRd(I.Direct r) = r = rd                fun equalRd(I.Direct r) = CB.sameColor(r, rd)
473                  | equalRd(I.MemReg r) = r = rd                  | equalRd(I.MemReg r) = CB.sameColor(r, rd)
474                  | equalRd _ = false                  | equalRd _ = false
475    
476                   (* Emit a binary operator.  If the destination is                   (* Emit a binary operator.  If the destination is
# Line 453  Line 544 
544                fun divrem(signed, overflow, e1, e2, resultReg) =                fun divrem(signed, overflow, e1, e2, resultReg) =
545                let val (opnd1, opnd2) = (operand e1, operand e2)                let val (opnd1, opnd2) = (operand e1, operand e2)
546                    val _ = move(opnd1, eax)                    val _ = move(opnd1, eax)
547                    val oper = if signed then (emit(I.CDQ); I.IDIV)                    val oper = if signed then (emit(I.CDQ); I.IDIVL1)
548                               else (zero edx; I.UDIV)                               else (zero edx; I.DIVL1)
549                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);
550                    move(resultReg, rdOpnd);                    move(resultReg, rdOpnd);
551                    if overflow then trap() else ()                    if overflow then trap() else ()
552                end                end
553    
554                    (* Optimize the special case for division *)                    (* Optimize the special case for division *)
555                fun divide(signed, overflow, e1, e2 as T.LI n) =                fun divide(signed, overflow, e1, e2 as T.LI n') = let
556                let fun isPowerOf2 w = Word.andb((w - 0w1), w) = 0w0                    val n = toInt32 n'
557                      val w = T.I.toWord32(32, n')
558                      fun isPowerOf2 w = W32.andb((w - 0w1), w) = 0w0
559                    fun log2 n =  (* n must be > 0!!! *)                    fun log2 n =  (* n must be > 0!!! *)
560                        let fun loop(0w1,pow) = pow                        let fun loop(0w1,pow) = pow
561                              | loop(w,pow) = loop(Word.>>(w, 0w1),pow+1)                              | loop(w,pow) = loop(W32.>>(w, 0w1),pow+1)
562                        in loop(n,0) end                        in loop(n,0) end
                   val w = Word.fromInt n  
563                in  if n > 1 andalso isPowerOf2 w then                in  if n > 1 andalso isPowerOf2 w then
564                       let val pow = T.LI(log2 w)                       let val pow = T.LI(T.I.fromInt(32,log2 w))
565                       in  if signed then                       in  if signed then
566                           (* signed; simulate round towards zero *)                           (* signed; simulate round towards zero *)
567                           let val label = Label.newLabel ""                           let val label = Label.anon()
568                               val reg1  = expr e1                               val reg1  = expr e1
569                               val opnd1 = I.Direct reg1                               val opnd1 = I.Direct reg1
570                           in  if setZeroBit e1 then ()                           in  if setZeroBit e1 then ()
# Line 482  Line 574 
574                                       I.UNARY{unOp=I.INCL, opnd=opnd1}                                       I.UNARY{unOp=I.INCL, opnd=opnd1}
575                                    else                                    else
576                                       I.BINARY{binOp=I.ADDL,                                       I.BINARY{binOp=I.ADDL,
577                                                src=I.Immed(toInt32 n - 1),                                                src=I.Immed(n - 1),
578                                                dst=opnd1});                                                dst=opnd1});
579                               defineLabel label;                               defineLabel label;
580                               shift(I.SARL, T.REG(32, reg1), pow)                               shift(I.SARL, T.REG(32, reg1), pow)
# Line 503  Line 595 
595                fun rem(signed, overflow, e1, e2) =                fun rem(signed, overflow, e1, e2) =
596                      divrem(signed, overflow, e1, e2, edx)                      divrem(signed, overflow, e1, e2, edx)
597    
598                      (* Makes sure the destination must be a register *)
599                  fun dstMustBeReg f =
600                      if isMemReg rd then
601                      let val tmpR = newReg()
602                          val tmp  = I.Direct(tmpR)
603                      in  f(tmpR, tmp); move(tmp, rdOpnd) end
604                      else f(rd, rdOpnd)
605    
606                    (* unsigned integer multiplication *)                    (* unsigned integer multiplication *)
607                fun uMultiply(e1, e2) =                fun uMultiply(e1, e2) =
608                    (* note e2 can never be (I.Direct edx) *)                    (* note e2 can never be (I.Direct edx) *)
609                    (move(operand e1, eax);                    (move(operand e1, eax);
610                     mark(I.MULTDIV{multDivOp=I.UMUL,                     mark(I.MULTDIV{multDivOp=I.MULL1,
611                                    src=regOrMem(operand e2)},an);                                    src=regOrMem(operand e2)},an);
612                     move(eax, rdOpnd)                     move(eax, rdOpnd)
613                    )                    )
# Line 516  Line 616 
616                     * The only forms that are allowed that also sets the                     * The only forms that are allowed that also sets the
617                     * OF and CF flags are:                     * OF and CF flags are:
618                     *                     *
619                       *          (dst)  (src1)  (src2)
620                     *      imul r32, r32/m32, imm8                     *      imul r32, r32/m32, imm8
621                       *          (dst)  (src)
622                     *      imul r32, imm8                     *      imul r32, imm8
623                     *      imul r32, imm32                     *      imul r32, imm32
624                       *      imul r32, r32/m32
625                       * Note: destination must be a register!
626                     *)                     *)
627                fun multiply(e1, e2) =                fun multiply(e1, e2) =
628                let fun doit(i1 as I.Immed _, i2 as I.Immed _, dstR, dst) =                dstMustBeReg(fn (rd, rdOpnd) =>
629                        (move(i1, dst);                let fun doit(i1 as I.Immed _, i2 as I.Immed _) =
630                         mark(I.MUL3{dst=dstR, src1=i2, src2=NONE},an))                        (move(i1, rdOpnd);
631                      | doit(rm, i2 as I.Immed _, dstR, dst) =                         mark(I.BINARY{binOp=I.IMULL, dst=rdOpnd, src=i2},an))
632                          doit(i2, rm, dstR, dst)                      | doit(rm, i2 as I.Immed _) = doit(i2, rm)
633                      | doit(imm as I.Immed(i), rm, dstR, dst) =                      | doit(imm as I.Immed(i), rm) =
634                         mark(I.MUL3{dst=dstR, src1=rm, src2=SOME i},an)                             mark(I.MUL3{dst=rd, src1=rm, src2=i},an)
635                      | doit(r1 as I.Direct _, r2 as I.Direct _, dstR, dst) =                      | doit(r1 as I.Direct _, r2 as I.Direct _) =
636                        (move(r1, dst);                        (move(r1, rdOpnd);
637                         mark(I.MUL3{dst=dstR, src1=r2, src2=NONE},an))                         mark(I.BINARY{binOp=I.IMULL, dst=rdOpnd, src=r2},an))
638                      | doit(r1 as I.Direct _, rm, dstR, dst) =                      | doit(r1 as I.Direct _, rm) =
639                        (move(r1, dst);                        (move(r1, rdOpnd);
640                         mark(I.MUL3{dst=dstR, src1=rm, src2=NONE},an))                         mark(I.BINARY{binOp=I.IMULL, dst=rdOpnd, src=rm},an))
641                      | doit(rm, r as I.Direct _, dstR, dst) =                      | doit(rm, r as I.Direct _) = doit(r, rm)
642                         doit(r, rm, dstR, dst)                      | doit(rm1, rm2) =
                     | doit(rm1, rm2, dstR, dst) =  
643                         if equalRd rm2 then                         if equalRd rm2 then
644                         let val tmpR = newReg()                         let val tmpR = newReg()
645                             val tmp  = I.Direct tmpR                             val tmp  = I.Direct tmpR
646                         in move(rm1, tmp);                         in move(rm1, tmp);
647                            mark(I.MUL3{dst=tmpR, src1=rm2, src2=NONE},an);                            mark(I.BINARY{binOp=I.IMULL, dst=tmp, src=rm2},an);
648                            move(tmp, dst)                            move(tmp, rdOpnd)
649                         end                         end
650                         else                         else
651                           (move(rm1, dst);                           (move(rm1, rdOpnd);
652                            mark(I.MUL3{dst=dstR, src1=rm2, src2=NONE},an)                            mark(I.BINARY{binOp=I.IMULL, dst=rdOpnd, src=rm2},an)
653                           )                           )
654                    val (opnd1, opnd2) = (operand e1, operand e2)                    val (opnd1, opnd2) = (operand e1, operand e2)
655                in  if isMemReg rd then (* destination must be a real reg *)                in  doit(opnd1, opnd2)
                   let val tmpR = newReg()  
                       val tmp  = I.Direct tmpR  
                   in  doit(opnd1, opnd2, tmpR, tmp);  
                       move(tmp, rdOpnd)  
                   end  
                   else  
                       doit(opnd1, opnd2, rd, rdOpnd)  
656                end                end
657                  )
                  (* Makes sure the destination must be a register *)  
               fun dstMustBeReg f =  
                   if isMemReg rd then  
                   let val tmpR = newReg()  
                       val tmp  = I.Direct(tmpR)  
                   in  f(tmpR, tmp); move(tmp, rdOpnd) end  
                   else f(rd, rdOpnd)  
658    
659                   (* Emit a load instruction; makes sure that the destination                   (* Emit a load instruction; makes sure that the destination
660                    * is a register                    * is a register
# Line 585  Line 674 
674    
675                   (* Generate setcc instruction:                   (* Generate setcc instruction:
676                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))
677                      * Bug, if eax is either t1 or t2 then problem will occur!!!
678                      * Note that we have to use eax as the destination of the
679                      * setcc because it only works on the registers
680                      * %al, %bl, %cl, %dl and %[abcd]h.  The last four registers
681                      * are inaccessible in 32 bit mode.
682                    *)                    *)
683                fun setcc(ty, cc, t1, t2, yes, no) =                fun setcc(ty, cc, t1, t2, yes, no) =
684                let val tmpR = newReg()                let val (cc, yes, no) =
685                    val tmp = I.Direct tmpR                           if yes > no then (cc, yes, no)
686                    (* We create a temporary here just in                           else (T.Basis.negateCond cc, no, yes)
                    * case t1 or t2 contains a use of rd.  
                    *)  
687                in  (* Clear the destination first.                in  (* Clear the destination first.
688                     * This this because stupid SETcc                     * This this because stupid SETcc
689                     * only writes to the low order                     * only writes to the low order
690                     * byte.  That's Intel architecture, folks.                     * byte.  That's Intel architecture, folks.
691                     *)                     *)
692                    zero tmp;                    case (yes, no, cc) of
693                    case (yes, no) of                      (1, 0, T.LT) =>
694                      (1, 0) => (* normal case *)                       let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
695                         in  move(tmp, rdOpnd);
696                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
697                         end
698                      | (1, 0, T.GT) =>
699                         let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
700                         in  emit(I.UNARY{unOp=I.NOTL,opnd=tmp});
701                             move(tmp, rdOpnd);
702                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
703                         end
704                      | (1, 0, _) => (* normal case *)
705                      let val cc = cmp(true, ty, cc, t1, t2, [])                      let val cc = cmp(true, ty, cc, t1, t2, [])
706                      in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end                      in  mark(I.SET{cond=cond cc, opnd=eax}, an);
707                    | (0, 1) => (* flip *)                          emit(I.BINARY{binOp=I.ANDL,src=I.Immed 255, dst=eax});
708                      let val cc = cmp(true, ty,                          move(eax, rdOpnd)
709                                       T.Basis.negateCond cc, t1, t2, [])                      end
710                      in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end                    | (C1, C2, _)  =>
                   | (C1, C2)  =>  
711                      (* general case;                      (* general case;
712                       * from the Intel optimization guide p3-5 *)                       * from the Intel optimization guide p3-5
713                      let val C1 = toInt32 C1                       *)
714                          val C2 = toInt32 C2                      let val _  = zero eax;
715                          val cc = cmp(true, ty, cc, t1, t2, [])                          val cc = cmp(true, ty, cc, t1, t2, [])
716                      in  emit(I.SET{cond=cond cc, opnd=tmp});                      in  case C1-C2 of
717                          case Int32.abs(C1-C2)-1 of                            D as (1 | 2 | 3 | 4 | 5 | 8 | 9) =>
718                            D as (1 | 2 | 4 | 8) =>                            let val (base,scale) =
719                            let val addr = I.Indexed{base=SOME tmpR,                                    case D of
720                                                     index=tmpR,                                      1 => (NONE, 0)
721                                                     scale=Int32.toInt D,                                    | 2 => (NONE, 1)
722                                                     disp=I.Immed(C1-C2),                                    | 3 => (SOME C.eax, 1)
723                                      | 4 => (NONE, 2)
724                                      | 5 => (SOME C.eax, 2)
725                                      | 8 => (NONE, 3)
726                                      | 9 => (SOME C.eax, 3)
727                                  val addr = I.Indexed{base=base,
728                                                       index=C.eax,
729                                                       scale=scale,
730                                                       disp=I.Immed C2,
731                                                     mem=readonly}                                                     mem=readonly}
732                            in  mark(I.LEA{r32=tmpR, addr=addr}, an) end                                val tmpR = newReg()
733                          | _ =>                                val tmp  = I.Direct tmpR
734                           (emit(I.UNARY{unOp=I.DECL, opnd=tmp});                            in  emit(I.SET{cond=cond cc, opnd=eax});
735                                  mark(I.LEA{r32=tmpR, addr=addr}, an);
736                                  move(tmp, rdOpnd)
737                              end
738                            | D =>
739                               (emit(I.SET{cond=cond(T.Basis.negateCond cc),
740                                           opnd=eax});
741                                emit(I.UNARY{unOp=I.DECL, opnd=eax});
742                            emit(I.BINARY{binOp=I.ANDL,                            emit(I.BINARY{binOp=I.ANDL,
743                                          src=I.Immed(C2-C1), dst=tmp});                                            src=I.Immed D, dst=eax});
744                            mark(I.BINARY{binOp=I.ADDL,                              if C2 = 0 then
745                                          src=I.Immed(Int32.min(C1,C2)),                                 move(eax, rdOpnd)
746                                          dst=tmp}, an)                              else
747                           )                                 let val tmpR = newReg()
748                      end;                                     val tmp  = I.Direct tmpR
749                                   in  mark(I.LEA{addr=
750                                             I.Displace{
751                                                 base=C.eax,
752                                                 disp=I.Immed C2,
753                                                 mem=readonly},
754                                                 r32=tmpR}, an);
755                    move(tmp, rdOpnd)                    move(tmp, rdOpnd)
756                                    end
757                               )
758                        end
759                end (* setcc *)                end (* setcc *)
760    
761                    (* Generate cmovcc instruction.                    (* Generate cmovcc instruction.
# Line 640  Line 765 
765                let fun genCmov(dstR, _) =                let fun genCmov(dstR, _) =
766                    let val _ = doExpr(no, dstR, []) (* false branch *)                    let val _ = doExpr(no, dstR, []) (* false branch *)
767                        val cc = cmp(true, ty, cc, t1, t2, [])  (* compare *)                        val cc = cmp(true, ty, cc, t1, t2, [])  (* compare *)
768                    in  mark(I.CMOV{cond=cond cc, src=operand yes, dst=dstR}, an)                    in  mark(I.CMOV{cond=cond cc, src=regOrMem(operand yes),
769                                      dst=dstR}, an)
770                    end                    end
771                in  dstMustBeReg genCmov                in  dstMustBeReg genCmov
772                end                end
773    
774                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)
775    
776                      (* Add n to rd *)
777                  fun addN n =
778                  let val n = operand n
779                      val src = if isMemReg rd then immedOrReg n else n
780                  in  mark(I.BINARY{binOp=I.ADDL, src=src, dst=rdOpnd}, an) end
781    
782                    (* Generate addition *)                    (* Generate addition *)
783                fun addition(e1, e2) =                fun addition(e1, e2) =
784                      case e1 of
785                        T.REG(_,rs) => if CB.sameColor(rs,rd) then addN e2
786                                       else addition1(e1,e2)
787                      | _ => addition1(e1,e2)
788                  and addition1(e1, e2) =
789                      case e2 of
790                        T.REG(_,rs) => if CB.sameColor(rs,rd) then addN e1
791                                       else addition2(e1,e2)
792                      | _ => addition2(e1,e2)
793                  and addition2(e1,e2) =
794                  (dstMustBeReg(fn (dstR, _) =>                  (dstMustBeReg(fn (dstR, _) =>
795                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))
796                  handle EA => binaryComm(I.ADDL, e1, e2))                  handle EA => binaryComm(I.ADDL, e1, e2))
797    
                   (* Add n to rd *)  
               fun addN n =  
                 mark(I.BINARY{binOp=I.ADDL, src=I.Immed(toInt32 n),  
                               dst=rdOpnd}, an)  
798    
799            in  case exp of            in  case exp of
800                 T.REG(_,rs) =>                 T.REG(_,rs) =>
801                     if isMemReg rs andalso isMemReg rd then                     if isMemReg rs andalso isMemReg rd then
802                        let val tmp = I.Direct(newReg())                        let val tmp = I.Direct(newReg())
803                        in  move'(MemReg rs, tmp, an);                        in  move'(I.MemReg rs, tmp, an);
804                            move'(tmp, rdOpnd, [])                            move'(tmp, rdOpnd, [])
805                        end                        end
806                     else move'(IntReg rs, rdOpnd, an)                     else move'(IntReg rs, rdOpnd, an)
807               | (T.LI 0 | T.LI32 0w0) =>               | T.LI z => let
808                     val n = toInt32 z
809                   in
810                     if n=0 then
811                   (* As per Fermin's request, special optimization for rd := 0.                   (* As per Fermin's request, special optimization for rd := 0.
812                    * Currently we don't bother with the size.                    * Currently we don't bother with the size.
813                    *)                    *)
814                   if isMemReg rd then move'(I.Immed 0, rdOpnd, an)                   if isMemReg rd then move'(I.Immed 0, rdOpnd, an)
815                   else mark(I.BINARY{binOp=I.XORL, src=rdOpnd, dst=rdOpnd}, an)                   else mark(I.BINARY{binOp=I.XORL, src=rdOpnd, dst=rdOpnd}, an)
816               | T.LI n      => move'(I.Immed(toInt32 n), rdOpnd, an)                   else
817               | T.LI32 w    => move'(I.Immed(wToInt32 w), rdOpnd, an)                     move'(I.Immed(n), rdOpnd, an)
818               | T.CONST c   => move'(I.ImmedLabel(LE.CONST c), rdOpnd, an)                 end
819               | T.LABEL lab => move'(I.ImmedLabel lab, rdOpnd, an)               | (T.CONST _ | T.LABEL _) =>
820                     move'(I.ImmedLabel exp, rdOpnd, an)
821                 | T.LABEXP le => move'(I.ImmedLabel le, rdOpnd, an)
822    
823                 (* 32-bit addition *)                 (* 32-bit addition *)
824               | T.ADD(32, e, (T.LI 1|T.LI32 0w1)) => unary(I.INCL, e)               | T.ADD(32, e1, e2 as T.LI n) => let
825               | T.ADD(32, (T.LI 1|T.LI32 0w1), e) => unary(I.INCL, e)                   val n = toInt32 n
826               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)                 in
827               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)                   case n
828               | T.ADD(32, e1 as T.REG(_, rs), e2 as T.LI n) =>                   of 1  => unary(I.INCL, e1)
829                    if rs = rd then addN n else addition(e1, e2)                    | ~1 => unary(I.DECL, e1)
830               | T.ADD(32, e1 as T.LI n, e2 as T.REG(_, rs)) =>                    | _ => addition(e1, e2)
831                    if rs = rd then addN n else addition(e1, e2)                 end
832                 | T.ADD(32, e1 as T.LI n, e2) => let
833                     val n = toInt32 n
834                   in
835                     case n
836                     of  1 => unary(I.INCL, e2)
837                      | ~1 => unary(I.DECL, e2)
838                      | _ => addition(e1, e2)
839                   end
840               | T.ADD(32, e1, e2) => addition(e1, e2)               | T.ADD(32, e1, e2) => addition(e1, e2)
841    
842                 (* 32-bit subtraction *)                 (* 32-bit addition but set the flag!
843               | T.SUB(32, e, (T.LI 1 | T.LI32 0w1)) => unary(I.DECL, e)                  * This is a stupid hack for now.
              | T.SUB(32, e, T.LI ~1) => unary(I.INCL, e)  
              | T.SUB(32, (T.LI 0 | T.LI32 0w0), e) => unary(I.NEGL, e)  
   
              (* Never mind:  
                | T.SUB(32, e1, e2 as T.LI n) =>  
                  (mark(I.LEA{r32=rd, addr=address(T.ADD(32, e1, T.LI(~n)),  
                                                   I.Region.readonly)}, an)  
                   handle (Overflow|EA) => binary(I.SUBL, e1, e2))  
844               *)               *)
845                 | T.ADD(0, e, e1 as T.LI n) => let
846                     val n = T.I.toInt(32, n)
847                   in
848                     if n=1 then unary(I.INCL, e)
849                     else if n = ~1 then unary(I.DECL, e)
850                          else binaryComm(I.ADDL, e, e1)
851                   end
852                 | T.ADD(0, e1 as T.LI n, e) => let
853                     val n = T.I.toInt(32, n)
854                   in
855                     if n=1 then unary(I.INCL, e)
856                     else if n = ~1 then unary(I.DECL, e)
857                          else binaryComm(I.ADDL, e1, e)
858                   end
859                 | T.ADD(0, e1, e2) => binaryComm(I.ADDL, e1, e2)
860    
861                   (* 32-bit subtraction *)
862                 | T.SUB(32, e1, e2 as T.LI n) => let
863                     val n = toInt32 n
864                   in
865                     case n
866                     of 0 => doExpr(e1, rd, an)
867                      | 1 => unary(I.DECL, e1)
868                      | ~1 => unary(I.INCL, e1)
869                      | _ => binary(I.SUBL, e1, e2)
870                   end
871                 | T.SUB(32, e1 as T.LI n, e2) =>
872                     if T.I.isZero n then unary(I.NEGL, e2)
873                     else binary(I.SUBL, e1, e2)
874               | T.SUB(32, e1, e2) => binary(I.SUBL, e1, e2)               | T.SUB(32, e1, e2) => binary(I.SUBL, e1, e2)
875    
876               | T.MULU(32, x, y) => uMultiply(x, y)               | T.MULU(32, x, y) => uMultiply(x, y)
# Line 727  Line 899 
899               | T.LOAD(8, ea, mem) => load8(ea, mem)               | T.LOAD(8, ea, mem) => load8(ea, mem)
900               | T.LOAD(16, ea, mem) => load16(ea, mem)               | T.LOAD(16, ea, mem) => load16(ea, mem)
901               | T.LOAD(32, ea, mem) => load32(ea, mem)               | T.LOAD(32, ea, mem) => load32(ea, mem)
              | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(8,ea,mem)) => load8s(ea, mem)  
              | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(16,ea,mem)) => load16s(ea, mem)  
902    
903               | T.COND(32, T.CMP(ty, cc, t1, t2), T.LI yes, T.LI no) =>               | T.SX(32,8,T.LOAD(8,ea,mem)) => load8s(ea, mem)
904                   setcc(ty, cc, t1, t2, yes, no)               | T.SX(32,16,T.LOAD(16,ea,mem)) => load16s(ea, mem)
905                 | T.ZX(32,8,T.LOAD(8,ea,mem)) => load8(ea, mem)
906                 | T.ZX(32,16,T.LOAD(16,ea,mem)) => load16(ea, mem)
907    
908                 | T.COND(32, T.CMP(ty, cc, t1, t2), y as T.LI yes, n as T.LI no) =>
909                    (case !arch of (* PentiumPro and higher has CMOVcc *)
910                      Pentium => setcc(ty, cc, t1, t2, toInt32 yes, toInt32 no)
911                    | _ => cmovcc(ty, cc, t1, t2, y, n)
912                    )
913               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>
914                  (case !arch of (* PentiumPro and higher has CMOVcc *)                  (case !arch of (* PentiumPro and higher has CMOVcc *)
915                     Pentium => unknownExp exp                     Pentium => unknownExp exp
# Line 741  Line 919 
919               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))
920               | T.MARK(e, a) => doExpr(e, rd, a::an)               | T.MARK(e, a) => doExpr(e, rd, a::an)
921               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)
922               | T.REXT e => compileRexp (reducer()) {e=e, rd=rd, an=an}               | T.REXT e =>
923                     ExtensionComp.compileRext (reducer()) {e=e, rd=rd, an=an}
924                 (* simplify and try again *)                 (* simplify and try again *)
925               | exp => unknownExp exp               | exp => unknownExp exp
926            end (* doExpr *)            end (* doExpr *)
# Line 761  Line 940 
940            * On the x86, TEST is superior to AND for doing the same thing,            * On the x86, TEST is superior to AND for doing the same thing,
941            * since it doesn't need to write out the result in a register.            * since it doesn't need to write out the result in a register.
942            *)            *)
943       and cmpWithZero(cc as (T.EQ | T.NE), e as T.ANDB(ty, a, b))  =       and cmpWithZero(cc as (T.EQ | T.NE), e as T.ANDB(ty, a, b), an) =
944              (case ty of              (case ty of
945                 8 =>  test(I.TESTB, a, b)                 8  => test(I.TESTB, a, b, an)
946               | 16 => test(I.TESTW, a, b)               | 16 => test(I.TESTW, a, b, an)
947               | 32 => test(I.TESTL, a, b)               | 32 => test(I.TESTL, a, b, an)
948               | _  => (expr e; ())               | _  => doExpr(e, newReg(), an);
949               ; cc)               cc)
950          | cmpWithZero(cc, e) = (expr e; cc)          | cmpWithZero(cc, e, an) =
951              let val e =
952                    case e of (* hack to disable the lea optimization XXX *)
953                      T.ADD(_, a, b) => T.ADD(0, a, b)
954                    | e => e
955              in  doExpr(e, newReg(), an); cc end
956    
957            (* Emit a test.            (* Emit a test.
958             *   The available modes are             *   The available modes are
# Line 785  Line 969 
969             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction
970             * by TESTB.             * by TESTB.
971             *)             *)
972        and test(testopcode, a, b) =        and test(testopcode, a, b, an) =
973            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)
974                (* translate r, r/m => r/m, r *)                (* translate r, r/m => r/m, r *)
975                val (opnd1, opnd2) =                val (opnd1, opnd2) =
976                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)
977            in  emit(testopcode{lsrc=opnd1, rsrc=opnd2})            in  mark(testopcode{lsrc=opnd1, rsrc=opnd2}, an)
978            end            end
979    
980              (* %eflags <- src *)
981          and moveToEflags src =
982              if CB.sameColor(src, C.eflags) then ()
983              else (move(I.Direct src, eax); emit(I.LAHF))
984    
985              (* dst <- %eflags *)
986          and moveFromEflags dst =
987              if CB.sameColor(dst, C.eflags) then ()
988              else (emit(I.SAHF); move(eax, I.Direct dst))
989    
990           (* generate a condition code expression           (* generate a condition code expression
991             * The zero is for setting the condition code!             * The zero is for setting the condition code!
992             * I have no idea why this is used.             * I have no idea why this is used.
993             *)             *)
994        and doCCexpr(T.CMP(ty, cc, t1, t2), 0, an) =        and doCCexpr(T.CMP(ty, cc, t1, t2), rd, an) =
995            (cmp(false, ty, cc, t1, t2, an); ())            (cmp(false, ty, cc, t1, t2, an);
996               moveFromEflags rd
997              )
998            | doCCexpr(T.CC(cond,rs), rd, an) =
999              if CB.sameColor(rs,C.eflags) orelse CB.sameColor(rd,C.eflags) then
1000                 (moveToEflags rs; moveFromEflags rd)
1001              else
1002                 move'(I.Direct rs, I.Direct rd, an)
1003          | doCCexpr(T.CCMARK(e,A.MARKREG f),rd,an) = (f rd; doCCexpr(e,rd,an))          | doCCexpr(T.CCMARK(e,A.MARKREG f),rd,an) = (f rd; doCCexpr(e,rd,an))
1004          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)
1005          | doCCexpr(T.CCEXT e, cd, an) =          | doCCexpr(T.CCEXT e, cd, an) =
1006             compileCCexp (reducer()) {e=e, cd=cd, an=an}             ExtensionComp.compileCCext (reducer()) {e=e, ccd=cd, an=an}
1007          | doCCexpr _ = error "doCCexpr"          | doCCexpr _ = error "doCCexpr"
1008    
1009       and ccExpr e = error "ccExpr"       and ccExpr e = error "ccExpr"
# Line 812  Line 1013 
1013             * we can also reorder the operands.             * we can also reorder the operands.
1014             *)             *)
1015        and cmp(swapable, ty, cc, t1, t2, an) =        and cmp(swapable, ty, cc, t1, t2, an) =
1016            (case cc of                 (* == and <> can be always be reordered *)
1017               (T.EQ | T.NE) =>            let val swapable = swapable orelse cc = T.EQ orelse cc = T.NE
1018                (* Sometimes the comparison is not necessary because            in (* Sometimes the comparison is not necessary because
1019                 * the bits are already set!                 * the bits are already set!
1020                 *)                 *)
1021                if isZero t1 andalso setZeroBit t2 then cmpWithZero(cc, t2)               if isZero t1 andalso setZeroBit2 t2 then
1022                else if isZero t2 andalso setZeroBit t1 then cmpWithZero(cc, t1)                   if swapable then
1023                     (* == and <> can be reordered *)                      cmpWithZero(T.Basis.swapCond cc, t2, an)
1024                else genCmp(ty, true, cc, t1, t2, an)                   else (* can't reorder the comparison! *)
1025             |  _ => genCmp(ty, swapable, cc, t1, t2, an)                      genCmp(ty, false, cc, t1, t2, an)
1026            )               else if isZero t2 andalso setZeroBit2 t1 then
1027                    cmpWithZero(cc, t1, an)
1028                 else genCmp(ty, swapable, cc, t1, t2, an)
1029              end
1030    
1031            (* Give a and b which are the operands to a comparison (or test)            (* Give a and b which are the operands to a comparison (or test)
1032             * Return the appropriate condition code and operands.             * Return the appropriate condition code and operands.
# Line 855  Line 1059 
1059            end            end
1060    
1061            (* generate code for jumps *)            (* generate code for jumps *)
1062        and jmp(T.LABEL(lexp as LE.LABEL lab), labs, an) =        and jmp(lexp as T.LABEL lab, labs, an) =
1063               mark(I.JMP(I.ImmedLabel lexp, [lab]), an)               mark(I.JMP(I.ImmedLabel lexp, [lab]), an)
1064          | jmp(T.LABEL lexp, labs, an) = mark(I.JMP(I.ImmedLabel lexp, labs), an)          | jmp(T.LABEXP le, labs, an) = mark(I.JMP(I.ImmedLabel le, labs), an)
1065          | jmp(ea, labs, an)           = mark(I.JMP(operand ea, labs), an)          | jmp(ea, labs, an)           = mark(I.JMP(operand ea, labs), an)
1066    
1067         (* convert mlrisc to cellset:         (* convert mlrisc to cellset:
1068          *)          *)
1069         and cellset mlrisc =         and cellset mlrisc =
1070             let val addCCReg = C.addCell C.CC             let val addCCReg = CB.CellSet.add
1071                 fun g([],acc) = acc                 fun g([],acc) = acc
1072                   | g(T.GPR(T.REG(_,r))::regs,acc)  = g(regs,C.addReg(r,acc))                   | g(T.GPR(T.REG(_,r))::regs,acc)  = g(regs,C.addReg(r,acc))
1073                   | g(T.FPR(T.FREG(_,f))::regs,acc) = g(regs,C.addFreg(f,acc))                   | g(T.FPR(T.FREG(_,f))::regs,acc) = g(regs,C.addFreg(f,acc))
# Line 873  Line 1077 
1077             in  g(mlrisc, C.empty) end             in  g(mlrisc, C.empty) end
1078    
1079            (* generate code for calls *)            (* generate code for calls *)
1080        and call(ea, flow, def, use, mem, an) =        and call(ea, flow, def, use, mem, cutsTo, an, pops) =
1081            mark(I.CALL(operand ea,cellset(def),cellset(use),mem),an)        let fun return(set, []) = set
1082                | return(set, a::an) =
1083                  case #peek A.RETURN_ARG a of
1084                    SOME r => return(CB.CellSet.add(r, set), an)
1085                  | NONE => return(set, an)
1086          in
1087              mark(I.CALL{opnd=operand ea,defs=cellset(def),uses=cellset(use),
1088                          return=return(C.empty,an),cutsTo=cutsTo,mem=mem,
1089                          pops=pops},an)
1090          end
1091    
1092            (* generate code for integer stores *)            (* generate code for integer stores; first move data to %eax
1093        and store8(ea, d, mem, an) =             * This is mainly because we can't allocate to registers like
1094            let val src = (* movb has to use %eax as source. Stupid x86! *)             * ah, dl, dx etc.
1095               *)
1096          and genStore(mvOp, ea, d, mem, an) =
1097              let val src =
1098                   case immedOrReg(operand d) of                   case immedOrReg(operand d) of
1099                       src as I.Direct r =>                       src as I.Direct r =>
1100                         if r = C.eax then src else (move(src, eax); eax)                         if CB.sameColor(r,C.eax)
1101                           then src else (move(src, eax); eax)
1102                     | src => src                     | src => src
1103            in  mark(I.MOVE{mvOp=I.MOVB, src=src, dst=address(ea,mem)},an)            in  mark(I.MOVE{mvOp=mvOp, src=src, dst=address(ea,mem)},an)
1104            end            end
1105        and store16(ea, d, mem, an) = error "store16"  
1106              (* generate code for 8-bit integer stores *)
1107              (* movb has to use %eax as source. Stupid x86! *)
1108          and store8(ea, d, mem, an) = genStore(I.MOVB, ea, d, mem, an)
1109          and store16(ea, d, mem, an) =
1110            mark(I.MOVE{mvOp=I.MOVW, src=immedOrReg(operand d), dst=address(ea, mem)}, an)
1111        and store32(ea, d, mem, an) =        and store32(ea, d, mem, an) =
1112              move'(immedOrReg(operand d), address(ea, mem), an)              move'(immedOrReg(operand d), address(ea, mem), an)
1113    
# Line 897  Line 1119 
1119          | branch(T.FCMP(fty, fcc, t1, t2), lab, an) =          | branch(T.FCMP(fty, fcc, t1, t2), lab, an) =
1120             fbranch(fty, fcc, t1, t2, lab, an)             fbranch(fty, fcc, t1, t2, lab, an)
1121          | branch(ccexp, lab, an) =          | branch(ccexp, lab, an) =
1122             (doCCexpr(ccexp, 0, []);             (doCCexpr(ccexp, C.eflags, []);
1123              mark(I.JCC{cond=cond(Gen.condOf ccexp), opnd=immedLabel lab}, an)              mark(I.JCC{cond=cond(Gen.condOf ccexp), opnd=immedLabel lab}, an)
1124             )             )
1125    
1126            (* generate code for floating point compare and branch *)            (* generate code for floating point compare and branch *)
1127        and fbranch(fty, fcc, t1, t2, lab, an) =        and fbranch(fty, fcc, t1, t2, lab, an) =
1128            let fun compare() =            let fun j cc = mark(I.JCC{cond=cc, opnd=immedLabel lab},an)
1129              in  fbranching(fty, fcc, t1, t2, j)
1130              end
1131    
1132          and fbranching(fty, fcc, t1, t2, j) =
1133                let fun ignoreOrder (T.FREG _) = true                let fun ignoreOrder (T.FREG _) = true
1134                      | ignoreOrder (T.FLOAD _) = true                      | ignoreOrder (T.FLOAD _) = true
1135                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e
1136                      | ignoreOrder _ = false                      | ignoreOrder _ = false
1137                in  if ignoreOrder t1 orelse ignoreOrder t2 then  
1138                  fun compare'() = (* Sethi-Ullman style *)
1139                      (if ignoreOrder t1 orelse ignoreOrder t2 then
1140                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))
1141                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);
1142                          emit(I.FXCH{opnd=C.ST(1)}));                          emit(I.FXCH{opnd=C.ST(1)}));
1143                    emit(I.FUCOMPP)                     emit(I.FUCOMPP);
1144                       fcc
1145                      )
1146    
1147                  fun compare''() =
1148                          (* direct style *)
1149                          (* Try to make lsrc the memory operand *)
1150                      let val lsrc = foperand(fty, t1)
1151                          val rsrc = foperand(fty, t2)
1152                          val fsize = fsize fty
1153                          fun cmp(lsrc, rsrc, fcc) =
1154                          let val i = !arch <> Pentium
1155                          in  emit(I.FCMP{i=i,fsize=fsize,lsrc=lsrc,rsrc=rsrc});
1156                              fcc
1157                          end
1158                      in  case (lsrc, rsrc) of
1159                             (I.FPR _, I.FPR _) => cmp(lsrc, rsrc, fcc)
1160                           | (I.FPR _, mem) => cmp(mem,lsrc,T.Basis.swapFcond fcc)
1161                           | (mem, I.FPR _) => cmp(lsrc, rsrc, fcc)
1162                           | (lsrc, rsrc) => (* can't be both memory! *)
1163                             let val ftmpR = newFreg()
1164                                 val ftmp  = I.FPR ftmpR
1165                             in  emit(I.FMOVE{fsize=fsize,src=rsrc,dst=ftmp});
1166                                 cmp(lsrc, ftmp, fcc)
1167                             end
1168                end                end
1169    
1170                  fun compare() =
1171                      if enableFastFPMode andalso !fast_floating_point
1172                      then compare''() else compare'()
1173    
1174                fun andil i = emit(I.BINARY{binOp=I.ANDL,src=I.Immed(i),dst=eax})                fun andil i = emit(I.BINARY{binOp=I.ANDL,src=I.Immed(i),dst=eax})
1175                  fun testil i = emit(I.TESTL{lsrc=eax,rsrc=I.Immed(i)})
1176                fun xoril i = emit(I.BINARY{binOp=I.XORL,src=I.Immed(i),dst=eax})                fun xoril i = emit(I.BINARY{binOp=I.XORL,src=I.Immed(i),dst=eax})
1177                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})
               fun j(cc, lab) = mark(I.JCC{cond=cc, opnd=immedLabel lab},an)  
1178                fun sahf() = emit(I.SAHF)                fun sahf() = emit(I.SAHF)
1179                fun branch() =                fun branch(fcc) =
1180                      case fcc
1181                      of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ))
1182                       | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE))
1183                       | T.?    => (sahf(); j(I.P))
1184                       | T.<=>  => (sahf(); j(I.NP))
1185                       | T.>    => (testil 0x4500;  j(I.EQ))
1186                       | T.?<=  => (testil 0x4500;  j(I.NE))
1187                       | T.>=   => (testil 0x500; j(I.EQ))
1188                       | T.?<   => (testil 0x500; j(I.NE))
1189                       | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ))
1190                       | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE))
1191                       | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ);
1192                                    cmpil 0x4000; j(I.EQ))
1193                       | T.?>   => (sahf(); j(I.P); testil 0x4100; j(I.EQ))
1194                       | T.<>   => (testil 0x4400; j(I.EQ))
1195                       | T.?=   => (testil 0x4400; j(I.NE))
1196                       | _      => error(concat[
1197                                      "fbranch(", T.Basis.fcondToString fcc, ")"
1198                                    ])
1199                     (*esac*)
1200    
1201                  (*
1202                   *             P  Z  C
1203                   * x < y       0  0  1
1204                   * x > y       0  0  0
1205                   * x = y       0  1  0
1206                   * unordered   1  1  1
1207                   * When it's unordered, all three flags, P, Z, C are set.
1208                   *)
1209    
1210                  fun fast_branch(fcc) =
1211                    case fcc                    case fcc
1212                    of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))                    of T.==   => orderedOnly(I.EQ)
1213                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))                     | T.?<>  => (j(I.P); j(I.NE))
1214                     | T.?    => (sahf(); j(I.P,lab))                     | T.?    => j(I.P)
1215                     | T.<=>  => (sahf(); j(I.NP,lab))                     | T.<=>  => j(I.NP)
1216                     | T.>    => (andil 0x4500;  j(I.EQ,lab))                     | T.>    => orderedOnly(I.A)
1217                     | T.?<=  => (andil 0x4500;  j(I.NE,lab))                     | T.?<=  => j(I.BE)
1218                     | T.>=   => (andil 0x500; j(I.EQ,lab))                     | T.>=   => orderedOnly(I.AE)
1219                     | T.?<   => (andil 0x500; j(I.NE,lab))                     | T.?<   => j(I.B)
1220                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))                     | T.<    => orderedOnly(I.B)
1221                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))                     | T.?>=  => (j(I.P); j(I.AE))
1222                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);                     | T.<=   => orderedOnly(I.BE)
1223                                  cmpil 0x4000; j(I.EQ,lab))                     | T.?>   => (j(I.P); j(I.A))
1224                     | T.?>   => (sahf(); j(I.P,lab); andil 0x4100; j(I.EQ,lab))                     | T.<>   => orderedOnly(I.NE)
1225                     | T.<>   => (andil 0x4400; j(I.EQ,lab))                     | T.?=   => j(I.EQ)
1226                     | T.?=   => (andil 0x4400; j(I.NE,lab))                     | _      => error(concat[
1227                     | _      => error "fbranch"                                    "fbranch(", T.Basis.fcondToString fcc, ")"
1228                                    ])
1229                   (*esac*)                   (*esac*)
1230            in  compare(); emit I.FNSTSW; branch()                and orderedOnly fcc =
1231                  let val label = Label.anon()
1232                  in  emit(I.JCC{cond=I.P, opnd=immedLabel label});
1233                      j fcc;
1234                      defineLabel label
1235                  end
1236    
1237                  val fcc = compare()
1238              in  if !arch <> Pentium andalso
1239                     (enableFastFPMode andalso !fast_floating_point) then
1240                    fast_branch(fcc)
1241                  else
1242                    (emit I.FNSTSW;
1243                     branch(fcc)
1244                    )
1245            end            end
1246    
1247          (*========================================================
1248           * Floating point code generation starts here.
1249           * Some generic fp routines first.
1250           *========================================================*)
1251    
1252           (* Can this tree be folded into the src operand of a floating point
1253            * operations?
1254            *)
1255          and foldableFexp(T.FREG _) = true
1256            | foldableFexp(T.FLOAD _) = true
1257            | foldableFexp(T.CVTI2F(_, (16 | 32), _)) = true
1258            | foldableFexp(T.CVTF2F(_, _, t)) = foldableFexp t
1259            | foldableFexp(T.FMARK(t, _)) = foldableFexp t
1260            | foldableFexp _ = false
1261    
1262            (* Move integer e of size ty into a memory location.
1263             * Returns a quadruple:
1264             *  (INTEGER,return ty,effect address of memory location,cleanup code)
1265             *)
1266          and convertIntToFloat(ty, e) =
1267              let val opnd = operand e
1268              in  if isMemOpnd opnd andalso (ty = 16 orelse ty = 32)
1269                  then (INTEGER, ty, opnd, [])
1270                  else
1271                    let val {instrs, tempMem, cleanup} =
1272                            cvti2f{ty=ty, src=opnd, an=getAnnotations()}
1273                    in  emits instrs;
1274                        (INTEGER, 32, tempMem, cleanup)
1275                    end
1276              end
1277    
1278          (*========================================================
1279           * Sethi-Ullman based floating point code generation as
1280           * implemented by Lal
1281           *========================================================*)
1282    
1283        and fld(32, opnd) = I.FLDS opnd        and fld(32, opnd) = I.FLDS opnd
1284          | fld(64, opnd) = I.FLDL opnd          | fld(64, opnd) = I.FLDL opnd
1285            | fld(80, opnd) = I.FLDT opnd
1286          | fld _         = error "fld"          | fld _         = error "fld"
1287    
1288          and fild(16, opnd) = I.FILD opnd
1289            | fild(32, opnd) = I.FILDL opnd
1290            | fild(64, opnd) = I.FILDLL opnd
1291            | fild _         = error "fild"
1292    
1293          and fxld(INTEGER, ty, opnd) = fild(ty, opnd)
1294            | fxld(REAL, fty, opnd) = fld(fty, opnd)
1295    
1296        and fstp(32, opnd) = I.FSTPS opnd        and fstp(32, opnd) = I.FSTPS opnd
1297          | fstp(64, opnd) = I.FSTPL opnd          | fstp(64, opnd) = I.FSTPL opnd
1298            | fstp(80, opnd) = I.FSTPT opnd
1299          | fstp _         = error "fstp"          | fstp _         = error "fstp"
1300    
1301            (* generate code for floating point stores *)            (* generate code for floating point stores *)
1302        and fstore(fty, ea, d, mem, an) =        and fstore'(fty, ea, d, mem, an) =
1303            (case d of            (case d of
1304               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))
1305             | _ => reduceFexp(fty, d, []);             | _ => reduceFexp(fty, d, []);
1306             mark(fstp(fty, address(ea, mem)), an)             mark(fstp(fty, address(ea, mem)), an)
1307            )            )
1308    
1309        and fexpr e = error "fexpr"            (* generate code for floating point loads *)
1310          and fload'(fty, ea, mem, fd, an) =
1311                let val ea = address(ea, mem)
1312                in  mark(fld(fty, ea), an);
1313                    if CB.sameColor(fd,ST0) then ()
1314                    else emit(fstp(fty, I.FDirect fd))
1315                end
1316    
1317          and fexpr' e = (reduceFexp(64, e, []); C.ST(0))
1318    
1319            (* generate floating point expression and put the result in fd *)            (* generate floating point expression and put the result in fd *)
1320        and doFexpr(fty, T.FREG(_, fs), fd, an) =        and doFexpr'(fty, T.FREG(_, fs), fd, an) =
1321              (if fs = fd then ()              (if CB.sameColor(fs,fd) then ()
1322               else mark(I.FCOPY{dst=[fd], src=[fs], tmp=NONE}, an)               else mark'(I.COPY{k=CB.FP, sz=64, dst=[fd], src=[fs], tmp=NONE}, an)
1323              )              )
1324          | doFexpr(fty, T.FLOAD(fty', ea, mem), fd, an) =          | doFexpr'(_, T.FLOAD(fty, ea, mem), fd, an) =
1325              let val ea = address(ea, mem)              fload'(fty, ea, mem, fd, an)
1326              in  mark(fld(fty', ea), an);          | doFexpr'(fty, T.FEXT fexp, fd, an) =
1327                  emit(fstp(fty, I.FDirect fd))              (ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an};
1328              end               if CB.sameColor(fd,ST0) then () else emit(fstp(fty, I.FDirect fd))
1329          | doFexpr(fty, e, fd, an) =              )
1330            | doFexpr'(fty, e, fd, an) =
1331              (reduceFexp(fty, e, []);              (reduceFexp(fty, e, []);
1332               mark(fstp(fty, I.FDirect fd), an)               if CB.sameColor(fd,ST0) then ()
1333                 else mark(fstp(fty, I.FDirect fd), an)
1334              )              )
1335    
1336            (*            (*
# Line 980  Line 1339 
1339             * and put result in %ST(0).             * and put result in %ST(0).
1340             *)             *)
1341        and reduceFexp(fty, fexp, an)  =        and reduceFexp(fty, fexp, an)  =
1342            let val ST = I.FDirect(C.ST 0)            let val ST = I.ST(C.ST 0)
1343                val ST1 = I.FDirect(C.ST 1)                val ST1 = I.ST(C.ST 1)
1344                  val cleanupCode = ref [] : I.instruction list ref
1345                datatype su_numbers =  
1346                  LEAF of int                datatype su_tree =
1347                | BINARY of int * su_numbers * su_numbers                  LEAF of int * T.fexp * ans
1348                | UNARY of int * su_numbers                | BINARY of int * T.fty * fbinop * su_tree * su_tree * ans
1349                  | UNARY of int * T.fty * I.funOp * su_tree * ans
1350                datatype direction = LEFT | RIGHT                and fbinop = FADD | FSUB | FMUL | FDIV
1351                             | FIADD | FISUB | FIMUL | FIDIV
1352                fun label(LEAF n) = n                withtype ans = Annotations.annotations
1353                  | label(BINARY(n, _, _)) = n  
1354                  | label(UNARY(n, _)) = n                fun label(LEAF(n, _, _)) = n
1355                    | label(BINARY(n, _, _, _, _, _)) = n
1356               (* Generate tree of sethi-ullman numbers *)                  | label(UNARY(n, _, _, _, _)) = n
1357                fun suBinary(t1, t2) =  
1358                    let val su1 = suNumbering(t1, LEFT)                fun annotate(LEAF(n, x, an), a)  = LEAF(n,x,a::an)
1359                        val su2 = suNumbering(t2, RIGHT)                  | annotate(BINARY(n,t,b,x,y,an), a) = BINARY(n,t,b,x,y,a::an)
1360                        val n1 = label su1                  | annotate(UNARY(n,t,u,x,an), a) = UNARY(n,t,u,x,a::an)
1361                        val n2 = label su2  
1362                    in  BINARY(if n1=n2 then n1+1 else Int.max(n1, n2), su1, su2)                (* Generate expression tree with sethi-ullman numbers *)
1363                    end                fun su(e as T.FREG _)       = LEAF(1, e, [])
1364                    | su(e as T.FLOAD _)      = LEAF(1, e, [])
1365                and suUnary(t) =                  | su(e as T.CVTI2F _)     = LEAF(1, e, [])
1366                    let val su = suNumbering(t, LEFT)                  | su(T.CVTF2F(_, _, t))   = su t
1367                    in  UNARY(label su, su)                  | su(T.FMARK(t, a))       = annotate(su t, a)
1368                    end                  | su(T.FABS(fty, t))      = suUnary(fty, I.FABS, t)
1369                    | su(T.FNEG(fty, t))      = suUnary(fty, I.FCHS, t)
1370                and suNumbering(T.FREG _, LEFT) = LEAF 1                  | su(T.FSQRT(fty, t))     = suUnary(fty, I.FSQRT, t)
1371                  | suNumbering(T.FREG _, RIGHT) = LEAF 0                  | su(T.FADD(fty, t1, t2)) = suComBinary(fty,FADD,FIADD,t1,t2)
1372                  | suNumbering(T.FLOAD _, LEFT) = LEAF 1                  | su(T.FMUL(fty, t1, t2)) = suComBinary(fty,FMUL,FIMUL,t1,t2)
1373                  | suNumbering(T.FLOAD _, RIGHT) = LEAF 0                  | su(T.FSUB(fty, t1, t2)) = suBinary(fty,FSUB,FISUB,t1,t2)
1374                  | suNumbering(T.FADD(_, t1, t2), _) = suBinary(t1, t2)                  | su(T.FDIV(fty, t1, t2)) = suBinary(fty,FDIV,FIDIV,t1,t2)
1375                  | suNumbering(T.FMUL(_, t1, t2), _) = suBinary(t1, t2)                  | su _ = error "su"
1376                  | suNumbering(T.FSUB(_, t1, t2), _) = suBinary(t1, t2)  
1377                  | suNumbering(T.FDIV(_, t1, t2), _) = suBinary(t1, t2)                (* Try to fold the the memory operand or integer conversion *)
1378                  | suNumbering(T.FABS(_,t), _) = suUnary(t)                and suFold(e as T.FREG _) = (LEAF(0, e, []), false)
1379                  | suNumbering(T.FNEG(_,t), _) = suUnary(t)                  | suFold(e as T.FLOAD _) = (LEAF(0, e, []), false)
1380                  | suNumbering(T.CVTI2F _, _) = UNARY(1, LEAF 0)                  | suFold(e as T.CVTI2F(_,(16 | 32),_)) = (LEAF(0, e, []), true)
1381                  | suNumbering(T.CVTF2F(_,_,t), _) = suUnary t                  | suFold(T.CVTF2F(_, _, t)) = suFold t
1382                  | suNumbering(T.FMARK(e,a),x) = suNumbering(e,x)                  | suFold(T.FMARK(t, a)) =
1383                  | suNumbering _ = error "suNumbering"                    let val (t, integer) = suFold t
1384                      in  (annotate(t, a), integer) end
1385                fun leafEA(T.FREG(fty, f)) = (fty, I.FDirect f)                  | suFold e = (su e, false)
1386                  | leafEA(T.FLOAD(fty, ea, mem)) = (fty, address(ea, mem))  
1387                  | leafEA _ = error "leafEA"                (* Form unary tree *)
1388                  and suUnary(fty, funary, t) =
1389                fun cvti2d(t,an) =                    let val t = su t
1390                let val opnd = operand t                    in  UNARY(label t, fty, funary, t, [])
1391                    fun doMemOpnd () =                    end
1392                        (emit(I.MOVE{mvOp=I.MOVL, src=opnd, dst=tempMem});  
1393                         mark(I.FILD tempMem,an))                (* Form binary tree *)
1394                in  case opnd of                and suBinary(fty, binop, ibinop, t1, t2) =
1395                      I.Direct _ => doMemOpnd()                    let val t1 = su t1
1396                    | I.Immed _ => doMemOpnd()                        val (t2, integer) = suFold t2
1397                    | _ => mark(I.FILD opnd, an)                        val n1 = label t1
1398                end                        val n2 = label t2
1399                          val n  = if n1=n2 then n1+1 else Int.max(n1,n2)
1400                (* traverse expression and su-number tree *)                        val myOp = if integer then ibinop else binop
1401                fun gencode(_, LEAF 0, an) = ()                    in  BINARY(n, fty, myOp, t1, t2, [])
1402                  | gencode(T.FMARK(e,a), x, an) = gencode(e, x, a::an)                    end
1403                  | gencode(f, LEAF 1, an) = mark(fld(leafEA f), an)  
1404                  | gencode(t, BINARY(_, su1, LEAF 0), an) =                (* Try to fold in the operand if possible.
1405                    let (* optimize the common case when both operands                 * This only applies to commutative operations.
1406                         * are equal *)                 *)
1407                        fun sameEA(T.FREG(t1, f1), T.FREG(t2, f2)) =                and suComBinary(fty, binop, ibinop, t1, t2) =
1408                              t1 = t2 andalso f1 = f2                    let val (t1, t2) = if foldableFexp t2
1409                          | sameEA _ = false                                       then (t1, t2) else (t2, t1)
1410                        fun doit(oper, t1, t2) =                    in  suBinary(fty, binop, ibinop, t1, t2) end
1411                           (gencode(t1, su1, []);  
1412                            mark(I.FBINARY{binOp=oper,                and sameTree(LEAF(_, T.FREG(t1,f1), []),
1413                                           src=if sameEA(t1, t2) then ST                             LEAF(_, T.FREG(t2,f2), [])) =
1414                                               else #2(leafEA t2),                          t1 = t2 andalso CB.sameColor(f1,f2)
1415                                           dst=ST}, an)                  | sameTree _ = false
1416                           )  
1417                    in                (* Traverse tree and generate code *)
1418                      case t of                fun gencode(LEAF(_, t, an)) = mark(fxld(leafEA t), an)
1419                         T.FADD(_, t1, t2) => doit(I.FADD, t1, t2)                  | gencode(BINARY(_, _, binop, x, t2 as LEAF(0, y, a1), a2)) =
1420                       | T.FMUL(_, t1, t2) => doit(I.FMUL, t1, t2)                    let val _          = gencode x
1421                       | T.FSUB(_, t1, t2) => doit(I.FSUB, t1, t2)                        val (_, fty, src) = leafEA y
1422                       | T.FDIV(_, t1, t2) => doit(I.FDIV, t1, t2)                        fun gen(code) = mark(code, a1 @ a2)
1423                       | _ => error "gencode.BINARY"                        fun binary(oper32, oper64) =
1424                    end                            if sameTree(x, t2) then
1425                  | gencode(fexp, BINARY(fty, su1, su2), an) =                               gen(I.FBINARY{binOp=oper64, src=ST, dst=ST})
1426                    let fun doit(t1, t2, oper, operP, operRP) = let                            else
1427                       (* oper[P] =>  ST(1) := ST oper ST(1); [pop]                               let val oper =
1428                                       if isMemOpnd src then
1429                                          case fty of
1430                                            32 => oper32
1431                                          | 64 => oper64
1432                                          | _  => error "gencode: BINARY"
1433                                       else oper64
1434                                 in gen(I.FBINARY{binOp=oper, src=src, dst=ST}) end
1435                          fun ibinary(oper16, oper32) =
1436                              let val oper = case fty of
1437                                               16 => oper16
1438                                             | 32 => oper32
1439                                             | _  => error "gencode: IBINARY"
1440                              in  gen(I.FIBINARY{binOp=oper, src=src}) end
1441                      in  case binop of
1442                            FADD => binary(I.FADDS, I.FADDL)
1443                          | FSUB => binary(I.FDIVS, I.FSUBL)
1444                          | FMUL => binary(I.FMULS, I.FMULL)
1445                          | FDIV => binary(I.FDIVS, I.FDIVL)
1446                          | FIADD => ibinary(I.FIADDS, I.FIADDL)
1447                          | FISUB => ibinary(I.FIDIVS, I.FISUBL)
1448                          | FIMUL => ibinary(I.FIMULS, I.FIMULL)
1449                          | FIDIV => ibinary(I.FIDIVS, I.FIDIVL)
1450                      end
1451                    | gencode(BINARY(_, fty, binop, t1, t2, an)) =
1452                      let fun doit(t1, t2, oper, operP, operRP) =
1453                          let (* oper[P] =>  ST(1) := ST oper ST(1); [pop]
1454                        * operR[P] => ST(1) := ST(1) oper ST; [pop]                        * operR[P] => ST(1) := ST(1) oper ST; [pop]
1455                        *)                        *)
1456                        val n1 = label su1                             val n1 = label t1
1457                        val n2 = label su2                             val n2 = label t2
1458                      in                        in if n1 < n2 andalso n1 <= 7 then
1459                        if n1 < n2 andalso n1 <= 7 then                             (gencode t2;
1460                          (gencode(t2, su2, []);                              gencode t1;
                          gencode(t1, su1, []);  
1461                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))
1462                        else if n2 <= n1 andalso n2 <= 7 then                        else if n2 <= n1 andalso n2 <= 7 then
1463                          (gencode(t1, su1, []);                             (gencode t1;
1464                           gencode(t2, su2, []);                              gencode t2;
1465                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))
1466                        else let (* both labels > 7 *)                           else
1467                             let (* both labels > 7 *)
1468                            val fs = I.FDirect(newFreg())                            val fs = I.FDirect(newFreg())
1469                          in                           in  gencode t2;
                           gencode (t2, su2, []);  
1470                            emit(fstp(fty, fs));                            emit(fstp(fty, fs));
1471                            gencode (t1, su1, []);                               gencode t1;
1472                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)
1473                          end                          end
1474                      end                      end
1475                    in                    in case binop of
1476                      case fexp                         FADD => doit(t1,t2,I.FADDL,I.FADDP,I.FADDP)
1477                      of T.FADD(_, t1, t2) => doit(t1, t2,I.FADD,I.FADDP,I.FADDP)                       | FMUL => doit(t1,t2,I.FMULL,I.FMULP,I.FMULP)
1478                       | T.FMUL(_, t1, t2) => doit(t1, t2,I.FMUL,I.FMULP,I.FMULP)                       | FSUB => doit(t1,t2,I.FSUBL,I.FSUBP,I.FSUBRP)
1479                       | T.FSUB(_, t1, t2) => doit(t1, t2,I.FSUB,I.FSUBP,I.FSUBRP)                       | FDIV => doit(t1,t2,I.FDIVL,I.FDIVP,I.FDIVRP)
                      | T.FDIV(_, t1, t2) => doit(t1, t2,I.FDIV,I.FDIVP,I.FDIVRP)  
1480                       | _ => error "gencode.BINARY"                       | _ => error "gencode.BINARY"
1481                    end                    end
1482                  | gencode(fexp, UNARY(_, LEAF 0), an) =                  | gencode(UNARY(_, _, unaryOp, su, an)) =
1483                    (case fexp                     (gencode(su); mark(I.FUNARY(unaryOp),an))
1484                      of T.FABS(fty, t) =>  
1485                           (emit(fld(leafEA t)); mark(I.FUNARY(I.FABS),an))                (* Generate code for a leaf.
1486                       | T.FNEG(fty, t) =>                 * Returns the type and an effective address
1487                           (emit(fld(leafEA t)); mark(I.FUNARY(I.FCHS),an))                 *)
1488                       | T.CVTI2F(_,_,t) => cvti2d(t,an) (* XXX *)                and leafEA(T.FREG(fty, f)) = (REAL, fty, I.FDirect f)
1489                       | _ => error "gencode.UNARY"                  | leafEA(T.FLOAD(fty, ea, mem)) = (REAL, fty, address(ea, mem))
1490                     (*esac*))                  | leafEA(T.CVTI2F(_, 32, t)) = int2real(32, t)
1491                  | gencode(fexp, UNARY(_, su), an) =                  | leafEA(T.CVTI2F(_, 16, t)) = int2real(16, t)
1492                    let fun doit(oper, t) =                  | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, t)
1493                         (gencode(t, su, []); mark(I.FUNARY(oper),an))                  | leafEA _ = error "leafEA"
1494                    in case fexp  
1495                       of T.FABS(_, t) => doit(I.FABS, t)                and int2real(ty, e) =
1496                        | T.FNEG(_, t) => doit(I.FCHS, t)                    let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1497                        | T.CVTF2F(_,_,t) => gencode(t, su, an)                    in  cleanupCode := !cleanupCode @ cleanup;
1498                        | T.CVTI2F _ => error "gencode:UNARY:cvti2f"                        (INTEGER, ty, ea)
                       | _ => error "gencode.UNARY"  
1499                    end                    end
                 | gencode _ = error "gencode"  
1500    
1501                val labels = suNumbering(fexp, LEFT)           in  gencode(su fexp);
1502            in  gencode(fexp, labels, an)               emits(!cleanupCode)
1503            end (*reduceFexp*)            end (*reduceFexp*)
1504    
1505           (*========================================================
1506            * This section generates 3-address style floating
1507            * point code.
1508            *========================================================*)
1509    
1510          and isize 16 = I.I16
1511            | isize 32 = I.I32
1512            | isize _  = error "isize"
1513    
1514          and fstore''(fty, ea, d, mem, an) =
1515              (floatingPointUsed := true;
1516               mark(I.FMOVE{fsize=fsize fty, dst=address(ea,mem),
1517                            src=foperand(fty, d)},
1518                    an)
1519              )
1520    
1521          and fload''(fty, ea, mem, d, an) =
1522              (floatingPointUsed := true;
1523               mark(I.FMOVE{fsize=fsize fty, src=address(ea,mem),
1524                            dst=RealReg d}, an)
1525              )
1526    
1527          and fiload''(ity, ea, d, an) =
1528              (floatingPointUsed := true;
1529               mark(I.FILOAD{isize=isize ity, ea=ea, dst=RealReg d}, an)
1530              )
1531    
1532          and fexpr''(e as T.FREG(_,f)) =
1533              if isFMemReg f then transFexpr e else f
1534            | fexpr'' e = transFexpr e
1535    
1536          and transFexpr e =
1537              let val fd = newFreg() in doFexpr''(64, e, fd, []); fd end
1538    
1539             (*
1540              * Process a floating point operand.  Put operand in register
1541              * when possible.  The operand should match the given fty.
1542              *)
1543          and foperand(fty, e as T.FREG(fty', f)) =
1544                 if fty = fty' then RealReg f else I.FPR(fexpr'' e)
1545            | foperand(fty, T.CVTF2F(_, _, e)) =
1546                 foperand(fty, e) (* nop on the x86 *)
1547            | foperand(fty, e as T.FLOAD(fty', ea, mem)) =
1548                 (* fold operand when the precison matches *)
1549                 if fty = fty' then address(ea, mem) else I.FPR(fexpr'' e)
1550            | foperand(fty, e) = I.FPR(fexpr'' e)
1551    
1552             (*
1553              * Process a floating point operand.
1554              * Try to fold in a memory operand or conversion from an integer.
1555              *)
1556          and fioperand(T.FREG(fty,f)) = (REAL, fty, RealReg f, [])
1557            | fioperand(T.FLOAD(fty, ea, mem)) =
1558                 (REAL, fty, address(ea, mem), [])
1559            | fioperand(T.CVTF2F(_, _, e)) = fioperand(e) (* nop on the x86 *)
1560            | fioperand(T.CVTI2F(_, ty, e)) = convertIntToFloat(ty, e)
1561            | fioperand(T.FMARK(e,an)) = fioperand(e) (* XXX *)
1562            | fioperand(e) = (REAL, 64, I.FPR(fexpr'' e), [])
1563    
1564              (* Generate binary operator.  Since the real binary operators
1565               * does not take memory as destination, we also ensure this
1566               * does not happen.
1567               *)
1568          and fbinop(targetFty,
1569                     binOp, binOpR, ibinOp, ibinOpR, lsrc, rsrc, fd, an) =
1570                  (* Put the mem operand in rsrc *)
1571              let
1572                  fun isMemOpnd(T.FREG(_, f)) = isFMemReg f
1573                    | isMemOpnd(T.FLOAD _) = true
1574                    | isMemOpnd(T.CVTI2F(_, (16 | 32), _)) = true
1575                    | isMemOpnd(T.CVTF2F(_, _, t)) = isMemOpnd t
1576                    | isMemOpnd(T.FMARK(t, _)) = isMemOpnd t
1577                    | isMemOpnd _ = false
1578                  val (binOp, ibinOp, lsrc, rsrc) =
1579                      if isMemOpnd lsrc then (binOpR, ibinOpR, rsrc, lsrc)
1580                      else (binOp, ibinOp, lsrc, rsrc)
1581                  val lsrc = foperand(targetFty, lsrc)
1582                  val (kind, fty, rsrc, code) = fioperand(rsrc)
1583                  fun dstMustBeFreg f =
1584                      if targetFty <> 64 then
1585                      let val tmpR = newFreg()
1586                          val tmp  = I.FPR tmpR
1587                      in  mark(f tmp, an);
1588                          emit(I.FMOVE{fsize=fsize targetFty,
1589                                       src=tmp, dst=RealReg fd})
1590                      end
1591                      else mark(f(RealReg fd), an)
1592              in  case kind of
1593                    REAL =>
1594                      dstMustBeFreg(fn dst =>
1595                                       I.FBINOP{fsize=fsize fty, binOp=binOp,
1596                                                lsrc=lsrc, rsrc=rsrc, dst=dst})
1597                  | INTEGER =>
1598                      (dstMustBeFreg(fn dst =>
1599                                        I.FIBINOP{isize=isize fty, binOp=ibinOp,
1600                                                  lsrc=lsrc, rsrc=rsrc, dst=dst});
1601                       emits code
1602                      )
1603              end
1604    
1605          and funop(fty, unOp, src, fd, an) =
1606              let val src = foperand(fty, src)
1607              in  mark(I.FUNOP{fsize=fsize fty,
1608                               unOp=unOp, src=src, dst=RealReg fd},an)
1609              end
1610    
1611          and doFexpr''(fty, e, fd, an) =
1612             (floatingPointUsed := true;
1613              case e of
1614                T.FREG(_,fs) => if CB.sameColor(fs,fd) then ()
1615                                else fcopy''(fty, [fd], [fs], an)
1616                (* Stupid x86 does everything as 80-bits internally. *)
1617    
1618                (* Binary operators *)
1619              | T.FADD(_, a, b) => fbinop(fty,
1620                                          I.FADDL, I.FADDL, I.FIADDL, I.FIADDL,
1621                                          a, b, fd, an)
1622              | T.FSUB(_, a, b) => fbinop(fty,
1623                                          I.FSUBL, I.FSUBRL, I.FISUBL, I.FISUBRL,
1624                                          a, b, fd, an)
1625              | T.FMUL(_, a, b) => fbinop(fty,
1626                                          I.FMULL, I.FMULL, I.FIMULL, I.FIMULL,
1627                                          a, b, fd, an)
1628              | T.FDIV(_, a, b) => fbinop(fty,
1629                                          I.FDIVL, I.FDIVRL, I.FIDIVL, I.FIDIVRL,
1630                                          a, b, fd, an)
1631    
1632                (* Unary operators *)
1633              | T.FNEG(_, a) => funop(fty, I.FCHS, a, fd, an)
1634              | T.FABS(_, a) => funop(fty, I.FABS, a, fd, an)
1635              | T.FSQRT(_, a) => funop(fty, I.FSQRT, a, fd, an)
1636    
1637                (* Load *)
1638              | T.FLOAD(fty,ea,mem) => fload''(fty, ea, mem, fd, an)
1639    
1640                (* Type conversions *)
1641              | T.CVTF2F(_, _, e) => doFexpr''(fty, e, fd, an)
1642              | T.CVTI2F(_, ty, e) =>
1643                let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1644                in  fiload''(ty, ea, fd, an);
1645                    emits cleanup
1646                end
1647    
1648              | T.FMARK(e,A.MARKREG f) => (f fd; doFexpr''(fty, e, fd, an))
1649              | T.FMARK(e, a) => doFexpr''(fty, e, fd, a::an)
1650              | T.FPRED(e, c) => doFexpr''(fty, e, fd, A.CTRLUSE c::an)
1651              | T.FEXT fexp =>
1652                 ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an}
1653              | _ => error("doFexpr''")
1654             )
1655    
1656           (*========================================================
1657            * Tie the two styles of fp code generation together
1658            *========================================================*)
1659          and fstore(fty, ea, d, mem, an) =
1660              if enableFastFPMode andalso !fast_floating_point
1661              then fstore''(fty, ea, d, mem, an)
1662              else fstore'(fty, ea, d, mem, an)
1663          and fload(fty, ea, d, mem, an) =
1664              if enableFastFPMode andalso !fast_floating_point
1665              then fload''(fty, ea, d, mem, an)
1666              else fload'(fty, ea, d, mem, an)
1667          and fexpr e =
1668              if enableFastFPMode andalso !fast_floating_point
1669              then fexpr'' e else fexpr' e
1670          and doFexpr(fty, e, fd, an) =
1671              if enableFastFPMode andalso !fast_floating_point
1672              then doFexpr''(fty, e, fd, an)
1673              else doFexpr'(fty, e, fd, an)
1674    
1675          (*================================================================
1676           * Optimizations for x := x op y
1677           * Special optimizations:
1678           * Generate a binary operator, result must in memory.
1679           * The source must not be in memory
1680           *================================================================*)
1681          and binaryMem(binOp, src, dst, mem, an) =
1682              mark(I.BINARY{binOp=binOp, src=immedOrReg(operand src),
1683                            dst=address(dst,mem)}, an)
1684          and unaryMem(unOp, opnd, mem, an) =
1685              mark(I.UNARY{unOp=unOp, opnd=address(opnd,mem)}, an)
1686    
1687          and isOne(T.LI n) = n = one
1688            | isOne _ = false
1689    
1690          (*
1691           * Perform optimizations based on recognizing
1692           *    x := x op y    or
1693           *    x := y op x
1694           * first.
1695           *)
1696          and store(ty, ea, d, mem, an,
1697                    {INC,DEC,ADD,SUB,NOT,NEG,SHL,SHR,SAR,OR,AND,XOR},
1698                    doStore
1699                   ) =
1700              let fun default() = doStore(ea, d, mem, an)
1701                  fun binary1(t, t', unary, binary, ea', x) =
1702                      if t = ty andalso t' = ty then
1703                         if MLTreeUtils.eqRexp(ea, ea') then
1704                            if isOne x then unaryMem(unary, ea, mem, an)
1705                            else binaryMem(binary, x, ea, mem, an)
1706                          else default()
1707                      else default()
1708                  fun unary(t,unOp, ea') =
1709                      if t = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1710                         unaryMem(unOp, ea, mem, an)
1711                      else default()
1712                  fun binary(t,t',binOp,ea',x) =
1713                      if t = ty andalso t' = ty andalso
1714                         MLTreeUtils.eqRexp(ea, ea') then
1715                          binaryMem(binOp, x, ea, mem, an)
1716                      else default()
1717    
1718                  fun binaryCom1(t,unOp,binOp,x,y) =
1719                  if t = ty then
1720                  let fun again() =
1721                        case y of
1722                          T.LOAD(ty',ea',_) =>
1723                            if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1724                               if isOne x then unaryMem(unOp, ea, mem, an)
1725                               else binaryMem(binOp,x,ea,mem,an)
1726                            else default()
1727                        | _ => default()
1728                  in  case x of
1729                        T.LOAD(ty',ea',_) =>
1730                          if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1731                             if isOne y then unaryMem(unOp, ea, mem, an)
1732                             else binaryMem(binOp,y,ea,mem,an)
1733                          else again()
1734                      | _ => again()
1735                  end
1736                  else default()
1737    
1738                  fun binaryCom(t,binOp,x,y) =
1739                  if t = ty then
1740                  let fun again() =
1741                        case y of
1742                          T.LOAD(ty',ea',_) =>
1743                            if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1744                               binaryMem(binOp,x,ea,mem,an)
1745                            else default()
1746                        | _ => default()
1747                  in  case x of
1748                        T.LOAD(ty',ea',_) =>
1749                          if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1750                             binaryMem(binOp,y,ea,mem,an)
1751                          else again()
1752                      | _ => again()
1753                  end
1754                  else default()
1755    
1756              in  case d of
1757                    T.ADD(t,x,y) => binaryCom1(t,INC,ADD,x,y)
1758                  | T.SUB(t,T.LOAD(t',ea',_),x) => binary1(t,t',DEC,SUB,ea',x)
1759                  | T.ORB(t,x,y) => binaryCom(t,OR,x,y)
1760                  | T.ANDB(t,x,y) => binaryCom(t,AND,x,y)
1761                  | T.XORB(t,x,y) => binaryCom(t,XOR,x,y)
1762                  | T.SLL(t,T.LOAD(t',ea',_),x) => binary(t,t',SHL,ea',x)
1763                  | T.SRL(t,T.LOAD(t',ea',_),x) => binary(t,t',SHR,ea',x)
1764                  | T.SRA(t,T.LOAD(t',ea',_),x) => binary(t,t',SAR,ea',x)
1765                  | T.NEG(t,T.LOAD(t',ea',_)) => unary(t,NEG,ea')
1766                  | T.NOTB(t,T.LOAD(t',ea',_)) => unary(t,NOT,ea')
1767                  | _ => default()
1768              end (* store *)
1769    
1770            (* generate code for a statement *)            (* generate code for a statement *)
1771        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)
1772          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)
1773          | stmt(T.CCMV(ccd, e), an) = doCCexpr(e, ccd, an)          | stmt(T.CCMV(ccd, e), an) = doCCexpr(e, ccd, an)
1774          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)
1775          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)
1776          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)          | stmt(T.JMP(e, labs), an) = jmp(e, labs, an)
1777          | stmt(T.CALL(e, flow, def, use, cdef, cuse, mem), an) =          | stmt(T.CALL{funct, targets, defs, uses, region, pops, ...}, an) =
1778               call(e,flow,def,use,mem,an)               call(funct,targets,defs,uses,region,[],an, pops)
1779            | stmt(T.FLOW_TO(T.CALL{funct, targets, defs, uses, region, pops, ...},
1780                             cutTo), an) =
1781                 call(funct,targets,defs,uses,region,cutTo,an, pops)
1782          | stmt(T.RET _, an) = mark(I.RET NONE, an)          | stmt(T.RET _, an) = mark(I.RET NONE, an)
1783          | stmt(T.STORE(8, ea, d, mem), an) = store8(ea, d, mem, an)          | stmt(T.STORE(8, ea, d, mem), an)  =
1784          | stmt(T.STORE(16, ea, d, mem), an) = store16(ea, d, mem, an)               store(8, ea, d, mem, an, opcodes8, store8)
1785          | stmt(T.STORE(32, ea, d, mem), an) = store32(ea, d, mem, an)          | stmt(T.STORE(16, ea, d, mem), an) =
1786                 store(16, ea, d, mem, an, opcodes16, store16)
1787            | stmt(T.STORE(32, ea, d, mem), an) =
1788                 store(32, ea, d, mem, an, opcodes32, store32)
1789    
1790          | stmt(T.FSTORE(fty, ea, d, mem), an) = fstore(fty, ea, d, mem, an)          | stmt(T.FSTORE(fty, ea, d, mem), an) = fstore(fty, ea, d, mem, an)
1791          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)          | stmt(T.BCC(cc, lab), an) = branch(cc, lab, an)
1792          | stmt(T.DEFINE l, _) = defineLabel l          | stmt(T.DEFINE l, _) = defineLabel l
1793          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)
1794            | stmt(T.EXT s, an) =
1795                 ExtensionComp.compileSext (reducer()) {stm=s, an=an}
1796          | stmt(s, _) = doStmts(Gen.compileStm s)          | stmt(s, _) = doStmts(Gen.compileStm s)
1797    
1798        and doStmt s = stmt(s, [])        and doStmt s = stmt(s, [])
# Line 1147  Line 1802 
1802           ((* Must be cleared by the client.           ((* Must be cleared by the client.
1803             * if rewriteMemReg then memRegsUsed := 0w0 else ();             * if rewriteMemReg then memRegsUsed := 0w0 else ();
1804             *)             *)
1805            trapLabel := NONE; beginCluster 0)            floatingPointUsed := false;
1806              trapLabel := NONE;
1807              beginCluster 0
1808             )
1809        and endCluster' a =        and endCluster' a =
1810           (case !trapLabel           (case !trapLabel
1811            of NONE => ()            of NONE => ()
1812             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))
1813            (*esac*);            (*esac*);
1814              (* If floating point has been used allocate an extra
1815               * register just in case we didn't use any explicit register
1816               *)
1817              if !floatingPointUsed then (newFreg(); ())
1818              else ();
1819            endCluster(a)            endCluster(a)
1820           )           )
1821    
1822        and reducer() =        and reducer() =
1823            T.REDUCER{reduceRexp    = expr,            TS.REDUCER{reduceRexp    = expr,
1824                      reduceFexp    = fexpr,                      reduceFexp    = fexpr,
1825                      reduceCCexp   = ccExpr,                      reduceCCexp   = ccExpr,
1826                      reduceStm     = stmt,                      reduceStm     = stmt,
1827                      operand       = operand,                      operand       = operand,
1828                      reduceOperand = reduceOpnd,                      reduceOperand = reduceOpnd,
1829                      addressOf     = fn e => address(e, I.Region.memory), (*XXX*)                      addressOf     = fn e => address(e, I.Region.memory), (*XXX*)
1830                      emit          = mark,                      emit          = mark',
1831                      instrStream   = instrStream,                      instrStream   = instrStream,
1832                      mltreeStream  = self()                      mltreeStream  = self()
1833                     }                     }
1834    
1835        and self() =        and self() =
1836            S.STREAM            TS.S.STREAM
1837            {  beginCluster= beginCluster',            {  beginCluster= beginCluster',
1838               endCluster  = endCluster',               endCluster  = endCluster',
1839               emit        = doStmt,               emit        = doStmt,
# Line 1179  Line 1842 
1842               entryLabel  = entryLabel,               entryLabel  = entryLabel,
1843               comment     = comment,               comment     = comment,
1844               annotation  = annotation,               annotation  = annotation,
1845               exitBlock   = fn mlrisc => exitBlock(cellset mlrisc),               getAnnotations = getAnnotations,
1846               alias       = alias,               exitBlock      = fn mlrisc => exitBlock(cellset mlrisc)
              phi         = phi  
1847            }            }
1848    
1849    in  self()    in  self()

Legend:
Removed from v.545  
changed lines
  Added in v.1156

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