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

Legend:
Removed from v.591  
changed lines
  Added in v.1009

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