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 565, Sun Mar 5 04:10:18 2000 UTC revision 744, Fri Dec 8 04:11:42 2000 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
# Line 37  Line 46 
46       sharing X86MLTree.LabelExp = X86Instr.LabelExp       sharing X86MLTree.LabelExp = X86Instr.LabelExp
47      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII
48      val arch : arch ref      val arch : arch ref
49      val tempMem : X86Instr.operand (* temporary for CVTI2F *)      val cvti2f :
50             (* source operand, guaranteed to be non-memory! *)
51             {ty: X86MLTree.ty, src: X86Instr.operand} ->
52             {instrs : X86Instr.instruction list,(* the instructions *)
53              tempMem: X86Instr.operand,         (* temporary for CVTI2F *)
54              cleanup: X86Instr.instruction list (* cleanup code *)
55             }
56        (* When the following flag is set, we allocate floating point registers
57         * directly on the floating point stack
58         *)
59        val fast_floating_point : bool ref
60    ) : sig include MLTREECOMP    ) : sig include MLTREECOMP
61            val rewriteMemReg : bool            val rewriteMemReg : bool
62        end =        end =
# Line 51  Line 70 
70    structure LE = I.LabelExp    structure LE = I.LabelExp
71    structure A = MLRiscAnnotations    structure A = MLRiscAnnotations
72    
73    type instrStream = (I.instruction,C.regmap,C.cellset) T.stream    type instrStream = (I.instruction,C.cellset) T.stream
74    type mltreeStream = (T.stm,C.regmap,T.mlrisc list) T.stream    type mltreeStream = (T.stm,T.mlrisc list) T.stream
75    
76    datatype kind = REAL | INTEGER    datatype kind = REAL | INTEGER
77    
# Line 70  Line 89 
89     * If this is on, we can avoid doing RewritePseudo phase entirely.     * If this is on, we can avoid doing RewritePseudo phase entirely.
90     *)     *)
91    val rewriteMemReg = rewriteMemReg    val rewriteMemReg = rewriteMemReg
92    fun isMemReg r = rewriteMemReg andalso r >= 8 andalso r < 32  
93      (* The following hardcoded *)
94      fun isMemReg r = rewriteMemReg andalso
95                       let val r = C.registerNum r
96                       in  r >= 8 andalso r < 32
97                       end
98      fun isFMemReg r = if enableFastFPMode andalso !fast_floating_point
99                        then let val r = C.registerNum r
100                             in r >= 8 andalso r < 32 end
101                        else true
102      val isAnyFMemReg = List.exists (fn r =>
103                                      let val r = C.registerNum r
104                                      in  r >= 8 andalso r < 32 end
105                                     )
106    
107    val ST0 = C.ST 0    val ST0 = C.ST 0
108    val ST7 = C.ST 7    val ST7 = C.ST 7
# Line 81  Line 113 
113    fun selectInstructions    fun selectInstructions
114         (instrStream as         (instrStream as
115          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,
116                   beginCluster,endCluster,exitBlock,alias,phi,comment,...}) =                   beginCluster,endCluster,exitBlock,comment,...}) =
117    let exception EA    let exception EA
118    
119        (* label where a trap is generated -- one per cluster *)        (* label where a trap is generated -- one per cluster *)
120        val trapLabel = ref (NONE: (I.instruction * Label.label) option)        val trapLabel = ref (NONE: (I.instruction * Label.label) option)
121    
122          (* flag floating point generation *)
123          val floatingPointUsed = ref false
124    
125        (* effective address of an integer register *)        (* effective address of an integer register *)
126        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
127        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  
           )  
128    
129        (* Add an overflow trap *)        (* Add an overflow trap *)
130        fun trap() =        fun trap() =
# Line 109  Line 140 
140        val newReg  = C.newReg        val newReg  = C.newReg
141        val newFreg = C.newFreg        val newFreg = C.newFreg
142    
143          fun fsize 32 = I.FP32
144            | fsize 64 = I.FP64
145            | fsize 80 = I.FP80
146            | fsize _  = error "fsize"
147    
148        (* mark an expression with a list of annotations *)        (* mark an expression with a list of annotations *)
149        fun mark'(i,[]) = i        fun mark'(i,[]) = i
150          | 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 116  Line 152 
152        (* annotate an expression and emit it *)        (* annotate an expression and emit it *)
153        fun mark(i,an) = emit(mark'(i,an))        fun mark(i,an) = emit(mark'(i,an))
154    
155          val emits = app emit
156    
157        (* emit parallel copies for integers        (* emit parallel copies for integers
158         * Translates parallel copies that involve memregs into         * Translates parallel copies that involve memregs into
159         * individual copies.         * individual copies.
# Line 123  Line 161 
161        fun copy([], [], an) = ()        fun copy([], [], an) = ()
162          | copy(dst, src, an) =          | copy(dst, src, an) =
163            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} =
164                    if rd = rs then [] else                    if C.sameColor(rd,rs) then [] else
165                    let val tmpR = I.Direct(newReg())                    let val tmpR = I.Direct(newReg())
166                    in  [I.MOVE{mvOp=I.MOVL, src=src, dst=tmpR},                    in  [I.MOVE{mvOp=I.MOVL, src=src, dst=tmpR},
167                         I.MOVE{mvOp=I.MOVL, src=tmpR, dst=dst}]                         I.MOVE{mvOp=I.MOVL, src=tmpR, dst=dst}]
168                    end                    end
169                  | mvInstr{dst=I.Direct rd, src=I.Direct rs} =                  | mvInstr{dst=I.Direct rd, src=I.Direct rs} =
170                      if rd = rs then []                      if C.sameColor(rd,rs) then []
171                      else [I.COPY{dst=[rd], src=[rs], tmp=NONE}]                      else [I.COPY{dst=[rd], src=[rs], tmp=NONE}]
172                  | mvInstr{dst, src} = [I.MOVE{mvOp=I.MOVL, src=src, dst=dst}]                  | mvInstr{dst, src} = [I.MOVE{mvOp=I.MOVL, src=src, dst=dst}]
173            in            in
174               app emit (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}               emits (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}
175                 {regmap=fn r => r, tmp=SOME(I.Direct(newReg())),                 {tmp=SOME(I.Direct(newReg())),
176                  dst=dst, src=src})                  dst=dst, src=src})
177            end            end
178    
# Line 169  Line 207 
207          | setZeroBit(T.SRA _)      = true          | setZeroBit(T.SRA _)      = true
208          | setZeroBit(T.SRL _)      = true          | setZeroBit(T.SRL _)      = true
209          | setZeroBit(T.SLL _)      = true          | setZeroBit(T.SLL _)      = true
210            | setZeroBit(T.SUB _)      = true
211            | setZeroBit(T.ADDT _)     = true
212            | setZeroBit(T.SUBT _)     = true
213          | setZeroBit(T.MARK(e, _)) = setZeroBit e          | setZeroBit(T.MARK(e, _)) = setZeroBit e
214          | setZeroBit _             = false          | setZeroBit _             = false
215    
216        (* emit parallel copies for floating point *)        fun setZeroBit2(T.ANDB _)     = true
217        fun fcopy(fty, [], [], _) = ()          | setZeroBit2(T.ORB _)      = true
218          | fcopy(fty, dst as [_], src as [_], an) =          | setZeroBit2(T.XORB _)     = true
219            | setZeroBit2(T.SRA _)      = true
220            | setZeroBit2(T.SRL _)      = true
221            | setZeroBit2(T.SLL _)      = true
222            | setZeroBit2(T.ADD(32, _, _)) = true (* can't use leal! *)
223            | setZeroBit2(T.SUB _)      = true
224            | setZeroBit2(T.ADDT _)     = true
225            | setZeroBit2(T.SUBT _)     = true
226            | setZeroBit2(T.MARK(e, _)) = setZeroBit2 e
227            | setZeroBit2 _             = false
228    
229          (* emit parallel copies for floating point
230           * Normal version.
231           *)
232          fun fcopy'(fty, [], [], _) = ()
233            | fcopy'(fty, dst as [_], src as [_], an) =
234              mark(I.FCOPY{dst=dst,src=src,tmp=NONE}, an)              mark(I.FCOPY{dst=dst,src=src,tmp=NONE}, an)
235          | fcopy(fty, dst, src, an) =          | fcopy'(fty, dst, src, an) =
236              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)
237    
238          (* emit parallel copies for floating point.
239           * Fast version.
240           * Translates parallel copies that involve memregs into
241           * individual copies.
242           *)
243    
244          fun fcopy''(fty, [], [], _) = ()
245            | fcopy''(fty, dst, src, an) =
246              if true orelse isAnyFMemReg dst orelse isAnyFMemReg src then
247              let val fsize = fsize fty
248                  fun mvInstr{dst, src} = [I.FMOVE{fsize=fsize, src=src, dst=dst}]
249              in
250                  emits (Shuffle.shuffle{mvInstr=mvInstr, ea=RealReg}
251                    {tmp=case dst of
252                           [_] => NONE
253                         |  _  => SOME(I.FPR(newReg())),
254                     dst=dst, src=src})
255              end
256              else
257                mark(I.FCOPY{dst=dst,src=src,tmp=
258                             case dst of
259                               [_] => NONE
260                             | _   => SOME(I.FPR(newFreg()))}, an)
261    
262          fun fcopy x = if enableFastFPMode andalso !fast_floating_point
263                        then fcopy'' x else fcopy' x
264    
265        (* Translates MLTREE condition code to x86 condition code *)        (* Translates MLTREE condition code to x86 condition code *)
266        fun cond T.LT = I.LT | cond T.LTU = I.B        fun cond T.LT = I.LT | cond T.LTU = I.B
267          | cond T.LE = I.LE | cond T.LEU = I.BE          | cond T.LE = I.LE | cond T.LEU = I.BE
# Line 188  Line 271 
271    
272        (* Move and annotate *)        (* Move and annotate *)
273        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) =
274            if s=d then ()            if C.sameColor(s,d) then ()
275            else mark(I.COPY{dst=[d], src=[s], tmp=NONE}, an)            else mark(I.COPY{dst=[d], src=[s], tmp=NONE}, an)
276          | 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)
277    
# Line 281  Line 364 
364            (* generate code for tree and ensure that it is not in %esp *)            (* generate code for tree and ensure that it is not in %esp *)
365            and exprNotEsp tree =            and exprNotEsp tree =
366                let val r = expr tree                let val r = expr tree
367                in  if r = C.esp then                in  if C.sameColor(r, C.esp) then
368                       let val tmp = newReg()                       let val tmp = newReg()
369                       in  move(I.Direct r, I.Direct tmp); tmp end                       in  move(I.Direct r, I.Direct tmp); tmp end
370                    else r                    else r
# Line 293  Line 376 
376              | displace(trees, t, b as SOME base, NONE, _, d) = (* no index *)              | displace(trees, t, b as SOME base, NONE, _, d) = (* no index *)
377                (* make t the index, but make sure that it is not %esp! *)                (* make t the index, but make sure that it is not %esp! *)
378                let val i = expr t                let val i = expr t
379                in  if i = C.esp then                in  if C.sameColor(i, C.esp) then
380                      (* swap base and index *)                      (* swap base and index *)
381                      if base <> C.esp then                      if C.sameColor(base, C.esp) then
382                         doEA(trees, SOME i, b, 0, d)                         doEA(trees, SOME i, b, 0, d)
383                      else  (* base and index = %esp! *)                      else  (* base and index = %esp! *)
384                         let val index = newReg()                         let val index = newReg()
# Line 374  Line 457 
457        and doExpr(exp, rd : I.C.cell, an) =        and doExpr(exp, rd : I.C.cell, an) =
458            let val rdOpnd = IntReg rd            let val rdOpnd = IntReg rd
459    
460                fun equalRd(I.Direct r) = r = rd                fun equalRd(I.Direct r) = C.sameColor(r, rd)
461                  | equalRd(I.MemReg r) = r = rd                  | equalRd(I.MemReg r) = C.sameColor(r, rd)
462                  | equalRd _ = false                  | equalRd _ = false
463    
464                   (* Emit a binary operator.  If the destination is                   (* Emit a binary operator.  If the destination is
# Line 449  Line 532 
532                fun divrem(signed, overflow, e1, e2, resultReg) =                fun divrem(signed, overflow, e1, e2, resultReg) =
533                let val (opnd1, opnd2) = (operand e1, operand e2)                let val (opnd1, opnd2) = (operand e1, operand e2)
534                    val _ = move(opnd1, eax)                    val _ = move(opnd1, eax)
535                    val oper = if signed then (emit(I.CDQ); I.IDIV)                    val oper = if signed then (emit(I.CDQ); I.IDIVL)
536                               else (zero edx; I.UDIV)                               else (zero edx; I.DIVL)
537                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);
538                    move(resultReg, rdOpnd);                    move(resultReg, rdOpnd);
539                    if overflow then trap() else ()                    if overflow then trap() else ()
# Line 503  Line 586 
586                fun uMultiply(e1, e2) =                fun uMultiply(e1, e2) =
587                    (* note e2 can never be (I.Direct edx) *)                    (* note e2 can never be (I.Direct edx) *)
588                    (move(operand e1, eax);                    (move(operand e1, eax);
589                     mark(I.MULTDIV{multDivOp=I.UMUL,                     mark(I.MULTDIV{multDivOp=I.MULL,
590                                    src=regOrMem(operand e2)},an);                                    src=regOrMem(operand e2)},an);
591                     move(eax, rdOpnd)                     move(eax, rdOpnd)
592                    )                    )
# Line 581  Line 664 
664    
665                   (* Generate setcc instruction:                   (* Generate setcc instruction:
666                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))
667                      * Bug, if eax is either t1 or t2 then problem will occur!!!
668                      * Note that we have to use eax as the destination of the
669                      * setcc because it only works on the registers
670                      * %al, %bl, %cl, %dl and %[abcd]h.  The last four registers
671                      * are inaccessible in 32 bit mode.
672                    *)                    *)
673                fun setcc(ty, cc, t1, t2, yes, no) =                fun setcc(ty, cc, t1, t2, yes, no) =
674                let val tmpR = newReg()                let val (cc, yes, no) =
675                    val tmp = I.Direct tmpR                           if yes > no then (cc, yes, no)
676                    (* We create a temporary here just in                           else (T.Basis.negateCond cc, no, yes)
                    * case t1 or t2 contains a use of rd.  
                    *)  
677                in  (* Clear the destination first.                in  (* Clear the destination first.
678                     * This this because stupid SETcc                     * This this because stupid SETcc
679                     * only writes to the low order                     * only writes to the low order
680                     * byte.  That's Intel architecture, folks.                     * byte.  That's Intel architecture, folks.
681                     *)                     *)
682                    zero tmp;                    case (yes, no, cc) of
683                    case (yes, no) of                      (1, 0, T.LT) =>
684                      (1, 0) => (* normal case *)                       let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
685                         in  move(tmp, rdOpnd);
686                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
687                         end
688                      | (1, 0, T.GT) =>
689                         let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
690                         in  emit(I.UNARY{unOp=I.NOTL,opnd=tmp});
691                             move(tmp, rdOpnd);
692                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
693                         end
694                      | (1, 0, _) => (* normal case *)
695                      let val cc = cmp(true, ty, cc, t1, t2, [])                      let val cc = cmp(true, ty, cc, t1, t2, [])
696                      in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end                      in  mark(I.SET{cond=cond cc, opnd=eax}, an);
697                    | (0, 1) => (* flip *)                          emit(I.BINARY{binOp=I.ANDL,src=I.Immed 255, dst=eax});
698                      let val cc = cmp(true, ty,                          move(eax, rdOpnd)
699                                       T.Basis.negateCond cc, t1, t2, [])                      end
700                      in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end                    | (C1, C2, _)  =>
                   | (C1, C2)  =>  
701                      (* general case;                      (* general case;
702                       * from the Intel optimization guide p3-5 *)                       * from the Intel optimization guide p3-5
703                      let val C1 = toInt32 C1                       *)
704                          val C2 = toInt32 C2                      let val _  = zero eax;
705                          val cc = cmp(true, ty, cc, t1, t2, [])                          val cc = cmp(true, ty, cc, t1, t2, [])
706                      in  emit(I.SET{cond=cond cc, opnd=tmp});                      in  case C1-C2 of
707                          case Int32.abs(C1-C2)-1 of                            D as (1 | 2 | 3 | 4 | 5 | 8 | 9) =>
708                            D as (1 | 2 | 4 | 8) =>                            let val (base,scale) =
709                            let val addr = I.Indexed{base=SOME tmpR,                                    case D of
710                                                     index=tmpR,                                      1 => (NONE, 0)
711                                                     scale=Int32.toInt D,                                    | 2 => (NONE, 1)
712                                                     disp=I.Immed(C1-C2),                                    | 3 => (SOME C.eax, 1)
713                                      | 4 => (NONE, 2)
714                                      | 5 => (SOME C.eax, 2)
715                                      | 8 => (NONE, 3)
716                                      | 9 => (SOME C.eax, 3)
717                                  val addr = I.Indexed{base=base,
718                                                       index=C.eax,
719                                                       scale=scale,
720                                                       disp=I.Immed C2,
721                                                     mem=readonly}                                                     mem=readonly}
722                            in  mark(I.LEA{r32=tmpR, addr=addr}, an) end                                val tmpR = newReg()
723                          | _ =>                                val tmp  = I.Direct tmpR
724                           (emit(I.UNARY{unOp=I.DECL, opnd=tmp});                            in  emit(I.SET{cond=cond cc, opnd=eax});
725                                  mark(I.LEA{r32=tmpR, addr=addr}, an);
726                                  move(tmp, rdOpnd)
727                              end
728                            | D =>
729                               (emit(I.SET{cond=cond(T.Basis.negateCond cc),
730                                           opnd=eax});
731                                emit(I.UNARY{unOp=I.DECL, opnd=eax});
732                            emit(I.BINARY{binOp=I.ANDL,                            emit(I.BINARY{binOp=I.ANDL,
733                                          src=I.Immed(C2-C1), dst=tmp});                                            src=I.Immed D, dst=eax});
734                            mark(I.BINARY{binOp=I.ADDL,                              if C2 = 0 then
735                                          src=I.Immed(Int32.min(C1,C2)),                                 move(eax, rdOpnd)
736                                          dst=tmp}, an)                              else
737                           )                                 let val tmpR = newReg()
738                      end;                                     val tmp  = I.Direct tmpR
739                                   in  mark(I.LEA{addr=
740                                             I.Displace{
741                                                 base=C.eax,
742                                                 disp=I.Immed C2,
743                                                 mem=readonly},
744                                                 r32=tmpR}, an);
745                    move(tmp, rdOpnd)                    move(tmp, rdOpnd)
746                                    end
747                               )
748                        end
749                end (* setcc *)                end (* setcc *)
750    
751                    (* Generate cmovcc instruction.                    (* Generate cmovcc instruction.
# Line 643  Line 762 
762    
763                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)
764    
765                      (* Add n to rd *)
766                  fun addN n =
767                  let val n = operand n
768                      val src = if isMemReg rd then immedOrReg n else n
769                  in  mark(I.BINARY{binOp=I.ADDL, src=src, dst=rdOpnd}, an) end
770    
771                    (* Generate addition *)                    (* Generate addition *)
772                fun addition(e1, e2) =                fun addition(e1, e2) =
773                      case e1 of
774                        T.REG(_,rs) => if C.sameColor(rs,rd) then addN e2
775                                       else addition1(e1,e2)
776                      | _ => addition1(e1,e2)
777                  and addition1(e1, e2) =
778                      case e2 of
779                        T.REG(_,rs) => if C.sameColor(rs,rd) then addN e1
780                                       else addition2(e1,e2)
781                      | _ => addition2(e1,e2)
782                  and addition2(e1,e2) =
783                  (dstMustBeReg(fn (dstR, _) =>                  (dstMustBeReg(fn (dstR, _) =>
784                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))
785                  handle EA => binaryComm(I.ADDL, e1, e2))                  handle EA => binaryComm(I.ADDL, e1, e2))
786    
                   (* Add n to rd *)  
               fun addN n =  
                 mark(I.BINARY{binOp=I.ADDL, src=I.Immed(toInt32 n),  
                               dst=rdOpnd}, an)  
787    
788            in  case exp of            in  case exp of
789                 T.REG(_,rs) =>                 T.REG(_,rs) =>
790                     if isMemReg rs andalso isMemReg rd then                     if isMemReg rs andalso isMemReg rd then
791                        let val tmp = I.Direct(newReg())                        let val tmp = I.Direct(newReg())
792                        in  move'(MemReg rs, tmp, an);                        in  move'(I.MemReg rs, tmp, an);
793                            move'(tmp, rdOpnd, [])                            move'(tmp, rdOpnd, [])
794                        end                        end
795                     else move'(IntReg rs, rdOpnd, an)                     else move'(IntReg rs, rdOpnd, an)
# Line 678  Line 809 
809               | T.ADD(32, (T.LI 1|T.LI32 0w1), e) => unary(I.INCL, e)               | T.ADD(32, (T.LI 1|T.LI32 0w1), e) => unary(I.INCL, e)
810               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)
811               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)
              | T.ADD(32, e1 as T.REG(_, rs), e2 as T.LI n) =>  
                   if rs = rd then addN n else addition(e1, e2)  
              | T.ADD(32, e1 as T.LI n, e2 as T.REG(_, rs)) =>  
                   if rs = rd then addN n else addition(e1, e2)  
812               | T.ADD(32, e1, e2) => addition(e1, e2)               | T.ADD(32, e1, e2) => addition(e1, e2)
813    
814                   (* 32-bit addition but set the flag!
815                    * This is a stupid hack for now.
816                    *)
817                 | T.ADD(0, e, (T.LI 1|T.LI32 0w1)) => unary(I.INCL, e)
818                 | T.ADD(0, (T.LI 1|T.LI32 0w1), e) => unary(I.INCL, e)
819                 | T.ADD(0, e, T.LI ~1) => unary(I.DECL, e)
820                 | T.ADD(0, T.LI ~1, e) => unary(I.DECL, e)
821                 | T.ADD(0, e1, e2) => binaryComm(I.ADDL, e1, e2)
822    
823                 (* 32-bit subtraction *)                 (* 32-bit subtraction *)
824                 | T.SUB(32, e, (T.LI 0 | T.LI32 0w0)) => doExpr(e, rd, an)
825               | T.SUB(32, e, (T.LI 1 | T.LI32 0w1)) => unary(I.DECL, e)               | T.SUB(32, e, (T.LI 1 | T.LI32 0w1)) => unary(I.DECL, e)
826               | T.SUB(32, e, T.LI ~1) => unary(I.INCL, e)               | T.SUB(32, e, T.LI ~1) => unary(I.INCL, e)
827               | T.SUB(32, (T.LI 0 | T.LI32 0w0), e) => unary(I.NEGL, e)               | T.SUB(32, (T.LI 0 | T.LI32 0w0), e) => unary(I.NEGL, e)
# Line 723  Line 860 
860               | T.LOAD(8, ea, mem) => load8(ea, mem)               | T.LOAD(8, ea, mem) => load8(ea, mem)
861               | T.LOAD(16, ea, mem) => load16(ea, mem)               | T.LOAD(16, ea, mem) => load16(ea, mem)
862               | T.LOAD(32, ea, mem) => load32(ea, mem)               | T.LOAD(32, ea, mem) => load32(ea, mem)
863               | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(8,ea,mem)) => load8s(ea, mem)               | T.SX(_,_,T.LOAD(8,ea,mem)) => load8s(ea, mem)
864               | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(16,ea,mem)) => load16s(ea, mem)               | T.SX(_,_,T.LOAD(16,ea,mem)) => load16s(ea, mem)
865    
866               | 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) =>
867                   setcc(ty, cc, t1, t2, yes, no)                   setcc(ty, cc, t1, t2, toInt32 yes, toInt32 no)
868                 | T.COND(32, T.CMP(ty, cc, t1, t2), T.LI32 yes, T.LI32 no) =>
869                     setcc(ty, cc, t1, t2, Word32.toLargeIntX yes,
870                                           Word32.toLargeIntX no)
871               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>
872                  (case !arch of (* PentiumPro and higher has CMOVcc *)                  (case !arch of (* PentiumPro and higher has CMOVcc *)
873                     Pentium => unknownExp exp                     Pentium => unknownExp exp
# Line 758  Line 898 
898            * 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,
899            * 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.
900            *)            *)
901       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) =
902              (case ty of              (case ty of
903                 8 =>  test(I.TESTB, a, b)                 8  => test(I.TESTB, a, b, an)
904               | 16 => test(I.TESTW, a, b)               | 16 => test(I.TESTW, a, b, an)
905               | 32 => test(I.TESTL, a, b)               | 32 => test(I.TESTL, a, b, an)
906               | _  => (expr e; ())               | _  => doExpr(e, newReg(), an);
907               ; cc)               cc)
908          | cmpWithZero(cc, e) = (expr e; cc)          | cmpWithZero(cc, e, an) =
909              let val e =
910                    case e of (* hack to disable the lea optimization XXX *)
911                      T.ADD(_, a, b) => T.ADD(0, a, b)
912                    | e => e
913              in  doExpr(e, newReg(), an); cc end
914    
915            (* Emit a test.            (* Emit a test.
916             *   The available modes are             *   The available modes are
# Line 782  Line 927 
927             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction
928             * by TESTB.             * by TESTB.
929             *)             *)
930        and test(testopcode, a, b) =        and test(testopcode, a, b, an) =
931            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)
932                (* translate r, r/m => r/m, r *)                (* translate r, r/m => r/m, r *)
933                val (opnd1, opnd2) =                val (opnd1, opnd2) =
934                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)
935            in  emit(testopcode{lsrc=opnd1, rsrc=opnd2})            in  mark(testopcode{lsrc=opnd1, rsrc=opnd2}, an)
936            end            end
937    
938           (* generate a condition code expression           (* generate a condition code expression
939             * The zero is for setting the condition code!             * The zero is for setting the condition code!
940             * I have no idea why this is used.             * I have no idea why this is used.
941             *)             *)
942        and doCCexpr(T.CMP(ty, cc, t1, t2), 0, an) =        and doCCexpr(T.CMP(ty, cc, t1, t2), rd, an) =
943              if C.sameColor(rd, C.eflags) then
944            (cmp(false, ty, cc, t1, t2, an); ())            (cmp(false, ty, cc, t1, t2, an); ())
945              else
946                 error "doCCexpr: cmp"
947          | 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))
948          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)
949          | doCCexpr(T.CCEXT e, cd, an) =          | doCCexpr(T.CCEXT e, cd, an) =
# Line 809  Line 957 
957             * we can also reorder the operands.             * we can also reorder the operands.
958             *)             *)
959        and cmp(swapable, ty, cc, t1, t2, an) =        and cmp(swapable, ty, cc, t1, t2, an) =
960            (case cc of                 (* == and <> can be always be reordered *)
961               (T.EQ | T.NE) =>            let val swapable = swapable orelse cc = T.EQ orelse cc = T.NE
962                (* Sometimes the comparison is not necessary because            in (* Sometimes the comparison is not necessary because
963                 * the bits are already set!                 * the bits are already set!
964                 *)                 *)
965                if isZero t1 andalso setZeroBit t2 then cmpWithZero(cc, t2)               if isZero t1 andalso setZeroBit2 t2 then
966                else if isZero t2 andalso setZeroBit t1 then cmpWithZero(cc, t1)                   if swapable then
967                     (* == and <> can be reordered *)                      cmpWithZero(T.Basis.swapCond cc, t2, an)
968                else genCmp(ty, true, cc, t1, t2, an)                   else (* can't reorder the comparison! *)
969             |  _ => genCmp(ty, swapable, cc, t1, t2, an)                      genCmp(ty, false, cc, t1, t2, an)
970            )               else if isZero t2 andalso setZeroBit2 t1 then
971                    cmpWithZero(cc, t1, an)
972                 else genCmp(ty, swapable, cc, t1, t2, an)
973              end
974    
975            (* 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)
976             * Return the appropriate condition code and operands.             * Return the appropriate condition code and operands.
# Line 860  Line 1011 
1011         (* convert mlrisc to cellset:         (* convert mlrisc to cellset:
1012          *)          *)
1013         and cellset mlrisc =         and cellset mlrisc =
1014             let val addCCReg = C.addCell C.CC             let val addCCReg = C.CellSet.add
1015                 fun g([],acc) = acc                 fun g([],acc) = acc
1016                   | 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))
1017                   | 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 878  Line 1029 
1029            let val src = (* movb has to use %eax as source. Stupid x86! *)            let val src = (* movb has to use %eax as source. Stupid x86! *)
1030                   case immedOrReg(operand d) of                   case immedOrReg(operand d) of
1031                       src as I.Direct r =>                       src as I.Direct r =>
1032                         if r = C.eax then src else (move(src, eax); eax)                         if C.sameColor(r,C.eax)
1033                           then src else (move(src, eax); eax)
1034                     | src => src                     | src => src
1035            in  mark(I.MOVE{mvOp=I.MOVB, src=src, dst=address(ea,mem)},an)            in  mark(I.MOVE{mvOp=I.MOVB, src=src, dst=address(ea,mem)},an)
1036            end            end
# Line 894  Line 1046 
1046          | branch(T.FCMP(fty, fcc, t1, t2), lab, an) =          | branch(T.FCMP(fty, fcc, t1, t2), lab, an) =
1047             fbranch(fty, fcc, t1, t2, lab, an)             fbranch(fty, fcc, t1, t2, lab, an)
1048          | branch(ccexp, lab, an) =          | branch(ccexp, lab, an) =
1049             (doCCexpr(ccexp, 0, []);             (doCCexpr(ccexp, C.eflags, []);
1050              mark(I.JCC{cond=cond(Gen.condOf ccexp), opnd=immedLabel lab}, an)              mark(I.JCC{cond=cond(Gen.condOf ccexp), opnd=immedLabel lab}, an)
1051             )             )
1052    
1053            (* generate code for floating point compare and branch *)            (* generate code for floating point compare and branch *)
1054        and fbranch(fty, fcc, t1, t2, lab, an) =        and fbranch(fty, fcc, t1, t2, lab, an) =
           let fun compare() =  
1055                let fun ignoreOrder (T.FREG _) = true                let fun ignoreOrder (T.FREG _) = true
1056                      | ignoreOrder (T.FLOAD _) = true                      | ignoreOrder (T.FLOAD _) = true
1057                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e
1058                      | ignoreOrder _ = false                      | ignoreOrder _ = false
1059                in  if ignoreOrder t1 orelse ignoreOrder t2 then  
1060                  fun compare'() = (* Sethi-Ullman style *)
1061                      (if ignoreOrder t1 orelse ignoreOrder t2 then
1062                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))
1063                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);
1064                          emit(I.FXCH{opnd=C.ST(1)}));                          emit(I.FXCH{opnd=C.ST(1)}));
1065                    emit(I.FUCOMPP)                     emit(I.FUCOMPP);
1066                       fcc
1067                      )
1068    
1069                  fun compare''() =
1070                          (* direct style *)
1071                          (* Try to make lsrc the memory operand *)
1072                      let val lsrc = foperand(fty, t1)
1073                          val rsrc = foperand(fty, t2)
1074                          val fsize = fsize fty
1075                          fun cmp(lsrc, rsrc, fcc) =
1076                              (emit(I.FCMP{fsize=fsize,lsrc=lsrc,rsrc=rsrc}); fcc)
1077                      in  case (lsrc, rsrc) of
1078                             (I.FPR _, I.FPR _) => cmp(lsrc, rsrc, fcc)
1079                           | (I.FPR _, mem) => cmp(mem,lsrc,T.Basis.swapFcond fcc)
1080                           | (mem, I.FPR _) => cmp(lsrc, rsrc, fcc)
1081                           | (lsrc, rsrc) => (* can't be both memory! *)
1082                             let val ftmpR = newFreg()
1083                                 val ftmp  = I.FPR ftmpR
1084                             in  emit(I.FMOVE{fsize=fsize,src=rsrc,dst=ftmp});
1085                                 cmp(lsrc, ftmp, fcc)
1086                             end
1087                end                end
1088    
1089                  fun compare() =
1090                      if enableFastFPMode andalso !fast_floating_point
1091                      then compare''() else compare'()
1092    
1093                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})
1094                  fun testil i = emit(I.TESTL{lsrc=eax,rsrc=I.Immed(i)})
1095                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})
1096                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})
1097                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)
1098                fun sahf() = emit(I.SAHF)                fun sahf() = emit(I.SAHF)
1099                fun branch() =                fun branch(fcc) =
1100                    case fcc                    case fcc
1101                    of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))                    of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))
1102                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))
1103                     | T.?    => (sahf(); j(I.P,lab))                     | T.?    => (sahf(); j(I.P,lab))
1104                     | T.<=>  => (sahf(); j(I.NP,lab))                     | T.<=>  => (sahf(); j(I.NP,lab))
1105                     | T.>    => (andil 0x4500;  j(I.EQ,lab))                     | T.>    => (testil 0x4500;  j(I.EQ,lab))
1106                     | T.?<=  => (andil 0x4500;  j(I.NE,lab))                     | T.?<=  => (testil 0x4500;  j(I.NE,lab))
1107                     | T.>=   => (andil 0x500; j(I.EQ,lab))                     | T.>=   => (testil 0x500; j(I.EQ,lab))
1108                     | T.?<   => (andil 0x500; j(I.NE,lab))                     | T.?<   => (testil 0x500; j(I.NE,lab))
1109                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))
1110                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))
1111                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);
1112                                  cmpil 0x4000; j(I.EQ,lab))                                  cmpil 0x4000; j(I.EQ,lab))
1113                     | T.?>   => (sahf(); j(I.P,lab); andil 0x4100; j(I.EQ,lab))                     | T.?>   => (sahf(); j(I.P,lab); testil 0x4100; j(I.EQ,lab))
1114                     | T.<>   => (andil 0x4400; j(I.EQ,lab))                     | T.<>   => (testil 0x4400; j(I.EQ,lab))
1115                     | T.?=   => (andil 0x4400; j(I.NE,lab))                     | T.?=   => (testil 0x4400; j(I.NE,lab))
1116                     | _      => error "fbranch"                     | _      => error "fbranch"
1117                   (*esac*)                   (*esac*)
1118            in  compare(); emit I.FNSTSW; branch()                val fcc = compare()
1119              in  emit I.FNSTSW;
1120                  branch(fcc)
1121              end
1122    
1123          (*========================================================
1124           * Floating point code generation starts here.
1125           * Some generic fp routines first.
1126           *========================================================*)
1127    
1128           (* Can this tree be folded into the src operand of a floating point
1129            * operations?
1130            *)
1131          and foldableFexp(T.FREG _) = true
1132            | foldableFexp(T.FLOAD _) = true
1133            | foldableFexp(T.CVTI2F(_, (16 | 32), _)) = true
1134            | foldableFexp(T.CVTF2F(_, _, t)) = foldableFexp t
1135            | foldableFexp(T.FMARK(t, _)) = foldableFexp t
1136            | foldableFexp _ = false
1137    
1138            (* Move integer e of size ty into a memory location.
1139             * Returns a quadruple:
1140             *  (INTEGER,return ty,effect address of memory location,cleanup code)
1141             *)
1142          and convertIntToFloat(ty, e) =
1143              let val opnd = operand e
1144              in  if isMemOpnd opnd andalso (ty = 16 orelse ty = 32)
1145                  then (INTEGER, ty, opnd, [])
1146                  else
1147                    let val {instrs, tempMem, cleanup} = cvti2f{ty=ty, src=opnd}
1148                    in  emits instrs;
1149                        (INTEGER, 32, tempMem, cleanup)
1150            end            end
1151              end
1152    
1153          (*========================================================
1154           * Sethi-Ullman based floating point code generation as
1155           * implemented by Lal
1156           *========================================================*)
1157    
1158        and fld(32, opnd) = I.FLDS opnd        and fld(32, opnd) = I.FLDS opnd
1159          | fld(64, opnd) = I.FLDL opnd          | fld(64, opnd) = I.FLDL opnd
# Line 957  Line 1174 
1174          | fstp _         = error "fstp"          | fstp _         = error "fstp"
1175    
1176            (* generate code for floating point stores *)            (* generate code for floating point stores *)
1177        and fstore(fty, ea, d, mem, an) =        and fstore'(fty, ea, d, mem, an) =
1178            (case d of            (case d of
1179               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))
1180             | _ => reduceFexp(fty, d, []);             | _ => reduceFexp(fty, d, []);
1181             mark(fstp(fty, address(ea, mem)), an)             mark(fstp(fty, address(ea, mem)), an)
1182            )            )
1183    
1184        and fexpr e = error "fexpr"            (* generate code for floating point loads *)
1185          and fload'(fty, ea, mem, fd, an) =
1186                let val ea = address(ea, mem)
1187                in  mark(fld(fty, ea), an);
1188                    if C.sameColor(fd,ST0) then ()
1189                    else emit(fstp(fty, I.FDirect fd))
1190                end
1191    
1192          and fexpr' e = (reduceFexp(64, e, []); C.ST(0))
1193    
1194            (* generate floating point expression and put the result in fd *)            (* generate floating point expression and put the result in fd *)
1195        and doFexpr(fty, T.FREG(_, fs), fd, an) =        and doFexpr'(fty, T.FREG(_, fs), fd, an) =
1196              (if fs = fd then ()              (if C.sameColor(fs,fd) then ()
1197               else mark(I.FCOPY{dst=[fd], src=[fs], tmp=NONE}, an)               else mark(I.FCOPY{dst=[fd], src=[fs], tmp=NONE}, an)
1198              )              )
1199          | doFexpr(fty, T.FLOAD(fty', ea, mem), fd, an) =          | doFexpr'(_, T.FLOAD(fty, ea, mem), fd, an) =
1200              let val ea = address(ea, mem)              fload'(fty, ea, mem, fd, an)
1201              in  mark(fld(fty', ea), an);          | doFexpr'(fty, T.FEXT fexp, fd, an) =
1202                  emit(fstp(fty, I.FDirect fd))              (ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an};
1203              end               if C.sameColor(fd,ST0) then () else emit(fstp(fty, I.FDirect fd))
1204          | doFexpr(fty, e, fd, an) =              )
1205            | doFexpr'(fty, e, fd, an) =
1206              (reduceFexp(fty, e, []);              (reduceFexp(fty, e, []);
1207               mark(fstp(fty, I.FDirect fd), an)               if C.sameColor(fd,ST0) then ()
1208                 else mark(fstp(fty, I.FDirect fd), an)
1209              )              )
1210    
1211            (*            (*
# Line 989  Line 1216 
1216        and reduceFexp(fty, fexp, an)  =        and reduceFexp(fty, fexp, an)  =
1217            let val ST = I.ST(C.ST 0)            let val ST = I.ST(C.ST 0)
1218                val ST1 = I.ST(C.ST 1)                val ST1 = I.ST(C.ST 1)
1219                  val cleanupCode = ref [] : I.instruction list ref
1220    
1221                datatype su_tree =                datatype su_tree =
1222                  LEAF of int * T.fexp * ans                  LEAF of int * T.fexp * ans
# Line 1031  Line 1259 
1259                    in  (annotate(t, a), integer) end                    in  (annotate(t, a), integer) end
1260                  | suFold e = (su e, false)                  | suFold e = (su e, false)
1261    
               (* Can the tree be folded into the src operand? *)  
               and foldable(T.FREG _) = true  
                 | foldable(T.FLOAD _) = true  
                 | foldable(T.CVTI2F(_, (16 | 32), _)) = true  
                 | foldable(T.CVTF2F(_, _, t)) = foldable t  
                 | foldable(T.FMARK(t, _)) = foldable t  
                 | foldable _ = false  
   
1262                (* Form unary tree *)                (* Form unary tree *)
1263                and suUnary(fty, funary, t) =                and suUnary(fty, funary, t) =
1264                    let val t = su t                    let val t = su t
# Line 1060  Line 1280 
1280                 * This only applies to commutative operations.                 * This only applies to commutative operations.
1281                 *)                 *)
1282                and suComBinary(fty, binop, ibinop, t1, t2) =                and suComBinary(fty, binop, ibinop, t1, t2) =
1283                    let val (t1, t2) = if foldable t2 then (t1, t2) else (t2, t1)                    let val (t1, t2) = if foldableFexp t2
1284                                         then (t1, t2) else (t2, t1)
1285                    in  suBinary(fty, binop, ibinop, t1, t2) end                    in  suBinary(fty, binop, ibinop, t1, t2) end
1286    
1287                and sameTree(LEAF(_, T.FREG(t1,f1), []),                and sameTree(LEAF(_, T.FREG(t1,f1), []),
1288                             LEAF(_, T.FREG(t2,f2), [])) = t1=t2 andalso f1=f2                             LEAF(_, T.FREG(t2,f2), [])) =
1289                            t1 = t2 andalso C.sameColor(f1,f2)
1290                  | sameTree _ = false                  | sameTree _ = false
1291    
1292                (* Traverse tree and generate code *)                (* Traverse tree and generate code *)
# Line 1140  Line 1362 
1362                 *)                 *)
1363                and leafEA(T.FREG(fty, f)) = (REAL, fty, I.FDirect f)                and leafEA(T.FREG(fty, f)) = (REAL, fty, I.FDirect f)
1364                  | leafEA(T.FLOAD(fty, ea, mem)) = (REAL, fty, address(ea, mem))                  | leafEA(T.FLOAD(fty, ea, mem)) = (REAL, fty, address(ea, mem))
1365                  | leafEA(T.CVTI2F(_, 32, t)) = int2real(32, I.MOVL, t)                  | leafEA(T.CVTI2F(_, 32, t)) = int2real(32, t)
1366                  | leafEA(T.CVTI2F(_, 16, t)) = int2real(16, I.MOVSWL, t)                  | leafEA(T.CVTI2F(_, 16, t)) = int2real(16, t)
1367                  | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, I.MOVSBL, t)                  | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, t)
1368                  | leafEA _ = error "leafEA"                  | leafEA _ = error "leafEA"
1369    
1370                (* Move integer t of size ty into a memory location *)                and int2real(ty, e) =
1371                and int2real(ty, mov, t) =                    let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1372                    let val opnd = operand t                    in  cleanupCode := !cleanupCode @ cleanup;
1373                    in  if isMemOpnd opnd andalso (ty = 16 orelse ty = 32)                        (INTEGER, ty, ea)
                       then (INTEGER, ty, opnd)  
                       else (emit(I.MOVE{mvOp=mov, src=opnd, dst=tempMem});  
                             (INTEGER, 32, tempMem))  
1374                    end                    end
1375            in  gencode(su fexp)  
1376             in  gencode(su fexp);
1377                 emits(!cleanupCode)
1378            end (*reduceFexp*)            end (*reduceFexp*)
1379    
1380           (*========================================================
1381            * This section generates 3-address style floating
1382            * point code.
1383            *========================================================*)
1384    
1385          and isize 16 = I.I16
1386            | isize 32 = I.I32
1387            | isize _  = error "isize"
1388    
1389          and fstore''(fty, ea, d, mem, an) =
1390              (floatingPointUsed := true;
1391               mark(I.FMOVE{fsize=fsize fty, dst=address(ea,mem),
1392                            src=foperand(fty, d)},
1393                    an)
1394              )
1395    
1396          and fload''(fty, ea, mem, d, an) =
1397              (floatingPointUsed := true;
1398               mark(I.FMOVE{fsize=fsize fty, src=address(ea,mem),
1399                            dst=RealReg d}, an)
1400              )
1401    
1402          and fiload''(ity, ea, d, an) =
1403              (floatingPointUsed := true;
1404               mark(I.FILOAD{isize=isize ity, ea=ea, dst=RealReg d}, an)
1405              )
1406    
1407          and fexpr''(e as T.FREG(_,f)) =
1408              if isFMemReg f then transFexpr e else f
1409            | fexpr'' e = transFexpr e
1410    
1411          and transFexpr e =
1412              let val fd = newFreg() in doFexpr''(64, e, fd, []); fd end
1413    
1414             (*
1415              * Process a floating point operand.  Put operand in register
1416              * when possible.  The operand should match the given fty.
1417              *)
1418          and foperand(fty, e as T.FREG(fty', f)) =
1419                 if fty = fty' then RealReg f else I.FPR(fexpr'' e)
1420            | foperand(fty, T.CVTF2F(_, _, e)) =
1421                 foperand(fty, e) (* nop on the x86 *)
1422            | foperand(fty, e as T.FLOAD(fty', ea, mem)) =
1423                 (* fold operand when the precison matches *)
1424                 if fty = fty' then address(ea, mem) else I.FPR(fexpr'' e)
1425            | foperand(fty, e) = I.FPR(fexpr'' e)
1426    
1427             (*
1428              * Process a floating point operand.
1429              * Try to fold in a memory operand or conversion from an integer.
1430              *)
1431          and fioperand(T.FREG(fty,f)) = (REAL, fty, RealReg f, [])
1432            | fioperand(T.FLOAD(fty, ea, mem)) =
1433                 (REAL, fty, address(ea, mem), [])
1434            | fioperand(T.CVTF2F(_, _, e)) = fioperand(e) (* nop on the x86 *)
1435            | fioperand(T.CVTI2F(_, ty, e)) = convertIntToFloat(ty, e)
1436            | fioperand(T.FMARK(e,an)) = fioperand(e) (* XXX *)
1437            | fioperand(e) = (REAL, 64, I.FPR(fexpr'' e), [])
1438    
1439              (* Generate binary operator.  Since the real binary operators
1440               * does not take memory as destination, we also ensure this
1441               * does not happen.
1442               *)
1443          and fbinop(targetFty,
1444                     binOp, binOpR, ibinOp, ibinOpR, lsrc, rsrc, fd, an) =
1445                  (* Put the mem operand in rsrc *)
1446              let val _ = floatingPointUsed := true;
1447                  fun isMemOpnd(T.FREG(_, f)) = isFMemReg f
1448                    | isMemOpnd(T.FLOAD _) = true
1449                    | isMemOpnd(T.CVTI2F(_, (16 | 32), _)) = true
1450                    | isMemOpnd(T.CVTF2F(_, _, t)) = isMemOpnd t
1451                    | isMemOpnd(T.FMARK(t, _)) = isMemOpnd t
1452                    | isMemOpnd _ = false
1453                  val (binOp, ibinOp, lsrc, rsrc) =
1454                      if isMemOpnd lsrc then (binOpR, ibinOpR, rsrc, lsrc)
1455                      else (binOp, ibinOp, lsrc, rsrc)
1456                  val lsrc = foperand(targetFty, lsrc)
1457                  val (kind, fty, rsrc, code) = fioperand(rsrc)
1458                  fun dstMustBeFreg f =
1459                      if targetFty <> 64 then
1460                      let val tmpR = newFreg()
1461                          val tmp  = I.FPR tmpR
1462                      in  mark(f tmp, an);
1463                          emit(I.FMOVE{fsize=fsize targetFty,
1464                                       src=tmp, dst=RealReg fd})
1465                      end
1466                      else mark(f(RealReg fd), an)
1467              in  case kind of
1468                    REAL =>
1469                      dstMustBeFreg(fn dst =>
1470                                       I.FBINOP{fsize=fsize fty, binOp=binOp,
1471                                                lsrc=lsrc, rsrc=rsrc, dst=dst})
1472                  | INTEGER =>
1473                      (dstMustBeFreg(fn dst =>
1474                                        I.FIBINOP{isize=isize fty, binOp=ibinOp,
1475                                                  lsrc=lsrc, rsrc=rsrc, dst=dst});
1476                       emits code
1477                      )
1478              end
1479    
1480          and funop(fty, unOp, src, fd, an) =
1481              let val src = foperand(fty, src)
1482              in  mark(I.FUNOP{fsize=fsize fty,
1483                               unOp=unOp, src=src, dst=RealReg fd},an)
1484              end
1485    
1486          and doFexpr''(fty, e, fd, an) =
1487              case e of
1488                T.FREG(_,fs) => if C.sameColor(fs,fd) then ()
1489                                else fcopy''(fty, [fd], [fs], an)
1490                (* Stupid x86 does everything as 80-bits internally. *)
1491    
1492                (* Binary operators *)
1493              | T.FADD(_, a, b) => fbinop(fty,
1494                                          I.FADDL, I.FADDL, I.FIADDL, I.FIADDL,
1495                                          a, b, fd, an)
1496              | T.FSUB(_, a, b) => fbinop(fty,
1497                                          I.FSUBL, I.FSUBRL, I.FISUBL, I.FISUBRL,
1498                                          a, b, fd, an)
1499              | T.FMUL(_, a, b) => fbinop(fty,
1500                                          I.FMULL, I.FMULL, I.FIMULL, I.FIMULL,
1501                                          a, b, fd, an)
1502              | T.FDIV(_, a, b) => fbinop(fty,
1503                                          I.FDIVL, I.FDIVRL, I.FIDIVL, I.FIDIVRL,
1504                                          a, b, fd, an)
1505    
1506                (* Unary operators *)
1507              | T.FNEG(_, a) => funop(fty, I.FCHS, a, fd, an)
1508              | T.FABS(_, a) => funop(fty, I.FABS, a, fd, an)
1509              | T.FSQRT(_, a) => funop(fty, I.FSQRT, a, fd, an)
1510    
1511                (* Load *)
1512              | T.FLOAD(fty,ea,mem) => fload''(fty, ea, mem, fd, an)
1513    
1514                (* Type conversions *)
1515              | T.CVTF2F(_, _, e) => doFexpr''(fty, e, fd, an)
1516              | T.CVTI2F(_, ty, e) =>
1517                let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1518                in  fiload''(ty, ea, fd, an);
1519                    emits cleanup
1520                end
1521    
1522              | T.FMARK(e,A.MARKREG f) => (f fd; doFexpr''(fty, e, fd, an))
1523              | T.FMARK(e, a) => doFexpr''(fty, e, fd, a::an)
1524              | T.FPRED(e, c) => doFexpr''(fty, e, fd, A.CTRLUSE c::an)
1525              | T.FEXT fexp =>
1526                 ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an}
1527              | _ => error("doFexpr''")
1528    
1529           (*========================================================
1530            * Tie the two styles of fp code generation together
1531            *========================================================*)
1532          and fstore(fty, ea, d, mem, an) =
1533              if enableFastFPMode andalso !fast_floating_point
1534              then fstore''(fty, ea, d, mem, an)
1535              else fstore'(fty, ea, d, mem, an)
1536          and fload(fty, ea, d, mem, an) =
1537              if enableFastFPMode andalso !fast_floating_point
1538              then fload''(fty, ea, d, mem, an)
1539              else fload'(fty, ea, d, mem, an)
1540          and fexpr e =
1541              if enableFastFPMode andalso !fast_floating_point
1542              then fexpr'' e else fexpr' e
1543          and doFexpr(fty, e, fd, an) =
1544              if enableFastFPMode andalso !fast_floating_point
1545              then doFexpr''(fty, e, fd, an)
1546              else doFexpr'(fty, e, fd, an)
1547    
1548            (* generate code for a statement *)            (* generate code for a statement *)
1549        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)
1550          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)
1551          | stmt(T.CCMV(ccd, e), an) = doCCexpr(e, ccd, an)          | stmt(T.CCMV(ccd, e), an) = doCCexpr(e, ccd, an)
1552          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)
1553          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)
1554          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)          | stmt(T.JMP(e, labs), an) = jmp(e, labs, an)
1555          | stmt(T.CALL(e, flow, def, use, cdef, cuse, mem), an) =          | stmt(T.CALL{funct, targets, defs, uses, region, ...}, an) =
1556               call(e,flow,def,use,mem,an)               call(funct,targets,defs,uses,region,an)
1557          | stmt(T.RET _, an) = mark(I.RET NONE, an)          | stmt(T.RET _, an) = mark(I.RET NONE, an)
1558          | stmt(T.STORE(8, ea, d, mem), an) = store8(ea, d, mem, an)          | stmt(T.STORE(8, ea, d, mem), an) = store8(ea, d, mem, an)
1559          | stmt(T.STORE(16, ea, d, mem), an) = store16(ea, d, mem, an)          | stmt(T.STORE(16, ea, d, mem), an) = store16(ea, d, mem, an)
1560          | stmt(T.STORE(32, ea, d, mem), an) = store32(ea, d, mem, an)          | stmt(T.STORE(32, ea, d, mem), an) = store32(ea, d, mem, an)
1561          | 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)
1562          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)          | stmt(T.BCC(cc, lab), an) = branch(cc, lab, an)
1563          | stmt(T.DEFINE l, _) = defineLabel l          | stmt(T.DEFINE l, _) = defineLabel l
1564          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)
1565          | stmt(T.EXT s, an) =          | stmt(T.EXT s, an) =
# Line 1184  Line 1573 
1573           ((* Must be cleared by the client.           ((* Must be cleared by the client.
1574             * if rewriteMemReg then memRegsUsed := 0w0 else ();             * if rewriteMemReg then memRegsUsed := 0w0 else ();
1575             *)             *)
1576            trapLabel := NONE; beginCluster 0)            floatingPointUsed := false;
1577              trapLabel := NONE;
1578              beginCluster 0
1579             )
1580        and endCluster' a =        and endCluster' a =
1581           (case !trapLabel           (case !trapLabel
1582            of NONE => ()            of NONE => ()
1583             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))
1584            (*esac*);            (*esac*);
1585              (* If floating point has been used allocate an extra
1586               * register just in case we didn't use any explicit register
1587               *)
1588              if !floatingPointUsed then (newFreg(); ())
1589              else ();
1590            endCluster(a)            endCluster(a)
1591           )           )
1592    
# Line 1216  Line 1613 
1613               entryLabel  = entryLabel,               entryLabel  = entryLabel,
1614               comment     = comment,               comment     = comment,
1615               annotation  = annotation,               annotation  = annotation,
1616               exitBlock   = fn mlrisc => exitBlock(cellset mlrisc),               exitBlock   = fn mlrisc => exitBlock(cellset mlrisc)
              alias       = alias,  
              phi         = phi  
1617            }            }
1618    
1619    in  self()    in  self()

Legend:
Removed from v.565  
changed lines
  Added in v.744

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