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 731, Fri Nov 10 22:57:45 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
41    (structure X86Instr : X86INSTR    (structure X86Instr : X86INSTR
42     structure X86MLTree : MLTREE     structure X86MLTree : MLTREE
43    (* structure PseudoInstrs : X86_PSEUDO_INSTR *)     structure ExtensionComp : MLTREE_EXTENSION_COMP
44         where I = X86Instr and T = X86MLTree
45       sharing X86MLTree.Region = X86Instr.Region       sharing X86MLTree.Region = X86Instr.Region
46       sharing X86MLTree.LabelExp = X86Instr.LabelExp       sharing X86MLTree.LabelExp = X86Instr.LabelExp
      (* sharing PseudoInstrs.I = X86Instr  
      sharing PseudoInstrs.T = X86MLTree *)  
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      (* val memRegsUsed : word ref *)    (* bit mask of memRegs used *)           (* 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 54  Line 71 
71    structure A = MLRiscAnnotations    structure A = MLRiscAnnotations
72    
73    type instrStream = (I.instruction,C.regmap,C.cellset) T.stream    type instrStream = (I.instruction,C.regmap,C.cellset) T.stream
74    type ('s,'r,'f,'c) mltreeStream =    type mltreeStream = (T.stm,C.regmap,T.mlrisc list) T.stream
75       (('s,'r,'f,'c) T.stm,C.regmap,('s,'r,'f,'c) T.mlrisc list) T.stream  
76    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  
77    
78    structure Gen = MLTreeGen    structure Gen = MLTreeGen
79       (structure T = T       (structure T = T
# Line 77  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    
93      (* The following hardcoded *)
94    fun isMemReg r = rewriteMemReg andalso r >= 8 andalso r < 32    fun isMemReg r = rewriteMemReg andalso r >= 8 andalso r < 32
95      fun isFMemReg r = if enableFastFPMode andalso !fast_floating_point
96                        then r >= 32+8 andalso r < 32+32
97                        else true
98      val isAnyFMemReg = List.exists (fn r => r >= 32+8 andalso r < 32+32)
99    
100      val ST0 = C.ST 0
101      val ST7 = C.ST 7
102    
103    (*    (*
104     * The code generator     * The code generator
105     *)     *)
106    fun selectInstructions    fun selectInstructions
        (T.EXTENDER{compileStm,compileRexp,compileFexp,compileCCexp,...})  
107         (instrStream as         (instrStream as
108          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,
109                   beginCluster,endCluster,exitBlock,alias,phi,comment,...}) =                   beginCluster,endCluster,exitBlock,alias,phi,comment,...}) =
# Line 92  Line 112 
112        (* label where a trap is generated -- one per cluster *)        (* label where a trap is generated -- one per cluster *)
113        val trapLabel = ref (NONE: (I.instruction * Label.label) option)        val trapLabel = ref (NONE: (I.instruction * Label.label) option)
114    
115          (* flag floating point generation *)
116          val floatingPointUsed = ref false
117    
118        (* effective address of an integer register *)        (* effective address of an integer register *)
119        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
120        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  
           )  
121    
122        (* Add an overflow trap *)        (* Add an overflow trap *)
123        fun trap() =        fun trap() =
# Line 114  Line 133 
133        val newReg  = C.newReg        val newReg  = C.newReg
134        val newFreg = C.newFreg        val newFreg = C.newFreg
135    
136          fun fsize 32 = I.FP32
137            | fsize 64 = I.FP64
138            | fsize 80 = I.FP80
139            | fsize _  = error "fsize"
140    
141        (* mark an expression with a list of annotations *)        (* mark an expression with a list of annotations *)
142        fun mark'(i,[]) = i        fun mark'(i,[]) = i
143          | 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 145 
145        (* annotate an expression and emit it *)        (* annotate an expression and emit it *)
146        fun mark(i,an) = emit(mark'(i,an))        fun mark(i,an) = emit(mark'(i,an))
147    
148          val emits = app emit
149    
150        (* emit parallel copies for integers        (* emit parallel copies for integers
151         * Translates parallel copies that involve memregs into         * Translates parallel copies that involve memregs into
152         * individual copies.         * individual copies.
# Line 138  Line 164 
164                      else [I.COPY{dst=[rd], src=[rs], tmp=NONE}]                      else [I.COPY{dst=[rd], src=[rs], tmp=NONE}]
165                  | mvInstr{dst, src} = [I.MOVE{mvOp=I.MOVL, src=src, dst=dst}]                  | mvInstr{dst, src} = [I.MOVE{mvOp=I.MOVL, src=src, dst=dst}]
166            in            in
167               app emit (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}               emits (Shuffle.shuffle{mvInstr=mvInstr, ea=IntReg}
168                 {regmap=fn r => r, tmp=SOME(I.Direct(newReg())),                 {regmap=fn r => r, tmp=SOME(I.Direct(newReg())),
169                  dst=dst, src=src})                  dst=dst, src=src})
170            end            end
# Line 174  Line 200 
200          | setZeroBit(T.SRA _)      = true          | setZeroBit(T.SRA _)      = true
201          | setZeroBit(T.SRL _)      = true          | setZeroBit(T.SRL _)      = true
202          | setZeroBit(T.SLL _)      = true          | setZeroBit(T.SLL _)      = true
203            | setZeroBit(T.SUB _)      = true
204            | setZeroBit(T.ADDT _)     = true
205            | setZeroBit(T.SUBT _)     = true
206          | setZeroBit(T.MARK(e, _)) = setZeroBit e          | setZeroBit(T.MARK(e, _)) = setZeroBit e
207          | setZeroBit _             = false          | setZeroBit _             = false
208    
209        (* emit parallel copies for floating point *)        fun setZeroBit2(T.ANDB _)     = true
210        fun fcopy(fty, [], [], _) = ()          | setZeroBit2(T.ORB _)      = true
211          | fcopy(fty, dst as [_], src as [_], an) =          | setZeroBit2(T.XORB _)     = true
212            | setZeroBit2(T.SRA _)      = true
213            | setZeroBit2(T.SRL _)      = true
214            | setZeroBit2(T.SLL _)      = true
215            | setZeroBit2(T.ADD(32, _, _)) = true (* can't use leal! *)
216            | setZeroBit2(T.SUB _)      = true
217            | setZeroBit2(T.ADDT _)     = true
218            | setZeroBit2(T.SUBT _)     = true
219            | setZeroBit2(T.MARK(e, _)) = setZeroBit2 e
220            | setZeroBit2 _             = false
221    
222          (* emit parallel copies for floating point
223           * Normal version.
224           *)
225          fun fcopy'(fty, [], [], _) = ()
226            | fcopy'(fty, dst as [_], src as [_], an) =
227              mark(I.FCOPY{dst=dst,src=src,tmp=NONE}, an)              mark(I.FCOPY{dst=dst,src=src,tmp=NONE}, an)
228          | fcopy(fty, dst, src, an) =          | fcopy'(fty, dst, src, an) =
229              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)
230    
231          (* emit parallel copies for floating point.
232           * Fast version.
233           * Translates parallel copies that involve memregs into
234           * individual copies.
235           *)
236    
237          fun fcopy''(fty, [], [], _) = ()
238            | fcopy''(fty, dst, src, an) =
239              if true orelse isAnyFMemReg dst orelse isAnyFMemReg src then
240              let val fsize = fsize fty
241                  fun mvInstr{dst, src} = [I.FMOVE{fsize=fsize, src=src, dst=dst}]
242              in
243                  emits (Shuffle.shuffle{mvInstr=mvInstr, ea=RealReg}
244                    {regmap=fn r => r,
245                     tmp=case dst of
246                           [_] => NONE
247                         |  _  => SOME(I.FPR(newReg())),
248                     dst=dst, src=src})
249              end
250              else
251                mark(I.FCOPY{dst=dst,src=src,tmp=
252                             case dst of
253                               [_] => NONE
254                             | _   => SOME(I.FPR(newFreg()))}, an)
255    
256          fun fcopy x = if enableFastFPMode andalso !fast_floating_point
257                        then fcopy'' x else fcopy' x
258    
259        (* Translates MLTREE condition code to x86 condition code *)        (* Translates MLTREE condition code to x86 condition code *)
260        fun cond T.LT = I.LT | cond T.LTU = I.B        fun cond T.LT = I.LT | cond T.LTU = I.B
261          | cond T.LE = I.LE | cond T.LEU = I.BE          | cond T.LE = I.LE | cond T.LEU = I.BE
# Line 368  Line 440 
440            | I.Indexed _  => true            | I.Indexed _  => true
441            | I.MemReg _   => true            | I.MemReg _   => true
442            | I.LabelEA _  => true            | I.LabelEA _  => true
443              | I.FDirect f  => true
444            | _            => false            | _            => false
445            )            )
446    
# Line 453  Line 526 
526                fun divrem(signed, overflow, e1, e2, resultReg) =                fun divrem(signed, overflow, e1, e2, resultReg) =
527                let val (opnd1, opnd2) = (operand e1, operand e2)                let val (opnd1, opnd2) = (operand e1, operand e2)
528                    val _ = move(opnd1, eax)                    val _ = move(opnd1, eax)
529                    val oper = if signed then (emit(I.CDQ); I.IDIV)                    val oper = if signed then (emit(I.CDQ); I.IDIVL)
530                               else (zero edx; I.UDIV)                               else (zero edx; I.DIVL)
531                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);
532                    move(resultReg, rdOpnd);                    move(resultReg, rdOpnd);
533                    if overflow then trap() else ()                    if overflow then trap() else ()
# Line 507  Line 580 
580                fun uMultiply(e1, e2) =                fun uMultiply(e1, e2) =
581                    (* note e2 can never be (I.Direct edx) *)                    (* note e2 can never be (I.Direct edx) *)
582                    (move(operand e1, eax);                    (move(operand e1, eax);
583                     mark(I.MULTDIV{multDivOp=I.UMUL,                     mark(I.MULTDIV{multDivOp=I.MULL,
584                                    src=regOrMem(operand e2)},an);                                    src=regOrMem(operand e2)},an);
585                     move(eax, rdOpnd)                     move(eax, rdOpnd)
586                    )                    )
# Line 585  Line 658 
658    
659                   (* Generate setcc instruction:                   (* Generate setcc instruction:
660                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))
661                      * Bug, if eax is either t1 or t2 then problem will occur!!!
662                      * Note that we have to use eax as the destination of the
663                      * setcc because it only works on the registers
664                      * %al, %bl, %cl, %dl and %[abcd]h.  The last four registers
665                      * are inaccessible in 32 bit mode.
666                    *)                    *)
667                fun setcc(ty, cc, t1, t2, yes, no) =                fun setcc(ty, cc, t1, t2, yes, no) =
668                let val tmpR = newReg()                let val (cc, yes, no) =
669                    val tmp = I.Direct tmpR                           if yes > no then (cc, yes, no)
670                    (* We create a temporary here just in                           else (T.Basis.negateCond cc, no, yes)
                    * case t1 or t2 contains a use of rd.  
                    *)  
671                in  (* Clear the destination first.                in  (* Clear the destination first.
672                     * This this because stupid SETcc                     * This this because stupid SETcc
673                     * only writes to the low order                     * only writes to the low order
674                     * byte.  That's Intel architecture, folks.                     * byte.  That's Intel architecture, folks.
675                     *)                     *)
676                    zero tmp;                    case (yes, no, cc) of
677                    case (yes, no) of                      (1, 0, T.LT) =>
678                      (1, 0) => (* normal case *)                       let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
679                         in  move(tmp, rdOpnd);
680                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
681                         end
682                      | (1, 0, T.GT) =>
683                         let val tmp = I.Direct(expr(T.SUB(32,t1,t2)))
684                         in  emit(I.UNARY{unOp=I.NOTL,opnd=tmp});
685                             move(tmp, rdOpnd);
686                             emit(I.BINARY{binOp=I.SHRL,src=I.Immed 31,dst=rdOpnd})
687                         end
688                      | (1, 0, _) => (* normal case *)
689                      let val cc = cmp(true, ty, cc, t1, t2, [])                      let val cc = cmp(true, ty, cc, t1, t2, [])
690                      in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end                      in  mark(I.SET{cond=cond cc, opnd=eax}, an);
691                    | (0, 1) => (* flip *)                          emit(I.BINARY{binOp=I.ANDL,src=I.Immed 255, dst=eax});
692                      let val cc = cmp(true, ty,                          move(eax, rdOpnd)
693                                       T.Basis.negateCond cc, t1, t2, [])                      end
694                      in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end                    | (C1, C2, _)  =>
                   | (C1, C2)  =>  
695                      (* general case;                      (* general case;
696                       * from the Intel optimization guide p3-5 *)                       * from the Intel optimization guide p3-5
697                      let val C1 = toInt32 C1                       *)
698                          val C2 = toInt32 C2                      let val _  = zero eax;
699                          val cc = cmp(true, ty, cc, t1, t2, [])                          val cc = cmp(true, ty, cc, t1, t2, [])
700                      in  emit(I.SET{cond=cond cc, opnd=tmp});                      in  case C1-C2 of
701                          case Int32.abs(C1-C2)-1 of                            D as (1 | 2 | 3 | 4 | 5 | 8 | 9) =>
702                            D as (1 | 2 | 4 | 8) =>                            let val (base,scale) =
703                            let val addr = I.Indexed{base=SOME tmpR,                                    case D of
704                                                     index=tmpR,                                      1 => (NONE, 0)
705                                                     scale=Int32.toInt D,                                    | 2 => (NONE, 1)
706                                                     disp=I.Immed(C1-C2),                                    | 3 => (SOME C.eax, 1)
707                                      | 4 => (NONE, 2)
708                                      | 5 => (SOME C.eax, 2)
709                                      | 8 => (NONE, 3)
710                                      | 9 => (SOME C.eax, 3)
711                                  val addr = I.Indexed{base=base,
712                                                       index=C.eax,
713                                                       scale=scale,
714                                                       disp=I.Immed C2,
715                                                     mem=readonly}                                                     mem=readonly}
716                            in  mark(I.LEA{r32=tmpR, addr=addr}, an) end                                val tmpR = newReg()
717                          | _ =>                                val tmp  = I.Direct tmpR
718                           (emit(I.UNARY{unOp=I.DECL, opnd=tmp});                            in  emit(I.SET{cond=cond cc, opnd=eax});
719                                  mark(I.LEA{r32=tmpR, addr=addr}, an);
720                                  move(tmp, rdOpnd)
721                              end
722                            | D =>
723                               (emit(I.SET{cond=cond(T.Basis.negateCond cc),
724                                           opnd=eax});
725                                emit(I.UNARY{unOp=I.DECL, opnd=eax});
726                            emit(I.BINARY{binOp=I.ANDL,                            emit(I.BINARY{binOp=I.ANDL,
727                                          src=I.Immed(C2-C1), dst=tmp});                                            src=I.Immed D, dst=eax});
728                            mark(I.BINARY{binOp=I.ADDL,                              if C2 = 0 then
729                                          src=I.Immed(Int32.min(C1,C2)),                                 move(eax, rdOpnd)
730                                          dst=tmp}, an)                              else
731                           )                                 let val tmpR = newReg()
732                      end;                                     val tmp  = I.Direct tmpR
733                                   in  mark(I.LEA{addr=
734                                             I.Displace{
735                                                 base=C.eax,
736                                                 disp=I.Immed C2,
737                                                 mem=readonly},
738                                                 r32=tmpR}, an);
739                    move(tmp, rdOpnd)                    move(tmp, rdOpnd)
740                                    end
741                               )
742                        end
743                end (* setcc *)                end (* setcc *)
744    
745                    (* Generate cmovcc instruction.                    (* Generate cmovcc instruction.
# Line 647  Line 756 
756    
757                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)
758    
759                      (* Add n to rd *)
760                  fun addN n =
761                  let val n = operand n
762                      val src = if isMemReg rd then immedOrReg n else n
763                  in  mark(I.BINARY{binOp=I.ADDL, src=src, dst=rdOpnd}, an) end
764    
765                    (* Generate addition *)                    (* Generate addition *)
766                fun addition(e1, e2) =                fun addition(e1, e2) =
767                      case e1 of
768                        T.REG(_,rs) => if rs = rd then addN e2 else addition1(e1,e2)
769                      | _ => addition1(e1,e2)
770                  and addition1(e1, e2) =
771                      case e2 of
772                        T.REG(_,rs) => if rs = rd then addN e1 else addition2(e1,e2)
773                      | _ => addition2(e1,e2)
774                  and addition2(e1,e2) =
775                  (dstMustBeReg(fn (dstR, _) =>                  (dstMustBeReg(fn (dstR, _) =>
776                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))
777                  handle EA => binaryComm(I.ADDL, e1, e2))                  handle EA => binaryComm(I.ADDL, e1, e2))
778    
                   (* Add n to rd *)  
               fun addN n =  
                 mark(I.BINARY{binOp=I.ADDL, src=I.Immed(toInt32 n),  
                               dst=rdOpnd}, an)  
779    
780            in  case exp of            in  case exp of
781                 T.REG(_,rs) =>                 T.REG(_,rs) =>
782                     if isMemReg rs andalso isMemReg rd then                     if isMemReg rs andalso isMemReg rd then
783                        let val tmp = I.Direct(newReg())                        let val tmp = I.Direct(newReg())
784                        in  move'(MemReg rs, tmp, an);                        in  move'(I.MemReg rs, tmp, an);
785                            move'(tmp, rdOpnd, [])                            move'(tmp, rdOpnd, [])
786                        end                        end
787                     else move'(IntReg rs, rdOpnd, an)                     else move'(IntReg rs, rdOpnd, an)
# Line 682  Line 801 
801               | 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)
802               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)
803               | 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)  
804               | T.ADD(32, e1, e2) => addition(e1, e2)               | T.ADD(32, e1, e2) => addition(e1, e2)
805    
806                   (* 32-bit addition but set the flag!
807                    * This is a stupid hack for now.
808                    *)
809                 | T.ADD(0, e, (T.LI 1|T.LI32 0w1)) => unary(I.INCL, e)
810                 | T.ADD(0, (T.LI 1|T.LI32 0w1), e) => unary(I.INCL, e)
811                 | T.ADD(0, e, T.LI ~1) => unary(I.DECL, e)
812                 | T.ADD(0, T.LI ~1, e) => unary(I.DECL, e)
813                 | T.ADD(0, e1, e2) => binaryComm(I.ADDL, e1, e2)
814    
815                 (* 32-bit subtraction *)                 (* 32-bit subtraction *)
816                 | T.SUB(32, e, (T.LI 0 | T.LI32 0w0)) => doExpr(e, rd, an)
817               | 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)
818               | T.SUB(32, e, T.LI ~1) => unary(I.INCL, e)               | T.SUB(32, e, T.LI ~1) => unary(I.INCL, e)
819               | 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 731  Line 856 
856               | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(16,ea,mem)) => load16s(ea, mem)               | T.CVTI2I(_,T.SIGN_EXTEND,_,T.LOAD(16,ea,mem)) => load16s(ea, mem)
857    
858               | 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) =>
859                   setcc(ty, cc, t1, t2, yes, no)                   setcc(ty, cc, t1, t2, toInt32 yes, toInt32 no)
860                 | T.COND(32, T.CMP(ty, cc, t1, t2), T.LI32 yes, T.LI32 no) =>
861                     setcc(ty, cc, t1, t2, Word32.toLargeIntX yes,
862                                           Word32.toLargeIntX no)
863               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>
864                  (case !arch of (* PentiumPro and higher has CMOVcc *)                  (case !arch of (* PentiumPro and higher has CMOVcc *)
865                     Pentium => unknownExp exp                     Pentium => unknownExp exp
# Line 741  Line 869 
869               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))
870               | T.MARK(e, a) => doExpr(e, rd, a::an)               | T.MARK(e, a) => doExpr(e, rd, a::an)
871               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)
872               | T.REXT e => compileRexp (reducer()) {e=e, rd=rd, an=an}               | T.REXT e =>
873                     ExtensionComp.compileRext (reducer()) {e=e, rd=rd, an=an}
874                 (* simplify and try again *)                 (* simplify and try again *)
875               | exp => unknownExp exp               | exp => unknownExp exp
876            end (* doExpr *)            end (* doExpr *)
# Line 761  Line 890 
890            * 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,
891            * 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.
892            *)            *)
893       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) =
894              (case ty of              (case ty of
895                 8 =>  test(I.TESTB, a, b)                 8  => test(I.TESTB, a, b, an)
896               | 16 => test(I.TESTW, a, b)               | 16 => test(I.TESTW, a, b, an)
897               | 32 => test(I.TESTL, a, b)               | 32 => test(I.TESTL, a, b, an)
898               | _  => (expr e; ())               | _  => doExpr(e, newReg(), an);
899               ; cc)               cc)
900          | cmpWithZero(cc, e) = (expr e; cc)          | cmpWithZero(cc, e, an) =
901              let val e =
902                    case e of (* hack to disable the lea optimization XXX *)
903                      T.ADD(_, a, b) => T.ADD(0, a, b)
904                    | e => e
905              in  doExpr(e, newReg(), an); cc end
906    
907            (* Emit a test.            (* Emit a test.
908             *   The available modes are             *   The available modes are
# Line 785  Line 919 
919             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction             * are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction
920             * by TESTB.             * by TESTB.
921             *)             *)
922        and test(testopcode, a, b) =        and test(testopcode, a, b, an) =
923            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)            let val (_, opnd1, opnd2) = commuteComparison(T.EQ, true, a, b)
924                (* translate r, r/m => r/m, r *)                (* translate r, r/m => r/m, r *)
925                val (opnd1, opnd2) =                val (opnd1, opnd2) =
926                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)                     if isMemOpnd opnd2 then (opnd2, opnd1) else (opnd1, opnd2)
927            in  emit(testopcode{lsrc=opnd1, rsrc=opnd2})            in  mark(testopcode{lsrc=opnd1, rsrc=opnd2}, an)
928            end            end
929    
930           (* generate a condition code expression           (* generate a condition code expression
# Line 802  Line 936 
936          | 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))
937          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)
938          | doCCexpr(T.CCEXT e, cd, an) =          | doCCexpr(T.CCEXT e, cd, an) =
939             compileCCexp (reducer()) {e=e, cd=cd, an=an}             ExtensionComp.compileCCext (reducer()) {e=e, ccd=cd, an=an}
940          | doCCexpr _ = error "doCCexpr"          | doCCexpr _ = error "doCCexpr"
941    
942       and ccExpr e = error "ccExpr"       and ccExpr e = error "ccExpr"
# Line 812  Line 946 
946             * we can also reorder the operands.             * we can also reorder the operands.
947             *)             *)
948        and cmp(swapable, ty, cc, t1, t2, an) =        and cmp(swapable, ty, cc, t1, t2, an) =
949            (case cc of                 (* == and <> can be always be reordered *)
950               (T.EQ | T.NE) =>            let val swapable = swapable orelse cc = T.EQ orelse cc = T.NE
951                (* Sometimes the comparison is not necessary because            in (* Sometimes the comparison is not necessary because
952                 * the bits are already set!                 * the bits are already set!
953                 *)                 *)
954                if isZero t1 andalso setZeroBit t2 then cmpWithZero(cc, t2)               if isZero t1 andalso setZeroBit2 t2 then
955                else if isZero t2 andalso setZeroBit t1 then cmpWithZero(cc, t1)                   if swapable then
956                     (* == and <> can be reordered *)                      cmpWithZero(T.Basis.swapCond cc, t2, an)
957                else genCmp(ty, true, cc, t1, t2, an)                   else (* can't reorder the comparison! *)
958             |  _ => genCmp(ty, swapable, cc, t1, t2, an)                      genCmp(ty, false, cc, t1, t2, an)
959            )               else if isZero t2 andalso setZeroBit2 t1 then
960                    cmpWithZero(cc, t1, an)
961                 else genCmp(ty, swapable, cc, t1, t2, an)
962              end
963    
964            (* 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)
965             * Return the appropriate condition code and operands.             * Return the appropriate condition code and operands.
# Line 903  Line 1040 
1040    
1041            (* generate code for floating point compare and branch *)            (* generate code for floating point compare and branch *)
1042        and fbranch(fty, fcc, t1, t2, lab, an) =        and fbranch(fty, fcc, t1, t2, lab, an) =
           let fun compare() =  
1043                let fun ignoreOrder (T.FREG _) = true                let fun ignoreOrder (T.FREG _) = true
1044                      | ignoreOrder (T.FLOAD _) = true                      | ignoreOrder (T.FLOAD _) = true
1045                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e                      | ignoreOrder (T.FMARK(e,_)) = ignoreOrder e
1046                      | ignoreOrder _ = false                      | ignoreOrder _ = false
1047                in  if ignoreOrder t1 orelse ignoreOrder t2 then  
1048                  fun compare'() = (* Sethi-Ullman style *)
1049                      (if ignoreOrder t1 orelse ignoreOrder t2 then
1050                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))                         (reduceFexp(fty, t2, []); reduceFexp(fty, t1, []))
1051                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);                    else (reduceFexp(fty, t1, []); reduceFexp(fty, t2, []);
1052                          emit(I.FXCH{opnd=C.ST(1)}));                          emit(I.FXCH{opnd=C.ST(1)}));
1053                    emit(I.FUCOMPP)                     emit(I.FUCOMPP);
1054                       fcc
1055                      )
1056    
1057                  fun compare''() =
1058                          (* direct style *)
1059                          (* Try to make lsrc the memory operand *)
1060                      let val lsrc = foperand(fty, t1)
1061                          val rsrc = foperand(fty, t2)
1062                          val fsize = fsize fty
1063                          fun cmp(lsrc, rsrc, fcc) =
1064                              (emit(I.FCMP{fsize=fsize,lsrc=lsrc,rsrc=rsrc}); fcc)
1065                      in  case (lsrc, rsrc) of
1066                             (I.FPR _, I.FPR _) => cmp(lsrc, rsrc, fcc)
1067                           | (I.FPR _, mem) => cmp(mem,lsrc,T.Basis.swapFcond fcc)
1068                           | (mem, I.FPR _) => cmp(lsrc, rsrc, fcc)
1069                           | (lsrc, rsrc) => (* can't be both memory! *)
1070                             let val ftmpR = newFreg()
1071                                 val ftmp  = I.FPR ftmpR
1072                             in  emit(I.FMOVE{fsize=fsize,src=rsrc,dst=ftmp});
1073                                 cmp(lsrc, ftmp, fcc)
1074                end                end
1075                      end
1076    
1077                  fun compare() =
1078                      if enableFastFPMode andalso !fast_floating_point
1079                      then compare''() else compare'()
1080    
1081                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})
1082                  fun testil i = emit(I.TESTL{lsrc=eax,rsrc=I.Immed(i)})
1083                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})
1084                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})
1085                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)
1086                fun sahf() = emit(I.SAHF)                fun sahf() = emit(I.SAHF)
1087                fun branch() =                fun branch(fcc) =
1088                    case fcc                    case fcc
1089                    of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))                    of T.==   => (andil 0x4400; xoril 0x4000; j(I.EQ, lab))
1090                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))
1091                     | T.?    => (sahf(); j(I.P,lab))                     | T.?    => (sahf(); j(I.P,lab))
1092                     | T.<=>  => (sahf(); j(I.NP,lab))                     | T.<=>  => (sahf(); j(I.NP,lab))
1093                     | T.>    => (andil 0x4500;  j(I.EQ,lab))                     | T.>    => (testil 0x4500;  j(I.EQ,lab))
1094                     | T.?<=  => (andil 0x4500;  j(I.NE,lab))                     | T.?<=  => (testil 0x4500;  j(I.NE,lab))
1095                     | T.>=   => (andil 0x500; j(I.EQ,lab))                     | T.>=   => (testil 0x500; j(I.EQ,lab))
1096                     | T.?<   => (andil 0x500; j(I.NE,lab))                     | T.?<   => (testil 0x500; j(I.NE,lab))
1097                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))
1098                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))
1099                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);
1100                                  cmpil 0x4000; j(I.EQ,lab))                                  cmpil 0x4000; j(I.EQ,lab))
1101                     | T.?>   => (sahf(); j(I.P,lab); andil 0x4100; j(I.EQ,lab))                     | T.?>   => (sahf(); j(I.P,lab); testil 0x4100; j(I.EQ,lab))
1102                     | T.<>   => (andil 0x4400; j(I.EQ,lab))                     | T.<>   => (testil 0x4400; j(I.EQ,lab))
1103                     | T.?=   => (andil 0x4400; j(I.NE,lab))                     | T.?=   => (testil 0x4400; j(I.NE,lab))
1104                     | _      => error "fbranch"                     | _      => error "fbranch"
1105                   (*esac*)                   (*esac*)
1106            in  compare(); emit I.FNSTSW; branch()                val fcc = compare()
1107              in  emit I.FNSTSW;
1108                  branch(fcc)
1109              end
1110    
1111          (*========================================================
1112           * Floating point code generation starts here.
1113           * Some generic fp routines first.
1114           *========================================================*)
1115    
1116           (* Can this tree be folded into the src operand of a floating point
1117            * operations?
1118            *)
1119          and foldableFexp(T.FREG _) = true
1120            | foldableFexp(T.FLOAD _) = true
1121            | foldableFexp(T.CVTI2F(_, (16 | 32), _)) = true
1122            | foldableFexp(T.CVTF2F(_, _, t)) = foldableFexp t
1123            | foldableFexp(T.FMARK(t, _)) = foldableFexp t
1124            | foldableFexp _ = false
1125    
1126            (* Move integer e of size ty into a memory location.
1127             * Returns a quadruple:
1128             *  (INTEGER,return ty,effect address of memory location,cleanup code)
1129             *)
1130          and convertIntToFloat(ty, e) =
1131              let val opnd = operand e
1132              in  if isMemOpnd opnd andalso (ty = 16 orelse ty = 32)
1133                  then (INTEGER, ty, opnd, [])
1134                  else
1135                    let val {instrs, tempMem, cleanup} = cvti2f{ty=ty, src=opnd}
1136                    in  emits instrs;
1137                        (INTEGER, 32, tempMem, cleanup)
1138                    end
1139            end            end
1140    
1141          (*========================================================
1142           * Sethi-Ullman based floating point code generation as
1143           * implemented by Lal
1144           *========================================================*)
1145    
1146        and fld(32, opnd) = I.FLDS opnd        and fld(32, opnd) = I.FLDS opnd
1147          | fld(64, opnd) = I.FLDL opnd          | fld(64, opnd) = I.FLDL opnd
1148            | fld(80, opnd) = I.FLDT opnd
1149          | fld _         = error "fld"          | fld _         = error "fld"
1150    
1151          and fild(16, opnd) = I.FILD opnd
1152            | fild(32, opnd) = I.FILDL opnd
1153            | fild(64, opnd) = I.FILDLL opnd
1154            | fild _         = error "fild"
1155    
1156          and fxld(INTEGER, ty, opnd) = fild(ty, opnd)
1157            | fxld(REAL, fty, opnd) = fld(fty, opnd)
1158    
1159        and fstp(32, opnd) = I.FSTPS opnd        and fstp(32, opnd) = I.FSTPS opnd
1160          | fstp(64, opnd) = I.FSTPL opnd          | fstp(64, opnd) = I.FSTPL opnd
1161            | fstp(80, opnd) = I.FSTPT opnd
1162          | fstp _         = error "fstp"          | fstp _         = error "fstp"
1163    
1164            (* generate code for floating point stores *)            (* generate code for floating point stores *)
1165        and fstore(fty, ea, d, mem, an) =        and fstore'(fty, ea, d, mem, an) =
1166            (case d of            (case d of
1167               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))               T.FREG(fty, fs) => emit(fld(fty, I.FDirect fs))
1168             | _ => reduceFexp(fty, d, []);             | _ => reduceFexp(fty, d, []);
1169             mark(fstp(fty, address(ea, mem)), an)             mark(fstp(fty, address(ea, mem)), an)
1170            )            )
1171    
1172        and fexpr e = error "fexpr"            (* generate code for floating point loads *)
1173          and fload'(fty, ea, mem, fd, an) =
1174                let val ea = address(ea, mem)
1175                in  mark(fld(fty, ea), an);
1176                    if fd = ST0 then () else emit(fstp(fty, I.FDirect fd))
1177                end
1178    
1179          and fexpr' e = (reduceFexp(64, e, []); C.ST(0))
1180    
1181            (* generate floating point expression and put the result in fd *)            (* generate floating point expression and put the result in fd *)
1182        and doFexpr(fty, T.FREG(_, fs), fd, an) =        and doFexpr'(fty, T.FREG(_, fs), fd, an) =
1183              (if fs = fd then ()              (if fs = fd then ()
1184               else mark(I.FCOPY{dst=[fd], src=[fs], tmp=NONE}, an)               else mark(I.FCOPY{dst=[fd], src=[fs], tmp=NONE}, an)
1185              )              )
1186          | doFexpr(fty, T.FLOAD(fty', ea, mem), fd, an) =          | doFexpr'(_, T.FLOAD(fty, ea, mem), fd, an) =
1187              let val ea = address(ea, mem)              fload'(fty, ea, mem, fd, an)
1188              in  mark(fld(fty', ea), an);          | doFexpr'(fty, T.FEXT fexp, fd, an) =
1189                  emit(fstp(fty, I.FDirect fd))              (ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an};
1190              end               if fd = ST0 then () else emit(fstp(fty, I.FDirect fd))
1191          | doFexpr(fty, e, fd, an) =              )
1192            | doFexpr'(fty, e, fd, an) =
1193              (reduceFexp(fty, e, []);              (reduceFexp(fty, e, []);
1194               mark(fstp(fty, I.FDirect fd), an)               if fd = ST0 then () else mark(fstp(fty, I.FDirect fd), an)
1195              )              )
1196    
1197            (*            (*
# Line 980  Line 1200 
1200             * and put result in %ST(0).             * and put result in %ST(0).
1201             *)             *)
1202        and reduceFexp(fty, fexp, an)  =        and reduceFexp(fty, fexp, an)  =
1203            let val ST = I.FDirect(C.ST 0)            let val ST = I.ST(C.ST 0)
1204                val ST1 = I.FDirect(C.ST 1)                val ST1 = I.ST(C.ST 1)
1205                  val cleanupCode = ref [] : I.instruction list ref
1206                datatype su_numbers =  
1207                  LEAF of int                datatype su_tree =
1208                | BINARY of int * su_numbers * su_numbers                  LEAF of int * T.fexp * ans
1209                | UNARY of int * su_numbers                | BINARY of int * T.fty * fbinop * su_tree * su_tree * ans
1210                  | UNARY of int * T.fty * I.funOp * su_tree * ans
1211                datatype direction = LEFT | RIGHT                and fbinop = FADD | FSUB | FMUL | FDIV
1212                             | FIADD | FISUB | FIMUL | FIDIV
1213                fun label(LEAF n) = n                withtype ans = Annotations.annotations
1214                  | label(BINARY(n, _, _)) = n  
1215                  | label(UNARY(n, _)) = n                fun label(LEAF(n, _, _)) = n
1216                    | label(BINARY(n, _, _, _, _, _)) = n
1217               (* Generate tree of sethi-ullman numbers *)                  | label(UNARY(n, _, _, _, _)) = n
1218                fun suBinary(t1, t2) =  
1219                    let val su1 = suNumbering(t1, LEFT)                fun annotate(LEAF(n, x, an), a)  = LEAF(n,x,a::an)
1220                        val su2 = suNumbering(t2, RIGHT)                  | annotate(BINARY(n,t,b,x,y,an), a) = BINARY(n,t,b,x,y,a::an)
1221                        val n1 = label su1                  | annotate(UNARY(n,t,u,x,an), a) = UNARY(n,t,u,x,a::an)
1222                        val n2 = label su2  
1223                    in  BINARY(if n1=n2 then n1+1 else Int.max(n1, n2), su1, su2)                (* Generate expression tree with sethi-ullman numbers *)
1224                    end                fun su(e as T.FREG _)       = LEAF(1, e, [])
1225                    | su(e as T.FLOAD _)      = LEAF(1, e, [])
1226                and suUnary(t) =                  | su(e as T.CVTI2F _)     = LEAF(1, e, [])
1227                    let val su = suNumbering(t, LEFT)                  | su(T.CVTF2F(_, _, t))   = su t
1228                    in  UNARY(label su, su)                  | su(T.FMARK(t, a))       = annotate(su t, a)
1229                    end                  | su(T.FABS(fty, t))      = suUnary(fty, I.FABS, t)
1230                    | su(T.FNEG(fty, t))      = suUnary(fty, I.FCHS, t)
1231                and suNumbering(T.FREG _, LEFT) = LEAF 1                  | su(T.FSQRT(fty, t))     = suUnary(fty, I.FSQRT, t)
1232                  | suNumbering(T.FREG _, RIGHT) = LEAF 0                  | su(T.FADD(fty, t1, t2)) = suComBinary(fty,FADD,FIADD,t1,t2)
1233                  | suNumbering(T.FLOAD _, LEFT) = LEAF 1                  | su(T.FMUL(fty, t1, t2)) = suComBinary(fty,FMUL,FIMUL,t1,t2)
1234                  | suNumbering(T.FLOAD _, RIGHT) = LEAF 0                  | su(T.FSUB(fty, t1, t2)) = suBinary(fty,FSUB,FISUB,t1,t2)
1235                  | suNumbering(T.FADD(_, t1, t2), _) = suBinary(t1, t2)                  | su(T.FDIV(fty, t1, t2)) = suBinary(fty,FDIV,FIDIV,t1,t2)
1236                  | suNumbering(T.FMUL(_, t1, t2), _) = suBinary(t1, t2)                  | su _ = error "su"
1237                  | suNumbering(T.FSUB(_, t1, t2), _) = suBinary(t1, t2)  
1238                  | suNumbering(T.FDIV(_, t1, t2), _) = suBinary(t1, t2)                (* Try to fold the the memory operand or integer conversion *)
1239                  | suNumbering(T.FABS(_,t), _) = suUnary(t)                and suFold(e as T.FREG _) = (LEAF(0, e, []), false)
1240                  | suNumbering(T.FNEG(_,t), _) = suUnary(t)                  | suFold(e as T.FLOAD _) = (LEAF(0, e, []), false)
1241                  | suNumbering(T.CVTI2F _, _) = UNARY(1, LEAF 0)                  | suFold(e as T.CVTI2F(_,(16 | 32),_)) = (LEAF(0, e, []), true)
1242                  | suNumbering(T.CVTF2F(_,_,t), _) = suUnary t                  | suFold(T.CVTF2F(_, _, t)) = suFold t
1243                  | suNumbering(T.FMARK(e,a),x) = suNumbering(e,x)                  | suFold(T.FMARK(t, a)) =
1244                  | suNumbering _ = error "suNumbering"                    let val (t, integer) = suFold t
1245                      in  (annotate(t, a), integer) end
1246                fun leafEA(T.FREG(fty, f)) = (fty, I.FDirect f)                  | suFold e = (su e, false)
1247                  | leafEA(T.FLOAD(fty, ea, mem)) = (fty, address(ea, mem))  
1248                  | leafEA _ = error "leafEA"                (* Form unary tree *)
1249                  and suUnary(fty, funary, t) =
1250                fun cvti2d(t,an) =                    let val t = su t
1251                let val opnd = operand t                    in  UNARY(label t, fty, funary, t, [])
1252                    fun doMemOpnd () =                    end
1253                        (emit(I.MOVE{mvOp=I.MOVL, src=opnd, dst=tempMem});  
1254                         mark(I.FILD tempMem,an))                (* Form binary tree *)
1255                in  case opnd of                and suBinary(fty, binop, ibinop, t1, t2) =
1256                      I.Direct _ => doMemOpnd()                    let val t1 = su t1
1257                    | I.Immed _ => doMemOpnd()                        val (t2, integer) = suFold t2
1258                    | _ => mark(I.FILD opnd, an)                        val n1 = label t1
1259                end                        val n2 = label t2
1260                          val n  = if n1=n2 then n1+1 else Int.max(n1,n2)
1261                (* traverse expression and su-number tree *)                        val myOp = if integer then ibinop else binop
1262                fun gencode(_, LEAF 0, an) = ()                    in  BINARY(n, fty, myOp, t1, t2, [])
1263                  | gencode(T.FMARK(e,a), x, an) = gencode(e, x, a::an)                    end
1264                  | gencode(f, LEAF 1, an) = mark(fld(leafEA f), an)  
1265                  | gencode(t, BINARY(_, su1, LEAF 0), an) =                (* Try to fold in the operand if possible.
1266                    let (* optimize the common case when both operands                 * This only applies to commutative operations.
1267                         * are equal *)                 *)
1268                        fun sameEA(T.FREG(t1, f1), T.FREG(t2, f2)) =                and suComBinary(fty, binop, ibinop, t1, t2) =
1269                              t1 = t2 andalso f1 = f2                    let val (t1, t2) = if foldableFexp t2
1270                          | sameEA _ = false                                       then (t1, t2) else (t2, t1)
1271                        fun doit(oper, t1, t2) =                    in  suBinary(fty, binop, ibinop, t1, t2) end
1272                           (gencode(t1, su1, []);  
1273                            mark(I.FBINARY{binOp=oper,                and sameTree(LEAF(_, T.FREG(t1,f1), []),
1274                                           src=if sameEA(t1, t2) then ST                             LEAF(_, T.FREG(t2,f2), [])) = t1=t2 andalso f1=f2
1275                                               else #2(leafEA t2),                  | sameTree _ = false
1276                                           dst=ST}, an)  
1277                           )                (* Traverse tree and generate code *)
1278                    in                fun gencode(LEAF(_, t, an)) = mark(fxld(leafEA t), an)
1279                      case t of                  | gencode(BINARY(_, _, binop, x, t2 as LEAF(0, y, a1), a2)) =
1280                         T.FADD(_, t1, t2) => doit(I.FADD, t1, t2)                    let val _          = gencode x
1281                       | T.FMUL(_, t1, t2) => doit(I.FMUL, t1, t2)                        val (_, fty, src) = leafEA y
1282                       | T.FSUB(_, t1, t2) => doit(I.FSUB, t1, t2)                        fun gen(code) = mark(code, a1 @ a2)
1283                       | T.FDIV(_, t1, t2) => doit(I.FDIV, t1, t2)                        fun binary(oper32, oper64) =
1284                       | _ => error "gencode.BINARY"                            if sameTree(x, t2) then
1285                    end                               gen(I.FBINARY{binOp=oper64, src=ST, dst=ST})
1286                  | gencode(fexp, BINARY(fty, su1, su2), an) =                            else
1287                    let fun doit(t1, t2, oper, operP, operRP) = let                               let val oper =
1288                       (* oper[P] =>  ST(1) := ST oper ST(1); [pop]                                     if isMemOpnd src then
1289                                          case fty of
1290                                            32 => oper32
1291                                          | 64 => oper64
1292                                          | _  => error "gencode: BINARY"
1293                                       else oper64
1294                                 in gen(I.FBINARY{binOp=oper, src=src, dst=ST}) end
1295                          fun ibinary(oper16, oper32) =
1296                              let val oper = case fty of
1297                                               16 => oper16
1298                                             | 32 => oper32
1299                                             | _  => error "gencode: IBINARY"
1300                              in  gen(I.FIBINARY{binOp=oper, src=src}) end
1301                      in  case binop of
1302                            FADD => binary(I.FADDS, I.FADDL)
1303                          | FSUB => binary(I.FDIVS, I.FSUBL)
1304                          | FMUL => binary(I.FMULS, I.FMULL)
1305                          | FDIV => binary(I.FDIVS, I.FDIVL)
1306                          | FIADD => ibinary(I.FIADDS, I.FIADDL)
1307                          | FISUB => ibinary(I.FIDIVS, I.FISUBL)
1308                          | FIMUL => ibinary(I.FIMULS, I.FIMULL)
1309                          | FIDIV => ibinary(I.FIDIVS, I.FIDIVL)
1310                      end
1311                    | gencode(BINARY(_, fty, binop, t1, t2, an)) =
1312                      let fun doit(t1, t2, oper, operP, operRP) =
1313                          let (* oper[P] =>  ST(1) := ST oper ST(1); [pop]
1314                        * operR[P] => ST(1) := ST(1) oper ST; [pop]                        * operR[P] => ST(1) := ST(1) oper ST; [pop]
1315                        *)                        *)
1316                        val n1 = label su1                             val n1 = label t1
1317                        val n2 = label su2                             val n2 = label t2
1318                      in                        in if n1 < n2 andalso n1 <= 7 then
1319                        if n1 < n2 andalso n1 <= 7 then                             (gencode t2;
1320                          (gencode(t2, su2, []);                              gencode t1;
                          gencode(t1, su1, []);  
1321                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))
1322                        else if n2 <= n1 andalso n2 <= 7 then                        else if n2 <= n1 andalso n2 <= 7 then
1323                          (gencode(t1, su1, []);                             (gencode t1;
1324                           gencode(t2, su2, []);                              gencode t2;
1325                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))
1326                        else let (* both labels > 7 *)                           else
1327                             let (* both labels > 7 *)
1328                            val fs = I.FDirect(newFreg())                            val fs = I.FDirect(newFreg())
1329                          in                           in  gencode t2;
                           gencode (t2, su2, []);  
1330                            emit(fstp(fty, fs));                            emit(fstp(fty, fs));
1331                            gencode (t1, su1, []);                               gencode t1;
1332                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)
1333                          end                          end
1334                      end                      end
1335                    in                    in case binop of
1336                      case fexp                         FADD => doit(t1,t2,I.FADDL,I.FADDP,I.FADDP)
1337                      of T.FADD(_, t1, t2) => doit(t1, t2,I.FADD,I.FADDP,I.FADDP)                       | FMUL => doit(t1,t2,I.FMULL,I.FMULP,I.FMULP)
1338                       | T.FMUL(_, t1, t2) => doit(t1, t2,I.FMUL,I.FMULP,I.FMULP)                       | FSUB => doit(t1,t2,I.FSUBL,I.FSUBP,I.FSUBRP)
1339                       | 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)  
1340                       | _ => error "gencode.BINARY"                       | _ => error "gencode.BINARY"
1341                    end                    end
1342                  | gencode(fexp, UNARY(_, LEAF 0), an) =                  | gencode(UNARY(_, _, unaryOp, su, an)) =
1343                    (case fexp                     (gencode(su); mark(I.FUNARY(unaryOp),an))
1344                      of T.FABS(fty, t) =>  
1345                           (emit(fld(leafEA t)); mark(I.FUNARY(I.FABS),an))                (* Generate code for a leaf.
1346                       | T.FNEG(fty, t) =>                 * Returns the type and an effective address
1347                           (emit(fld(leafEA t)); mark(I.FUNARY(I.FCHS),an))                 *)
1348                       | T.CVTI2F(_,_,t) => cvti2d(t,an) (* XXX *)                and leafEA(T.FREG(fty, f)) = (REAL, fty, I.FDirect f)
1349                       | _ => error "gencode.UNARY"                  | leafEA(T.FLOAD(fty, ea, mem)) = (REAL, fty, address(ea, mem))
1350                     (*esac*))                  | leafEA(T.CVTI2F(_, 32, t)) = int2real(32, t)
1351                  | gencode(fexp, UNARY(_, su), an) =                  | leafEA(T.CVTI2F(_, 16, t)) = int2real(16, t)
1352                    let fun doit(oper, t) =                  | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, t)
1353                         (gencode(t, su, []); mark(I.FUNARY(oper),an))                  | leafEA _ = error "leafEA"
1354                    in case fexp  
1355                       of T.FABS(_, t) => doit(I.FABS, t)                and int2real(ty, e) =
1356                        | T.FNEG(_, t) => doit(I.FCHS, t)                    let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1357                        | T.CVTF2F(_,_,t) => gencode(t, su, an)                    in  cleanupCode := !cleanupCode @ cleanup;
1358                        | T.CVTI2F _ => error "gencode:UNARY:cvti2f"                        (INTEGER, ty, ea)
                       | _ => error "gencode.UNARY"  
1359                    end                    end
                 | gencode _ = error "gencode"  
1360    
1361                val labels = suNumbering(fexp, LEFT)           in  gencode(su fexp);
1362            in  gencode(fexp, labels, an)               emits(!cleanupCode)
1363            end (*reduceFexp*)            end (*reduceFexp*)
1364    
1365           (*========================================================
1366            * This section generates 3-address style floating
1367            * point code.
1368            *========================================================*)
1369    
1370          and isize 16 = I.I16
1371            | isize 32 = I.I32
1372            | isize _  = error "isize"
1373    
1374          and fstore''(fty, ea, d, mem, an) =
1375              (floatingPointUsed := true;
1376               mark(I.FMOVE{fsize=fsize fty, dst=address(ea,mem),
1377                            src=foperand(fty, d)},
1378                    an)
1379              )
1380    
1381          and fload''(fty, ea, mem, d, an) =
1382              (floatingPointUsed := true;
1383               mark(I.FMOVE{fsize=fsize fty, src=address(ea,mem),
1384                            dst=RealReg d}, an)
1385              )
1386    
1387          and fiload''(ity, ea, d, an) =
1388              (floatingPointUsed := true;
1389               mark(I.FILOAD{isize=isize ity, ea=ea, dst=RealReg d}, an)
1390              )
1391    
1392          and fexpr''(e as T.FREG(_,f)) =
1393              if isFMemReg f then transFexpr e else f
1394            | fexpr'' e = transFexpr e
1395    
1396          and transFexpr e =
1397              let val fd = newFreg() in doFexpr''(64, e, fd, []); fd end
1398    
1399             (*
1400              * Process a floating point operand.  Put operand in register
1401              * when possible.  The operand should match the given fty.
1402              *)
1403          and foperand(fty, e as T.FREG(fty', f)) =
1404                 if fty = fty' then RealReg f else I.FPR(fexpr'' e)
1405            | foperand(fty, T.CVTF2F(_, _, e)) =
1406                 foperand(fty, e) (* nop on the x86 *)
1407            | foperand(fty, e as T.FLOAD(fty', ea, mem)) =
1408                 (* fold operand when the precison matches *)
1409                 if fty = fty' then address(ea, mem) else I.FPR(fexpr'' e)
1410            | foperand(fty, e) = I.FPR(fexpr'' e)
1411    
1412             (*
1413              * Process a floating point operand.
1414              * Try to fold in a memory operand or conversion from an integer.
1415              *)
1416          and fioperand(T.FREG(fty,f)) = (REAL, fty, RealReg f, [])
1417            | fioperand(T.FLOAD(fty, ea, mem)) =
1418                 (REAL, fty, address(ea, mem), [])
1419            | fioperand(T.CVTF2F(_, _, e)) = fioperand(e) (* nop on the x86 *)
1420            | fioperand(T.CVTI2F(_, ty, e)) = convertIntToFloat(ty, e)
1421            | fioperand(T.FMARK(e,an)) = fioperand(e) (* XXX *)
1422            | fioperand(e) = (REAL, 64, I.FPR(fexpr'' e), [])
1423    
1424              (* Generate binary operator.  Since the real binary operators
1425               * does not take memory as destination, we also ensure this
1426               * does not happen.
1427               *)
1428          and fbinop(targetFty,
1429                     binOp, binOpR, ibinOp, ibinOpR, lsrc, rsrc, fd, an) =
1430                  (* Put the mem operand in rsrc *)
1431              let val _ = floatingPointUsed := true;
1432                  fun isMemOpnd(T.FREG(_, f)) = isFMemReg f
1433                    | isMemOpnd(T.FLOAD _) = true
1434                    | isMemOpnd(T.CVTI2F(_, (16 | 32), _)) = true
1435                    | isMemOpnd(T.CVTF2F(_, _, t)) = isMemOpnd t
1436                    | isMemOpnd(T.FMARK(t, _)) = isMemOpnd t
1437                    | isMemOpnd _ = false
1438                  val (binOp, ibinOp, lsrc, rsrc) =
1439                      if isMemOpnd lsrc then (binOpR, ibinOpR, rsrc, lsrc)
1440                      else (binOp, ibinOp, lsrc, rsrc)
1441                  val lsrc = foperand(targetFty, lsrc)
1442                  val (kind, fty, rsrc, code) = fioperand(rsrc)
1443                  fun dstMustBeFreg f =
1444                      if targetFty <> 64 then
1445                      let val tmpR = newFreg()
1446                          val tmp  = I.FPR tmpR
1447                      in  mark(f tmp, an);
1448                          emit(I.FMOVE{fsize=fsize targetFty,
1449                                       src=tmp, dst=RealReg fd})
1450                      end
1451                      else mark(f(RealReg fd), an)
1452              in  case kind of
1453                    REAL =>
1454                      dstMustBeFreg(fn dst =>
1455                                       I.FBINOP{fsize=fsize fty, binOp=binOp,
1456                                                lsrc=lsrc, rsrc=rsrc, dst=dst})
1457                  | INTEGER =>
1458                      (dstMustBeFreg(fn dst =>
1459                                        I.FIBINOP{isize=isize fty, binOp=ibinOp,
1460                                                  lsrc=lsrc, rsrc=rsrc, dst=dst});
1461                       emits code
1462                      )
1463              end
1464    
1465          and funop(fty, unOp, src, fd, an) =
1466              let val src = foperand(fty, src)
1467              in  mark(I.FUNOP{fsize=fsize fty,
1468                               unOp=unOp, src=src, dst=RealReg fd},an)
1469              end
1470    
1471          and doFexpr''(fty, e, fd, an) =
1472              case e of
1473                T.FREG(_,fs) => if fs = fd then ()
1474                                else fcopy''(fty, [fd], [fs], an)
1475                (* Stupid x86 does everything as 80-bits internally. *)
1476    
1477                (* Binary operators *)
1478              | T.FADD(_, a, b) => fbinop(fty,
1479                                          I.FADDL, I.FADDL, I.FIADDL, I.FIADDL,
1480                                          a, b, fd, an)
1481              | T.FSUB(_, a, b) => fbinop(fty,
1482                                          I.FSUBL, I.FSUBRL, I.FISUBL, I.FISUBRL,
1483                                          a, b, fd, an)
1484              | T.FMUL(_, a, b) => fbinop(fty,
1485                                          I.FMULL, I.FMULL, I.FIMULL, I.FIMULL,
1486                                          a, b, fd, an)
1487              | T.FDIV(_, a, b) => fbinop(fty,
1488                                          I.FDIVL, I.FDIVRL, I.FIDIVL, I.FIDIVRL,
1489                                          a, b, fd, an)
1490    
1491                (* Unary operators *)
1492              | T.FNEG(_, a) => funop(fty, I.FCHS, a, fd, an)
1493              | T.FABS(_, a) => funop(fty, I.FABS, a, fd, an)
1494              | T.FSQRT(_, a) => funop(fty, I.FSQRT, a, fd, an)
1495    
1496                (* Load *)
1497              | T.FLOAD(fty,ea,mem) => fload''(fty, ea, mem, fd, an)
1498    
1499                (* Type conversions *)
1500              | T.CVTF2F(_, _, e) => doFexpr''(fty, e, fd, an)
1501              | T.CVTI2F(_, ty, e) =>
1502                let val (_, ty, ea, cleanup) = convertIntToFloat(ty, e)
1503                in  fiload''(ty, ea, fd, an);
1504                    emits cleanup
1505                end
1506    
1507              | T.FMARK(e,A.MARKREG f) => (f fd; doFexpr''(fty, e, fd, an))
1508              | T.FMARK(e, a) => doFexpr''(fty, e, fd, a::an)
1509              | T.FPRED(e, c) => doFexpr''(fty, e, fd, A.CTRLUSE c::an)
1510              | T.FEXT fexp =>
1511                 ExtensionComp.compileFext (reducer()) {e=fexp, fd=fd, an=an}
1512              | _ => error("doFexpr''")
1513    
1514           (*========================================================
1515            * Tie the two styles of fp code generation together
1516            *========================================================*)
1517          and fstore(fty, ea, d, mem, an) =
1518              if enableFastFPMode andalso !fast_floating_point
1519              then fstore''(fty, ea, d, mem, an)
1520              else fstore'(fty, ea, d, mem, an)
1521          and fload(fty, ea, d, mem, an) =
1522              if enableFastFPMode andalso !fast_floating_point
1523              then fload''(fty, ea, d, mem, an)
1524              else fload'(fty, ea, d, mem, an)
1525          and fexpr e =
1526              if enableFastFPMode andalso !fast_floating_point
1527              then fexpr'' e else fexpr' e
1528          and doFexpr(fty, e, fd, an) =
1529              if enableFastFPMode andalso !fast_floating_point
1530              then doFexpr''(fty, e, fd, an)
1531              else doFexpr'(fty, e, fd, an)
1532    
1533            (* generate code for a statement *)            (* generate code for a statement *)
1534        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)        and stmt(T.MV(_, rd, e), an) = doExpr(e, rd, an)
1535          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)          | stmt(T.FMV(fty, fd, e), an) = doFexpr(fty, e, fd, an)
# Line 1128  Line 1537 
1537          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)
1538          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)
1539          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)
1540          | stmt(T.CALL(e, flow, def, use, cdef, cuse, mem), an) =          | stmt(T.CALL{funct, targets, defs, uses, cdefs, cuses, region}, an) =
1541               call(e,flow,def,use,mem,an)               call(funct,targets,defs,uses,region,an)
1542          | stmt(T.RET _, an) = mark(I.RET NONE, an)          | stmt(T.RET _, an) = mark(I.RET NONE, an)
1543          | 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)
1544          | 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)
# Line 1138  Line 1547 
1547          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)
1548          | stmt(T.DEFINE l, _) = defineLabel l          | stmt(T.DEFINE l, _) = defineLabel l
1549          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)
1550            | stmt(T.EXT s, an) =
1551                 ExtensionComp.compileSext (reducer()) {stm=s, an=an}
1552          | stmt(s, _) = doStmts(Gen.compileStm s)          | stmt(s, _) = doStmts(Gen.compileStm s)
1553    
1554        and doStmt s = stmt(s, [])        and doStmt s = stmt(s, [])
# Line 1147  Line 1558 
1558           ((* Must be cleared by the client.           ((* Must be cleared by the client.
1559             * if rewriteMemReg then memRegsUsed := 0w0 else ();             * if rewriteMemReg then memRegsUsed := 0w0 else ();
1560             *)             *)
1561            trapLabel := NONE; beginCluster 0)            floatingPointUsed := false;
1562              trapLabel := NONE;
1563              beginCluster 0
1564             )
1565        and endCluster' a =        and endCluster' a =
1566           (case !trapLabel           (case !trapLabel
1567            of NONE => ()            of NONE => ()
1568             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))             | SOME(_, lab) => (defineLabel lab; emit(I.INTO))
1569            (*esac*);            (*esac*);
1570              (* If floating point has been used allocate an extra
1571               * register just in case we didn't use any explicit register
1572               *)
1573              if !floatingPointUsed then (newFreg(); ())
1574              else ();
1575            endCluster(a)            endCluster(a)
1576           )           )
1577    

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

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