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 601, Thu Apr 6 04:38:14 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 31  Line 31 
31  functor X86  functor X86
32    (structure X86Instr : X86INSTR    (structure X86Instr : X86INSTR
33     structure X86MLTree : MLTREE     structure X86MLTree : MLTREE
34    (* structure PseudoInstrs : X86_PSEUDO_INSTR *)     structure ExtensionComp : MLTREE_EXTENSION_COMP
35         where I = X86Instr and T = X86MLTree
36       sharing X86MLTree.Region = X86Instr.Region       sharing X86MLTree.Region = X86Instr.Region
37       sharing X86MLTree.LabelExp = X86Instr.LabelExp       sharing X86MLTree.LabelExp = X86Instr.LabelExp
      (* sharing PseudoInstrs.I = X86Instr  
      sharing PseudoInstrs.T = X86MLTree *)  
38      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII      datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII
39      val arch : arch ref      val arch : arch ref
40      val tempMem : X86Instr.operand (* temporary for CVTI2F *)      val cvti2f :
41      (* val memRegsUsed : word ref *)    (* bit mask of memRegs used *)           (* source operand, guaranteed to be non-memory! *)
42             {ty: X86MLTree.ty, src: X86Instr.operand} ->
43             {instrs : X86Instr.instruction list,(* the instructions *)
44              tempMem: X86Instr.operand,         (* temporary for CVTI2F *)
45              cleanup: X86Instr.instruction list (* cleanup code *)
46             }
47    ) : sig include MLTREECOMP    ) : sig include MLTREECOMP
48            val rewriteMemReg : bool            val rewriteMemReg : bool
49        end =        end =
# Line 54  Line 58 
58    structure A = MLRiscAnnotations    structure A = MLRiscAnnotations
59    
60    type instrStream = (I.instruction,C.regmap,C.cellset) T.stream    type instrStream = (I.instruction,C.regmap,C.cellset) T.stream
61    type ('s,'r,'f,'c) mltreeStream =    type mltreeStream = (T.stm,C.regmap,T.mlrisc list) T.stream
62       (('s,'r,'f,'c) T.stm,C.regmap,('s,'r,'f,'c) T.mlrisc list) T.stream  
63    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  
64    
65    structure Gen = MLTreeGen    structure Gen = MLTreeGen
66       (structure T = T       (structure T = T
# Line 79  Line 78 
78    val rewriteMemReg = rewriteMemReg    val rewriteMemReg = rewriteMemReg
79    fun isMemReg r = rewriteMemReg andalso r >= 8 andalso r < 32    fun isMemReg r = rewriteMemReg andalso r >= 8 andalso r < 32
80    
81      val ST0 = C.ST 0
82      val ST7 = C.ST 7
83    
84    (*    (*
85     * The code generator     * The code generator
86     *)     *)
87    fun selectInstructions    fun selectInstructions
        (T.EXTENDER{compileStm,compileRexp,compileFexp,compileCCexp,...})  
88         (instrStream as         (instrStream as
89          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,          S.STREAM{emit,defineLabel,entryLabel,pseudoOp,annotation,
90                   beginCluster,endCluster,exitBlock,alias,phi,comment,...}) =                   beginCluster,endCluster,exitBlock,alias,phi,comment,...}) =
# Line 368  Line 369 
369            | I.Indexed _  => true            | I.Indexed _  => true
370            | I.MemReg _   => true            | I.MemReg _   => true
371            | I.LabelEA _  => true            | I.LabelEA _  => true
372              | I.FDirect f  => true
373            | _            => false            | _            => false
374            )            )
375    
# Line 585  Line 587 
587    
588                   (* Generate setcc instruction:                   (* Generate setcc instruction:
589                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))                    *  semantics:  MV(rd, COND(_, T.CMP(ty, cc, t1, t2), yes, no))
590                      * Bug, if eax is either t1 or t2 then problem will occur!!!
591                      * Note that we have to use eax as the destination of the
592                      * setcc because it only works on the registers
593                      * %al, %bl, %cl, %dl and %[abcd]h.  The last four registers
594                      * are inaccessible in 32 bit mode.
595                    *)                    *)
596                fun setcc(ty, cc, t1, t2, yes, no) =                fun setcc(ty, cc, t1, t2, yes, no) =
597                let val tmpR = newReg()                let val (cc, yes, no) =
598                    val tmp = I.Direct tmpR                           if yes > no then (cc, yes, no)
599                    (* We create a temporary here just in                           else (T.Basis.negateCond cc, no, yes)
                    * case t1 or t2 contains a use of rd.  
                    *)  
600                in  (* Clear the destination first.                in  (* Clear the destination first.
601                     * This this because stupid SETcc                     * This this because stupid SETcc
602                     * only writes to the low order                     * only writes to the low order
603                     * byte.  That's Intel architecture, folks.                     * byte.  That's Intel architecture, folks.
604                     *)                     *)
605                    zero tmp;                    zero eax;
606                    case (yes, no) of                    case (yes, no) of
607                      (1, 0) => (* normal case *)                      (1, 0) => (* normal case *)
608                      let val cc = cmp(true, ty, cc, t1, t2, [])                      let val cc = cmp(true, ty, cc, t1, t2, [])
609                      in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end                      in  mark(I.SET{cond=cond cc, opnd=eax}, an);
610                    | (0, 1) => (* flip *)                          move(eax, rdOpnd)
611                      let val cc = cmp(true, ty,                      end
                                      T.Basis.negateCond cc, t1, t2, [])  
                     in  mark(I.SET{cond=cond cc, opnd=tmp}, an) end  
612                    | (C1, C2)  =>                    | (C1, C2)  =>
613                      (* general case;                      (* general case;
614                       * from the Intel optimization guide p3-5 *)                       * from the Intel optimization guide p3-5
615                      let val C1 = toInt32 C1                       *)
616                          val C2 = toInt32 C2                      let val cc = cmp(true, ty, cc, t1, t2, [])
617                          val cc = cmp(true, ty, cc, t1, t2, [])                      in  case C1-C2 of
618                      in  emit(I.SET{cond=cond cc, opnd=tmp});                            D as (1 | 2 | 3 | 4 | 5 | 8 | 9) =>
619                          case Int32.abs(C1-C2)-1 of                            let val (base,scale) =
620                            D as (1 | 2 | 4 | 8) =>                                    case D of
621                            let val addr = I.Indexed{base=SOME tmpR,                                      1 => (NONE, 0)
622                                                     index=tmpR,                                    | 2 => (NONE, 1)
623                                                     scale=Int32.toInt D,                                    | 3 => (SOME C.eax, 1)
624                                                     disp=I.Immed(C1-C2),                                    | 4 => (NONE, 2)
625                                      | 5 => (SOME C.eax, 2)
626                                      | 8 => (NONE, 3)
627                                      | 9 => (SOME C.eax, 3)
628                                  val addr = I.Indexed{base=base,
629                                                       index=C.eax,
630                                                       scale=scale,
631                                                       disp=I.Immed C2,
632                                                     mem=readonly}                                                     mem=readonly}
633                            in  mark(I.LEA{r32=tmpR, addr=addr}, an) end                                val tmpR = newReg()
634                          | _ =>                                val tmp  = I.Direct tmpR
635                           (emit(I.UNARY{unOp=I.DECL, opnd=tmp});                            in  emit(I.SET{cond=cond cc, opnd=eax});
636                                  mark(I.LEA{r32=tmpR, addr=addr}, an);
637                                  move(tmp, rdOpnd)
638                              end
639                            | D =>
640                               (emit(I.SET{cond=cond(T.Basis.negateCond cc),
641                                           opnd=eax});
642                                emit(I.UNARY{unOp=I.DECL, opnd=eax});
643                            emit(I.BINARY{binOp=I.ANDL,                            emit(I.BINARY{binOp=I.ANDL,
644                                          src=I.Immed(C2-C1), dst=tmp});                                            src=I.Immed D, dst=eax});
645                            mark(I.BINARY{binOp=I.ADDL,                              if C2 = 0 then
646                                          src=I.Immed(Int32.min(C1,C2)),                                 move(eax, rdOpnd)
647                                          dst=tmp}, an)                              else
648                           )                                 let val tmpR = newReg()
649                      end;                                     val tmp  = I.Direct tmpR
650                                   in  mark(I.LEA{addr=
651                                             I.Displace{
652                                                 base=C.eax,
653                                                 disp=I.Immed C2,
654                                                 mem=readonly},
655                                                 r32=tmpR}, an);
656                    move(tmp, rdOpnd)                    move(tmp, rdOpnd)
657                                    end
658                               )
659                        end
660                end (* setcc *)                end (* setcc *)
661    
662                    (* Generate cmovcc instruction.                    (* Generate cmovcc instruction.
# Line 655  Line 681 
681    
682                    (* Add n to rd *)                    (* Add n to rd *)
683                fun addN n =                fun addN n =
684                  mark(I.BINARY{binOp=I.ADDL, src=I.Immed(toInt32 n),                let val n = operand n
685                                dst=rdOpnd}, an)                    val src = if isMemReg rd then immedOrReg n else n
686                  in  mark(I.BINARY{binOp=I.ADDL, src=src, dst=rdOpnd}, an) end
687    
688            in  case exp of            in  case exp of
689                 T.REG(_,rs) =>                 T.REG(_,rs) =>
# Line 682  Line 709 
709               | 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)
710               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)
711               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)
712               | T.ADD(32, e1 as T.REG(_, rs), e2 as T.LI n) =>               | T.ADD(32, e1 as T.REG(_, rs), e2) =>
713                    if rs = rd then addN n else addition(e1, e2)                    if rs = rd then addN e2 else addition(e1, e2)
714               | T.ADD(32, e1 as T.LI n, e2 as T.REG(_, rs)) =>               | T.ADD(32, e1, e2 as T.REG(_,rs)) =>
715                    if rs = rd then addN n else addition(e1, e2)                    if rs = rd then addN e1 else addition(e1, e2)
716               | T.ADD(32, e1, e2) => addition(e1, e2)               | T.ADD(32, e1, e2) => addition(e1, e2)
717    
718                 (* 32-bit subtraction *)                 (* 32-bit subtraction *)
# Line 731  Line 758 
758               | 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)
759    
760               | 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) =>
761                   setcc(ty, cc, t1, t2, yes, no)                   setcc(ty, cc, t1, t2, toInt32 yes, toInt32 no)
762                 | T.COND(32, T.CMP(ty, cc, t1, t2), T.LI32 yes, T.LI32 no) =>
763                     setcc(ty, cc, t1, t2, Word32.toLargeIntX yes,
764                                           Word32.toLargeIntX no)
765               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>
766                  (case !arch of (* PentiumPro and higher has CMOVcc *)                  (case !arch of (* PentiumPro and higher has CMOVcc *)
767                     Pentium => unknownExp exp                     Pentium => unknownExp exp
# Line 741  Line 771 
771               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))
772               | T.MARK(e, a) => doExpr(e, rd, a::an)               | T.MARK(e, a) => doExpr(e, rd, a::an)
773               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)
774               | T.REXT e => compileRexp (reducer()) {e=e, rd=rd, an=an}               | T.REXT e =>
775                     ExtensionComp.compileRext (reducer()) {e=e, rd=rd, an=an}
776                 (* simplify and try again *)                 (* simplify and try again *)
777               | exp => unknownExp exp               | exp => unknownExp exp
778            end (* doExpr *)            end (* doExpr *)
# Line 802  Line 833 
833          | 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))
834          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)
835          | doCCexpr(T.CCEXT e, cd, an) =          | doCCexpr(T.CCEXT e, cd, an) =
836             compileCCexp (reducer()) {e=e, cd=cd, an=an}             ExtensionComp.compileCCext (reducer()) {e=e, ccd=cd, an=an}
837          | doCCexpr _ = error "doCCexpr"          | doCCexpr _ = error "doCCexpr"
838    
839       and ccExpr e = error "ccExpr"       and ccExpr e = error "ccExpr"
# Line 915  Line 946 
946                    emit(I.FUCOMPP)                    emit(I.FUCOMPP)
947                end                end
948                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})
949                  fun testil i = emit(I.TESTL{lsrc=eax,rsrc=I.Immed(i)})
950                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})
951                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})
952                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)
# Line 925  Line 957 
957                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))
958                     | T.?    => (sahf(); j(I.P,lab))                     | T.?    => (sahf(); j(I.P,lab))
959                     | T.<=>  => (sahf(); j(I.NP,lab))                     | T.<=>  => (sahf(); j(I.NP,lab))
960                     | T.>    => (andil 0x4500;  j(I.EQ,lab))                     | T.>    => (testil 0x4500;  j(I.EQ,lab))
961                     | T.?<=  => (andil 0x4500;  j(I.NE,lab))                     | T.?<=  => (testil 0x4500;  j(I.NE,lab))
962                     | T.>=   => (andil 0x500; j(I.EQ,lab))                     | T.>=   => (testil 0x500; j(I.EQ,lab))
963                     | T.?<   => (andil 0x500; j(I.NE,lab))                     | T.?<   => (testil 0x500; j(I.NE,lab))
964                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))
965                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))
966                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);
967                                  cmpil 0x4000; j(I.EQ,lab))                                  cmpil 0x4000; j(I.EQ,lab))
968                     | T.?>   => (sahf(); j(I.P,lab); andil 0x4100; j(I.EQ,lab))                     | T.?>   => (sahf(); j(I.P,lab); testil 0x4100; j(I.EQ,lab))
969                     | T.<>   => (andil 0x4400; j(I.EQ,lab))                     | T.<>   => (testil 0x4400; j(I.EQ,lab))
970                     | T.?=   => (andil 0x4400; j(I.NE,lab))                     | T.?=   => (testil 0x4400; j(I.NE,lab))
971                     | _      => error "fbranch"                     | _      => error "fbranch"
972                   (*esac*)                   (*esac*)
973            in  compare(); emit I.FNSTSW; branch()            in  compare(); emit I.FNSTSW; branch()
# Line 943  Line 975 
975    
976        and fld(32, opnd) = I.FLDS opnd        and fld(32, opnd) = I.FLDS opnd
977          | fld(64, opnd) = I.FLDL opnd          | fld(64, opnd) = I.FLDL opnd
978            | fld(80, opnd) = I.FLDT opnd
979          | fld _         = error "fld"          | fld _         = error "fld"
980    
981          and fild(16, opnd) = I.FILD opnd
982            | fild(32, opnd) = I.FILDL opnd
983            | fild(64, opnd) = I.FILDLL opnd
984            | fild _         = error "fild"
985    
986          and fxld(INTEGER, ty, opnd) = fild(ty, opnd)
987            | fxld(REAL, fty, opnd) = fld(fty, opnd)
988    
989        and fstp(32, opnd) = I.FSTPS opnd        and fstp(32, opnd) = I.FSTPS opnd
990          | fstp(64, opnd) = I.FSTPL opnd          | fstp(64, opnd) = I.FSTPL opnd
991            | fstp(80, opnd) = I.FSTPT opnd
992          | fstp _         = error "fstp"          | fstp _         = error "fstp"
993    
994            (* generate code for floating point stores *)            (* generate code for floating point stores *)
# Line 957  Line 999 
999             mark(fstp(fty, address(ea, mem)), an)             mark(fstp(fty, address(ea, mem)), an)
1000            )            )
1001    
1002        and fexpr e = error "fexpr"        and fexpr e = (reduceFexp(64, e, []); C.ST(0))
1003    
1004            (* generate floating point expression and put the result in fd *)            (* generate floating point expression and put the result in fd *)
1005        and doFexpr(fty, T.FREG(_, fs), fd, an) =        and doFexpr(fty, T.FREG(_, fs), fd, an) =
# Line 980  Line 1022 
1022             * and put result in %ST(0).             * and put result in %ST(0).
1023             *)             *)
1024        and reduceFexp(fty, fexp, an)  =        and reduceFexp(fty, fexp, an)  =
1025            let val ST = I.FDirect(C.ST 0)            let val ST = I.ST(C.ST 0)
1026                val ST1 = I.FDirect(C.ST 1)                val ST1 = I.ST(C.ST 1)
1027                  val cleanupCode = ref [] : I.instruction list ref
1028                datatype su_numbers =  
1029                  LEAF of int                datatype su_tree =
1030                | BINARY of int * su_numbers * su_numbers                  LEAF of int * T.fexp * ans
1031                | UNARY of int * su_numbers                | BINARY of int * T.fty * fbinop * su_tree * su_tree * ans
1032                  | UNARY of int * T.fty * I.funOp * su_tree * ans
1033                datatype direction = LEFT | RIGHT                and fbinop = FADD | FSUB | FMUL | FDIV
1034                             | FIADD | FISUB | FIMUL | FIDIV
1035                fun label(LEAF n) = n                withtype ans = Annotations.annotations
1036                  | label(BINARY(n, _, _)) = n  
1037                  | label(UNARY(n, _)) = n                fun label(LEAF(n, _, _)) = n
1038                    | label(BINARY(n, _, _, _, _, _)) = n
1039               (* Generate tree of sethi-ullman numbers *)                  | label(UNARY(n, _, _, _, _)) = n
1040                fun suBinary(t1, t2) =  
1041                    let val su1 = suNumbering(t1, LEFT)                fun annotate(LEAF(n, x, an), a)  = LEAF(n,x,a::an)
1042                        val su2 = suNumbering(t2, RIGHT)                  | annotate(BINARY(n,t,b,x,y,an), a) = BINARY(n,t,b,x,y,a::an)
1043                        val n1 = label su1                  | annotate(UNARY(n,t,u,x,an), a) = UNARY(n,t,u,x,a::an)
1044                        val n2 = label su2  
1045                    in  BINARY(if n1=n2 then n1+1 else Int.max(n1, n2), su1, su2)                (* Generate expression tree with sethi-ullman numbers *)
1046                    end                fun su(e as T.FREG _)       = LEAF(1, e, [])
1047                    | su(e as T.FLOAD _)      = LEAF(1, e, [])
1048                and suUnary(t) =                  | su(e as T.CVTI2F _)     = LEAF(1, e, [])
1049                    let val su = suNumbering(t, LEFT)                  | su(T.CVTF2F(_, _, t))   = su t
1050                    in  UNARY(label su, su)                  | su(T.FMARK(t, a))       = annotate(su t, a)
1051                    end                  | su(T.FABS(fty, t))      = suUnary(fty, I.FABS, t)
1052                    | su(T.FNEG(fty, t))      = suUnary(fty, I.FCHS, t)
1053                and suNumbering(T.FREG _, LEFT) = LEAF 1                  | su(T.FSQRT(fty, t))     = suUnary(fty, I.FSQRT, t)
1054                  | suNumbering(T.FREG _, RIGHT) = LEAF 0                  | su(T.FADD(fty, t1, t2)) = suComBinary(fty,FADD,FIADD,t1,t2)
1055                  | suNumbering(T.FLOAD _, LEFT) = LEAF 1                  | su(T.FMUL(fty, t1, t2)) = suComBinary(fty,FMUL,FIMUL,t1,t2)
1056                  | suNumbering(T.FLOAD _, RIGHT) = LEAF 0                  | su(T.FSUB(fty, t1, t2)) = suBinary(fty,FSUB,FISUB,t1,t2)
1057                  | suNumbering(T.FADD(_, t1, t2), _) = suBinary(t1, t2)                  | su(T.FDIV(fty, t1, t2)) = suBinary(fty,FDIV,FIDIV,t1,t2)
1058                  | suNumbering(T.FMUL(_, t1, t2), _) = suBinary(t1, t2)                  | su _ = error "su"
1059                  | suNumbering(T.FSUB(_, t1, t2), _) = suBinary(t1, t2)  
1060                  | suNumbering(T.FDIV(_, t1, t2), _) = suBinary(t1, t2)                (* Try to fold the the memory operand or integer conversion *)
1061                  | suNumbering(T.FABS(_,t), _) = suUnary(t)                and suFold(e as T.FREG _) = (LEAF(0, e, []), false)
1062                  | suNumbering(T.FNEG(_,t), _) = suUnary(t)                  | suFold(e as T.FLOAD _) = (LEAF(0, e, []), false)
1063                  | suNumbering(T.CVTI2F _, _) = UNARY(1, LEAF 0)                  | suFold(e as T.CVTI2F(_,(16 | 32),_)) = (LEAF(0, e, []), true)
1064                  | suNumbering(T.CVTF2F(_,_,t), _) = suUnary t                  | suFold(T.CVTF2F(_, _, t)) = suFold t
1065                  | suNumbering(T.FMARK(e,a),x) = suNumbering(e,x)                  | suFold(T.FMARK(t, a)) =
1066                  | suNumbering _ = error "suNumbering"                    let val (t, integer) = suFold t
1067                      in  (annotate(t, a), integer) end
1068                fun leafEA(T.FREG(fty, f)) = (fty, I.FDirect f)                  | suFold e = (su e, false)
1069                  | leafEA(T.FLOAD(fty, ea, mem)) = (fty, address(ea, mem))  
1070                  | leafEA _ = error "leafEA"                (* Can the tree be folded into the src operand? *)
1071                  and foldable(T.FREG _) = true
1072                fun cvti2d(t,an) =                  | foldable(T.FLOAD _) = true
1073                let val opnd = operand t                  | foldable(T.CVTI2F(_, (16 | 32), _)) = true
1074                    fun doMemOpnd () =                  | foldable(T.CVTF2F(_, _, t)) = foldable t
1075                        (emit(I.MOVE{mvOp=I.MOVL, src=opnd, dst=tempMem});                  | foldable(T.FMARK(t, _)) = foldable t
1076                         mark(I.FILD tempMem,an))                  | foldable _ = false
1077                in  case opnd of  
1078                      I.Direct _ => doMemOpnd()                (* Form unary tree *)
1079                    | I.Immed _ => doMemOpnd()                and suUnary(fty, funary, t) =
1080                    | _ => mark(I.FILD opnd, an)                    let val t = su t
1081                end                    in  UNARY(label t, fty, funary, t, [])
1082                      end
1083                (* traverse expression and su-number tree *)  
1084                fun gencode(_, LEAF 0, an) = ()                (* Form binary tree *)
1085                  | gencode(T.FMARK(e,a), x, an) = gencode(e, x, a::an)                and suBinary(fty, binop, ibinop, t1, t2) =
1086                  | gencode(f, LEAF 1, an) = mark(fld(leafEA f), an)                    let val t1 = su t1
1087                  | gencode(t, BINARY(_, su1, LEAF 0), an) =                        val (t2, integer) = suFold t2
1088                    let (* optimize the common case when both operands                        val n1 = label t1
1089                         * are equal *)                        val n2 = label t2
1090                        fun sameEA(T.FREG(t1, f1), T.FREG(t2, f2)) =                        val n  = if n1=n2 then n1+1 else Int.max(n1,n2)
1091                              t1 = t2 andalso f1 = f2                        val myOp = if integer then ibinop else binop
1092                          | sameEA _ = false                    in  BINARY(n, fty, myOp, t1, t2, [])
1093                        fun doit(oper, t1, t2) =                    end
1094                           (gencode(t1, su1, []);  
1095                            mark(I.FBINARY{binOp=oper,                (* Try to fold in the operand if possible.
1096                                           src=if sameEA(t1, t2) then ST                 * This only applies to commutative operations.
1097                                               else #2(leafEA t2),                 *)
1098                                           dst=ST}, an)                and suComBinary(fty, binop, ibinop, t1, t2) =
1099                           )                    let val (t1, t2) = if foldable t2 then (t1, t2) else (t2, t1)
1100                    in                    in  suBinary(fty, binop, ibinop, t1, t2) end
1101                      case t of  
1102                         T.FADD(_, t1, t2) => doit(I.FADD, t1, t2)                and sameTree(LEAF(_, T.FREG(t1,f1), []),
1103                       | T.FMUL(_, t1, t2) => doit(I.FMUL, t1, t2)                             LEAF(_, T.FREG(t2,f2), [])) = t1=t2 andalso f1=f2
1104                       | T.FSUB(_, t1, t2) => doit(I.FSUB, t1, t2)                  | sameTree _ = false
1105                       | T.FDIV(_, t1, t2) => doit(I.FDIV, t1, t2)  
1106                       | _ => error "gencode.BINARY"                (* Traverse tree and generate code *)
1107                    end                fun gencode(LEAF(_, t, an)) = mark(fxld(leafEA t), an)
1108                  | gencode(fexp, BINARY(fty, su1, su2), an) =                  | gencode(BINARY(_, _, binop, x, t2 as LEAF(0, y, a1), a2)) =
1109                    let fun doit(t1, t2, oper, operP, operRP) = let                    let val _          = gencode x
1110                       (* oper[P] =>  ST(1) := ST oper ST(1); [pop]                        val (_, fty, src) = leafEA y
1111                          fun gen(code) = mark(code, a1 @ a2)
1112                          fun binary(oper32, oper64) =
1113                              if sameTree(x, t2) then
1114                                 gen(I.FBINARY{binOp=oper64, src=ST, dst=ST})
1115                              else
1116                                 let val oper =
1117                                       if isMemOpnd src then
1118                                          case fty of
1119                                            32 => oper32
1120                                          | 64 => oper64
1121                                          | _  => error "gencode: BINARY"
1122                                       else oper64
1123                                 in gen(I.FBINARY{binOp=oper, src=src, dst=ST}) end
1124                          fun ibinary(oper16, oper32) =
1125                              let val oper = case fty of
1126                                               16 => oper16
1127                                             | 32 => oper32
1128                                             | _  => error "gencode: IBINARY"
1129                              in  gen(I.FIBINARY{binOp=oper, src=src}) end
1130                      in  case binop of
1131                            FADD => binary(I.FADDS, I.FADDL)
1132                          | FSUB => binary(I.FDIVS, I.FSUBL)
1133                          | FMUL => binary(I.FMULS, I.FMULL)
1134                          | FDIV => binary(I.FDIVS, I.FDIVL)
1135                          | FIADD => ibinary(I.FIADDS, I.FIADDL)
1136                          | FISUB => ibinary(I.FIDIVS, I.FISUBL)
1137                          | FIMUL => ibinary(I.FIMULS, I.FIMULL)
1138                          | FIDIV => ibinary(I.FIDIVS, I.FIDIVL)
1139                      end
1140                    | gencode(BINARY(_, fty, binop, t1, t2, an)) =
1141                      let fun doit(t1, t2, oper, operP, operRP) =
1142                          let (* oper[P] =>  ST(1) := ST oper ST(1); [pop]
1143                        * operR[P] => ST(1) := ST(1) oper ST; [pop]                        * operR[P] => ST(1) := ST(1) oper ST; [pop]
1144                        *)                        *)
1145                        val n1 = label su1                             val n1 = label t1
1146                        val n2 = label su2                             val n2 = label t2
1147                      in                        in if n1 < n2 andalso n1 <= 7 then
1148                        if n1 < n2 andalso n1 <= 7 then                             (gencode t2;
1149                          (gencode(t2, su2, []);                              gencode t1;
                          gencode(t1, su1, []);  
1150                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))
1151                        else if n2 <= n1 andalso n2 <= 7 then                        else if n2 <= n1 andalso n2 <= 7 then
1152                          (gencode(t1, su1, []);                             (gencode t1;
1153                           gencode(t2, su2, []);                              gencode t2;
1154                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))
1155                        else let (* both labels > 7 *)                           else
1156                             let (* both labels > 7 *)
1157                            val fs = I.FDirect(newFreg())                            val fs = I.FDirect(newFreg())
1158                          in                           in  gencode t2;
                           gencode (t2, su2, []);  
1159                            emit(fstp(fty, fs));                            emit(fstp(fty, fs));
1160                            gencode (t1, su1, []);                               gencode t1;
1161                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)
1162                          end                          end
1163                      end                      end
1164                    in                    in case binop of
1165                      case fexp                         FADD => doit(t1,t2,I.FADDL,I.FADDP,I.FADDP)
1166                      of T.FADD(_, t1, t2) => doit(t1, t2,I.FADD,I.FADDP,I.FADDP)                       | FMUL => doit(t1,t2,I.FMULL,I.FMULP,I.FMULP)
1167                       | T.FMUL(_, t1, t2) => doit(t1, t2,I.FMUL,I.FMULP,I.FMULP)                       | FSUB => doit(t1,t2,I.FSUBL,I.FSUBP,I.FSUBRP)
1168                       | 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)  
1169                       | _ => error "gencode.BINARY"                       | _ => error "gencode.BINARY"
1170                    end                    end
1171                  | gencode(fexp, UNARY(_, LEAF 0), an) =                  | gencode(UNARY(_, _, unaryOp, su, an)) =
1172                    (case fexp                     (gencode(su); mark(I.FUNARY(unaryOp),an))
                     of T.FABS(fty, t) =>  
                          (emit(fld(leafEA t)); mark(I.FUNARY(I.FABS),an))  
                      | T.FNEG(fty, t) =>  
                          (emit(fld(leafEA t)); mark(I.FUNARY(I.FCHS),an))  
                      | T.CVTI2F(_,_,t) => cvti2d(t,an) (* XXX *)  
                      | _ => error "gencode.UNARY"  
                    (*esac*))  
                 | gencode(fexp, UNARY(_, su), an) =  
                   let fun doit(oper, t) =  
                        (gencode(t, su, []); mark(I.FUNARY(oper),an))  
                   in case fexp  
                      of T.FABS(_, t) => doit(I.FABS, t)  
                       | T.FNEG(_, t) => doit(I.FCHS, t)  
                       | T.CVTF2F(_,_,t) => gencode(t, su, an)  
                       | T.CVTI2F _ => error "gencode:UNARY:cvti2f"  
                       | _ => error "gencode.UNARY"  
                   end  
                 | gencode _ = error "gencode"  
1173    
1174                val labels = suNumbering(fexp, LEFT)                (* Generate code for a leaf.
1175            in  gencode(fexp, labels, an)                 * Returns the type and an effective address
1176                   *)
1177                  and leafEA(T.FREG(fty, f)) = (REAL, fty, I.FDirect f)
1178                    | leafEA(T.FLOAD(fty, ea, mem)) = (REAL, fty, address(ea, mem))
1179                    | leafEA(T.CVTI2F(_, 32, t)) = int2real(32, t)
1180                    | leafEA(T.CVTI2F(_, 16, t)) = int2real(16, t)
1181                    | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, t)
1182                    | leafEA _ = error "leafEA"
1183    
1184                  (* Move integer t of size ty into a memory location *)
1185                  and int2real(ty, t) =
1186                      let val opnd = operand t
1187                      in  if isMemOpnd opnd andalso (ty = 16 orelse ty = 32)
1188                          then (INTEGER, ty, opnd)
1189                          else
1190                            let val {instrs, tempMem, cleanup} =
1191                                       cvti2f{ty=ty, src=opnd}
1192                            in  app emit instrs;
1193                                cleanupCode := !cleanupCode @ cleanup;
1194                                (INTEGER, 32, tempMem)
1195                            end
1196                      end
1197              in  gencode(su fexp);
1198                  app emit(!cleanupCode)
1199            end (*reduceFexp*)            end (*reduceFexp*)
1200    
1201            (* generate code for a statement *)            (* generate code for a statement *)
# Line 1128  Line 1205 
1205          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)
1206          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)
1207          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)
1208          | stmt(T.CALL(e, flow, def, use, cdef, cuse, mem), an) =          | stmt(T.CALL{funct, targets, defs, uses, cdefs, cuses, region}, an) =
1209               call(e,flow,def,use,mem,an)               call(funct,targets,defs,uses,region,an)
1210          | stmt(T.RET _, an) = mark(I.RET NONE, an)          | stmt(T.RET _, an) = mark(I.RET NONE, an)
1211          | 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)
1212          | 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 1215 
1215          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)
1216          | stmt(T.DEFINE l, _) = defineLabel l          | stmt(T.DEFINE l, _) = defineLabel l
1217          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)
1218            | stmt(T.EXT s, an) =
1219                 ExtensionComp.compileSext (reducer()) {stm=s, an=an}
1220          | stmt(s, _) = doStmts(Gen.compileStm s)          | stmt(s, _) = doStmts(Gen.compileStm s)
1221    
1222        and doStmt s = stmt(s, [])        and doStmt s = stmt(s, [])

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

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