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

Legend:
Removed from v.585  
changed lines
  Added in v.1003

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