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 583, Thu Mar 23 21:52:30 2000 UTC revision 889, Thu Jul 19 20:35:20 2001 UTC
# 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         where T = X86Instr.T
44     structure ExtensionComp : MLTREE_EXTENSION_COMP     structure ExtensionComp : MLTREE_EXTENSION_COMP
45       where I = X86Instr and T = X86MLTree       where I = X86Instr
      sharing X86MLTree.Region = X86Instr.Region  
      sharing X86MLTree.LabelExp = X86Instr.LabelExp  
46      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII
47      val arch : arch ref      val arch : arch ref
48      val tempMem : X86Instr.operand (* temporary for CVTI2F *)      val cvti2f :
49             {ty: X86Instr.T.ty,
50              src: X86Instr.operand,
51                 (* source operand, guaranteed to be non-memory! *)
52              an: Annotations.annotations ref (* cluster annotations *)
53             } ->
54             {instrs : X86Instr.instruction list,(* the instructions *)
55              tempMem: X86Instr.operand,         (* temporary for CVTI2F *)
56              cleanup: X86Instr.instruction list (* cleanup code *)
57             }
58        (* When the following flag is set, we allocate floating point registers
59         * directly on the floating point stack
60         *)
61        val fast_floating_point : bool ref
62    ) : sig include MLTREECOMP    ) : sig include MLTREECOMP
63            val rewriteMemReg : bool            val rewriteMemReg : bool
64        end =        end =
65  struct  struct
   structure T = X86MLTree  
   structure S = T.Stream  
66    structure I = X86Instr    structure I = X86Instr
67      structure T = I.T
68      structure S = T.Stream
69    structure C = I.C    structure C = I.C
70    structure Shuffle = Shuffle(I)    structure Shuffle = Shuffle(I)
71    structure W32 = Word32    structure W32 = Word32
72    structure LE = I.LabelExp    structure LE = I.LabelExp
73    structure A = MLRiscAnnotations    structure A = MLRiscAnnotations
74      structure CB = CellsBasis
75    
76    type instrStream = (I.instruction,C.regmap,C.cellset) T.stream    type instrStream = (I.instruction,C.cellset) T.stream
77    type mltreeStream = (T.stm,C.regmap,T.mlrisc list) T.stream    type mltreeStream = (T.stm,T.mlrisc list) T.stream
78    
79    datatype kind = REAL | INTEGER    datatype kind = REAL | INTEGER
80    
# Line 70  Line 92 
92     * If this is on, we can avoid doing RewritePseudo phase entirely.     * If this is on, we can avoid doing RewritePseudo phase entirely.
93     *)     *)
94    val rewriteMemReg = rewriteMemReg    val rewriteMemReg = rewriteMemReg
95    fun isMemReg r = rewriteMemReg andalso r >= 8 andalso r < 32  
96      (* The following hardcoded *)
97      fun isMemReg r = rewriteMemReg andalso
98                       let val r = CB.registerNum r
99                       in  r >= 8 andalso r < 32
100                       end
101      fun isFMemReg r = if enableFastFPMode andalso !fast_floating_point
102                        then let val r = CB.registerNum r
103                             in r >= 8 andalso r < 32 end
104                        else true
105      val isAnyFMemReg = List.exists (fn r =>
106                                      let val r = CB.registerNum r
107                                      in  r >= 8 andalso r < 32 end
108                                     )
109    
110    val ST0 = C.ST 0    val ST0 = C.ST 0
111    val ST7 = C.ST 7    val ST7 = C.ST 7
112      val one = T.I.int_1
113    
114      val opcodes8 = {INC=I.INCB,DEC=I.DECB,ADD=I.ADDB,SUB=I.SUBB,
115                      NOT=I.NOTB,NEG=I.NEGB,
116                      SHL=I.SHLB,SHR=I.SHRB,SAR=I.SARB,
117                      OR=I.ORB,AND=I.ANDB,XOR=I.XORB}
118      val opcodes16 = {INC=I.INCW,DEC=I.DECW,ADD=I.ADDW,SUB=I.SUBW,
119                       NOT=I.NOTW,NEG=I.NEGW,
120                       SHL=I.SHLW,SHR=I.SHRW,SAR=I.SARW,
121                       OR=I.ORW,AND=I.ANDW,XOR=I.XORW}
122      val opcodes32 = {INC=I.INCL,DEC=I.DECL,ADD=I.ADDL,SUB=I.SUBL,
123                       NOT=I.NOTL,NEG=I.NEGL,
124                       SHL=I.SHLL,SHR=I.SHRL,SAR=I.SARL,
125                       OR=I.ORL,AND=I.ANDL,XOR=I.XORL}
126    
127    (*    (*
128     * The code generator     * The code generator
129     *)     *)
130    fun selectInstructions    fun selectInstructions
131         (instrStream as         (instrStream as
132          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,getAnnotations,
133                   beginCluster,endCluster,exitBlock,alias,phi,comment,...}) =                   beginCluster,endCluster,exitBlock,comment,...}) =
134    let exception EA    let exception EA
135    
136        (* label where a trap is generated -- one per cluster *)        (* label where a trap is generated -- one per cluster *)
137        val trapLabel = ref (NONE: (I.instruction * Label.label) option)        val trapLabel = ref (NONE: (I.instruction * Label.label) option)
138    
139          (* flag floating point generation *)
140          val floatingPointUsed = ref false
141    
142        (* effective address of an integer register *)        (* effective address of an integer register *)
143        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
144        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  
           )  
145    
146        (* Add an overflow trap *)        (* Add an overflow trap *)
147        fun trap() =        fun trap() =
# Line 101  Line 149 
149              case !trapLabel of              case !trapLabel of
150                NONE => let val label = Label.newLabel "trap"                NONE => let val label = Label.newLabel "trap"
151                            val jmp   = I.JCC{cond=I.O,                            val jmp   = I.JCC{cond=I.O,
152                                              opnd=I.ImmedLabel(LE.LABEL label)}                                              opnd=I.ImmedLabel(T.LABEL label)}
153                        in  trapLabel := SOME(jmp, label); jmp end                        in  trapLabel := SOME(jmp, label); jmp end
154              | SOME(jmp, _) => jmp              | SOME(jmp, _) => jmp
155        in  emit jmp end        in  emit jmp end
# Line 109  Line 157 
157        val newReg  = C.newReg        val newReg  = C.newReg
158        val newFreg = C.newFreg        val newFreg = C.newFreg
159    
160          fun fsize 32 = I.FP32
161            | fsize 64 = I.FP64
162            | fsize 80 = I.FP80
163            | fsize _  = error "fsize"
164    
165        (* mark an expression with a list of annotations *)        (* mark an expression with a list of annotations *)
166        fun mark'(i,[]) = i        fun mark'(i,[]) = i
167          | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)          | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)
# Line 116  Line 169 
169        (* annotate an expression and emit it *)        (* annotate an expression and emit it *)
170        fun mark(i,an) = emit(mark'(i,an))        fun mark(i,an) = emit(mark'(i,an))
171    
172          val emits = app emit
173    
174        (* emit parallel copies for integers        (* emit parallel copies for integers
175         * Translates parallel copies that involve memregs into         * Translates parallel copies that involve memregs into
176         * individual copies.         * individual copies.
# Line 123  Line 178 
178        fun copy([], [], an) = ()        fun copy([], [], an) = ()
179          | copy(dst, src, an) =          | copy(dst, src, an) =
180            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} =
181                    if rd = rs then [] else                    if CB.sameColor(rd,rs) then [] else
182                    let val tmpR = I.Direct(newReg())                    let val tmpR = I.Direct(newReg())
183                    in  [I.MOVE{mvOp=I.MOVL, src=src, dst=tmpR},                    in  [I.MOVE{mvOp=I.MOVL, src=src, dst=tmpR},
184                         I.MOVE{mvOp=I.MOVL, src=tmpR, dst=dst}]                         I.MOVE{mvOp=I.MOVL, src=tmpR, dst=dst}]
185                    end                    end
186                  | mvInstr{dst=I.Direct rd, src=I.Direct rs} =                  | mvInstr{dst=I.Direct rd, src=I.Direct rs} =
187                      if rd = rs then []                      if CB.sameColor(rd,rs) then []
188                      else [I.COPY{dst=[rd], src=[rs], tmp=NONE}]                      else [I.COPY{dst=[rd], src=[rs], tmp=NONE}]
189                  | mvInstr{dst, src} = [I.MOVE{mvOp=I.MOVL, src=src, dst=dst}]                  | mvInstr{dst, src} = [I.MOVE{mvOp=I.MOVL, src=src, dst=dst}]
190            in            in
191               app emit (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}               emits (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}
192                 {regmap=fn r => r, tmp=SOME(I.Direct(newReg())),                 {tmp=SOME(I.Direct(newReg())),
193                  dst=dst, src=src})                  dst=dst, src=src})
194            end            end
195    
196        (* conversions *)        (* conversions *)
197        val itow = Word.fromInt        val itow = Word.fromInt
198        val wtoi = Word.toInt        val wtoi = Word.toInt
199        fun toInt32 i = Int32.fromLarge(Int.toLarge i)        fun toInt32 i = T.I.toInt32(32, i)
200        val w32toi32 = Word32.toLargeIntX        val w32toi32 = Word32.toLargeIntX
201        val i32tow32 = Word32.fromLargeInt        val i32tow32 = Word32.fromLargeInt
202    
# Line 153  Line 208 
208        val ecx = I.Direct(C.ecx)        val ecx = I.Direct(C.ecx)
209        val edx = I.Direct(C.edx)        val edx = I.Direct(C.edx)
210    
211        fun immedLabel lab = I.ImmedLabel(LE.LABEL lab)        fun immedLabel lab = I.ImmedLabel(T.LABEL lab)
212    
213        (* Is the expression zero? *)        (* Is the expression zero? *)
214        fun isZero(T.LI 0) = true        fun isZero(T.LI z) = T.I.isZero z
         | isZero(T.LI32 0w0) = true  
215          | isZero(T.MARK(e,a)) = isZero e          | isZero(T.MARK(e,a)) = isZero e
216          | isZero _ = false          | isZero _ = false
217         (* Does the expression set the zero bit?         (* Does the expression set the zero bit?
# Line 169  Line 223 
223          | setZeroBit(T.SRA _)      = true          | setZeroBit(T.SRA _)      = true
224          | setZeroBit(T.SRL _)      = true          | setZeroBit(T.SRL _)      = true
225          | setZeroBit(T.SLL _)      = true          | setZeroBit(T.SLL _)      = true
226            | setZeroBit(T.SUB _)      = true
227            | setZeroBit(T.ADDT _)     = true
228            | setZeroBit(T.SUBT _)     = true
229          | setZeroBit(T.MARK(e, _)) = setZeroBit e          | setZeroBit(T.MARK(e, _)) = setZeroBit e
230          | setZeroBit _             = false          | setZeroBit _             = false
231    
232        (* emit parallel copies for floating point *)        fun setZeroBit2(T.ANDB _)     = true
233        fun fcopy(fty, [], [], _) = ()          | setZeroBit2(T.ORB _)      = true
234          | fcopy(fty, dst as [_], src as [_], an) =          | setZeroBit2(T.XORB _)     = true
235            | setZeroBit2(T.SRA _)      = true
236            | setZeroBit2(T.SRL _)      = true
237            | setZeroBit2(T.SLL _)      = true
238            | setZeroBit2(T.ADD(32, _, _)) = true (* can't use leal! *)
239            | setZeroBit2(T.SUB _)      = true
240            | setZeroBit2(T.ADDT _)     = true
241            | setZeroBit2(T.SUBT _)     = true
242            | setZeroBit2(T.MARK(e, _)) = setZeroBit2 e
243            | setZeroBit2 _             = false
244    
245          (* emit parallel copies for floating point
246           * Normal version.
247           *)
248          fun fcopy'(fty, [], [], _) = ()
249            | fcopy'(fty, dst as [_], src as [_], an) =
250              mark(I.FCOPY{dst=dst,src=src,tmp=NONE}, an)              mark(I.FCOPY{dst=dst,src=src,tmp=NONE}, an)
251          | fcopy(fty, dst, src, an) =          | fcopy'(fty, dst, src, an) =
252              mark(I.FCOPY{dst=dst,src=src,tmp=SOME(I.FDirect(newFreg()))}, an)              mark(I.FCOPY{dst=dst,src=src,tmp=SOME(I.FDirect(newFreg()))}, an)
253    
254          (* emit parallel copies for floating point.
255           * Fast version.
256           * Translates parallel copies that involve memregs into
257           * individual copies.
258           *)
259    
260          fun fcopy''(fty, [], [], _) = ()
261            | fcopy''(fty, dst, src, an) =
262              if true orelse isAnyFMemReg dst orelse isAnyFMemReg src then
263              let val fsize = fsize fty
264                  fun mvInstr{dst, src} = [I.FMOVE{fsize=fsize, src=src, dst=dst}]
265              in
266                  emits (Shuffle.shuffle{mvInstr=mvInstr, ea=RealReg}
267                    {tmp=case dst of
268                           [_] => NONE
269                         |  _  => SOME(I.FPR(newReg())),
270                     dst=dst, src=src})
271              end
272              else
273                mark(I.FCOPY{dst=dst,src=src,tmp=
274                             case dst of
275                               [_] => NONE
276                             | _   => SOME(I.FPR(newFreg()))}, an)
277    
278          fun fcopy x = if enableFastFPMode andalso !fast_floating_point
279                        then fcopy'' x else fcopy' x
280    
281        (* Translates MLTREE condition code to x86 condition code *)        (* Translates MLTREE condition code to x86 condition code *)
282        fun cond T.LT = I.LT | cond T.LTU = I.B        fun cond T.LT = I.LT | cond T.LTU = I.B
283          | cond T.LE = I.LE | cond T.LEU = I.BE          | cond T.LE = I.LE | cond T.LEU = I.BE
# Line 186  Line 285 
285          | cond T.GE = I.GE | cond T.GEU = I.AE          | cond T.GE = I.GE | cond T.GEU = I.AE
286          | cond T.GT = I.GT | cond T.GTU = I.A          | cond T.GT = I.GT | cond T.GTU = I.A
287    
288          fun zero dst = emit(I.BINARY{binOp=I.XORL, src=dst, dst=dst})
289    
290        (* Move and annotate *)        (* Move and annotate *)
291        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) =
292            if s=d then ()            if CB.sameColor(s,d) then ()
293            else mark(I.COPY{dst=[d], src=[s], tmp=NONE}, an)            else mark(I.COPY{dst=[d], src=[s], tmp=NONE}, an)
294            | move'(I.Immed 0, dst as I.Direct d, an) =
295                mark(I.BINARY{binOp=I.XORL, src=dst, dst=dst}, an)
296          | 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)
297    
298        (* Move only! *)        (* Move only! *)
299        fun move(src, dst) = move'(src, dst, [])        fun move(src, dst) = move'(src, dst, [])
300    
       fun zero dst = emit(I.BINARY{binOp=I.XORL, src=dst, dst=dst})  
   
301        val readonly = I.Region.readonly        val readonly = I.Region.readonly
302    
303        (*        (*
304         * Compute an effective address.  This is a new version         * Compute an effective address.
305         *)         *)
306        fun address(ea, mem) =        fun address(ea, mem) = let
       let (* tricky way to negate without overflow! *)  
           fun neg32 w = Word32.notb w + 0w1  
   
307            (* Keep building a bigger and bigger effective address expressions            (* Keep building a bigger and bigger effective address expressions
308             * The input is a list of trees             * The input is a list of trees
309             * b -- base             * b -- base
# Line 216  Line 314 
314            fun doEA([], b, i, s, d) = makeAddressingMode(b, i, s, d)            fun doEA([], b, i, s, d) = makeAddressingMode(b, i, s, d)
315              | doEA(t::trees, b, i, s, d) =              | doEA(t::trees, b, i, s, d) =
316                (case t of                (case t of
317                   T.LI n   => doEAImmed(trees, n, b, i, s, d)                   T.LI n   => doEAImmed(trees, toInt32 n, b, i, s, d)
318                 | T.LI32 n => doEAImmedw(trees, n, b, i, s, d)                 | T.CONST _ => doEALabel(trees, t, b, i, s, d)
319                 | T.CONST c => doEALabel(trees, LE.CONST c, b, i, s, d)                 | T.LABEL _ => doEALabel(trees, t, b, i, s, d)
320                 | T.LABEL le => doEALabel(trees, le, b, i, s, d)                 | T.LABEXP le => doEALabel(trees, le, b, i, s, d)
321                 | T.ADD(32, t1, t2 as T.REG(_,r)) =>                 | T.ADD(32, t1, t2 as T.REG(_,r)) =>
322                      if isMemReg r then doEA(t2::t1::trees, b, i, s, d)                      if isMemReg r then doEA(t2::t1::trees, b, i, s, d)
323                      else doEA(t1::t2::trees, b, i, s, d)                      else doEA(t1::t2::trees, b, i, s, d)
324                 | 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)
325                 | T.SUB(32, t1, T.LI n) =>                 | T.SUB(32, t1, T.LI n) =>
326                      (* can't overflow here *)                      doEA(t1::T.LI(T.I.NEG(32,n))::trees, b, i, s, d)
327                      doEA(t1::T.LI32(neg32(Word32.fromInt n))::trees, b, i, s, d)                 | T.SLL(32, t1, T.LI n) => let
328                 | T.SUB(32, t1, T.LI32 n) =>                      val n = T.I.toInt(32, n)
329                      doEA(t1::T.LI32(neg32 n)::trees, b, i, s, d)                   in
330                 | T.SLL(32, t1, T.LI 0) => displace(trees, t1, b, i, s, d)                     case n
331                 | 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)
332                 | 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)
333                 | 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)
334                 | T.SLL(32, t1, T.LI32 0w0) => displace(trees, t1, b, i, s, d)                      | 3 => indexed(trees, t1, t, 3, b, i, s, d)
335                 | T.SLL(32, t1, T.LI32 0w1) => indexed(trees,t1,t,1,b,i,s,d)                      | _ => displace(trees, t, b, i, s, d)
336                 | 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)  
337                 | t => displace(trees, t, b, i, s, d)                 | t => displace(trees, t, b, i, s, d)
338                )                )
339    
340            (* Add an immed constant *)            (* Add an immed constant *)
341            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)
342              | doEAImmed(trees, n, b, i, s, I.Immed m) =              | doEAImmed(trees, n, b, i, s, I.Immed m) =
343                   doEA(trees, b, i, s, (* no overflow! *)                   doEA(trees, b, i, s, I.Immed(n+m))
                        I.Immed(w32toi32(Word32.fromInt n + i32tow32 m)))  
344              | 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) =  
345                   doEA(trees, b, i, s,                   doEA(trees, b, i, s,
346                        I.ImmedLabel(LE.PLUS(le,LE.INT(Word32.toIntX n)))                        I.ImmedLabel(T.ADD(32,le,T.LI(T.I.fromInt32(32, n)))))
347                        handle Overflow => error "doEAImmedw: constant too large")              | doEAImmed(trees, n, b, i, s, _) = error "doEAImmed"
             | doEAImmedw(trees, n, b, i, s, _) = error "doEAImmedw"  
348    
349            (* Add a label expression *)            (* Add a label expression *)
350            and doEALabel(trees, le, b, i, s, I.Immed 0) =            and doEALabel(trees, le, b, i, s, I.Immed 0) =
351                   doEA(trees, b, i, s, I.ImmedLabel le)                   doEA(trees, b, i, s, I.ImmedLabel le)
352              | doEALabel(trees, le, b, i, s, I.Immed m) =              | doEALabel(trees, le, b, i, s, I.Immed m) =
353                   doEA(trees, b, i, s,                   doEA(trees, b, i, s,
354                        I.ImmedLabel(LE.PLUS(le,LE.INT(Int32.toInt m)))                        I.ImmedLabel(T.ADD(32,le,T.LI(T.I.fromInt32(32, m))))
355                        handle Overflow => error "doEALabel: constant too large")                        handle Overflow => error "doEALabel: constant too large")
356              | doEALabel(trees, le, b, i, s, I.ImmedLabel le') =              | doEALabel(trees, le, b, i, s, I.ImmedLabel le') =
357                   doEA(trees, b, i, s, I.ImmedLabel(LE.PLUS(le,le')))                   doEA(trees, b, i, s, I.ImmedLabel(T.ADD(32,le,le')))
358              | doEALabel(trees, le, b, i, s, _) = error "doEALabel"              | doEALabel(trees, le, b, i, s, _) = error "doEALabel"
359    
360            and makeAddressingMode(NONE, NONE, _, disp) = disp            and makeAddressingMode(NONE, NONE, _, disp) = disp
# Line 281  Line 367 
367            (* generate code for tree and ensure that it is not in %esp *)            (* generate code for tree and ensure that it is not in %esp *)
368            and exprNotEsp tree =            and exprNotEsp tree =
369                let val r = expr tree                let val r = expr tree
370                in  if r = C.esp then                in  if CB.sameColor(r, C.esp) then
371                       let val tmp = newReg()                       let val tmp = newReg()
372                       in  move(I.Direct r, I.Direct tmp); tmp end                       in  move(I.Direct r, I.Direct tmp); tmp end
373                    else r                    else r
# Line 293  Line 379 
379              | displace(trees, t, b as SOME base, NONE, _, d) = (* no index *)              | displace(trees, t, b as SOME base, NONE, _, d) = (* no index *)
380                (* make t the index, but make sure that it is not %esp! *)                (* make t the index, but make sure that it is not %esp! *)
381                let val i = expr t                let val i = expr t
382                in  if i = C.esp then                in  if CB.sameColor(i, C.esp) then
383                      (* swap base and index *)                      (* swap base and index *)
384                      if base <> C.esp then                      if CB.sameColor(base, C.esp) then
385                         doEA(trees, SOME i, b, 0, d)                         doEA(trees, SOME i, b, 0, d)
386                      else  (* base and index = %esp! *)                      else  (* base and index = %esp! *)
387                         let val index = newReg()                         let val index = newReg()
# Line 325  Line 411 
411        end (* address *)        end (* address *)
412    
413            (* reduce an expression into an operand *)            (* reduce an expression into an operand *)
414        and operand(T.LI i) = I.Immed(toInt32 i)        and operand(T.LI i) = I.Immed(toInt32(i))
415          | operand(T.LI32 w) = I.Immed(wToInt32 w)          | operand(x as (T.CONST _ | T.LABEL _)) = I.ImmedLabel x
416          | operand(T.CONST c) = I.ImmedLabel(LE.CONST c)          | operand(T.LABEXP le) = I.ImmedLabel le
         | operand(T.LABEL lab) = I.ImmedLabel lab  
417          | operand(T.REG(_,r)) = IntReg r          | operand(T.REG(_,r)) = IntReg r
418          | operand(T.LOAD(32,ea,mem)) = address(ea, mem)          | operand(T.LOAD(32,ea,mem)) = address(ea, mem)
419          | operand(t) = I.Direct(expr t)          | operand(t) = I.Direct(expr t)
# Line 371  Line 456 
456            * Compute an integer expression and put the result in            * Compute an integer expression and put the result in
457            * the destination register rd.            * the destination register rd.
458            *)            *)
459        and doExpr(exp, rd : I.C.cell, an) =        and doExpr(exp, rd : CB.cell, an) =
460            let val rdOpnd = IntReg rd            let val rdOpnd = IntReg rd
461    
462                fun equalRd(I.Direct r) = r = rd                fun equalRd(I.Direct r) = CB.sameColor(r, rd)
463                  | equalRd(I.MemReg r) = r = rd                  | equalRd(I.MemReg r) = CB.sameColor(r, rd)
464                  | equalRd _ = false                  | equalRd _ = false
465    
466                   (* Emit a binary operator.  If the destination is                   (* Emit a binary operator.  If the destination is
# Line 449  Line 534 
534                fun divrem(signed, overflow, e1, e2, resultReg) =                fun divrem(signed, overflow, e1, e2, resultReg) =
535                let val (opnd1, opnd2) = (operand e1, operand e2)                let val (opnd1, opnd2) = (operand e1, operand e2)
536                    val _ = move(opnd1, eax)                    val _ = move(opnd1, eax)
537                    val oper = if signed then (emit(I.CDQ); I.IDIV)                    val oper = if signed then (emit(I.CDQ); I.IDIVL1)
538                               else (zero edx; I.UDIV)                               else (zero edx; I.DIVL1)
539                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);
540                    move(resultReg, rdOpnd);                    move(resultReg, rdOpnd);
541                    if overflow then trap() else ()                    if overflow then trap() else ()
542                end                end
543    
544                    (* Optimize the special case for division *)                    (* Optimize the special case for division *)
545                fun divide(signed, overflow, e1, e2 as T.LI n) =                fun divide(signed, overflow, e1, e2 as T.LI n') = let
546                let fun isPowerOf2 w = Word.andb((w - 0w1), w) = 0w0                    val n = toInt32 n'
547                      val w = T.I.toWord32(32, n')
548                      fun isPowerOf2 w = W32.andb((w - 0w1), w) = 0w0
549                    fun log2 n =  (* n must be > 0!!! *)                    fun log2 n =  (* n must be > 0!!! *)
550                        let fun loop(0w1,pow) = pow                        let fun loop(0w1,pow) = pow
551                              | loop(w,pow) = loop(Word.>>(w, 0w1),pow+1)                              | loop(w,pow) = loop(W32.>>(w, 0w1),pow+1)
552                        in loop(n,0) end                        in loop(n,0) end
                   val w = Word.fromInt n  
553                in  if n > 1 andalso isPowerOf2 w then                in  if n > 1 andalso isPowerOf2 w then
554                       let val pow = T.LI(log2 w)                       let val pow = T.LI(T.I.fromInt(32,log2 w))
555                       in  if signed then                       in  if signed then
556                           (* signed; simulate round towards zero *)                           (* signed; simulate round towards zero *)
557                           let val label = Label.newLabel ""                           let val label = Label.newLabel ""
# Line 478  Line 564 
564                                       I.UNARY{unOp=I.INCL, opnd=opnd1}                                       I.UNARY{unOp=I.INCL, opnd=opnd1}
565                                    else                                    else
566                                       I.BINARY{binOp=I.ADDL,                                       I.BINARY{binOp=I.ADDL,
567                                                src=I.Immed(toInt32 n - 1),                                                src=I.Immed(n - 1),
568                                                dst=opnd1});                                                dst=opnd1});
569                               defineLabel label;                               defineLabel label;
570                               shift(I.SARL, T.REG(32, reg1), pow)                               shift(I.SARL, T.REG(32, reg1), pow)
# Line 499  Line 585 
585                fun rem(signed, overflow, e1, e2) =                fun rem(signed, overflow, e1, e2) =
586                      divrem(signed, overflow, e1, e2, edx)                      divrem(signed, overflow, e1, e2, edx)
587    
588                      (* Makes sure the destination must be a register *)
589                  fun dstMustBeReg f =
590                      if isMemReg rd then
591                      let val tmpR = newReg()
592                          val tmp  = I.Direct(tmpR)
593                      in  f(tmpR, tmp); move(tmp, rdOpnd) end
594                      else f(rd, rdOpnd)
595    
596                    (* unsigned integer multiplication *)                    (* unsigned integer multiplication *)
597                fun uMultiply(e1, e2) =                fun uMultiply(e1, e2) =
598                    (* note e2 can never be (I.Direct edx) *)                    (* note e2 can never be (I.Direct edx) *)
599                    (move(operand e1, eax);                    (move(operand e1, eax);
600                     mark(I.MULTDIV{multDivOp=I.UMUL,                     mark(I.MULTDIV{multDivOp=I.MULL1,
601                                    src=regOrMem(operand e2)},an);                                    src=regOrMem(operand e2)},an);
602                     move(eax, rdOpnd)                     move(eax, rdOpnd)
603                    )                    )
# Line 512  Line 606 
606                     * The only forms that are allowed that also sets the                     * The only forms that are allowed that also sets the
607                     * OF and CF flags are:                     * OF and CF flags are:
608                     *                     *
609                       *          (dst)  (src1)  (src2)
610                     *      imul r32, r32/m32, imm8                     *      imul r32, r32/m32, imm8
611                       *          (dst)  (src)
612                     *      imul r32, imm8                     *      imul r32, imm8
613                     *      imul r32, imm32                     *      imul r32, imm32
614                       *      imul r32, r32/m32
615                       * Note: destination must be a register!
616                     *)                     *)
617                fun multiply(e1, e2) =                fun multiply(e1, e2) =
618                let fun doit(i1 as I.Immed _, i2 as I.Immed _, dstR, dst) =                dstMustBeReg(fn (rd, rdOpnd) =>
619                        (move(i1, dst);                let fun doit(i1 as I.Immed _, i2 as I.Immed _) =
620                         mark(I.MUL3{dst=dstR, src1=i2, src2=NONE},an))                        (move(i1, rdOpnd);
621                      | doit(rm, i2 as I.Immed _, dstR, dst) =                         mark(I.BINARY{binOp=I.IMULL, dst=rdOpnd, src=i2},an))
622                          doit(i2, rm, dstR, dst)                      | doit(rm, i2 as I.Immed _) = doit(i2, rm)
623                      | doit(imm as I.Immed(i), rm, dstR, dst) =                      | doit(imm as I.Immed(i), rm) =
624                         mark(I.MUL3{dst=dstR, src1=rm, src2=SOME i},an)                             mark(I.MUL3{dst=rd, src1=rm, src2=i},an)
625                      | doit(r1 as I.Direct _, r2 as I.Direct _, dstR, dst) =                      | doit(r1 as I.Direct _, r2 as I.Direct _) =
626                        (move(r1, dst);                        (move(r1, rdOpnd);
627                         mark(I.MUL3{dst=dstR, src1=r2, src2=NONE},an))                         mark(I.BINARY{binOp=I.IMULL, dst=rdOpnd, src=r2},an))
628                      | doit(r1 as I.Direct _, rm, dstR, dst) =                      | doit(r1 as I.Direct _, rm) =
629                        (move(r1, dst);                        (move(r1, rdOpnd);
630                         mark(I.MUL3{dst=dstR, src1=rm, src2=NONE},an))                         mark(I.BINARY{binOp=I.IMULL, dst=rdOpnd, src=rm},an))
631                      | doit(rm, r as I.Direct _, dstR, dst) =                      | doit(rm, r as I.Direct _) = doit(r, rm)
632                         doit(r, rm, dstR, dst)                      | doit(rm1, rm2) =
                     | doit(rm1, rm2, dstR, dst) =  
633                         if equalRd rm2 then                         if equalRd rm2 then
634                         let val tmpR = newReg()                         let val tmpR = newReg()
635                             val tmp  = I.Direct tmpR                             val tmp  = I.Direct tmpR
636                         in move(rm1, tmp);                         in move(rm1, tmp);
637                            mark(I.MUL3{dst=tmpR, src1=rm2, src2=NONE},an);                            mark(I.BINARY{binOp=I.IMULL, dst=tmp, src=rm2},an);
638                            move(tmp, dst)                            move(tmp, rdOpnd)
639                         end                         end
640                         else                         else
641                           (move(rm1, dst);                           (move(rm1, rdOpnd);
642                            mark(I.MUL3{dst=dstR, src1=rm2, src2=NONE},an)                            mark(I.BINARY{binOp=I.IMULL, dst=rdOpnd, src=rm2},an)
643                           )                           )
644                    val (opnd1, opnd2) = (operand e1, operand e2)                    val (opnd1, opnd2) = (operand e1, operand e2)
645                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)  
646                    end                    end
647                    else                )
                       doit(opnd1, opnd2, rd, rdOpnd)  
               end  
   
                  (* 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)  
648    
649                   (* Emit a load instruction; makes sure that the destination                   (* Emit a load instruction; makes sure that the destination
650                    * is a register                    * is a register
# Line 596  Line 679 
679                     * only writes to the low order                     * only writes to the low order
680                     * byte.  That's Intel architecture, folks.                     * byte.  That's Intel architecture, folks.
681                     *)                     *)
682                    zero eax;                    case (yes, no, cc) of
683                    case (yes, no) of                      (1, 0, T.LT) =>
684                      (1, 0) => (* normal case *)                       let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
685                         in  move(tmp, rdOpnd);
686                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
687                         end
688                      | (1, 0, T.GT) =>
689                         let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
690                         in  emit(I.UNARY{unOp=I.NOTL,opnd=tmp});
691                             move(tmp, rdOpnd);
692                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
693                         end
694                      | (1, 0, _) => (* normal case *)
695                      let val cc = cmp(true, ty, cc, t1, t2, [])                      let val cc = cmp(true, ty, cc, t1, t2, [])
696                      in  mark(I.SET{cond=cond cc, opnd=eax}, an);                      in  mark(I.SET{cond=cond cc, opnd=eax}, an);
697                            emit(I.BINARY{binOp=I.ANDL,src=I.Immed 255, dst=eax});
698                          move(eax, rdOpnd)                          move(eax, rdOpnd)
699                      end                      end
700                    | (C1, C2)  =>                    | (C1, C2, _)  =>
701                      (* general case;                      (* general case;
702                       * from the Intel optimization guide p3-5                       * from the Intel optimization guide p3-5
703                       *)                       *)
704                      let val cc = cmp(true, ty, cc, t1, t2, [])                      let val _  = zero eax;
705                            val cc = cmp(true, ty, cc, t1, t2, [])
706                      in  case C1-C2 of                      in  case C1-C2 of
707                            D as (1 | 2 | 3 | 4 | 5 | 8 | 9) =>                            D as (1 | 2 | 3 | 4 | 5 | 8 | 9) =>
708                            let val (base,scale) =                            let val (base,scale) =
# Line 667  Line 762 
762    
763                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)
764    
765                      (* Add n to rd *)
766                  fun addN n =
767                  let val n = operand n
768                      val src = if isMemReg rd then immedOrReg n else n
769                  in  mark(I.BINARY{binOp=I.ADDL, src=src, dst=rdOpnd}, an) end
770    
771                    (* Generate addition *)                    (* Generate addition *)
772                fun addition(e1, e2) =                fun addition(e1, e2) =
773                      case e1 of
774                        T.REG(_,rs) => if CB.sameColor(rs,rd) then addN e2
775                                       else addition1(e1,e2)
776                      | _ => addition1(e1,e2)
777                  and addition1(e1, e2) =
778                      case e2 of
779                        T.REG(_,rs) => if CB.sameColor(rs,rd) then addN e1
780                                       else addition2(e1,e2)
781                      | _ => addition2(e1,e2)
782                  and addition2(e1,e2) =
783                  (dstMustBeReg(fn (dstR, _) =>                  (dstMustBeReg(fn (dstR, _) =>
784                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))
785                  handle EA => binaryComm(I.ADDL, e1, e2))                  handle EA => binaryComm(I.ADDL, e1, e2))
786    
                   (* Add n to rd *)  
               fun addN n =  
                 mark(I.BINARY{binOp=I.ADDL, src=I.Immed(toInt32 n),  
                               dst=rdOpnd}, an)  
787    
788            in  case exp of            in  case exp of
789                 T.REG(_,rs) =>                 T.REG(_,rs) =>
790                     if isMemReg rs andalso isMemReg rd then                     if isMemReg rs andalso isMemReg rd then
791                        let val tmp = I.Direct(newReg())                        let val tmp = I.Direct(newReg())
792                        in  move'(MemReg rs, tmp, an);                        in  move'(I.MemReg rs, tmp, an);
793                            move'(tmp, rdOpnd, [])                            move'(tmp, rdOpnd, [])
794                        end                        end
795                     else move'(IntReg rs, rdOpnd, an)                     else move'(IntReg rs, rdOpnd, an)
796               | (T.LI 0 | T.LI32 0w0) =>               | T.LI z => let
797                     val n = toInt32 z
798                   in
799                     if n=0 then
800                   (* As per Fermin's request, special optimization for rd := 0.                   (* As per Fermin's request, special optimization for rd := 0.
801                    * Currently we don't bother with the size.                    * Currently we don't bother with the size.
802                    *)                    *)
803                   if isMemReg rd then move'(I.Immed 0, rdOpnd, an)                   if isMemReg rd then move'(I.Immed 0, rdOpnd, an)
804                   else mark(I.BINARY{binOp=I.XORL, src=rdOpnd, dst=rdOpnd}, an)                   else mark(I.BINARY{binOp=I.XORL, src=rdOpnd, dst=rdOpnd}, an)
805               | T.LI n      => move'(I.Immed(toInt32 n), rdOpnd, an)                   else
806               | T.LI32 w    => move'(I.Immed(wToInt32 w), rdOpnd, an)                     move'(I.Immed(n), rdOpnd, an)
807               | T.CONST c   => move'(I.ImmedLabel(LE.CONST c), rdOpnd, an)                 end
808               | T.LABEL lab => move'(I.ImmedLabel lab, rdOpnd, an)               | (T.CONST _ | T.LABEL _) =>
809                     move'(I.ImmedLabel exp, rdOpnd, an)
810                 | T.LABEXP le => move'(I.ImmedLabel le, rdOpnd, an)
811    
812                 (* 32-bit addition *)                 (* 32-bit addition *)
813               | T.ADD(32, e, (T.LI 1|T.LI32 0w1)) => unary(I.INCL, e)               | T.ADD(32, e1, e2 as T.LI n) => let
814               | T.ADD(32, (T.LI 1|T.LI32 0w1), e) => unary(I.INCL, e)                   val n = toInt32 n
815               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)                 in
816               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)                   case n
817               | T.ADD(32, e1 as T.REG(_, rs), e2 as T.LI n) =>                   of 1  => unary(I.INCL, e1)
818                    if rs = rd then addN n else addition(e1, e2)                    | ~1 => unary(I.DECL, e1)
819               | T.ADD(32, e1 as T.LI n, e2 as T.REG(_, rs)) =>                    | _ => addition(e1, e2)
820                    if rs = rd then addN n else addition(e1, e2)                 end
821                 | T.ADD(32, e1 as T.LI n, e2) => let
822                     val n = toInt32 n
823                   in
824                     case n
825                     of  1 => unary(I.INCL, e2)
826                      | ~1 => unary(I.DECL, e2)
827                      | _ => addition(e1, e2)
828                   end
829               | T.ADD(32, e1, e2) => addition(e1, e2)               | T.ADD(32, e1, e2) => addition(e1, e2)
830    
831                 (* 32-bit subtraction *)                 (* 32-bit addition but set the flag!
832               | 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))  
833               *)               *)
834                 | T.ADD(0, e, e1 as T.LI n) => let
835                     val n = T.I.toInt(32, n)
836                   in
837                     if n=1 then unary(I.INCL, e)
838                     else if n = ~1 then unary(I.DECL, e)
839                          else binaryComm(I.ADDL, e, e1)
840                   end
841                 | T.ADD(0, e1 as T.LI n, e) => let
842                     val n = T.I.toInt(32, n)
843                   in
844                     if n=1 then unary(I.INCL, e)
845                     else if n = ~1 then unary(I.DECL, e)
846                          else binaryComm(I.ADDL, e1, e)
847                   end
848                 | T.ADD(0, e1, e2) => binaryComm(I.ADDL, e1, e2)
849    
850                   (* 32-bit subtraction *)
851                 | T.SUB(32, e1, e2 as T.LI n) => let
852                     val n = toInt32 n
853                   in
854                     case n
855                     of 0 => doExpr(e1, rd, an)
856                      | 1 => unary(I.DECL, e1)
857                      | ~1 => unary(I.INCL, e1)
858                      | _ => binary(I.SUBL, e1, e2)
859                   end
860                 | T.SUB(32, e1 as T.LI n, e2) =>
861                     if T.I.isZero n then unary(I.NEGL, e2)
862                     else binary(I.SUBL, e1, e2)
863               | T.SUB(32, e1, e2) => binary(I.SUBL, e1, e2)               | T.SUB(32, e1, e2) => binary(I.SUBL, e1, e2)
864    
865               | T.MULU(32, x, y) => uMultiply(x, y)               | T.MULU(32, x, y) => uMultiply(x, y)
# Line 747  Line 888 
888               | T.LOAD(8, ea, mem) => load8(ea, mem)               | T.LOAD(8, ea, mem) => load8(ea, mem)
889               | T.LOAD(16, ea, mem) => load16(ea, mem)               | T.LOAD(16, ea, mem) => load16(ea, mem)
890               | T.LOAD(32, ea, mem) => load32(ea, mem)               | T.LOAD(32, ea, mem) => load32(ea, mem)
891               | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(8,ea,mem)) => load8s(ea, mem)  
892               | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(16,ea,mem)) => load16s(ea, mem)               | T.SX(32,8,T.LOAD(8,ea,mem)) => load8s(ea, mem)
893                 | T.SX(32,16,T.LOAD(16,ea,mem)) => load16s(ea, mem)
894                 | T.ZX(32,8,T.LOAD(8,ea,mem)) => load8(ea, mem)
895                 | T.ZX(32,16,T.LOAD(16,ea,mem)) => load16(ea, mem)
896    
897               | T.COND(32, T.CMP(ty, cc, t1, t2), T.LI yes, T.LI no) =>               | T.COND(32, T.CMP(ty, cc, t1, t2), T.LI yes, T.LI no) =>
898                   setcc(ty, cc, t1, t2, toInt32 yes, toInt32 no)                   setcc(ty, cc, t1, t2, toInt32 yes, toInt32 no)
              | T.COND(32, T.CMP(ty, cc, t1, t2), T.LI32 yes, T.LI32 no) =>  
                  setcc(ty, cc, t1, t2, Word32.toLargeIntX yes,  
                                        Word32.toLargeIntX no)  
899               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>
900                  (case !arch of (* PentiumPro and higher has CMOVcc *)                  (case !arch of (* PentiumPro and higher has CMOVcc *)
901                     Pentium => unknownExp exp                     Pentium => unknownExp exp
# Line 785  Line 926 
926            * 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,
927            * 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.
928            *)            *)
929       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) =
930              (case ty of              (case ty of
931                 8 =>  test(I.TESTB, a, b)                 8  => test(I.TESTB, a, b, an)
932               | 16 => test(I.TESTW, a, b)               | 16 => test(I.TESTW, a, b, an)
933               | 32 => test(I.TESTL, a, b)               | 32 => test(I.TESTL, a, b, an)
934               | _  => (expr e; ())               | _  => doExpr(e, newReg(), an);
935               ; cc)               cc)
936          | cmpWithZero(cc, e) = (expr e; cc)          | cmpWithZero(cc, e, an) =
937              let val e =
938                    case e of (* hack to disable the lea optimization XXX *)
939                      T.ADD(_, a, b) => T.ADD(0, a, b)
940                    | e => e
941              in  doExpr(e, newReg(), an); cc end
942    
943            (* Emit a test.            (* Emit a test.
944             *   The available modes are             *   The available modes are
# Line 809  Line 955 
955             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction
956             * by TESTB.             * by TESTB.
957             *)             *)
958        and test(testopcode, a, b) =        and test(testopcode, a, b, an) =
959            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)
960                (* translate r, r/m => r/m, r *)                (* translate r, r/m => r/m, r *)
961                val (opnd1, opnd2) =                val (opnd1, opnd2) =
962                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)
963            in  emit(testopcode{lsrc=opnd1, rsrc=opnd2})            in  mark(testopcode{lsrc=opnd1, rsrc=opnd2}, an)
964            end            end
965    
966              (* %eflags <- src *)
967          and moveToEflags src =
968              if CB.sameColor(src, C.eflags) then ()
969              else (move(I.Direct src, eax); emit(I.LAHF))
970    
971              (* dst <- %eflags *)
972          and moveFromEflags dst =
973              if CB.sameColor(dst, C.eflags) then ()
974              else (emit(I.SAHF); move(eax, I.Direct dst))
975    
976           (* generate a condition code expression           (* generate a condition code expression
977             * The zero is for setting the condition code!             * The zero is for setting the condition code!
978             * I have no idea why this is used.             * I have no idea why this is used.
979             *)             *)
980        and doCCexpr(T.CMP(ty, cc, t1, t2), 0, an) =        and doCCexpr(T.CMP(ty, cc, t1, t2), rd, an) =
981            (cmp(false, ty, cc, t1, t2, an); ())            (cmp(false, ty, cc, t1, t2, an);
982               moveFromEflags rd
983              )
984            | doCCexpr(T.CC(cond,rs), rd, an) =
985              if CB.sameColor(rs,C.eflags) orelse CB.sameColor(rd,C.eflags) then
986                 (moveToEflags rs; moveFromEflags rd)
987              else
988                 move'(I.Direct rs, I.Direct rd, an)
989          | 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))
990          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)
991          | doCCexpr(T.CCEXT e, cd, an) =          | doCCexpr(T.CCEXT e, cd, an) =
# Line 836  Line 999 
999             * we can also reorder the operands.             * we can also reorder the operands.
1000             *)             *)
1001        and cmp(swapable, ty, cc, t1, t2, an) =        and cmp(swapable, ty, cc, t1, t2, an) =
1002            (case cc of                 (* == and <> can be always be reordered *)
1003               (T.EQ | T.NE) =>            let val swapable = swapable orelse cc = T.EQ orelse cc = T.NE
1004                (* Sometimes the comparison is not necessary because            in (* Sometimes the comparison is not necessary because
1005                 * the bits are already set!                 * the bits are already set!
1006                 *)                 *)
1007                if isZero t1 andalso setZeroBit t2 then cmpWithZero(cc, t2)               if isZero t1 andalso setZeroBit2 t2 then
1008                else if isZero t2 andalso setZeroBit t1 then cmpWithZero(cc, t1)                   if swapable then
1009                     (* == and <> can be reordered *)                      cmpWithZero(T.Basis.swapCond cc, t2, an)
1010                else genCmp(ty, true, cc, t1, t2, an)                   else (* can't reorder the comparison! *)
1011             |  _ => genCmp(ty, swapable, cc, t1, t2, an)                      genCmp(ty, false, cc, t1, t2, an)
1012            )               else if isZero t2 andalso setZeroBit2 t1 then
1013                    cmpWithZero(cc, t1, an)
1014                 else genCmp(ty, swapable, cc, t1, t2, an)
1015              end
1016    
1017            (* 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)
1018             * Return the appropriate condition code and operands.             * Return the appropriate condition code and operands.
# Line 879  Line 1045 
1045            end            end
1046    
1047            (* generate code for jumps *)            (* generate code for jumps *)
1048        and jmp(T.LABEL(lexp as LE.LABEL lab), labs, an) =        and jmp(lexp as T.LABEL lab, labs, an) =
1049               mark(I.JMP(I.ImmedLabel lexp, [lab]), an)               mark(I.JMP(I.ImmedLabel lexp, [lab]), an)
1050          | 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)
1051          | jmp(ea, labs, an)           = mark(I.JMP(operand ea, labs), an)          | jmp(ea, labs, an)           = mark(I.JMP(operand ea, labs), an)
1052    
1053         (* convert mlrisc to cellset:         (* convert mlrisc to cellset:
1054          *)          *)
1055         and cellset mlrisc =         and cellset mlrisc =
1056             let val addCCReg = C.addCell C.CC             let val addCCReg = C.CellSet.add
1057                 fun g([],acc) = acc                 fun g([],acc) = acc
1058                   | 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))
1059                   | 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 897  Line 1063 
1063             in  g(mlrisc, C.empty) end             in  g(mlrisc, C.empty) end
1064    
1065            (* generate code for calls *)            (* generate code for calls *)
1066        and call(ea, flow, def, use, mem, an) =        and call(ea, flow, def, use, mem, cutsTo, an, pops) =
1067            mark(I.CALL(operand ea,cellset(def),cellset(use),mem),an)        let fun return(set, []) = set
1068                | return(set, a::an) =
1069                  case #peek A.RETURN_ARG a of
1070                    SOME r => return(C.CellSet.add(r, set), an)
1071                  | NONE => return(set, an)
1072          in
1073              mark(I.CALL{opnd=operand ea,defs=cellset(def),uses=cellset(use),
1074                          return=return(C.empty,an),cutsTo=cutsTo,mem=mem,
1075                          pops=pops},an)
1076          end
1077    
1078            (* generate code for integer stores *)            (* generate code for integer stores; first move data to %eax
1079        and store8(ea, d, mem, an) =             * This is mainly because we can't allocate to registers like
1080            let val src = (* movb has to use %eax as source. Stupid x86! *)             * ah, dl, dx etc.
1081               *)
1082          and genStore(mvOp, ea, d, mem, an) =
1083              let val src =
1084                   case immedOrReg(operand d) of                   case immedOrReg(operand d) of
1085                       src as I.Direct r =>                       src as I.Direct r =>
1086                         if r = C.eax then src else (move(src, eax); eax)                         if CB.sameColor(r,C.eax)
1087                           then src else (move(src, eax); eax)
1088                     | src => src                     | src => src
1089            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)
1090            end            end
1091        and store16(ea, d, mem, an) = error "store16"  
1092              (* generate code for 8-bit integer stores *)
1093              (* movb has to use %eax as source. Stupid x86! *)
1094          and store8(ea, d, mem, an) = genStore(I.MOVB, ea, d, mem, an)
1095          and store16(ea, d, mem, an) =
1096            mark(I.MOVE{mvOp=I.MOVW, src=immedOrReg(operand d), dst=address(ea, mem)}, an)
1097        and store32(ea, d, mem, an) =        and store32(ea, d, mem, an) =
1098              move'(immedOrReg(operand d), address(ea, mem), an)              move'(immedOrReg(operand d), address(ea, mem), an)
1099    
# Line 921  Line 1105 
1105          | branch(T.FCMP(fty, fcc, t1, t2), lab, an) =          | branch(T.FCMP(fty, fcc, t1, t2), lab, an) =
1106             fbranch(fty, fcc, t1, t2, lab, an)             fbranch(fty, fcc, t1, t2, lab, an)
1107          | branch(ccexp, lab, an) =          | branch(ccexp, lab, an) =
1108             (doCCexpr(ccexp, 0, []);             (doCCexpr(ccexp, C.eflags, []);
1109              mark(I.JCC{cond=cond(Gen.condOf ccexp), opnd=immedLabel lab}, an)              mark(I.JCC{cond=cond(Gen.condOf ccexp), opnd=immedLabel lab}, an)
1110             )             )
1111    
1112            (* generate code for floating point compare and branch *)            (* generate code for floating point compare and branch *)
1113        and fbranch(fty, fcc, t1, t2, lab, an) =        and fbranch(fty, fcc, t1, t2, lab, an) =
           let fun compare() =  
1114                let fun ignoreOrder (T.FREG _) = true                let fun ignoreOrder (T.FREG _) = true
1115                      | ignoreOrder (T.FLOAD _) = true                      | ignoreOrder (T.FLOAD _) = true
1116                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e
1117                      | ignoreOrder _ = false                      | ignoreOrder _ = false
1118                in  if ignoreOrder t1 orelse ignoreOrder t2 then  
1119                  fun compare'() = (* Sethi-Ullman style *)
1120                      (if ignoreOrder t1 orelse ignoreOrder t2 then
1121                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))
1122                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);
1123                          emit(I.FXCH{opnd=C.ST(1)}));                          emit(I.FXCH{opnd=C.ST(1)}));
1124                    emit(I.FUCOMPP)                     emit(I.FUCOMPP);
1125                       fcc
1126                      )
1127    
1128                  fun compare''() =
1129                          (* direct style *)
1130                          (* Try to make lsrc the memory operand *)
1131                      let val lsrc = foperand(fty, t1)
1132                          val rsrc = foperand(fty, t2)
1133                          val fsize = fsize fty
1134                          fun cmp(lsrc, rsrc, fcc) =
1135                              (emit(I.FCMP{fsize=fsize,lsrc=lsrc,rsrc=rsrc}); fcc)
1136                      in  case (lsrc, rsrc) of
1137                             (I.FPR _, I.FPR _) => cmp(lsrc, rsrc, fcc)
1138                           | (I.FPR _, mem) => cmp(mem,lsrc,T.Basis.swapFcond fcc)
1139                           | (mem, I.FPR _) => cmp(lsrc, rsrc, fcc)
1140                           | (lsrc, rsrc) => (* can't be both memory! *)
1141                             let val ftmpR = newFreg()
1142                                 val ftmp  = I.FPR ftmpR
1143                             in  emit(I.FMOVE{fsize=fsize,src=rsrc,dst=ftmp});
1144                                 cmp(lsrc, ftmp, fcc)
1145                             end
1146                end                end
1147    
1148                  fun compare() =
1149                      if enableFastFPMode andalso !fast_floating_point
1150                      then compare''() else compare'()
1151    
1152                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})
1153                  fun testil i = emit(I.TESTL{lsrc=eax,rsrc=I.Immed(i)})
1154                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})
1155                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})
1156                fun j(cc, lab) = mark(I.JCC{cond=cc, opnd=immedLabel lab},an)                fun j(cc, lab) = mark(I.JCC{cond=cc, opnd=immedLabel lab},an)
1157                fun sahf() = emit(I.SAHF)                fun sahf() = emit(I.SAHF)
1158                fun branch() =                fun branch(fcc) =
1159                    case fcc                    case fcc
1160                    of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))                    of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))
1161                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))
1162                     | T.?    => (sahf(); j(I.P,lab))                     | T.?    => (sahf(); j(I.P,lab))
1163                     | T.<=>  => (sahf(); j(I.NP,lab))                     | T.<=>  => (sahf(); j(I.NP,lab))
1164                     | T.>    => (andil 0x4500;  j(I.EQ,lab))                     | T.>    => (testil 0x4500;  j(I.EQ,lab))
1165                     | T.?<=  => (andil 0x4500;  j(I.NE,lab))                     | T.?<=  => (testil 0x4500;  j(I.NE,lab))
1166                     | T.>=   => (andil 0x500; j(I.EQ,lab))                     | T.>=   => (testil 0x500; j(I.EQ,lab))
1167                     | T.?<   => (andil 0x500; j(I.NE,lab))                     | T.?<   => (testil 0x500; j(I.NE,lab))
1168                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))
1169                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))
1170                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);
1171                                  cmpil 0x4000; j(I.EQ,lab))                                  cmpil 0x4000; j(I.EQ,lab))
1172                     | T.?>   => (sahf(); j(I.P,lab); andil 0x4100; j(I.EQ,lab))                     | T.?>   => (sahf(); j(I.P,lab); testil 0x4100; j(I.EQ,lab))
1173                     | T.<>   => (andil 0x4400; j(I.EQ,lab))                     | T.<>   => (testil 0x4400; j(I.EQ,lab))
1174                     | T.?=   => (andil 0x4400; j(I.NE,lab))                     | T.?=   => (testil 0x4400; j(I.NE,lab))
1175                     | _      => error "fbranch"                     | _      => error "fbranch"
1176                   (*esac*)                   (*esac*)
1177            in  compare(); emit I.FNSTSW; branch()                val fcc = compare()
1178              in  emit I.FNSTSW;
1179                  branch(fcc)
1180              end
1181    
1182          (*========================================================
1183           * Floating point code generation starts here.
1184           * Some generic fp routines first.
1185           *========================================================*)
1186    
1187           (* Can this tree be folded into the src operand of a floating point
1188            * operations?
1189            *)
1190          and foldableFexp(T.FREG _) = true
1191            | foldableFexp(T.FLOAD _) = true
1192            | foldableFexp(T.CVTI2F(_, (16 | 32), _)) = true
1193            | foldableFexp(T.CVTF2F(_, _, t)) = foldableFexp t
1194            | foldableFexp(T.FMARK(t, _)) = foldableFexp t
1195            | foldableFexp _ = false
1196    
1197            (* Move integer e of size ty into a memory location.
1198             * Returns a quadruple:
1199             *  (INTEGER,return ty,effect address of memory location,cleanup code)
1200             *)
1201          and convertIntToFloat(ty, e) =
1202              let val opnd = operand e
1203              in  if isMemOpnd opnd andalso (ty = 16 orelse ty = 32)
1204                  then (INTEGER, ty, opnd, [])
1205                  else
1206                    let val {instrs, tempMem, cleanup} =
1207                            cvti2f{ty=ty, src=opnd, an=getAnnotations()}
1208                    in  emits instrs;
1209                        (INTEGER, 32, tempMem, cleanup)
1210            end            end
1211              end
1212    
1213          (*========================================================
1214           * Sethi-Ullman based floating point code generation as
1215           * implemented by Lal
1216           *========================================================*)
1217    
1218        and fld(32, opnd) = I.FLDS opnd        and fld(32, opnd) = I.FLDS opnd
1219          | fld(64, opnd) = I.FLDL opnd          | fld(64, opnd) = I.FLDL opnd
# Line 984  Line 1234 
1234          | fstp _         = error "fstp"          | fstp _         = error "fstp"
1235    
1236            (* generate code for floating point stores *)            (* generate code for floating point stores *)
1237        and fstore(fty, ea, d, mem, an) =        and fstore'(fty, ea, d, mem, an) =
1238            (case d of            (case d of
1239               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))
1240             | _ => reduceFexp(fty, d, []);             | _ => reduceFexp(fty, d, []);
1241             mark(fstp(fty, address(ea, mem)), an)             mark(fstp(fty, address(ea, mem)), an)
1242            )            )
1243    
1244        and fexpr e = error "fexpr"            (* generate code for floating point loads *)
1245          and fload'(fty, ea, mem, fd, an) =
1246                let val ea = address(ea, mem)
1247                in  mark(fld(fty, ea), an);
1248                    if CB.sameColor(fd,ST0) then ()
1249                    else emit(fstp(fty, I.FDirect fd))
1250                end
1251    
1252          and fexpr' e = (reduceFexp(64, e, []); C.ST(0))
1253    
1254            (* generate floating point expression and put the result in fd *)            (* generate floating point expression and put the result in fd *)
1255        and doFexpr(fty, T.FREG(_, fs), fd, an) =        and doFexpr'(fty, T.FREG(_, fs), fd, an) =
1256              (if fs = fd then ()              (if CB.sameColor(fs,fd) then ()
1257               else mark(I.FCOPY{dst=[fd], src=[fs], tmp=NONE}, an)               else mark(I.FCOPY{dst=[fd], src=[fs], tmp=NONE}, an)
1258              )              )
1259          | doFexpr(fty, T.FLOAD(fty', ea, mem), fd, an) =          | doFexpr'(_, T.FLOAD(fty, ea, mem), fd, an) =
1260              let val ea = address(ea, mem)              fload'(fty, ea, mem, fd, an)
1261              in  mark(fld(fty', ea), an);          | doFexpr'(fty, T.FEXT fexp, fd, an) =
1262                  emit(fstp(fty, I.FDirect fd))              (ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an};
1263              end               if CB.sameColor(fd,ST0) then () else emit(fstp(fty, I.FDirect fd))
1264          | doFexpr(fty, e, fd, an) =              )
1265            | doFexpr'(fty, e, fd, an) =
1266              (reduceFexp(fty, e, []);              (reduceFexp(fty, e, []);
1267               mark(fstp(fty, I.FDirect fd), an)               if CB.sameColor(fd,ST0) then ()
1268                 else mark(fstp(fty, I.FDirect fd), an)
1269              )              )
1270    
1271            (*            (*
# Line 1016  Line 1276 
1276        and reduceFexp(fty, fexp, an)  =        and reduceFexp(fty, fexp, an)  =
1277            let val ST = I.ST(C.ST 0)            let val ST = I.ST(C.ST 0)
1278                val ST1 = I.ST(C.ST 1)                val ST1 = I.ST(C.ST 1)
1279                  val cleanupCode = ref [] : I.instruction list ref
1280    
1281                datatype su_tree =                datatype su_tree =
1282                  LEAF of int * T.fexp * ans                  LEAF of int * T.fexp * ans
# Line 1058  Line 1319 
1319                    in  (annotate(t, a), integer) end                    in  (annotate(t, a), integer) end
1320                  | suFold e = (su e, false)                  | suFold e = (su e, false)
1321    
               (* Can the tree be folded into the src operand? *)  
               and foldable(T.FREG _) = true  
                 | foldable(T.FLOAD _) = true  
                 | foldable(T.CVTI2F(_, (16 | 32), _)) = true  
                 | foldable(T.CVTF2F(_, _, t)) = foldable t  
                 | foldable(T.FMARK(t, _)) = foldable t  
                 | foldable _ = false  
   
1322                (* Form unary tree *)                (* Form unary tree *)
1323                and suUnary(fty, funary, t) =                and suUnary(fty, funary, t) =
1324                    let val t = su t                    let val t = su t
# Line 1087  Line 1340 
1340                 * This only applies to commutative operations.                 * This only applies to commutative operations.
1341                 *)                 *)
1342                and suComBinary(fty, binop, ibinop, t1, t2) =                and suComBinary(fty, binop, ibinop, t1, t2) =
1343                    let val (t1, t2) = if foldable t2 then (t1, t2) else (t2, t1)                    let val (t1, t2) = if foldableFexp t2
1344                                         then (t1, t2) else (t2, t1)
1345                    in  suBinary(fty, binop, ibinop, t1, t2) end                    in  suBinary(fty, binop, ibinop, t1, t2) end
1346    
1347                and sameTree(LEAF(_, T.FREG(t1,f1), []),                and sameTree(LEAF(_, T.FREG(t1,f1), []),
1348                             LEAF(_, T.FREG(t2,f2), [])) = t1=t2 andalso f1=f2                             LEAF(_, T.FREG(t2,f2), [])) =
1349                            t1 = t2 andalso CB.sameColor(f1,f2)
1350                  | sameTree _ = false                  | sameTree _ = false
1351    
1352                (* Traverse tree and generate code *)                (* Traverse tree and generate code *)
# Line 1167  Line 1422 
1422                 *)                 *)
1423                and leafEA(T.FREG(fty, f)) = (REAL, fty, I.FDirect f)                and leafEA(T.FREG(fty, f)) = (REAL, fty, I.FDirect f)
1424                  | leafEA(T.FLOAD(fty, ea, mem)) = (REAL, fty, address(ea, mem))                  | leafEA(T.FLOAD(fty, ea, mem)) = (REAL, fty, address(ea, mem))
1425                  | leafEA(T.CVTI2F(_, 32, t)) = int2real(32, I.MOVL, t)                  | leafEA(T.CVTI2F(_, 32, t)) = int2real(32, t)
1426                  | leafEA(T.CVTI2F(_, 16, t)) = int2real(16, I.MOVSWL, t)                  | leafEA(T.CVTI2F(_, 16, t)) = int2real(16, t)
1427                  | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, I.MOVSBL, t)                  | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, t)
1428                  | leafEA _ = error "leafEA"                  | leafEA _ = error "leafEA"
1429    
1430                (* Move integer t of size ty into a memory location *)                and int2real(ty, e) =
1431                and int2real(ty, mov, t) =                    let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1432                    let val opnd = operand t                    in  cleanupCode := !cleanupCode @ cleanup;
1433                    in  if isMemOpnd opnd andalso (ty = 16 orelse ty = 32)                        (INTEGER, ty, ea)
                       then (INTEGER, ty, opnd)  
                       else (emit(I.MOVE{mvOp=mov, src=opnd, dst=tempMem});  
                             (INTEGER, 32, tempMem))  
1434                    end                    end
1435            in  gencode(su fexp)  
1436             in  gencode(su fexp);
1437                 emits(!cleanupCode)
1438            end (*reduceFexp*)            end (*reduceFexp*)
1439    
1440           (*========================================================
1441            * This section generates 3-address style floating
1442            * point code.
1443            *========================================================*)
1444    
1445          and isize 16 = I.I16
1446            | isize 32 = I.I32
1447            | isize _  = error "isize"
1448    
1449          and fstore''(fty, ea, d, mem, an) =
1450              (floatingPointUsed := true;
1451               mark(I.FMOVE{fsize=fsize fty, dst=address(ea,mem),
1452                            src=foperand(fty, d)},
1453                    an)
1454              )
1455    
1456          and fload''(fty, ea, mem, d, an) =
1457              (floatingPointUsed := true;
1458               mark(I.FMOVE{fsize=fsize fty, src=address(ea,mem),
1459                            dst=RealReg d}, an)
1460              )
1461    
1462          and fiload''(ity, ea, d, an) =
1463              (floatingPointUsed := true;
1464               mark(I.FILOAD{isize=isize ity, ea=ea, dst=RealReg d}, an)
1465              )
1466    
1467          and fexpr''(e as T.FREG(_,f)) =
1468              if isFMemReg f then transFexpr e else f
1469            | fexpr'' e = transFexpr e
1470    
1471          and transFexpr e =
1472              let val fd = newFreg() in doFexpr''(64, e, fd, []); fd end
1473    
1474             (*
1475              * Process a floating point operand.  Put operand in register
1476              * when possible.  The operand should match the given fty.
1477              *)
1478          and foperand(fty, e as T.FREG(fty', f)) =
1479                 if fty = fty' then RealReg f else I.FPR(fexpr'' e)
1480            | foperand(fty, T.CVTF2F(_, _, e)) =
1481                 foperand(fty, e) (* nop on the x86 *)
1482            | foperand(fty, e as T.FLOAD(fty', ea, mem)) =
1483                 (* fold operand when the precison matches *)
1484                 if fty = fty' then address(ea, mem) else I.FPR(fexpr'' e)
1485            | foperand(fty, e) = I.FPR(fexpr'' e)
1486    
1487             (*
1488              * Process a floating point operand.
1489              * Try to fold in a memory operand or conversion from an integer.
1490              *)
1491          and fioperand(T.FREG(fty,f)) = (REAL, fty, RealReg f, [])
1492            | fioperand(T.FLOAD(fty, ea, mem)) =
1493                 (REAL, fty, address(ea, mem), [])
1494            | fioperand(T.CVTF2F(_, _, e)) = fioperand(e) (* nop on the x86 *)
1495            | fioperand(T.CVTI2F(_, ty, e)) = convertIntToFloat(ty, e)
1496            | fioperand(T.FMARK(e,an)) = fioperand(e) (* XXX *)
1497            | fioperand(e) = (REAL, 64, I.FPR(fexpr'' e), [])
1498    
1499              (* Generate binary operator.  Since the real binary operators
1500               * does not take memory as destination, we also ensure this
1501               * does not happen.
1502               *)
1503          and fbinop(targetFty,
1504                     binOp, binOpR, ibinOp, ibinOpR, lsrc, rsrc, fd, an) =
1505                  (* Put the mem operand in rsrc *)
1506              let val _ = floatingPointUsed := true;
1507                  fun isMemOpnd(T.FREG(_, f)) = isFMemReg f
1508                    | isMemOpnd(T.FLOAD _) = true
1509                    | isMemOpnd(T.CVTI2F(_, (16 | 32), _)) = true
1510                    | isMemOpnd(T.CVTF2F(_, _, t)) = isMemOpnd t
1511                    | isMemOpnd(T.FMARK(t, _)) = isMemOpnd t
1512                    | isMemOpnd _ = false
1513                  val (binOp, ibinOp, lsrc, rsrc) =
1514                      if isMemOpnd lsrc then (binOpR, ibinOpR, rsrc, lsrc)
1515                      else (binOp, ibinOp, lsrc, rsrc)
1516                  val lsrc = foperand(targetFty, lsrc)
1517                  val (kind, fty, rsrc, code) = fioperand(rsrc)
1518                  fun dstMustBeFreg f =
1519                      if targetFty <> 64 then
1520                      let val tmpR = newFreg()
1521                          val tmp  = I.FPR tmpR
1522                      in  mark(f tmp, an);
1523                          emit(I.FMOVE{fsize=fsize targetFty,
1524                                       src=tmp, dst=RealReg fd})
1525                      end
1526                      else mark(f(RealReg fd), an)
1527              in  case kind of
1528                    REAL =>
1529                      dstMustBeFreg(fn dst =>
1530                                       I.FBINOP{fsize=fsize fty, binOp=binOp,
1531                                                lsrc=lsrc, rsrc=rsrc, dst=dst})
1532                  | INTEGER =>
1533                      (dstMustBeFreg(fn dst =>
1534                                        I.FIBINOP{isize=isize fty, binOp=ibinOp,
1535                                                  lsrc=lsrc, rsrc=rsrc, dst=dst});
1536                       emits code
1537                      )
1538              end
1539    
1540          and funop(fty, unOp, src, fd, an) =
1541              let val src = foperand(fty, src)
1542              in  mark(I.FUNOP{fsize=fsize fty,
1543                               unOp=unOp, src=src, dst=RealReg fd},an)
1544              end
1545    
1546          and doFexpr''(fty, e, fd, an) =
1547              case e of
1548                T.FREG(_,fs) => if CB.sameColor(fs,fd) then ()
1549                                else fcopy''(fty, [fd], [fs], an)
1550                (* Stupid x86 does everything as 80-bits internally. *)
1551    
1552                (* Binary operators *)
1553              | T.FADD(_, a, b) => fbinop(fty,
1554                                          I.FADDL, I.FADDL, I.FIADDL, I.FIADDL,
1555                                          a, b, fd, an)
1556              | T.FSUB(_, a, b) => fbinop(fty,
1557                                          I.FSUBL, I.FSUBRL, I.FISUBL, I.FISUBRL,
1558                                          a, b, fd, an)
1559              | T.FMUL(_, a, b) => fbinop(fty,
1560                                          I.FMULL, I.FMULL, I.FIMULL, I.FIMULL,
1561                                          a, b, fd, an)
1562              | T.FDIV(_, a, b) => fbinop(fty,
1563                                          I.FDIVL, I.FDIVRL, I.FIDIVL, I.FIDIVRL,
1564                                          a, b, fd, an)
1565    
1566                (* Unary operators *)
1567              | T.FNEG(_, a) => funop(fty, I.FCHS, a, fd, an)
1568              | T.FABS(_, a) => funop(fty, I.FABS, a, fd, an)
1569              | T.FSQRT(_, a) => funop(fty, I.FSQRT, a, fd, an)
1570    
1571                (* Load *)
1572              | T.FLOAD(fty,ea,mem) => fload''(fty, ea, mem, fd, an)
1573    
1574                (* Type conversions *)
1575              | T.CVTF2F(_, _, e) => doFexpr''(fty, e, fd, an)
1576              | T.CVTI2F(_, ty, e) =>
1577                let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1578                in  fiload''(ty, ea, fd, an);
1579                    emits cleanup
1580                end
1581    
1582              | T.FMARK(e,A.MARKREG f) => (f fd; doFexpr''(fty, e, fd, an))
1583              | T.FMARK(e, a) => doFexpr''(fty, e, fd, a::an)
1584              | T.FPRED(e, c) => doFexpr''(fty, e, fd, A.CTRLUSE c::an)
1585              | T.FEXT fexp =>
1586                 ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an}
1587              | _ => error("doFexpr''")
1588    
1589           (*========================================================
1590            * Tie the two styles of fp code generation together
1591            *========================================================*)
1592          and fstore(fty, ea, d, mem, an) =
1593              if enableFastFPMode andalso !fast_floating_point
1594              then fstore''(fty, ea, d, mem, an)
1595              else fstore'(fty, ea, d, mem, an)
1596          and fload(fty, ea, d, mem, an) =
1597              if enableFastFPMode andalso !fast_floating_point
1598              then fload''(fty, ea, d, mem, an)
1599              else fload'(fty, ea, d, mem, an)
1600          and fexpr e =
1601              if enableFastFPMode andalso !fast_floating_point
1602              then fexpr'' e else fexpr' e
1603          and doFexpr(fty, e, fd, an) =
1604              if enableFastFPMode andalso !fast_floating_point
1605              then doFexpr''(fty, e, fd, an)
1606              else doFexpr'(fty, e, fd, an)
1607    
1608          (*================================================================
1609           * Optimizations for x := x op y
1610           * Special optimizations:
1611           * Generate a binary operator, result must in memory.
1612           * The source must not be in memory
1613           *================================================================*)
1614          and binaryMem(binOp, src, dst, mem, an) =
1615              mark(I.BINARY{binOp=binOp, src=immedOrReg(operand src),
1616                            dst=address(dst,mem)}, an)
1617          and unaryMem(unOp, opnd, mem, an) =
1618              mark(I.UNARY{unOp=unOp, opnd=address(opnd,mem)}, an)
1619    
1620          and isOne(T.LI n) = n = one
1621            | isOne _ = false
1622    
1623          (*
1624           * Perform optimizations based on recognizing
1625           *    x := x op y    or
1626           *    x := y op x
1627           * first.
1628           *)
1629          and store(ty, ea, d, mem, an,
1630                    {INC,DEC,ADD,SUB,NOT,NEG,SHL,SHR,SAR,OR,AND,XOR},
1631                    doStore
1632                   ) =
1633              let fun default() = doStore(ea, d, mem, an)
1634                  fun binary1(t, t', unary, binary, ea', x) =
1635                      if t = ty andalso t' = ty then
1636                         if MLTreeUtils.eqRexp(ea, ea') then
1637                            if isOne x then unaryMem(unary, ea, mem, an)
1638                            else binaryMem(binary, x, ea, mem, an)
1639                          else default()
1640                      else default()
1641                  fun unary(t,unOp, ea') =
1642                      if t = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1643                         unaryMem(unOp, ea, mem, an)
1644                      else default()
1645                  fun binary(t,t',binOp,ea',x) =
1646                      if t = ty andalso t' = ty andalso
1647                         MLTreeUtils.eqRexp(ea, ea') then
1648                          binaryMem(binOp, x, ea, mem, an)
1649                      else default()
1650    
1651                  fun binaryCom1(t,unOp,binOp,x,y) =
1652                  if t = ty then
1653                  let fun again() =
1654                        case y of
1655                          T.LOAD(ty',ea',_) =>
1656                            if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1657                               if isOne x then unaryMem(unOp, ea, mem, an)
1658                               else binaryMem(binOp,x,ea,mem,an)
1659                            else default()
1660                        | _ => default()
1661                  in  case x of
1662                        T.LOAD(ty',ea',_) =>
1663                          if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1664                             if isOne y then unaryMem(unOp, ea, mem, an)
1665                             else binaryMem(binOp,y,ea,mem,an)
1666                          else again()
1667                      | _ => again()
1668                  end
1669                  else default()
1670    
1671                  fun binaryCom(t,binOp,x,y) =
1672                  if t = ty then
1673                  let fun again() =
1674                        case y of
1675                          T.LOAD(ty',ea',_) =>
1676                            if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1677                               binaryMem(binOp,x,ea,mem,an)
1678                            else default()
1679                        | _ => default()
1680                  in  case x of
1681                        T.LOAD(ty',ea',_) =>
1682                          if ty' = ty andalso MLTreeUtils.eqRexp(ea, ea') then
1683                             binaryMem(binOp,y,ea,mem,an)
1684                          else again()
1685                      | _ => again()
1686                  end
1687                  else default()
1688    
1689              in  case d of
1690                    T.ADD(t,x,y) => binaryCom1(t,INC,ADD,x,y)
1691                  | T.SUB(t,T.LOAD(t',ea',_),x) => binary1(t,t',DEC,SUB,ea',x)
1692                  | T.ORB(t,x,y) => binaryCom(t,OR,x,y)
1693                  | T.ANDB(t,x,y) => binaryCom(t,AND,x,y)
1694                  | T.XORB(t,x,y) => binaryCom(t,XOR,x,y)
1695                  | T.SLL(t,T.LOAD(t',ea',_),x) => binary(t,t',SHL,ea',x)
1696                  | T.SRL(t,T.LOAD(t',ea',_),x) => binary(t,t',SHR,ea',x)
1697                  | T.SRA(t,T.LOAD(t',ea',_),x) => binary(t,t',SAR,ea',x)
1698                  | T.NEG(t,T.LOAD(t',ea',_)) => unary(t,NEG,ea')
1699                  | T.NOTB(t,T.LOAD(t',ea',_)) => unary(t,NOT,ea')
1700                  | _ => default()
1701              end (* store *)
1702    
1703            (* generate code for a statement *)            (* generate code for a statement *)
1704        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)
1705          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)
1706          | stmt(T.CCMV(ccd, e), an) = doCCexpr(e, ccd, an)          | stmt(T.CCMV(ccd, e), an) = doCCexpr(e, ccd, an)
1707          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)
1708          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)
1709          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)          | stmt(T.JMP(e, labs), an) = jmp(e, labs, an)
1710          | stmt(T.CALL(e, flow, def, use, cdef, cuse, mem), an) =          | stmt(T.CALL{funct, targets, defs, uses, region, pops, ...}, an) =
1711               call(e,flow,def,use,mem,an)               call(funct,targets,defs,uses,region,[],an, pops)
1712            | stmt(T.FLOW_TO(T.CALL{funct, targets, defs, uses, region, pops, ...},
1713                             cutTo), an) =
1714                 call(funct,targets,defs,uses,region,cutTo,an, pops)
1715          | stmt(T.RET _, an) = mark(I.RET NONE, an)          | stmt(T.RET _, an) = mark(I.RET NONE, an)
1716          | stmt(T.STORE(8, ea, d, mem), an) = store8(ea, d, mem, an)          | stmt(T.STORE(8, ea, d, mem), an)  =
1717          | stmt(T.STORE(16, ea, d, mem), an) = store16(ea, d, mem, an)               store(8, ea, d, mem, an, opcodes8, store8)
1718          | stmt(T.STORE(32, ea, d, mem), an) = store32(ea, d, mem, an)          | stmt(T.STORE(16, ea, d, mem), an) =
1719                 store(16, ea, d, mem, an, opcodes16, store16)
1720            | stmt(T.STORE(32, ea, d, mem), an) =
1721                 store(32, ea, d, mem, an, opcodes32, store32)
1722    
1723          | 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)
1724          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)          | stmt(T.BCC(cc, lab), an) = branch(cc, lab, an)
1725          | stmt(T.DEFINE l, _) = defineLabel l          | stmt(T.DEFINE l, _) = defineLabel l
1726          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)
1727          | stmt(T.EXT s, an) =          | stmt(T.EXT s, an) =
# Line 1211  Line 1735 
1735           ((* Must be cleared by the client.           ((* Must be cleared by the client.
1736             * if rewriteMemReg then memRegsUsed := 0w0 else ();             * if rewriteMemReg then memRegsUsed := 0w0 else ();
1737             *)             *)
1738            trapLabel := NONE; beginCluster 0)            floatingPointUsed := false;
1739              trapLabel := NONE;
1740              beginCluster 0
1741             )
1742        and endCluster' a =        and endCluster' a =
1743           (case !trapLabel           (case !trapLabel
1744            of NONE => ()            of NONE => ()
1745             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))
1746            (*esac*);            (*esac*);
1747              (* If floating point has been used allocate an extra
1748               * register just in case we didn't use any explicit register
1749               *)
1750              if !floatingPointUsed then (newFreg(); ())
1751              else ();
1752            endCluster(a)            endCluster(a)
1753           )           )
1754    
# Line 1243  Line 1775 
1775               entryLabel  = entryLabel,               entryLabel  = entryLabel,
1776               comment     = comment,               comment     = comment,
1777               annotation  = annotation,               annotation  = annotation,
1778               exitBlock   = fn mlrisc => exitBlock(cellset mlrisc),               getAnnotations = getAnnotations,
1779               alias       = alias,               exitBlock      = fn mlrisc => exitBlock(cellset mlrisc)
              phi         = phi  
1780            }            }
1781    
1782    in  self()    in  self()

Legend:
Removed from v.583  
changed lines
  Added in v.889

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