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 779, Sun Jan 14 06:40:32 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 ExtensionComp : MLTREE_EXTENSION_COMP
43    (* structure PseudoInstrs : X86_PSEUDO_INSTR *)       where I = X86Instr
      sharing X86MLTree.Region = X86Instr.Region  
      sharing X86MLTree.LabelExp = X86Instr.LabelExp  
      (* sharing PseudoInstrs.I = X86Instr  
      sharing PseudoInstrs.T = X86MLTree *)  
44      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII
45      val arch : arch ref      val arch : arch ref
46      val tempMem : X86Instr.operand (* temporary for CVTI2F *)      val cvti2f :
47      (* val memRegsUsed : word ref *)    (* bit mask of memRegs used *)           (* source operand, guaranteed to be non-memory! *)
48             {ty: X86Instr.T.ty, src: X86Instr.operand} ->
49             {instrs : X86Instr.instruction list,(* the instructions *)
50              tempMem: X86Instr.operand,         (* temporary for CVTI2F *)
51              cleanup: X86Instr.instruction list (* cleanup code *)
52             }
53        (* When the following flag is set, we allocate floating point registers
54         * directly on the floating point stack
55         *)
56        val fast_floating_point : bool ref
57    ) : sig include MLTREECOMP    ) : sig include MLTREECOMP
58            val rewriteMemReg : bool            val rewriteMemReg : bool
59        end =        end =
60  struct  struct
   structure T = X86MLTree  
   structure S = T.Stream  
61    structure I = X86Instr    structure I = X86Instr
62      structure T = I.T
63      structure S = T.Stream
64    structure C = I.C    structure C = I.C
65    structure Shuffle = Shuffle(I)    structure Shuffle = Shuffle(I)
66    structure W32 = Word32    structure W32 = Word32
67    structure LE = I.LabelExp    structure LE = I.LabelExp
68    structure A = MLRiscAnnotations    structure A = MLRiscAnnotations
69    
70    type instrStream = (I.instruction,C.regmap,C.cellset) T.stream    type instrStream = (I.instruction,C.cellset) T.stream
71    type ('s,'r,'f,'c) mltreeStream =    type mltreeStream = (T.stm,T.mlrisc list) T.stream
72       (('s,'r,'f,'c) T.stm,C.regmap,('s,'r,'f,'c) T.mlrisc list) T.stream  
73    type ('s,'r,'f,'c) reducer =    datatype kind = REAL | INTEGER
      (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  
74    
75    structure Gen = MLTreeGen    structure Gen = MLTreeGen
76       (structure T = T       (structure T = T
# Line 77  Line 86 
86     * If this is on, we can avoid doing RewritePseudo phase entirely.     * If this is on, we can avoid doing RewritePseudo phase entirely.
87     *)     *)
88    val rewriteMemReg = rewriteMemReg    val rewriteMemReg = rewriteMemReg
89    fun isMemReg r = rewriteMemReg andalso r >= 8 andalso r < 32  
90      (* The following hardcoded *)
91      fun isMemReg r = rewriteMemReg andalso
92                       let val r = C.registerNum r
93                       in  r >= 8 andalso r < 32
94                       end
95      fun isFMemReg r = if enableFastFPMode andalso !fast_floating_point
96                        then let val r = C.registerNum r
97                             in r >= 8 andalso r < 32 end
98                        else true
99      val isAnyFMemReg = List.exists (fn r =>
100                                      let val r = C.registerNum r
101                                      in  r >= 8 andalso r < 32 end
102                                     )
103    
104      val ST0 = C.ST 0
105      val ST7 = C.ST 7
106    
107    (*    (*
108     * The code generator     * The code generator
109     *)     *)
110    fun selectInstructions    fun selectInstructions
        (T.EXTENDER{compileStm,compileRexp,compileFexp,compileCCexp,...})  
111         (instrStream as         (instrStream as
112          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,
113                   beginCluster,endCluster,exitBlock,alias,phi,comment,...}) =                   beginCluster,endCluster,exitBlock,comment,...}) =
114    let exception EA    let exception EA
115    
116        (* label where a trap is generated -- one per cluster *)        (* label where a trap is generated -- one per cluster *)
117        val trapLabel = ref (NONE: (I.instruction * Label.label) option)        val trapLabel = ref (NONE: (I.instruction * Label.label) option)
118    
119          (* flag floating point generation *)
120          val floatingPointUsed = ref false
121    
122        (* effective address of an integer register *)        (* effective address of an integer register *)
123        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
124        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  
           )  
125    
126        (* Add an overflow trap *)        (* Add an overflow trap *)
127        fun trap() =        fun trap() =
# Line 106  Line 129 
129              case !trapLabel of              case !trapLabel of
130                NONE => let val label = Label.newLabel "trap"                NONE => let val label = Label.newLabel "trap"
131                            val jmp   = I.JCC{cond=I.O,                            val jmp   = I.JCC{cond=I.O,
132                                              opnd=I.ImmedLabel(LE.LABEL label)}                                              opnd=I.ImmedLabel(T.LABEL label)}
133                        in  trapLabel := SOME(jmp, label); jmp end                        in  trapLabel := SOME(jmp, label); jmp end
134              | SOME(jmp, _) => jmp              | SOME(jmp, _) => jmp
135        in  emit jmp end        in  emit jmp end
# Line 114  Line 137 
137        val newReg  = C.newReg        val newReg  = C.newReg
138        val newFreg = C.newFreg        val newFreg = C.newFreg
139    
140          fun fsize 32 = I.FP32
141            | fsize 64 = I.FP64
142            | fsize 80 = I.FP80
143            | fsize _  = error "fsize"
144    
145        (* mark an expression with a list of annotations *)        (* mark an expression with a list of annotations *)
146        fun mark'(i,[]) = i        fun mark'(i,[]) = i
147          | 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 149 
149        (* annotate an expression and emit it *)        (* annotate an expression and emit it *)
150        fun mark(i,an) = emit(mark'(i,an))        fun mark(i,an) = emit(mark'(i,an))
151    
152          val emits = app emit
153    
154        (* emit parallel copies for integers        (* emit parallel copies for integers
155         * Translates parallel copies that involve memregs into         * Translates parallel copies that involve memregs into
156         * individual copies.         * individual copies.
# Line 128  Line 158 
158        fun copy([], [], an) = ()        fun copy([], [], an) = ()
159          | copy(dst, src, an) =          | copy(dst, src, an) =
160            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} =
161                    if rd = rs then [] else                    if C.sameColor(rd,rs) then [] else
162                    let val tmpR = I.Direct(newReg())                    let val tmpR = I.Direct(newReg())
163                    in  [I.MOVE{mvOp=I.MOVL, src=src, dst=tmpR},                    in  [I.MOVE{mvOp=I.MOVL, src=src, dst=tmpR},
164                         I.MOVE{mvOp=I.MOVL, src=tmpR, dst=dst}]                         I.MOVE{mvOp=I.MOVL, src=tmpR, dst=dst}]
165                    end                    end
166                  | mvInstr{dst=I.Direct rd, src=I.Direct rs} =                  | mvInstr{dst=I.Direct rd, src=I.Direct rs} =
167                      if rd = rs then []                      if C.sameColor(rd,rs) then []
168                      else [I.COPY{dst=[rd], src=[rs], tmp=NONE}]                      else [I.COPY{dst=[rd], src=[rs], tmp=NONE}]
169                  | mvInstr{dst, src} = [I.MOVE{mvOp=I.MOVL, src=src, dst=dst}]                  | mvInstr{dst, src} = [I.MOVE{mvOp=I.MOVL, src=src, dst=dst}]
170            in            in
171               app emit (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}               emits (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}
172                 {regmap=fn r => r, tmp=SOME(I.Direct(newReg())),                 {tmp=SOME(I.Direct(newReg())),
173                  dst=dst, src=src})                  dst=dst, src=src})
174            end            end
175    
176        (* conversions *)        (* conversions *)
177        val itow = Word.fromInt        val itow = Word.fromInt
178        val wtoi = Word.toInt        val wtoi = Word.toInt
179        fun toInt32 i = Int32.fromLarge(Int.toLarge i)        fun toInt32 i = T.I.toInt32(32, i)
180        val w32toi32 = Word32.toLargeIntX        val w32toi32 = Word32.toLargeIntX
181        val i32tow32 = Word32.fromLargeInt        val i32tow32 = Word32.fromLargeInt
182    
# Line 158  Line 188 
188        val ecx = I.Direct(C.ecx)        val ecx = I.Direct(C.ecx)
189        val edx = I.Direct(C.edx)        val edx = I.Direct(C.edx)
190    
191        fun immedLabel lab = I.ImmedLabel(LE.LABEL lab)        fun immedLabel lab = I.ImmedLabel(T.LABEL lab)
192    
193        (* Is the expression zero? *)        (* Is the expression zero? *)
194        fun isZero(T.LI 0) = true        fun isZero(T.LI z) = T.I.isZero z
         | isZero(T.LI32 0w0) = true  
195          | isZero(T.MARK(e,a)) = isZero e          | isZero(T.MARK(e,a)) = isZero e
196          | isZero _ = false          | isZero _ = false
197         (* Does the expression set the zero bit?         (* Does the expression set the zero bit?
# Line 174  Line 203 
203          | setZeroBit(T.SRA _)      = true          | setZeroBit(T.SRA _)      = true
204          | setZeroBit(T.SRL _)      = true          | setZeroBit(T.SRL _)      = true
205          | setZeroBit(T.SLL _)      = true          | setZeroBit(T.SLL _)      = true
206            | setZeroBit(T.SUB _)      = true
207            | setZeroBit(T.ADDT _)     = true
208            | setZeroBit(T.SUBT _)     = true
209          | setZeroBit(T.MARK(e, _)) = setZeroBit e          | setZeroBit(T.MARK(e, _)) = setZeroBit e
210          | setZeroBit _             = false          | setZeroBit _             = false
211    
212        (* emit parallel copies for floating point *)        fun setZeroBit2(T.ANDB _)     = true
213        fun fcopy(fty, [], [], _) = ()          | setZeroBit2(T.ORB _)      = true
214          | fcopy(fty, dst as [_], src as [_], an) =          | setZeroBit2(T.XORB _)     = true
215            | setZeroBit2(T.SRA _)      = true
216            | setZeroBit2(T.SRL _)      = true
217            | setZeroBit2(T.SLL _)      = true
218            | setZeroBit2(T.ADD(32, _, _)) = true (* can't use leal! *)
219            | setZeroBit2(T.SUB _)      = true
220            | setZeroBit2(T.ADDT _)     = true
221            | setZeroBit2(T.SUBT _)     = true
222            | setZeroBit2(T.MARK(e, _)) = setZeroBit2 e
223            | setZeroBit2 _             = false
224    
225          (* emit parallel copies for floating point
226           * Normal version.
227           *)
228          fun fcopy'(fty, [], [], _) = ()
229            | fcopy'(fty, dst as [_], src as [_], an) =
230              mark(I.FCOPY{dst=dst,src=src,tmp=NONE}, an)              mark(I.FCOPY{dst=dst,src=src,tmp=NONE}, an)
231          | fcopy(fty, dst, src, an) =          | fcopy'(fty, dst, src, an) =
232              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)
233    
234          (* emit parallel copies for floating point.
235           * Fast version.
236           * Translates parallel copies that involve memregs into
237           * individual copies.
238           *)
239    
240          fun fcopy''(fty, [], [], _) = ()
241            | fcopy''(fty, dst, src, an) =
242              if true orelse isAnyFMemReg dst orelse isAnyFMemReg src then
243              let val fsize = fsize fty
244                  fun mvInstr{dst, src} = [I.FMOVE{fsize=fsize, src=src, dst=dst}]
245              in
246                  emits (Shuffle.shuffle{mvInstr=mvInstr, ea=RealReg}
247                    {tmp=case dst of
248                           [_] => NONE
249                         |  _  => SOME(I.FPR(newReg())),
250                     dst=dst, src=src})
251              end
252              else
253                mark(I.FCOPY{dst=dst,src=src,tmp=
254                             case dst of
255                               [_] => NONE
256                             | _   => SOME(I.FPR(newFreg()))}, an)
257    
258          fun fcopy x = if enableFastFPMode andalso !fast_floating_point
259                        then fcopy'' x else fcopy' x
260    
261        (* Translates MLTREE condition code to x86 condition code *)        (* Translates MLTREE condition code to x86 condition code *)
262        fun cond T.LT = I.LT | cond T.LTU = I.B        fun cond T.LT = I.LT | cond T.LTU = I.B
263          | cond T.LE = I.LE | cond T.LEU = I.BE          | cond T.LE = I.LE | cond T.LEU = I.BE
# Line 193  Line 267 
267    
268        (* Move and annotate *)        (* Move and annotate *)
269        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) =
270            if s=d then ()            if C.sameColor(s,d) then ()
271            else mark(I.COPY{dst=[d], src=[s], tmp=NONE}, an)            else mark(I.COPY{dst=[d], src=[s], tmp=NONE}, an)
272          | 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)
273    
# Line 205  Line 279 
279        val readonly = I.Region.readonly        val readonly = I.Region.readonly
280    
281        (*        (*
282         * Compute an effective address.  This is a new version         * Compute an effective address.
283         *)         *)
284        fun address(ea, mem) =        fun address(ea, mem) = let
       let (* tricky way to negate without overflow! *)  
           fun neg32 w = Word32.notb w + 0w1  
   
285            (* Keep building a bigger and bigger effective address expressions            (* Keep building a bigger and bigger effective address expressions
286             * The input is a list of trees             * The input is a list of trees
287             * b -- base             * b -- base
# Line 221  Line 292 
292            fun doEA([], b, i, s, d) = makeAddressingMode(b, i, s, d)            fun doEA([], b, i, s, d) = makeAddressingMode(b, i, s, d)
293              | doEA(t::trees, b, i, s, d) =              | doEA(t::trees, b, i, s, d) =
294                (case t of                (case t of
295                   T.LI n   => doEAImmed(trees, n, b, i, s, d)                   T.LI n   => doEAImmed(trees, toInt32 n, b, i, s, d)
296                 | T.LI32 n => doEAImmedw(trees, n, b, i, s, d)                 | T.CONST _ => doEALabel(trees, t, b, i, s, d)
297                 | T.CONST c => doEALabel(trees, LE.CONST c, b, i, s, d)                 | T.LABEL _ => doEALabel(trees, t, b, i, s, d)
298                 | T.LABEL le => doEALabel(trees, le, b, i, s, d)                 | T.LABEXP le => doEALabel(trees, le, b, i, s, d)
299                 | T.ADD(32, t1, t2 as T.REG(_,r)) =>                 | T.ADD(32, t1, t2 as T.REG(_,r)) =>
300                      if isMemReg r then doEA(t2::t1::trees, b, i, s, d)                      if isMemReg r then doEA(t2::t1::trees, b, i, s, d)
301                      else doEA(t1::t2::trees, b, i, s, d)                      else doEA(t1::t2::trees, b, i, s, d)
302                 | 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)
303                 | T.SUB(32, t1, T.LI n) =>                 | T.SUB(32, t1, T.LI n) =>
304                      (* can't overflow here *)                      doEA(t1::T.LI(T.I.NEG(32,n))::trees, b, i, s, d)
305                      doEA(t1::T.LI32(neg32(Word32.fromInt n))::trees, b, i, s, d)                 | T.SLL(32, t1, T.LI n) => let
306                 | T.SUB(32, t1, T.LI32 n) =>                      val n = T.I.toInt(32, n)
307                      doEA(t1::T.LI32(neg32 n)::trees, b, i, s, d)                   in
308                 | T.SLL(32, t1, T.LI 0) => displace(trees, t1, b, i, s, d)                     case n
309                 | 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)
310                 | 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)
311                 | 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)
312                 | T.SLL(32, t1, T.LI32 0w0) => displace(trees, t1, b, i, s, d)                      | 3 => indexed(trees, t1, t, 3, b, i, s, d)
313                 | T.SLL(32, t1, T.LI32 0w1) => indexed(trees,t1,t,1,b,i,s,d)                      | _ => displace(trees, t, b, i, s, d)
314                 | 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)  
315                 | t => displace(trees, t, b, i, s, d)                 | t => displace(trees, t, b, i, s, d)
316                )                )
317    
318            (* Add an immed constant *)            (* Add an immed constant *)
319            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)
320              | doEAImmed(trees, n, b, i, s, I.Immed m) =              | doEAImmed(trees, n, b, i, s, I.Immed m) =
321                   doEA(trees, b, i, s, (* no overflow! *)                   doEA(trees, b, i, s, I.Immed(n+m))
                        I.Immed(w32toi32(Word32.fromInt n + i32tow32 m)))  
322              | 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) =  
323                   doEA(trees, b, i, s,                   doEA(trees, b, i, s,
324                        I.ImmedLabel(LE.PLUS(le,LE.INT(Word32.toIntX n)))                        I.ImmedLabel(T.ADD(32,le,T.LI(T.I.fromInt32(32, n)))))
325                        handle Overflow => error "doEAImmedw: constant too large")              | doEAImmed(trees, n, b, i, s, _) = error "doEAImmed"
             | doEAImmedw(trees, n, b, i, s, _) = error "doEAImmedw"  
326    
327            (* Add a label expression *)            (* Add a label expression *)
328            and doEALabel(trees, le, b, i, s, I.Immed 0) =            and doEALabel(trees, le, b, i, s, I.Immed 0) =
329                   doEA(trees, b, i, s, I.ImmedLabel le)                   doEA(trees, b, i, s, I.ImmedLabel le)
330              | doEALabel(trees, le, b, i, s, I.Immed m) =              | doEALabel(trees, le, b, i, s, I.Immed m) =
331                   doEA(trees, b, i, s,                   doEA(trees, b, i, s,
332                        I.ImmedLabel(LE.PLUS(le,LE.INT(Int32.toInt m)))                        I.ImmedLabel(T.ADD(32,le,T.LI(T.I.fromInt32(32, m))))
333                        handle Overflow => error "doEALabel: constant too large")                        handle Overflow => error "doEALabel: constant too large")
334              | doEALabel(trees, le, b, i, s, I.ImmedLabel le') =              | doEALabel(trees, le, b, i, s, I.ImmedLabel le') =
335                   doEA(trees, b, i, s, I.ImmedLabel(LE.PLUS(le,le')))                   doEA(trees, b, i, s, I.ImmedLabel(T.ADD(32,le,le')))
336              | doEALabel(trees, le, b, i, s, _) = error "doEALabel"              | doEALabel(trees, le, b, i, s, _) = error "doEALabel"
337    
338            and makeAddressingMode(NONE, NONE, _, disp) = disp            and makeAddressingMode(NONE, NONE, _, disp) = disp
# Line 286  Line 345 
345            (* generate code for tree and ensure that it is not in %esp *)            (* generate code for tree and ensure that it is not in %esp *)
346            and exprNotEsp tree =            and exprNotEsp tree =
347                let val r = expr tree                let val r = expr tree
348                in  if r = C.esp then                in  if C.sameColor(r, C.esp) then
349                       let val tmp = newReg()                       let val tmp = newReg()
350                       in  move(I.Direct r, I.Direct tmp); tmp end                       in  move(I.Direct r, I.Direct tmp); tmp end
351                    else r                    else r
# Line 298  Line 357 
357              | displace(trees, t, b as SOME base, NONE, _, d) = (* no index *)              | displace(trees, t, b as SOME base, NONE, _, d) = (* no index *)
358                (* make t the index, but make sure that it is not %esp! *)                (* make t the index, but make sure that it is not %esp! *)
359                let val i = expr t                let val i = expr t
360                in  if i = C.esp then                in  if C.sameColor(i, C.esp) then
361                      (* swap base and index *)                      (* swap base and index *)
362                      if base <> C.esp then                      if C.sameColor(base, C.esp) then
363                         doEA(trees, SOME i, b, 0, d)                         doEA(trees, SOME i, b, 0, d)
364                      else  (* base and index = %esp! *)                      else  (* base and index = %esp! *)
365                         let val index = newReg()                         let val index = newReg()
# Line 330  Line 389 
389        end (* address *)        end (* address *)
390    
391            (* reduce an expression into an operand *)            (* reduce an expression into an operand *)
392        and operand(T.LI i) = I.Immed(toInt32 i)        and operand(T.LI i) = I.Immed(toInt32(i))
393          | operand(T.LI32 w) = I.Immed(wToInt32 w)          | operand(x as (T.CONST _ | T.LABEL _)) = I.ImmedLabel x
394          | operand(T.CONST c) = I.ImmedLabel(LE.CONST c)          | operand(T.LABEXP le) = I.ImmedLabel le
         | operand(T.LABEL lab) = I.ImmedLabel lab  
395          | operand(T.REG(_,r)) = IntReg r          | operand(T.REG(_,r)) = IntReg r
396          | operand(T.LOAD(32,ea,mem)) = address(ea, mem)          | operand(T.LOAD(32,ea,mem)) = address(ea, mem)
397          | operand(t) = I.Direct(expr t)          | operand(t) = I.Direct(expr t)
# Line 368  Line 426 
426            | I.Indexed _  => true            | I.Indexed _  => true
427            | I.MemReg _   => true            | I.MemReg _   => true
428            | I.LabelEA _  => true            | I.LabelEA _  => true
429              | I.FDirect f  => true
430            | _            => false            | _            => false
431            )            )
432    
# Line 378  Line 437 
437        and doExpr(exp, rd : I.C.cell, an) =        and doExpr(exp, rd : I.C.cell, an) =
438            let val rdOpnd = IntReg rd            let val rdOpnd = IntReg rd
439    
440                fun equalRd(I.Direct r) = r = rd                fun equalRd(I.Direct r) = C.sameColor(r, rd)
441                  | equalRd(I.MemReg r) = r = rd                  | equalRd(I.MemReg r) = C.sameColor(r, rd)
442                  | equalRd _ = false                  | equalRd _ = false
443    
444                   (* Emit a binary operator.  If the destination is                   (* Emit a binary operator.  If the destination is
# Line 453  Line 512 
512                fun divrem(signed, overflow, e1, e2, resultReg) =                fun divrem(signed, overflow, e1, e2, resultReg) =
513                let val (opnd1, opnd2) = (operand e1, operand e2)                let val (opnd1, opnd2) = (operand e1, operand e2)
514                    val _ = move(opnd1, eax)                    val _ = move(opnd1, eax)
515                    val oper = if signed then (emit(I.CDQ); I.IDIV)                    val oper = if signed then (emit(I.CDQ); I.IDIVL)
516                               else (zero edx; I.UDIV)                               else (zero edx; I.DIVL)
517                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);
518                    move(resultReg, rdOpnd);                    move(resultReg, rdOpnd);
519                    if overflow then trap() else ()                    if overflow then trap() else ()
520                end                end
521    
522                    (* Optimize the special case for division *)                    (* Optimize the special case for division *)
523                fun divide(signed, overflow, e1, e2 as T.LI n) =                fun divide(signed, overflow, e1, e2 as T.LI n') = let
524                let fun isPowerOf2 w = Word.andb((w - 0w1), w) = 0w0                    val n = toInt32 n'
525                      val w = T.I.toWord32(32, n')
526                      fun isPowerOf2 w = W32.andb((w - 0w1), w) = 0w0
527                    fun log2 n =  (* n must be > 0!!! *)                    fun log2 n =  (* n must be > 0!!! *)
528                        let fun loop(0w1,pow) = pow                        let fun loop(0w1,pow) = pow
529                              | loop(w,pow) = loop(Word.>>(w, 0w1),pow+1)                              | loop(w,pow) = loop(W32.>>(w, 0w1),pow+1)
530                        in loop(n,0) end                        in loop(n,0) end
                   val w = Word.fromInt n  
531                in  if n > 1 andalso isPowerOf2 w then                in  if n > 1 andalso isPowerOf2 w then
532                       let val pow = T.LI(log2 w)                       let val pow = T.LI(T.I.fromInt(32,log2 w))
533                       in  if signed then                       in  if signed then
534                           (* signed; simulate round towards zero *)                           (* signed; simulate round towards zero *)
535                           let val label = Label.newLabel ""                           let val label = Label.newLabel ""
# Line 482  Line 542 
542                                       I.UNARY{unOp=I.INCL, opnd=opnd1}                                       I.UNARY{unOp=I.INCL, opnd=opnd1}
543                                    else                                    else
544                                       I.BINARY{binOp=I.ADDL,                                       I.BINARY{binOp=I.ADDL,
545                                                src=I.Immed(toInt32 n - 1),                                                src=I.Immed(n - 1),
546                                                dst=opnd1});                                                dst=opnd1});
547                               defineLabel label;                               defineLabel label;
548                               shift(I.SARL, T.REG(32, reg1), pow)                               shift(I.SARL, T.REG(32, reg1), pow)
# Line 507  Line 567 
567                fun uMultiply(e1, e2) =                fun uMultiply(e1, e2) =
568                    (* note e2 can never be (I.Direct edx) *)                    (* note e2 can never be (I.Direct edx) *)
569                    (move(operand e1, eax);                    (move(operand e1, eax);
570                     mark(I.MULTDIV{multDivOp=I.UMUL,                     mark(I.MULTDIV{multDivOp=I.MULL,
571                                    src=regOrMem(operand e2)},an);                                    src=regOrMem(operand e2)},an);
572                     move(eax, rdOpnd)                     move(eax, rdOpnd)
573                    )                    )
# Line 585  Line 645 
645    
646                   (* Generate setcc instruction:                   (* Generate setcc instruction:
647                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))
648                      * Bug, if eax is either t1 or t2 then problem will occur!!!
649                      * Note that we have to use eax as the destination of the
650                      * setcc because it only works on the registers
651                      * %al, %bl, %cl, %dl and %[abcd]h.  The last four registers
652                      * are inaccessible in 32 bit mode.
653                    *)                    *)
654                fun setcc(ty, cc, t1, t2, yes, no) =                fun setcc(ty, cc, t1, t2, yes, no) =
655                let val tmpR = newReg()                let val (cc, yes, no) =
656                    val tmp = I.Direct tmpR                           if yes > no then (cc, yes, no)
657                    (* We create a temporary here just in                           else (T.Basis.negateCond cc, no, yes)
                    * case t1 or t2 contains a use of rd.  
                    *)  
658                in  (* Clear the destination first.                in  (* Clear the destination first.
659                     * This this because stupid SETcc                     * This this because stupid SETcc
660                     * only writes to the low order                     * only writes to the low order
661                     * byte.  That's Intel architecture, folks.                     * byte.  That's Intel architecture, folks.
662                     *)                     *)
663                    zero tmp;                    case (yes, no, cc) of
664                    case (yes, no) of                      (1, 0, T.LT) =>
665                      (1, 0) => (* normal case *)                       let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
666                         in  move(tmp, rdOpnd);
667                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
668                         end
669                      | (1, 0, T.GT) =>
670                         let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
671                         in  emit(I.UNARY{unOp=I.NOTL,opnd=tmp});
672                             move(tmp, rdOpnd);
673                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
674                         end
675                      | (1, 0, _) => (* normal case *)
676                      let val cc = cmp(true, ty, cc, t1, t2, [])                      let val cc = cmp(true, ty, cc, t1, t2, [])
677                      in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end                      in  mark(I.SET{cond=cond cc, opnd=eax}, an);
678                    | (0, 1) => (* flip *)                          emit(I.BINARY{binOp=I.ANDL,src=I.Immed 255, dst=eax});
679                      let val cc = cmp(true, ty,                          move(eax, rdOpnd)
680                                       T.Basis.negateCond cc, t1, t2, [])                      end
681                      in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end                    | (C1, C2, _)  =>
                   | (C1, C2)  =>  
682                      (* general case;                      (* general case;
683                       * from the Intel optimization guide p3-5 *)                       * from the Intel optimization guide p3-5
684                      let val C1 = toInt32 C1                       *)
685                          val C2 = toInt32 C2                      let val _  = zero eax;
686                          val cc = cmp(true, ty, cc, t1, t2, [])                          val cc = cmp(true, ty, cc, t1, t2, [])
687                      in  emit(I.SET{cond=cond cc, opnd=tmp});                      in  case C1-C2 of
688                          case Int32.abs(C1-C2)-1 of                            D as (1 | 2 | 3 | 4 | 5 | 8 | 9) =>
689                            D as (1 | 2 | 4 | 8) =>                            let val (base,scale) =
690                            let val addr = I.Indexed{base=SOME tmpR,                                    case D of
691                                                     index=tmpR,                                      1 => (NONE, 0)
692                                                     scale=Int32.toInt D,                                    | 2 => (NONE, 1)
693                                                     disp=I.Immed(C1-C2),                                    | 3 => (SOME C.eax, 1)
694                                      | 4 => (NONE, 2)
695                                      | 5 => (SOME C.eax, 2)
696                                      | 8 => (NONE, 3)
697                                      | 9 => (SOME C.eax, 3)
698                                  val addr = I.Indexed{base=base,
699                                                       index=C.eax,
700                                                       scale=scale,
701                                                       disp=I.Immed C2,
702                                                     mem=readonly}                                                     mem=readonly}
703                            in  mark(I.LEA{r32=tmpR, addr=addr}, an) end                                val tmpR = newReg()
704                          | _ =>                                val tmp  = I.Direct tmpR
705                           (emit(I.UNARY{unOp=I.DECL, opnd=tmp});                            in  emit(I.SET{cond=cond cc, opnd=eax});
706                                  mark(I.LEA{r32=tmpR, addr=addr}, an);
707                                  move(tmp, rdOpnd)
708                              end
709                            | D =>
710                               (emit(I.SET{cond=cond(T.Basis.negateCond cc),
711                                           opnd=eax});
712                                emit(I.UNARY{unOp=I.DECL, opnd=eax});
713                            emit(I.BINARY{binOp=I.ANDL,                            emit(I.BINARY{binOp=I.ANDL,
714                                          src=I.Immed(C2-C1), dst=tmp});                                            src=I.Immed D, dst=eax});
715                            mark(I.BINARY{binOp=I.ADDL,                              if C2 = 0 then
716                                          src=I.Immed(Int32.min(C1,C2)),                                 move(eax, rdOpnd)
717                                          dst=tmp}, an)                              else
718                           )                                 let val tmpR = newReg()
719                      end;                                     val tmp  = I.Direct tmpR
720                                   in  mark(I.LEA{addr=
721                                             I.Displace{
722                                                 base=C.eax,
723                                                 disp=I.Immed C2,
724                                                 mem=readonly},
725                                                 r32=tmpR}, an);
726                    move(tmp, rdOpnd)                    move(tmp, rdOpnd)
727                                    end
728                               )
729                        end
730                end (* setcc *)                end (* setcc *)
731    
732                    (* Generate cmovcc instruction.                    (* Generate cmovcc instruction.
# Line 647  Line 743 
743    
744                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)
745    
746                      (* Add n to rd *)
747                  fun addN n =
748                  let val n = operand n
749                      val src = if isMemReg rd then immedOrReg n else n
750                  in  mark(I.BINARY{binOp=I.ADDL, src=src, dst=rdOpnd}, an) end
751    
752                    (* Generate addition *)                    (* Generate addition *)
753                fun addition(e1, e2) =                fun addition(e1, e2) =
754                      case e1 of
755                        T.REG(_,rs) => if C.sameColor(rs,rd) then addN e2
756                                       else addition1(e1,e2)
757                      | _ => addition1(e1,e2)
758                  and addition1(e1, e2) =
759                      case e2 of
760                        T.REG(_,rs) => if C.sameColor(rs,rd) then addN e1
761                                       else addition2(e1,e2)
762                      | _ => addition2(e1,e2)
763                  and addition2(e1,e2) =
764                  (dstMustBeReg(fn (dstR, _) =>                  (dstMustBeReg(fn (dstR, _) =>
765                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))
766                  handle EA => binaryComm(I.ADDL, e1, e2))                  handle EA => binaryComm(I.ADDL, e1, e2))
767    
                   (* Add n to rd *)  
               fun addN n =  
                 mark(I.BINARY{binOp=I.ADDL, src=I.Immed(toInt32 n),  
                               dst=rdOpnd}, an)  
768    
769            in  case exp of            in  case exp of
770                 T.REG(_,rs) =>                 T.REG(_,rs) =>
771                     if isMemReg rs andalso isMemReg rd then                     if isMemReg rs andalso isMemReg rd then
772                        let val tmp = I.Direct(newReg())                        let val tmp = I.Direct(newReg())
773                        in  move'(MemReg rs, tmp, an);                        in  move'(I.MemReg rs, tmp, an);
774                            move'(tmp, rdOpnd, [])                            move'(tmp, rdOpnd, [])
775                        end                        end
776                     else move'(IntReg rs, rdOpnd, an)                     else move'(IntReg rs, rdOpnd, an)
777               | (T.LI 0 | T.LI32 0w0) =>               | T.LI z => let
778                     val n = toInt32 z
779                   in
780                     if n=0 then
781                   (* As per Fermin's request, special optimization for rd := 0.                   (* As per Fermin's request, special optimization for rd := 0.
782                    * Currently we don't bother with the size.                    * Currently we don't bother with the size.
783                    *)                    *)
784                   if isMemReg rd then move'(I.Immed 0, rdOpnd, an)                   if isMemReg rd then move'(I.Immed 0, rdOpnd, an)
785                   else mark(I.BINARY{binOp=I.XORL, src=rdOpnd, dst=rdOpnd}, an)                   else mark(I.BINARY{binOp=I.XORL, src=rdOpnd, dst=rdOpnd}, an)
786               | T.LI n      => move'(I.Immed(toInt32 n), rdOpnd, an)                   else
787               | T.LI32 w    => move'(I.Immed(wToInt32 w), rdOpnd, an)                     move'(I.Immed(n), rdOpnd, an)
788               | T.CONST c   => move'(I.ImmedLabel(LE.CONST c), rdOpnd, an)                 end
789               | T.LABEL lab => move'(I.ImmedLabel lab, rdOpnd, an)               | (T.CONST _ | T.LABEL _) =>
790                     move'(I.ImmedLabel exp, rdOpnd, an)
791                 | T.LABEXP le => move'(I.ImmedLabel le, rdOpnd, an)
792    
793                 (* 32-bit addition *)                 (* 32-bit addition *)
794               | T.ADD(32, e, (T.LI 1|T.LI32 0w1)) => unary(I.INCL, e)               | T.ADD(32, e1, e2 as T.LI n) => let
795               | T.ADD(32, (T.LI 1|T.LI32 0w1), e) => unary(I.INCL, e)                   val n = toInt32 n
796               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)                 in
797               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)                   case n
798               | T.ADD(32, e1 as T.REG(_, rs), e2 as T.LI n) =>                   of 1  => unary(I.INCL, e1)
799                    if rs = rd then addN n else addition(e1, e2)                    | ~1 => unary(I.DECL, e1)
800               | T.ADD(32, e1 as T.LI n, e2 as T.REG(_, rs)) =>                    | _ => addition(e1, e2)
801                    if rs = rd then addN n else addition(e1, e2)                 end
802                 | T.ADD(32, e1 as T.LI n, e2) => let
803                     val n = toInt32 n
804                   in
805                     case n
806                     of  1 => unary(I.INCL, e2)
807                      | ~1 => unary(I.DECL, e2)
808                      | _ => addition(e1, e2)
809                   end
810               | T.ADD(32, e1, e2) => addition(e1, e2)               | T.ADD(32, e1, e2) => addition(e1, e2)
811    
812                 (* 32-bit subtraction *)                 (* 32-bit addition but set the flag!
813               | 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))  
814               *)               *)
815                 | T.ADD(0, e, e1 as T.LI n) => let
816                     val n = T.I.toInt(32, n)
817                   in
818                     if n=1 then unary(I.INCL, e)
819                     else if n = ~1 then unary(I.DECL, e)
820                          else binaryComm(I.ADDL, e, e1)
821                   end
822                 | T.ADD(0, e1 as T.LI n, e) => let
823                     val n = T.I.toInt(32, n)
824                   in
825                     if n=1 then unary(I.INCL, e)
826                     else if n = ~1 then unary(I.DECL, e)
827                          else binaryComm(I.ADDL, e1, e)
828                   end
829                 | T.ADD(0, e1, e2) => binaryComm(I.ADDL, e1, e2)
830    
831                   (* 32-bit subtraction *)
832                 | T.SUB(32, e1, e2 as T.LI n) => let
833                     val n = toInt32 n
834                   in
835                     case n
836                     of 0 => doExpr(e1, rd, an)
837                      | 1 => unary(I.DECL, e1)
838                      | ~1 => unary(I.INCL, e1)
839                      | _ => binary(I.SUBL, e1, e2)
840                   end
841                 | T.SUB(32, e1 as T.LI n, e2) =>
842                     if T.I.isZero n then unary(I.NEGL, e2)
843                     else binary(I.SUBL, e1, e2)
844               | T.SUB(32, e1, e2) => binary(I.SUBL, e1, e2)               | T.SUB(32, e1, e2) => binary(I.SUBL, e1, e2)
845    
846               | T.MULU(32, x, y) => uMultiply(x, y)               | T.MULU(32, x, y) => uMultiply(x, y)
# Line 727  Line 869 
869               | T.LOAD(8, ea, mem) => load8(ea, mem)               | T.LOAD(8, ea, mem) => load8(ea, mem)
870               | T.LOAD(16, ea, mem) => load16(ea, mem)               | T.LOAD(16, ea, mem) => load16(ea, mem)
871               | T.LOAD(32, ea, mem) => load32(ea, mem)               | T.LOAD(32, ea, mem) => load32(ea, mem)
872               | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(8,ea,mem)) => load8s(ea, mem)  
873               | 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)
874                 | T.SX(32,16,T.LOAD(16,ea,mem)) => load16s(ea, mem)
875                 | T.ZX(32,8,T.LOAD(8,ea,mem)) => load8(ea, mem)
876                 | T.ZX(32,16,T.LOAD(16,ea,mem)) => load16(ea, mem)
877    
878               | 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) =>
879                   setcc(ty, cc, t1, t2, yes, no)                   setcc(ty, cc, t1, t2, toInt32 yes, toInt32 no)
880               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>
881                  (case !arch of (* PentiumPro and higher has CMOVcc *)                  (case !arch of (* PentiumPro and higher has CMOVcc *)
882                     Pentium => unknownExp exp                     Pentium => unknownExp exp
# Line 741  Line 886 
886               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))
887               | T.MARK(e, a) => doExpr(e, rd, a::an)               | T.MARK(e, a) => doExpr(e, rd, a::an)
888               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)
889               | T.REXT e => compileRexp (reducer()) {e=e, rd=rd, an=an}               | T.REXT e =>
890                     ExtensionComp.compileRext (reducer()) {e=e, rd=rd, an=an}
891                 (* simplify and try again *)                 (* simplify and try again *)
892               | exp => unknownExp exp               | exp => unknownExp exp
893            end (* doExpr *)            end (* doExpr *)
# Line 761  Line 907 
907            * 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,
908            * 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.
909            *)            *)
910       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) =
911              (case ty of              (case ty of
912                 8 =>  test(I.TESTB, a, b)                 8  => test(I.TESTB, a, b, an)
913               | 16 => test(I.TESTW, a, b)               | 16 => test(I.TESTW, a, b, an)
914               | 32 => test(I.TESTL, a, b)               | 32 => test(I.TESTL, a, b, an)
915               | _  => (expr e; ())               | _  => doExpr(e, newReg(), an);
916               ; cc)               cc)
917          | cmpWithZero(cc, e) = (expr e; cc)          | cmpWithZero(cc, e, an) =
918              let val e =
919                    case e of (* hack to disable the lea optimization XXX *)
920                      T.ADD(_, a, b) => T.ADD(0, a, b)
921                    | e => e
922              in  doExpr(e, newReg(), an); cc end
923    
924            (* Emit a test.            (* Emit a test.
925             *   The available modes are             *   The available modes are
# Line 785  Line 936 
936             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction
937             * by TESTB.             * by TESTB.
938             *)             *)
939        and test(testopcode, a, b) =        and test(testopcode, a, b, an) =
940            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)
941                (* translate r, r/m => r/m, r *)                (* translate r, r/m => r/m, r *)
942                val (opnd1, opnd2) =                val (opnd1, opnd2) =
943                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)
944            in  emit(testopcode{lsrc=opnd1, rsrc=opnd2})            in  mark(testopcode{lsrc=opnd1, rsrc=opnd2}, an)
945            end            end
946    
947           (* generate a condition code expression           (* generate a condition code expression
948             * The zero is for setting the condition code!             * The zero is for setting the condition code!
949             * I have no idea why this is used.             * I have no idea why this is used.
950             *)             *)
951        and doCCexpr(T.CMP(ty, cc, t1, t2), 0, an) =        and doCCexpr(T.CMP(ty, cc, t1, t2), rd, an) =
952              if C.sameColor(rd, C.eflags) then
953            (cmp(false, ty, cc, t1, t2, an); ())            (cmp(false, ty, cc, t1, t2, an); ())
954              else
955                 error "doCCexpr: cmp"
956          | 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))
957          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)
958          | doCCexpr(T.CCEXT e, cd, an) =          | doCCexpr(T.CCEXT e, cd, an) =
959             compileCCexp (reducer()) {e=e, cd=cd, an=an}             ExtensionComp.compileCCext (reducer()) {e=e, ccd=cd, an=an}
960          | doCCexpr _ = error "doCCexpr"          | doCCexpr _ = error "doCCexpr"
961    
962       and ccExpr e = error "ccExpr"       and ccExpr e = error "ccExpr"
# Line 812  Line 966 
966             * we can also reorder the operands.             * we can also reorder the operands.
967             *)             *)
968        and cmp(swapable, ty, cc, t1, t2, an) =        and cmp(swapable, ty, cc, t1, t2, an) =
969            (case cc of                 (* == and <> can be always be reordered *)
970               (T.EQ | T.NE) =>            let val swapable = swapable orelse cc = T.EQ orelse cc = T.NE
971                (* Sometimes the comparison is not necessary because            in (* Sometimes the comparison is not necessary because
972                 * the bits are already set!                 * the bits are already set!
973                 *)                 *)
974                if isZero t1 andalso setZeroBit t2 then cmpWithZero(cc, t2)               if isZero t1 andalso setZeroBit2 t2 then
975                else if isZero t2 andalso setZeroBit t1 then cmpWithZero(cc, t1)                   if swapable then
976                     (* == and <> can be reordered *)                      cmpWithZero(T.Basis.swapCond cc, t2, an)
977                else genCmp(ty, true, cc, t1, t2, an)                   else (* can't reorder the comparison! *)
978             |  _ => genCmp(ty, swapable, cc, t1, t2, an)                      genCmp(ty, false, cc, t1, t2, an)
979            )               else if isZero t2 andalso setZeroBit2 t1 then
980                    cmpWithZero(cc, t1, an)
981                 else genCmp(ty, swapable, cc, t1, t2, an)
982              end
983    
984            (* 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)
985             * Return the appropriate condition code and operands.             * Return the appropriate condition code and operands.
# Line 855  Line 1012 
1012            end            end
1013    
1014            (* generate code for jumps *)            (* generate code for jumps *)
1015        and jmp(T.LABEL(lexp as LE.LABEL lab), labs, an) =        and jmp(lexp as T.LABEL lab, labs, an) =
1016               mark(I.JMP(I.ImmedLabel lexp, [lab]), an)               mark(I.JMP(I.ImmedLabel lexp, [lab]), an)
1017          | 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)
1018          | jmp(ea, labs, an)           = mark(I.JMP(operand ea, labs), an)          | jmp(ea, labs, an)           = mark(I.JMP(operand ea, labs), an)
1019    
1020         (* convert mlrisc to cellset:         (* convert mlrisc to cellset:
1021          *)          *)
1022         and cellset mlrisc =         and cellset mlrisc =
1023             let val addCCReg = C.addCell C.CC             let val addCCReg = C.CellSet.add
1024                 fun g([],acc) = acc                 fun g([],acc) = acc
1025                   | 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))
1026                   | 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 881  Line 1038 
1038            let val src = (* movb has to use %eax as source. Stupid x86! *)            let val src = (* movb has to use %eax as source. Stupid x86! *)
1039                   case immedOrReg(operand d) of                   case immedOrReg(operand d) of
1040                       src as I.Direct r =>                       src as I.Direct r =>
1041                         if r = C.eax then src else (move(src, eax); eax)                         if C.sameColor(r,C.eax)
1042                           then src else (move(src, eax); eax)
1043                     | src => src                     | src => src
1044            in  mark(I.MOVE{mvOp=I.MOVB, src=src, dst=address(ea,mem)},an)            in  mark(I.MOVE{mvOp=I.MOVB, src=src, dst=address(ea,mem)},an)
1045            end            end
# Line 897  Line 1055 
1055          | branch(T.FCMP(fty, fcc, t1, t2), lab, an) =          | branch(T.FCMP(fty, fcc, t1, t2), lab, an) =
1056             fbranch(fty, fcc, t1, t2, lab, an)             fbranch(fty, fcc, t1, t2, lab, an)
1057          | branch(ccexp, lab, an) =          | branch(ccexp, lab, an) =
1058             (doCCexpr(ccexp, 0, []);             (doCCexpr(ccexp, C.eflags, []);
1059              mark(I.JCC{cond=cond(Gen.condOf ccexp), opnd=immedLabel lab}, an)              mark(I.JCC{cond=cond(Gen.condOf ccexp), opnd=immedLabel lab}, an)
1060             )             )
1061    
1062            (* generate code for floating point compare and branch *)            (* generate code for floating point compare and branch *)
1063        and fbranch(fty, fcc, t1, t2, lab, an) =        and fbranch(fty, fcc, t1, t2, lab, an) =
           let fun compare() =  
1064                let fun ignoreOrder (T.FREG _) = true                let fun ignoreOrder (T.FREG _) = true
1065                      | ignoreOrder (T.FLOAD _) = true                      | ignoreOrder (T.FLOAD _) = true
1066                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e
1067                      | ignoreOrder _ = false                      | ignoreOrder _ = false
1068                in  if ignoreOrder t1 orelse ignoreOrder t2 then  
1069                  fun compare'() = (* Sethi-Ullman style *)
1070                      (if ignoreOrder t1 orelse ignoreOrder t2 then
1071                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))
1072                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);
1073                          emit(I.FXCH{opnd=C.ST(1)}));                          emit(I.FXCH{opnd=C.ST(1)}));
1074                    emit(I.FUCOMPP)                     emit(I.FUCOMPP);
1075                       fcc
1076                      )
1077    
1078                  fun compare''() =
1079                          (* direct style *)
1080                          (* Try to make lsrc the memory operand *)
1081                      let val lsrc = foperand(fty, t1)
1082                          val rsrc = foperand(fty, t2)
1083                          val fsize = fsize fty
1084                          fun cmp(lsrc, rsrc, fcc) =
1085                              (emit(I.FCMP{fsize=fsize,lsrc=lsrc,rsrc=rsrc}); fcc)
1086                      in  case (lsrc, rsrc) of
1087                             (I.FPR _, I.FPR _) => cmp(lsrc, rsrc, fcc)
1088                           | (I.FPR _, mem) => cmp(mem,lsrc,T.Basis.swapFcond fcc)
1089                           | (mem, I.FPR _) => cmp(lsrc, rsrc, fcc)
1090                           | (lsrc, rsrc) => (* can't be both memory! *)
1091                             let val ftmpR = newFreg()
1092                                 val ftmp  = I.FPR ftmpR
1093                             in  emit(I.FMOVE{fsize=fsize,src=rsrc,dst=ftmp});
1094                                 cmp(lsrc, ftmp, fcc)
1095                             end
1096                end                end
1097    
1098                  fun compare() =
1099                      if enableFastFPMode andalso !fast_floating_point
1100                      then compare''() else compare'()
1101    
1102                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})
1103                  fun testil i = emit(I.TESTL{lsrc=eax,rsrc=I.Immed(i)})
1104                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})
1105                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})
1106                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)
1107                fun sahf() = emit(I.SAHF)                fun sahf() = emit(I.SAHF)
1108                fun branch() =                fun branch(fcc) =
1109                    case fcc                    case fcc
1110                    of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))                    of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))
1111                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))
1112                     | T.?    => (sahf(); j(I.P,lab))                     | T.?    => (sahf(); j(I.P,lab))
1113                     | T.<=>  => (sahf(); j(I.NP,lab))                     | T.<=>  => (sahf(); j(I.NP,lab))
1114                     | T.>    => (andil 0x4500;  j(I.EQ,lab))                     | T.>    => (testil 0x4500;  j(I.EQ,lab))
1115                     | T.?<=  => (andil 0x4500;  j(I.NE,lab))                     | T.?<=  => (testil 0x4500;  j(I.NE,lab))
1116                     | T.>=   => (andil 0x500; j(I.EQ,lab))                     | T.>=   => (testil 0x500; j(I.EQ,lab))
1117                     | T.?<   => (andil 0x500; j(I.NE,lab))                     | T.?<   => (testil 0x500; j(I.NE,lab))
1118                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))
1119                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))
1120                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);
1121                                  cmpil 0x4000; j(I.EQ,lab))                                  cmpil 0x4000; j(I.EQ,lab))
1122                     | T.?>   => (sahf(); j(I.P,lab); andil 0x4100; j(I.EQ,lab))                     | T.?>   => (sahf(); j(I.P,lab); testil 0x4100; j(I.EQ,lab))
1123                     | T.<>   => (andil 0x4400; j(I.EQ,lab))                     | T.<>   => (testil 0x4400; j(I.EQ,lab))
1124                     | T.?=   => (andil 0x4400; j(I.NE,lab))                     | T.?=   => (testil 0x4400; j(I.NE,lab))
1125                     | _      => error "fbranch"                     | _      => error "fbranch"
1126                   (*esac*)                   (*esac*)
1127            in  compare(); emit I.FNSTSW; branch()                val fcc = compare()
1128              in  emit I.FNSTSW;
1129                  branch(fcc)
1130              end
1131    
1132          (*========================================================
1133           * Floating point code generation starts here.
1134           * Some generic fp routines first.
1135           *========================================================*)
1136    
1137           (* Can this tree be folded into the src operand of a floating point
1138            * operations?
1139            *)
1140          and foldableFexp(T.FREG _) = true
1141            | foldableFexp(T.FLOAD _) = true
1142            | foldableFexp(T.CVTI2F(_, (16 | 32), _)) = true
1143            | foldableFexp(T.CVTF2F(_, _, t)) = foldableFexp t
1144            | foldableFexp(T.FMARK(t, _)) = foldableFexp t
1145            | foldableFexp _ = false
1146    
1147            (* Move integer e of size ty into a memory location.
1148             * Returns a quadruple:
1149             *  (INTEGER,return ty,effect address of memory location,cleanup code)
1150             *)
1151          and convertIntToFloat(ty, e) =
1152              let val opnd = operand e
1153              in  if isMemOpnd opnd andalso (ty = 16 orelse ty = 32)
1154                  then (INTEGER, ty, opnd, [])
1155                  else
1156                    let val {instrs, tempMem, cleanup} = cvti2f{ty=ty, src=opnd}
1157                    in  emits instrs;
1158                        (INTEGER, 32, tempMem, cleanup)
1159                    end
1160            end            end
1161    
1162          (*========================================================
1163           * Sethi-Ullman based floating point code generation as
1164           * implemented by Lal
1165           *========================================================*)
1166    
1167        and fld(32, opnd) = I.FLDS opnd        and fld(32, opnd) = I.FLDS opnd
1168          | fld(64, opnd) = I.FLDL opnd          | fld(64, opnd) = I.FLDL opnd
1169            | fld(80, opnd) = I.FLDT opnd
1170          | fld _         = error "fld"          | fld _         = error "fld"
1171    
1172          and fild(16, opnd) = I.FILD opnd
1173            | fild(32, opnd) = I.FILDL opnd
1174            | fild(64, opnd) = I.FILDLL opnd
1175            | fild _         = error "fild"
1176    
1177          and fxld(INTEGER, ty, opnd) = fild(ty, opnd)
1178            | fxld(REAL, fty, opnd) = fld(fty, opnd)
1179    
1180        and fstp(32, opnd) = I.FSTPS opnd        and fstp(32, opnd) = I.FSTPS opnd
1181          | fstp(64, opnd) = I.FSTPL opnd          | fstp(64, opnd) = I.FSTPL opnd
1182            | fstp(80, opnd) = I.FSTPT opnd
1183          | fstp _         = error "fstp"          | fstp _         = error "fstp"
1184    
1185            (* generate code for floating point stores *)            (* generate code for floating point stores *)
1186        and fstore(fty, ea, d, mem, an) =        and fstore'(fty, ea, d, mem, an) =
1187            (case d of            (case d of
1188               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))
1189             | _ => reduceFexp(fty, d, []);             | _ => reduceFexp(fty, d, []);
1190             mark(fstp(fty, address(ea, mem)), an)             mark(fstp(fty, address(ea, mem)), an)
1191            )            )
1192    
1193        and fexpr e = error "fexpr"            (* generate code for floating point loads *)
1194          and fload'(fty, ea, mem, fd, an) =
1195                let val ea = address(ea, mem)
1196                in  mark(fld(fty, ea), an);
1197                    if C.sameColor(fd,ST0) then ()
1198                    else emit(fstp(fty, I.FDirect fd))
1199                end
1200    
1201          and fexpr' e = (reduceFexp(64, e, []); C.ST(0))
1202    
1203            (* generate floating point expression and put the result in fd *)            (* generate floating point expression and put the result in fd *)
1204        and doFexpr(fty, T.FREG(_, fs), fd, an) =        and doFexpr'(fty, T.FREG(_, fs), fd, an) =
1205              (if fs = fd then ()              (if C.sameColor(fs,fd) then ()
1206               else mark(I.FCOPY{dst=[fd], src=[fs], tmp=NONE}, an)               else mark(I.FCOPY{dst=[fd], src=[fs], tmp=NONE}, an)
1207              )              )
1208          | doFexpr(fty, T.FLOAD(fty', ea, mem), fd, an) =          | doFexpr'(_, T.FLOAD(fty, ea, mem), fd, an) =
1209              let val ea = address(ea, mem)              fload'(fty, ea, mem, fd, an)
1210              in  mark(fld(fty', ea), an);          | doFexpr'(fty, T.FEXT fexp, fd, an) =
1211                  emit(fstp(fty, I.FDirect fd))              (ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an};
1212              end               if C.sameColor(fd,ST0) then () else emit(fstp(fty, I.FDirect fd))
1213          | doFexpr(fty, e, fd, an) =              )
1214            | doFexpr'(fty, e, fd, an) =
1215              (reduceFexp(fty, e, []);              (reduceFexp(fty, e, []);
1216               mark(fstp(fty, I.FDirect fd), an)               if C.sameColor(fd,ST0) then ()
1217                 else mark(fstp(fty, I.FDirect fd), an)
1218              )              )
1219    
1220            (*            (*
# Line 980  Line 1223 
1223             * and put result in %ST(0).             * and put result in %ST(0).
1224             *)             *)
1225        and reduceFexp(fty, fexp, an)  =        and reduceFexp(fty, fexp, an)  =
1226            let val ST = I.FDirect(C.ST 0)            let val ST = I.ST(C.ST 0)
1227                val ST1 = I.FDirect(C.ST 1)                val ST1 = I.ST(C.ST 1)
1228                  val cleanupCode = ref [] : I.instruction list ref
1229                datatype su_numbers =  
1230                  LEAF of int                datatype su_tree =
1231                | BINARY of int * su_numbers * su_numbers                  LEAF of int * T.fexp * ans
1232                | UNARY of int * su_numbers                | BINARY of int * T.fty * fbinop * su_tree * su_tree * ans
1233                  | UNARY of int * T.fty * I.funOp * su_tree * ans
1234                datatype direction = LEFT | RIGHT                and fbinop = FADD | FSUB | FMUL | FDIV
1235                             | FIADD | FISUB | FIMUL | FIDIV
1236                fun label(LEAF n) = n                withtype ans = Annotations.annotations
1237                  | label(BINARY(n, _, _)) = n  
1238                  | label(UNARY(n, _)) = n                fun label(LEAF(n, _, _)) = n
1239                    | label(BINARY(n, _, _, _, _, _)) = n
1240               (* Generate tree of sethi-ullman numbers *)                  | label(UNARY(n, _, _, _, _)) = n
1241                fun suBinary(t1, t2) =  
1242                    let val su1 = suNumbering(t1, LEFT)                fun annotate(LEAF(n, x, an), a)  = LEAF(n,x,a::an)
1243                        val su2 = suNumbering(t2, RIGHT)                  | annotate(BINARY(n,t,b,x,y,an), a) = BINARY(n,t,b,x,y,a::an)
1244                        val n1 = label su1                  | annotate(UNARY(n,t,u,x,an), a) = UNARY(n,t,u,x,a::an)
1245                        val n2 = label su2  
1246                    in  BINARY(if n1=n2 then n1+1 else Int.max(n1, n2), su1, su2)                (* Generate expression tree with sethi-ullman numbers *)
1247                    end                fun su(e as T.FREG _)       = LEAF(1, e, [])
1248                    | su(e as T.FLOAD _)      = LEAF(1, e, [])
1249                and suUnary(t) =                  | su(e as T.CVTI2F _)     = LEAF(1, e, [])
1250                    let val su = suNumbering(t, LEFT)                  | su(T.CVTF2F(_, _, t))   = su t
1251                    in  UNARY(label su, su)                  | su(T.FMARK(t, a))       = annotate(su t, a)
1252                    end                  | su(T.FABS(fty, t))      = suUnary(fty, I.FABS, t)
1253                    | su(T.FNEG(fty, t))      = suUnary(fty, I.FCHS, t)
1254                and suNumbering(T.FREG _, LEFT) = LEAF 1                  | su(T.FSQRT(fty, t))     = suUnary(fty, I.FSQRT, t)
1255                  | suNumbering(T.FREG _, RIGHT) = LEAF 0                  | su(T.FADD(fty, t1, t2)) = suComBinary(fty,FADD,FIADD,t1,t2)
1256                  | suNumbering(T.FLOAD _, LEFT) = LEAF 1                  | su(T.FMUL(fty, t1, t2)) = suComBinary(fty,FMUL,FIMUL,t1,t2)
1257                  | suNumbering(T.FLOAD _, RIGHT) = LEAF 0                  | su(T.FSUB(fty, t1, t2)) = suBinary(fty,FSUB,FISUB,t1,t2)
1258                  | suNumbering(T.FADD(_, t1, t2), _) = suBinary(t1, t2)                  | su(T.FDIV(fty, t1, t2)) = suBinary(fty,FDIV,FIDIV,t1,t2)
1259                  | suNumbering(T.FMUL(_, t1, t2), _) = suBinary(t1, t2)                  | su _ = error "su"
1260                  | suNumbering(T.FSUB(_, t1, t2), _) = suBinary(t1, t2)  
1261                  | suNumbering(T.FDIV(_, t1, t2), _) = suBinary(t1, t2)                (* Try to fold the the memory operand or integer conversion *)
1262                  | suNumbering(T.FABS(_,t), _) = suUnary(t)                and suFold(e as T.FREG _) = (LEAF(0, e, []), false)
1263                  | suNumbering(T.FNEG(_,t), _) = suUnary(t)                  | suFold(e as T.FLOAD _) = (LEAF(0, e, []), false)
1264                  | suNumbering(T.CVTI2F _, _) = UNARY(1, LEAF 0)                  | suFold(e as T.CVTI2F(_,(16 | 32),_)) = (LEAF(0, e, []), true)
1265                  | suNumbering(T.CVTF2F(_,_,t), _) = suUnary t                  | suFold(T.CVTF2F(_, _, t)) = suFold t
1266                  | suNumbering(T.FMARK(e,a),x) = suNumbering(e,x)                  | suFold(T.FMARK(t, a)) =
1267                  | suNumbering _ = error "suNumbering"                    let val (t, integer) = suFold t
1268                      in  (annotate(t, a), integer) end
1269                fun leafEA(T.FREG(fty, f)) = (fty, I.FDirect f)                  | suFold e = (su e, false)
1270                  | leafEA(T.FLOAD(fty, ea, mem)) = (fty, address(ea, mem))  
1271                  | leafEA _ = error "leafEA"                (* Form unary tree *)
1272                  and suUnary(fty, funary, t) =
1273                fun cvti2d(t,an) =                    let val t = su t
1274                let val opnd = operand t                    in  UNARY(label t, fty, funary, t, [])
1275                    fun doMemOpnd () =                    end
1276                        (emit(I.MOVE{mvOp=I.MOVL, src=opnd, dst=tempMem});  
1277                         mark(I.FILD tempMem,an))                (* Form binary tree *)
1278                in  case opnd of                and suBinary(fty, binop, ibinop, t1, t2) =
1279                      I.Direct _ => doMemOpnd()                    let val t1 = su t1
1280                    | I.Immed _ => doMemOpnd()                        val (t2, integer) = suFold t2
1281                    | _ => mark(I.FILD opnd, an)                        val n1 = label t1
1282                end                        val n2 = label t2
1283                          val n  = if n1=n2 then n1+1 else Int.max(n1,n2)
1284                (* traverse expression and su-number tree *)                        val myOp = if integer then ibinop else binop
1285                fun gencode(_, LEAF 0, an) = ()                    in  BINARY(n, fty, myOp, t1, t2, [])
1286                  | gencode(T.FMARK(e,a), x, an) = gencode(e, x, a::an)                    end
1287                  | gencode(f, LEAF 1, an) = mark(fld(leafEA f), an)  
1288                  | gencode(t, BINARY(_, su1, LEAF 0), an) =                (* Try to fold in the operand if possible.
1289                    let (* optimize the common case when both operands                 * This only applies to commutative operations.
1290                         * are equal *)                 *)
1291                        fun sameEA(T.FREG(t1, f1), T.FREG(t2, f2)) =                and suComBinary(fty, binop, ibinop, t1, t2) =
1292                              t1 = t2 andalso f1 = f2                    let val (t1, t2) = if foldableFexp t2
1293                          | sameEA _ = false                                       then (t1, t2) else (t2, t1)
1294                        fun doit(oper, t1, t2) =                    in  suBinary(fty, binop, ibinop, t1, t2) end
1295                           (gencode(t1, su1, []);  
1296                            mark(I.FBINARY{binOp=oper,                and sameTree(LEAF(_, T.FREG(t1,f1), []),
1297                                           src=if sameEA(t1, t2) then ST                             LEAF(_, T.FREG(t2,f2), [])) =
1298                                               else #2(leafEA t2),                          t1 = t2 andalso C.sameColor(f1,f2)
1299                                           dst=ST}, an)                  | sameTree _ = false
1300                           )  
1301                    in                (* Traverse tree and generate code *)
1302                      case t of                fun gencode(LEAF(_, t, an)) = mark(fxld(leafEA t), an)
1303                         T.FADD(_, t1, t2) => doit(I.FADD, t1, t2)                  | gencode(BINARY(_, _, binop, x, t2 as LEAF(0, y, a1), a2)) =
1304                       | T.FMUL(_, t1, t2) => doit(I.FMUL, t1, t2)                    let val _          = gencode x
1305                       | T.FSUB(_, t1, t2) => doit(I.FSUB, t1, t2)                        val (_, fty, src) = leafEA y
1306                       | T.FDIV(_, t1, t2) => doit(I.FDIV, t1, t2)                        fun gen(code) = mark(code, a1 @ a2)
1307                       | _ => error "gencode.BINARY"                        fun binary(oper32, oper64) =
1308                    end                            if sameTree(x, t2) then
1309                  | gencode(fexp, BINARY(fty, su1, su2), an) =                               gen(I.FBINARY{binOp=oper64, src=ST, dst=ST})
1310                    let fun doit(t1, t2, oper, operP, operRP) = let                            else
1311                       (* oper[P] =>  ST(1) := ST oper ST(1); [pop]                               let val oper =
1312                                       if isMemOpnd src then
1313                                          case fty of
1314                                            32 => oper32
1315                                          | 64 => oper64
1316                                          | _  => error "gencode: BINARY"
1317                                       else oper64
1318                                 in gen(I.FBINARY{binOp=oper, src=src, dst=ST}) end
1319                          fun ibinary(oper16, oper32) =
1320                              let val oper = case fty of
1321                                               16 => oper16
1322                                             | 32 => oper32
1323                                             | _  => error "gencode: IBINARY"
1324                              in  gen(I.FIBINARY{binOp=oper, src=src}) end
1325                      in  case binop of
1326                            FADD => binary(I.FADDS, I.FADDL)
1327                          | FSUB => binary(I.FDIVS, I.FSUBL)
1328                          | FMUL => binary(I.FMULS, I.FMULL)
1329                          | FDIV => binary(I.FDIVS, I.FDIVL)
1330                          | FIADD => ibinary(I.FIADDS, I.FIADDL)
1331                          | FISUB => ibinary(I.FIDIVS, I.FISUBL)
1332                          | FIMUL => ibinary(I.FIMULS, I.FIMULL)
1333                          | FIDIV => ibinary(I.FIDIVS, I.FIDIVL)
1334                      end
1335                    | gencode(BINARY(_, fty, binop, t1, t2, an)) =
1336                      let fun doit(t1, t2, oper, operP, operRP) =
1337                          let (* oper[P] =>  ST(1) := ST oper ST(1); [pop]
1338                        * operR[P] => ST(1) := ST(1) oper ST; [pop]                        * operR[P] => ST(1) := ST(1) oper ST; [pop]
1339                        *)                        *)
1340                        val n1 = label su1                             val n1 = label t1
1341                        val n2 = label su2                             val n2 = label t2
1342                      in                        in if n1 < n2 andalso n1 <= 7 then
1343                        if n1 < n2 andalso n1 <= 7 then                             (gencode t2;
1344                          (gencode(t2, su2, []);                              gencode t1;
                          gencode(t1, su1, []);  
1345                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))
1346                        else if n2 <= n1 andalso n2 <= 7 then                        else if n2 <= n1 andalso n2 <= 7 then
1347                          (gencode(t1, su1, []);                             (gencode t1;
1348                           gencode(t2, su2, []);                              gencode t2;
1349                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))
1350                        else let (* both labels > 7 *)                           else
1351                             let (* both labels > 7 *)
1352                            val fs = I.FDirect(newFreg())                            val fs = I.FDirect(newFreg())
1353                          in                           in  gencode t2;
                           gencode (t2, su2, []);  
1354                            emit(fstp(fty, fs));                            emit(fstp(fty, fs));
1355                            gencode (t1, su1, []);                               gencode t1;
1356                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)
1357                          end                          end
1358                      end                      end
1359                    in                    in case binop of
1360                      case fexp                         FADD => doit(t1,t2,I.FADDL,I.FADDP,I.FADDP)
1361                      of T.FADD(_, t1, t2) => doit(t1, t2,I.FADD,I.FADDP,I.FADDP)                       | FMUL => doit(t1,t2,I.FMULL,I.FMULP,I.FMULP)
1362                       | T.FMUL(_, t1, t2) => doit(t1, t2,I.FMUL,I.FMULP,I.FMULP)                       | FSUB => doit(t1,t2,I.FSUBL,I.FSUBP,I.FSUBRP)
1363                       | 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)  
1364                       | _ => error "gencode.BINARY"                       | _ => error "gencode.BINARY"
1365                    end                    end
1366                  | gencode(fexp, UNARY(_, LEAF 0), an) =                  | gencode(UNARY(_, _, unaryOp, su, an)) =
1367                    (case fexp                     (gencode(su); mark(I.FUNARY(unaryOp),an))
1368                      of T.FABS(fty, t) =>  
1369                           (emit(fld(leafEA t)); mark(I.FUNARY(I.FABS),an))                (* Generate code for a leaf.
1370                       | T.FNEG(fty, t) =>                 * Returns the type and an effective address
1371                           (emit(fld(leafEA t)); mark(I.FUNARY(I.FCHS),an))                 *)
1372                       | T.CVTI2F(_,_,t) => cvti2d(t,an) (* XXX *)                and leafEA(T.FREG(fty, f)) = (REAL, fty, I.FDirect f)
1373                       | _ => error "gencode.UNARY"                  | leafEA(T.FLOAD(fty, ea, mem)) = (REAL, fty, address(ea, mem))
1374                     (*esac*))                  | leafEA(T.CVTI2F(_, 32, t)) = int2real(32, t)
1375                  | gencode(fexp, UNARY(_, su), an) =                  | leafEA(T.CVTI2F(_, 16, t)) = int2real(16, t)
1376                    let fun doit(oper, t) =                  | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, t)
1377                         (gencode(t, su, []); mark(I.FUNARY(oper),an))                  | leafEA _ = error "leafEA"
1378                    in case fexp  
1379                       of T.FABS(_, t) => doit(I.FABS, t)                and int2real(ty, e) =
1380                        | T.FNEG(_, t) => doit(I.FCHS, t)                    let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1381                        | T.CVTF2F(_,_,t) => gencode(t, su, an)                    in  cleanupCode := !cleanupCode @ cleanup;
1382                        | T.CVTI2F _ => error "gencode:UNARY:cvti2f"                        (INTEGER, ty, ea)
                       | _ => error "gencode.UNARY"  
1383                    end                    end
                 | gencode _ = error "gencode"  
1384    
1385                val labels = suNumbering(fexp, LEFT)           in  gencode(su fexp);
1386            in  gencode(fexp, labels, an)               emits(!cleanupCode)
1387            end (*reduceFexp*)            end (*reduceFexp*)
1388    
1389           (*========================================================
1390            * This section generates 3-address style floating
1391            * point code.
1392            *========================================================*)
1393    
1394          and isize 16 = I.I16
1395            | isize 32 = I.I32
1396            | isize _  = error "isize"
1397    
1398          and fstore''(fty, ea, d, mem, an) =
1399              (floatingPointUsed := true;
1400               mark(I.FMOVE{fsize=fsize fty, dst=address(ea,mem),
1401                            src=foperand(fty, d)},
1402                    an)
1403              )
1404    
1405          and fload''(fty, ea, mem, d, an) =
1406              (floatingPointUsed := true;
1407               mark(I.FMOVE{fsize=fsize fty, src=address(ea,mem),
1408                            dst=RealReg d}, an)
1409              )
1410    
1411          and fiload''(ity, ea, d, an) =
1412              (floatingPointUsed := true;
1413               mark(I.FILOAD{isize=isize ity, ea=ea, dst=RealReg d}, an)
1414              )
1415    
1416          and fexpr''(e as T.FREG(_,f)) =
1417              if isFMemReg f then transFexpr e else f
1418            | fexpr'' e = transFexpr e
1419    
1420          and transFexpr e =
1421              let val fd = newFreg() in doFexpr''(64, e, fd, []); fd end
1422    
1423             (*
1424              * Process a floating point operand.  Put operand in register
1425              * when possible.  The operand should match the given fty.
1426              *)
1427          and foperand(fty, e as T.FREG(fty', f)) =
1428                 if fty = fty' then RealReg f else I.FPR(fexpr'' e)
1429            | foperand(fty, T.CVTF2F(_, _, e)) =
1430                 foperand(fty, e) (* nop on the x86 *)
1431            | foperand(fty, e as T.FLOAD(fty', ea, mem)) =
1432                 (* fold operand when the precison matches *)
1433                 if fty = fty' then address(ea, mem) else I.FPR(fexpr'' e)
1434            | foperand(fty, e) = I.FPR(fexpr'' e)
1435    
1436             (*
1437              * Process a floating point operand.
1438              * Try to fold in a memory operand or conversion from an integer.
1439              *)
1440          and fioperand(T.FREG(fty,f)) = (REAL, fty, RealReg f, [])
1441            | fioperand(T.FLOAD(fty, ea, mem)) =
1442                 (REAL, fty, address(ea, mem), [])
1443            | fioperand(T.CVTF2F(_, _, e)) = fioperand(e) (* nop on the x86 *)
1444            | fioperand(T.CVTI2F(_, ty, e)) = convertIntToFloat(ty, e)
1445            | fioperand(T.FMARK(e,an)) = fioperand(e) (* XXX *)
1446            | fioperand(e) = (REAL, 64, I.FPR(fexpr'' e), [])
1447    
1448              (* Generate binary operator.  Since the real binary operators
1449               * does not take memory as destination, we also ensure this
1450               * does not happen.
1451               *)
1452          and fbinop(targetFty,
1453                     binOp, binOpR, ibinOp, ibinOpR, lsrc, rsrc, fd, an) =
1454                  (* Put the mem operand in rsrc *)
1455              let val _ = floatingPointUsed := true;
1456                  fun isMemOpnd(T.FREG(_, f)) = isFMemReg f
1457                    | isMemOpnd(T.FLOAD _) = true
1458                    | isMemOpnd(T.CVTI2F(_, (16 | 32), _)) = true
1459                    | isMemOpnd(T.CVTF2F(_, _, t)) = isMemOpnd t
1460                    | isMemOpnd(T.FMARK(t, _)) = isMemOpnd t
1461                    | isMemOpnd _ = false
1462                  val (binOp, ibinOp, lsrc, rsrc) =
1463                      if isMemOpnd lsrc then (binOpR, ibinOpR, rsrc, lsrc)
1464                      else (binOp, ibinOp, lsrc, rsrc)
1465                  val lsrc = foperand(targetFty, lsrc)
1466                  val (kind, fty, rsrc, code) = fioperand(rsrc)
1467                  fun dstMustBeFreg f =
1468                      if targetFty <> 64 then
1469                      let val tmpR = newFreg()
1470                          val tmp  = I.FPR tmpR
1471                      in  mark(f tmp, an);
1472                          emit(I.FMOVE{fsize=fsize targetFty,
1473                                       src=tmp, dst=RealReg fd})
1474                      end
1475                      else mark(f(RealReg fd), an)
1476              in  case kind of
1477                    REAL =>
1478                      dstMustBeFreg(fn dst =>
1479                                       I.FBINOP{fsize=fsize fty, binOp=binOp,
1480                                                lsrc=lsrc, rsrc=rsrc, dst=dst})
1481                  | INTEGER =>
1482                      (dstMustBeFreg(fn dst =>
1483                                        I.FIBINOP{isize=isize fty, binOp=ibinOp,
1484                                                  lsrc=lsrc, rsrc=rsrc, dst=dst});
1485                       emits code
1486                      )
1487              end
1488    
1489          and funop(fty, unOp, src, fd, an) =
1490              let val src = foperand(fty, src)
1491              in  mark(I.FUNOP{fsize=fsize fty,
1492                               unOp=unOp, src=src, dst=RealReg fd},an)
1493              end
1494    
1495          and doFexpr''(fty, e, fd, an) =
1496              case e of
1497                T.FREG(_,fs) => if C.sameColor(fs,fd) then ()
1498                                else fcopy''(fty, [fd], [fs], an)
1499                (* Stupid x86 does everything as 80-bits internally. *)
1500    
1501                (* Binary operators *)
1502              | T.FADD(_, a, b) => fbinop(fty,
1503                                          I.FADDL, I.FADDL, I.FIADDL, I.FIADDL,
1504                                          a, b, fd, an)
1505              | T.FSUB(_, a, b) => fbinop(fty,
1506                                          I.FSUBL, I.FSUBRL, I.FISUBL, I.FISUBRL,
1507                                          a, b, fd, an)
1508              | T.FMUL(_, a, b) => fbinop(fty,
1509                                          I.FMULL, I.FMULL, I.FIMULL, I.FIMULL,
1510                                          a, b, fd, an)
1511              | T.FDIV(_, a, b) => fbinop(fty,
1512                                          I.FDIVL, I.FDIVRL, I.FIDIVL, I.FIDIVRL,
1513                                          a, b, fd, an)
1514    
1515                (* Unary operators *)
1516              | T.FNEG(_, a) => funop(fty, I.FCHS, a, fd, an)
1517              | T.FABS(_, a) => funop(fty, I.FABS, a, fd, an)
1518              | T.FSQRT(_, a) => funop(fty, I.FSQRT, a, fd, an)
1519    
1520                (* Load *)
1521              | T.FLOAD(fty,ea,mem) => fload''(fty, ea, mem, fd, an)
1522    
1523                (* Type conversions *)
1524              | T.CVTF2F(_, _, e) => doFexpr''(fty, e, fd, an)
1525              | T.CVTI2F(_, ty, e) =>
1526                let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1527                in  fiload''(ty, ea, fd, an);
1528                    emits cleanup
1529                end
1530    
1531              | T.FMARK(e,A.MARKREG f) => (f fd; doFexpr''(fty, e, fd, an))
1532              | T.FMARK(e, a) => doFexpr''(fty, e, fd, a::an)
1533              | T.FPRED(e, c) => doFexpr''(fty, e, fd, A.CTRLUSE c::an)
1534              | T.FEXT fexp =>
1535                 ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an}
1536              | _ => error("doFexpr''")
1537    
1538           (*========================================================
1539            * Tie the two styles of fp code generation together
1540            *========================================================*)
1541          and fstore(fty, ea, d, mem, an) =
1542              if enableFastFPMode andalso !fast_floating_point
1543              then fstore''(fty, ea, d, mem, an)
1544              else fstore'(fty, ea, d, mem, an)
1545          and fload(fty, ea, d, mem, an) =
1546              if enableFastFPMode andalso !fast_floating_point
1547              then fload''(fty, ea, d, mem, an)
1548              else fload'(fty, ea, d, mem, an)
1549          and fexpr e =
1550              if enableFastFPMode andalso !fast_floating_point
1551              then fexpr'' e else fexpr' e
1552          and doFexpr(fty, e, fd, an) =
1553              if enableFastFPMode andalso !fast_floating_point
1554              then doFexpr''(fty, e, fd, an)
1555              else doFexpr'(fty, e, fd, an)
1556    
1557            (* generate code for a statement *)            (* generate code for a statement *)
1558        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)
1559          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)
1560          | stmt(T.CCMV(ccd, e), an) = doCCexpr(e, ccd, an)          | stmt(T.CCMV(ccd, e), an) = doCCexpr(e, ccd, an)
1561          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)
1562          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)
1563          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)          | stmt(T.JMP(e, labs), an) = jmp(e, labs, an)
1564          | stmt(T.CALL(e, flow, def, use, cdef, cuse, mem), an) =          | stmt(T.CALL{funct, targets, defs, uses, region, ...}, an) =
1565               call(e,flow,def,use,mem,an)               call(funct,targets,defs,uses,region,an)
1566          | stmt(T.RET _, an) = mark(I.RET NONE, an)          | stmt(T.RET _, an) = mark(I.RET NONE, an)
1567          | stmt(T.STORE(8, ea, d, mem), an) = store8(ea, d, mem, an)          | stmt(T.STORE(8, ea, d, mem), an) = store8(ea, d, mem, an)
1568          | stmt(T.STORE(16, ea, d, mem), an) = store16(ea, d, mem, an)          | stmt(T.STORE(16, ea, d, mem), an) = store16(ea, d, mem, an)
1569          | stmt(T.STORE(32, ea, d, mem), an) = store32(ea, d, mem, an)          | stmt(T.STORE(32, ea, d, mem), an) = store32(ea, d, mem, an)
1570          | 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)
1571          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)          | stmt(T.BCC(cc, lab), an) = branch(cc, lab, an)
1572          | stmt(T.DEFINE l, _) = defineLabel l          | stmt(T.DEFINE l, _) = defineLabel l
1573          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)
1574            | stmt(T.EXT s, an) =
1575                 ExtensionComp.compileSext (reducer()) {stm=s, an=an}
1576          | stmt(s, _) = doStmts(Gen.compileStm s)          | stmt(s, _) = doStmts(Gen.compileStm s)
1577    
1578        and doStmt s = stmt(s, [])        and doStmt s = stmt(s, [])
# Line 1147  Line 1582 
1582           ((* Must be cleared by the client.           ((* Must be cleared by the client.
1583             * if rewriteMemReg then memRegsUsed := 0w0 else ();             * if rewriteMemReg then memRegsUsed := 0w0 else ();
1584             *)             *)
1585            trapLabel := NONE; beginCluster 0)            floatingPointUsed := false;
1586              trapLabel := NONE;
1587              beginCluster 0
1588             )
1589        and endCluster' a =        and endCluster' a =
1590           (case !trapLabel           (case !trapLabel
1591            of NONE => ()            of NONE => ()
1592             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))
1593            (*esac*);            (*esac*);
1594              (* If floating point has been used allocate an extra
1595               * register just in case we didn't use any explicit register
1596               *)
1597              if !floatingPointUsed then (newFreg(); ())
1598              else ();
1599            endCluster(a)            endCluster(a)
1600           )           )
1601    
# Line 1179  Line 1622 
1622               entryLabel  = entryLabel,               entryLabel  = entryLabel,
1623               comment     = comment,               comment     = comment,
1624               annotation  = annotation,               annotation  = annotation,
1625               exitBlock   = fn mlrisc => exitBlock(cellset mlrisc),               exitBlock   = fn mlrisc => exitBlock(cellset mlrisc)
              alias       = alias,  
              phi         = phi  
1626            }            }
1627    
1628    in  self()    in  self()

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

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