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

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

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