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 651, Thu Jun 1 18:34:03 2000 UTC revision 744, Fri Dec 8 04:11:42 2000 UTC
# 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 44  Line 53 
53            tempMem: X86Instr.operand,         (* temporary for CVTI2F *)            tempMem: X86Instr.operand,         (* temporary for CVTI2F *)
54            cleanup: X86Instr.instruction list (* cleanup code *)            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 57  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 76  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 87  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 115  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 122  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 129  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 175  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 194  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 287  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 299  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 380  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 602  Line 679 
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 eax;                    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=eax}, an);                      in  mark(I.SET{cond=cond cc, opnd=eax}, an);
697                            emit(I.BINARY{binOp=I.ANDL,src=I.Immed 255, dst=eax});
698                          move(eax, rdOpnd)                          move(eax, rdOpnd)
699                      end                      end
700                    | (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                       *)                       *)
704                      let val cc = cmp(true, ty, cc, t1, t2, [])                      let val _  = zero eax;
705                            val cc = cmp(true, ty, cc, t1, t2, [])
706                      in  case C1-C2 of                      in  case C1-C2 of
707                            D as (1 | 2 | 3 | 4 | 5 | 8 | 9) =>                            D as (1 | 2 | 3 | 4 | 5 | 8 | 9) =>
708                            let val (base,scale) =                            let val (base,scale) =
# Line 682  Line 771 
771                    (* Generate addition *)                    (* Generate addition *)
772                fun addition(e1, e2) =                fun addition(e1, e2) =
773                    case e1 of                    case e1 of
774                      T.REG(_,rs) => if rs = rd then addN e2 else addition1(e1,e2)                      T.REG(_,rs) => if C.sameColor(rs,rd) then addN e2
775                                       else addition1(e1,e2)
776                    | _ => addition1(e1,e2)                    | _ => addition1(e1,e2)
777                and addition1(e1, e2) =                and addition1(e1, e2) =
778                    case e2 of                    case e2 of
779                      T.REG(_,rs) => if rs = rd then addN e1 else addition2(e1,e2)                      T.REG(_,rs) => if C.sameColor(rs,rd) then addN e1
780                                       else addition2(e1,e2)
781                    | _ => addition2(e1,e2)                    | _ => addition2(e1,e2)
782                and addition2(e1,e2) =                and addition2(e1,e2) =
783                  (dstMustBeReg(fn (dstR, _) =>                  (dstMustBeReg(fn (dstR, _) =>
# Line 698  Line 789 
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 720  Line 811 
811               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)
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 759  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, toInt32 yes, toInt32 no)                   setcc(ty, cc, t1, t2, toInt32 yes, toInt32 no)
# Line 797  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 821  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 848  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 899  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 917  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 933  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)})                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))
# Line 975  Line 1115 
1115                     | T.?=   => (testil 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
1151            end            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
1160          | fld(80, opnd) = I.FLDT opnd          | fld(80, opnd) = I.FLDT opnd
# Line 997  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 = (reduceFexp(64, e, []); C.ST(0))            (* 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                  if fd = ST0 then () else 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               if fd = ST0 then () else 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 1072  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 1101  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 1186  Line 1367 
1367                  | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, 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, 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  
                         let val {instrs, tempMem, cleanup} =  
                                    cvti2f{ty=ty, src=opnd}  
                         in  app emit instrs;  
                             cleanupCode := !cleanupCode @ cleanup;  
                             (INTEGER, 32, tempMem)  
                         end  
1374                    end                    end
1375    
1376            in  gencode(su fexp);            in  gencode(su fexp);
1377                app emit(!cleanupCode)               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{funct, targets, defs, uses, cdefs, cuses, region}, an) =          | stmt(T.CALL{funct, targets, defs, uses, region, ...}, an) =
1556               call(funct,targets,defs,uses,region,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 1231  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 1263  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.651  
changed lines
  Added in v.744

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