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

SCM Repository

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

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

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

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

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

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