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 624, Fri Apr 21 03:06:21 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 453  Line 455 
455                fun divrem(signed, overflow, e1, e2, resultReg) =                fun divrem(signed, overflow, e1, e2, resultReg) =
456                let val (opnd1, opnd2) = (operand e1, operand e2)                let val (opnd1, opnd2) = (operand e1, operand e2)
457                    val _ = move(opnd1, eax)                    val _ = move(opnd1, eax)
458                    val oper = if signed then (emit(I.CDQ); I.IDIV)                    val oper = if signed then (emit(I.CDQ); I.IDIVL)
459                               else (zero edx; I.UDIV)                               else (zero edx; I.DIVL)
460                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);                in  mark(I.MULTDIV{multDivOp=oper, src=regOrMem opnd2},an);
461                    move(resultReg, rdOpnd);                    move(resultReg, rdOpnd);
462                    if overflow then trap() else ()                    if overflow then trap() else ()
# Line 507  Line 509 
509                fun uMultiply(e1, e2) =                fun uMultiply(e1, e2) =
510                    (* note e2 can never be (I.Direct edx) *)                    (* note e2 can never be (I.Direct edx) *)
511                    (move(operand e1, eax);                    (move(operand e1, eax);
512                     mark(I.MULTDIV{multDivOp=I.UMUL,                     mark(I.MULTDIV{multDivOp=I.MULL,
513                                    src=regOrMem(operand e2)},an);                                    src=regOrMem(operand e2)},an);
514                     move(eax, rdOpnd)                     move(eax, rdOpnd)
515                    )                    )
# 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 647  Line 673 
673    
674                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)                fun unknownExp exp = doExpr(Gen.compileRexp exp, rd, an)
675    
676                      (* Add n to rd *)
677                  fun addN n =
678                  let val n = operand n
679                      val src = if isMemReg rd then immedOrReg n else n
680                  in  mark(I.BINARY{binOp=I.ADDL, src=src, dst=rdOpnd}, an) end
681    
682                    (* Generate addition *)                    (* Generate addition *)
683                fun addition(e1, e2) =                fun addition(e1, e2) =
684                      case e1 of
685                        T.REG(_,rs) => if rs = rd then addN e2 else addition1(e1,e2)
686                      | _ => addition1(e1,e2)
687                  and addition1(e1, e2) =
688                      case e2 of
689                        T.REG(_,rs) => if rs = rd then addN e1 else addition2(e1,e2)
690                      | _ => addition2(e1,e2)
691                  and addition2(e1,e2) =
692                  (dstMustBeReg(fn (dstR, _) =>                  (dstMustBeReg(fn (dstR, _) =>
693                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))                      mark(I.LEA{r32=dstR, addr=address(exp, readonly)}, an))
694                  handle EA => binaryComm(I.ADDL, e1, e2))                  handle EA => binaryComm(I.ADDL, e1, e2))
695    
                   (* Add n to rd *)  
               fun addN n =  
                 mark(I.BINARY{binOp=I.ADDL, src=I.Immed(toInt32 n),  
                               dst=rdOpnd}, an)  
696    
697            in  case exp of            in  case exp of
698                 T.REG(_,rs) =>                 T.REG(_,rs) =>
# Line 682  Line 718 
718               | 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)
719               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)               | T.ADD(32, e, T.LI ~1) => unary(I.DECL, e)
720               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)               | T.ADD(32, T.LI ~1, e) => unary(I.DECL, e)
              | T.ADD(32, e1 as T.REG(_, rs), e2 as T.LI n) =>  
                   if rs = rd then addN n else addition(e1, e2)  
              | T.ADD(32, e1 as T.LI n, e2 as T.REG(_, rs)) =>  
                   if rs = rd then addN n else addition(e1, e2)  
721               | T.ADD(32, e1, e2) => addition(e1, e2)               | T.ADD(32, e1, e2) => addition(e1, e2)
722    
723                 (* 32-bit subtraction *)                 (* 32-bit subtraction *)
# Line 731  Line 763 
763               | 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)
764    
765               | 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) =>
766                   setcc(ty, cc, t1, t2, yes, no)                   setcc(ty, cc, t1, t2, toInt32 yes, toInt32 no)
767                 | T.COND(32, T.CMP(ty, cc, t1, t2), T.LI32 yes, T.LI32 no) =>
768                     setcc(ty, cc, t1, t2, Word32.toLargeIntX yes,
769                                           Word32.toLargeIntX no)
770               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>               | T.COND(32, T.CMP(ty, cc, t1, t2), yes, no) =>
771                  (case !arch of (* PentiumPro and higher has CMOVcc *)                  (case !arch of (* PentiumPro and higher has CMOVcc *)
772                     Pentium => unknownExp exp                     Pentium => unknownExp exp
# Line 741  Line 776 
776               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))               | T.MARK(e, A.MARKREG f) => (f rd; doExpr(e, rd, an))
777               | T.MARK(e, a) => doExpr(e, rd, a::an)               | T.MARK(e, a) => doExpr(e, rd, a::an)
778               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)               | T.PRED(e,c) => doExpr(e, rd, A.CTRLUSE c::an)
779               | T.REXT e => compileRexp (reducer()) {e=e, rd=rd, an=an}               | T.REXT e =>
780                     ExtensionComp.compileRext (reducer()) {e=e, rd=rd, an=an}
781                 (* simplify and try again *)                 (* simplify and try again *)
782               | exp => unknownExp exp               | exp => unknownExp exp
783            end (* doExpr *)            end (* doExpr *)
# Line 802  Line 838 
838          | 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))
839          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)          | doCCexpr(T.CCMARK(e,a), rd, an) = doCCexpr(e,rd,a::an)
840          | doCCexpr(T.CCEXT e, cd, an) =          | doCCexpr(T.CCEXT e, cd, an) =
841             compileCCexp (reducer()) {e=e, cd=cd, an=an}             ExtensionComp.compileCCext (reducer()) {e=e, ccd=cd, an=an}
842          | doCCexpr _ = error "doCCexpr"          | doCCexpr _ = error "doCCexpr"
843    
844       and ccExpr e = error "ccExpr"       and ccExpr e = error "ccExpr"
# Line 915  Line 951 
951                    emit(I.FUCOMPP)                    emit(I.FUCOMPP)
952                end                end
953                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})
954                  fun testil i = emit(I.TESTL{lsrc=eax,rsrc=I.Immed(i)})
955                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})
956                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})                fun cmpil i = emit(I.CMPL{rsrc=I.Immed(i), lsrc=eax})
957                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 962 
962                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))                     | T.?<>  => (andil 0x4400; xoril 0x4000; j(I.NE, lab))
963                     | T.?    => (sahf(); j(I.P,lab))                     | T.?    => (sahf(); j(I.P,lab))
964                     | T.<=>  => (sahf(); j(I.NP,lab))                     | T.<=>  => (sahf(); j(I.NP,lab))
965                     | T.>    => (andil 0x4500;  j(I.EQ,lab))                     | T.>    => (testil 0x4500;  j(I.EQ,lab))
966                     | T.?<=  => (andil 0x4500;  j(I.NE,lab))                     | T.?<=  => (testil 0x4500;  j(I.NE,lab))
967                     | T.>=   => (andil 0x500; j(I.EQ,lab))                     | T.>=   => (testil 0x500; j(I.EQ,lab))
968                     | T.?<   => (andil 0x500; j(I.NE,lab))                     | T.?<   => (testil 0x500; j(I.NE,lab))
969                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))                     | T.<    => (andil 0x4500; cmpil 0x100; j(I.EQ,lab))
970                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))                     | T.?>=  => (andil 0x4500; cmpil 0x100; j(I.NE,lab))
971                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);                     | T.<=   => (andil 0x4100; cmpil 0x100; j(I.EQ,lab);
972                                  cmpil 0x4000; j(I.EQ,lab))                                  cmpil 0x4000; j(I.EQ,lab))
973                     | T.?>   => (sahf(); j(I.P,lab); andil 0x4100; j(I.EQ,lab))                     | T.?>   => (sahf(); j(I.P,lab); testil 0x4100; j(I.EQ,lab))
974                     | T.<>   => (andil 0x4400; j(I.EQ,lab))                     | T.<>   => (testil 0x4400; j(I.EQ,lab))
975                     | T.?=   => (andil 0x4400; j(I.NE,lab))                     | T.?=   => (testil 0x4400; j(I.NE,lab))
976                     | _      => error "fbranch"                     | _      => error "fbranch"
977                   (*esac*)                   (*esac*)
978            in  compare(); emit I.FNSTSW; branch()            in  compare(); emit I.FNSTSW; branch()
# Line 943  Line 980 
980    
981        and fld(32, opnd) = I.FLDS opnd        and fld(32, opnd) = I.FLDS opnd
982          | fld(64, opnd) = I.FLDL opnd          | fld(64, opnd) = I.FLDL opnd
983            | fld(80, opnd) = I.FLDT opnd
984          | fld _         = error "fld"          | fld _         = error "fld"
985    
986          and fild(16, opnd) = I.FILD opnd
987            | fild(32, opnd) = I.FILDL opnd
988            | fild(64, opnd) = I.FILDLL opnd
989            | fild _         = error "fild"
990    
991          and fxld(INTEGER, ty, opnd) = fild(ty, opnd)
992            | fxld(REAL, fty, opnd) = fld(fty, opnd)
993    
994        and fstp(32, opnd) = I.FSTPS opnd        and fstp(32, opnd) = I.FSTPS opnd
995          | fstp(64, opnd) = I.FSTPL opnd          | fstp(64, opnd) = I.FSTPL opnd
996            | fstp(80, opnd) = I.FSTPT opnd
997          | fstp _         = error "fstp"          | fstp _         = error "fstp"
998    
999            (* generate code for floating point stores *)            (* generate code for floating point stores *)
# Line 957  Line 1004 
1004             mark(fstp(fty, address(ea, mem)), an)             mark(fstp(fty, address(ea, mem)), an)
1005            )            )
1006    
1007        and fexpr e = error "fexpr"        and fexpr e = (reduceFexp(64, e, []); C.ST(0))
1008    
1009            (* generate floating point expression and put the result in fd *)            (* generate floating point expression and put the result in fd *)
1010        and doFexpr(fty, T.FREG(_, fs), fd, an) =        and doFexpr(fty, T.FREG(_, fs), fd, an) =
# Line 967  Line 1014 
1014          | doFexpr(fty, T.FLOAD(fty', ea, mem), fd, an) =          | doFexpr(fty, T.FLOAD(fty', ea, mem), fd, an) =
1015              let val ea = address(ea, mem)              let val ea = address(ea, mem)
1016              in  mark(fld(fty', ea), an);              in  mark(fld(fty', ea), an);
1017                  emit(fstp(fty, I.FDirect fd))                  if fd = ST0 then () else emit(fstp(fty, I.FDirect fd))
1018              end              end
1019          | doFexpr(fty, e, fd, an) =          | doFexpr(fty, e, fd, an) =
1020              (reduceFexp(fty, e, []);              (reduceFexp(fty, e, []);
1021               mark(fstp(fty, I.FDirect fd), an)               if fd = ST0 then () else mark(fstp(fty, I.FDirect fd), an)
1022              )              )
1023    
1024            (*            (*
# Line 980  Line 1027 
1027             * and put result in %ST(0).             * and put result in %ST(0).
1028             *)             *)
1029        and reduceFexp(fty, fexp, an)  =        and reduceFexp(fty, fexp, an)  =
1030            let val ST = I.FDirect(C.ST 0)            let val ST = I.ST(C.ST 0)
1031                val ST1 = I.FDirect(C.ST 1)                val ST1 = I.ST(C.ST 1)
1032                  val cleanupCode = ref [] : I.instruction list ref
1033                datatype su_numbers =  
1034                  LEAF of int                datatype su_tree =
1035                | BINARY of int * su_numbers * su_numbers                  LEAF of int * T.fexp * ans
1036                | UNARY of int * su_numbers                | BINARY of int * T.fty * fbinop * su_tree * su_tree * ans
1037                  | UNARY of int * T.fty * I.funOp * su_tree * ans
1038                datatype direction = LEFT | RIGHT                and fbinop = FADD | FSUB | FMUL | FDIV
1039                             | FIADD | FISUB | FIMUL | FIDIV
1040                fun label(LEAF n) = n                withtype ans = Annotations.annotations
1041                  | label(BINARY(n, _, _)) = n  
1042                  | label(UNARY(n, _)) = n                fun label(LEAF(n, _, _)) = n
1043                    | label(BINARY(n, _, _, _, _, _)) = n
1044               (* Generate tree of sethi-ullman numbers *)                  | label(UNARY(n, _, _, _, _)) = n
1045                fun suBinary(t1, t2) =  
1046                    let val su1 = suNumbering(t1, LEFT)                fun annotate(LEAF(n, x, an), a)  = LEAF(n,x,a::an)
1047                        val su2 = suNumbering(t2, RIGHT)                  | annotate(BINARY(n,t,b,x,y,an), a) = BINARY(n,t,b,x,y,a::an)
1048                        val n1 = label su1                  | annotate(UNARY(n,t,u,x,an), a) = UNARY(n,t,u,x,a::an)
1049                        val n2 = label su2  
1050                    in  BINARY(if n1=n2 then n1+1 else Int.max(n1, n2), su1, su2)                (* Generate expression tree with sethi-ullman numbers *)
1051                    end                fun su(e as T.FREG _)       = LEAF(1, e, [])
1052                    | su(e as T.FLOAD _)      = LEAF(1, e, [])
1053                and suUnary(t) =                  | su(e as T.CVTI2F _)     = LEAF(1, e, [])
1054                    let val su = suNumbering(t, LEFT)                  | su(T.CVTF2F(_, _, t))   = su t
1055                    in  UNARY(label su, su)                  | su(T.FMARK(t, a))       = annotate(su t, a)
1056                    end                  | su(T.FABS(fty, t))      = suUnary(fty, I.FABS, t)
1057                    | su(T.FNEG(fty, t))      = suUnary(fty, I.FCHS, t)
1058                and suNumbering(T.FREG _, LEFT) = LEAF 1                  | su(T.FSQRT(fty, t))     = suUnary(fty, I.FSQRT, t)
1059                  | suNumbering(T.FREG _, RIGHT) = LEAF 0                  | su(T.FADD(fty, t1, t2)) = suComBinary(fty,FADD,FIADD,t1,t2)
1060                  | suNumbering(T.FLOAD _, LEFT) = LEAF 1                  | su(T.FMUL(fty, t1, t2)) = suComBinary(fty,FMUL,FIMUL,t1,t2)
1061                  | suNumbering(T.FLOAD _, RIGHT) = LEAF 0                  | su(T.FSUB(fty, t1, t2)) = suBinary(fty,FSUB,FISUB,t1,t2)
1062                  | suNumbering(T.FADD(_, t1, t2), _) = suBinary(t1, t2)                  | su(T.FDIV(fty, t1, t2)) = suBinary(fty,FDIV,FIDIV,t1,t2)
1063                  | suNumbering(T.FMUL(_, t1, t2), _) = suBinary(t1, t2)                  | su _ = error "su"
1064                  | suNumbering(T.FSUB(_, t1, t2), _) = suBinary(t1, t2)  
1065                  | suNumbering(T.FDIV(_, t1, t2), _) = suBinary(t1, t2)                (* Try to fold the the memory operand or integer conversion *)
1066                  | suNumbering(T.FABS(_,t), _) = suUnary(t)                and suFold(e as T.FREG _) = (LEAF(0, e, []), false)
1067                  | suNumbering(T.FNEG(_,t), _) = suUnary(t)                  | suFold(e as T.FLOAD _) = (LEAF(0, e, []), false)
1068                  | suNumbering(T.CVTI2F _, _) = UNARY(1, LEAF 0)                  | suFold(e as T.CVTI2F(_,(16 | 32),_)) = (LEAF(0, e, []), true)
1069                  | suNumbering(T.CVTF2F(_,_,t), _) = suUnary t                  | suFold(T.CVTF2F(_, _, t)) = suFold t
1070                  | suNumbering(T.FMARK(e,a),x) = suNumbering(e,x)                  | suFold(T.FMARK(t, a)) =
1071                  | suNumbering _ = error "suNumbering"                    let val (t, integer) = suFold t
1072                      in  (annotate(t, a), integer) end
1073                fun leafEA(T.FREG(fty, f)) = (fty, I.FDirect f)                  | suFold e = (su e, false)
1074                  | leafEA(T.FLOAD(fty, ea, mem)) = (fty, address(ea, mem))  
1075                  | leafEA _ = error "leafEA"                (* Can the tree be folded into the src operand? *)
1076                  and foldable(T.FREG _) = true
1077                fun cvti2d(t,an) =                  | foldable(T.FLOAD _) = true
1078                let val opnd = operand t                  | foldable(T.CVTI2F(_, (16 | 32), _)) = true
1079                    fun doMemOpnd () =                  | foldable(T.CVTF2F(_, _, t)) = foldable t
1080                        (emit(I.MOVE{mvOp=I.MOVL, src=opnd, dst=tempMem});                  | foldable(T.FMARK(t, _)) = foldable t
1081                         mark(I.FILD tempMem,an))                  | foldable _ = false
1082                in  case opnd of  
1083                      I.Direct _ => doMemOpnd()                (* Form unary tree *)
1084                    | I.Immed _ => doMemOpnd()                and suUnary(fty, funary, t) =
1085                    | _ => mark(I.FILD opnd, an)                    let val t = su t
1086                end                    in  UNARY(label t, fty, funary, t, [])
1087                      end
1088                (* traverse expression and su-number tree *)  
1089                fun gencode(_, LEAF 0, an) = ()                (* Form binary tree *)
1090                  | gencode(T.FMARK(e,a), x, an) = gencode(e, x, a::an)                and suBinary(fty, binop, ibinop, t1, t2) =
1091                  | gencode(f, LEAF 1, an) = mark(fld(leafEA f), an)                    let val t1 = su t1
1092                  | gencode(t, BINARY(_, su1, LEAF 0), an) =                        val (t2, integer) = suFold t2
1093                    let (* optimize the common case when both operands                        val n1 = label t1
1094                         * are equal *)                        val n2 = label t2
1095                        fun sameEA(T.FREG(t1, f1), T.FREG(t2, f2)) =                        val n  = if n1=n2 then n1+1 else Int.max(n1,n2)
1096                              t1 = t2 andalso f1 = f2                        val myOp = if integer then ibinop else binop
1097                          | sameEA _ = false                    in  BINARY(n, fty, myOp, t1, t2, [])
1098                        fun doit(oper, t1, t2) =                    end
1099                           (gencode(t1, su1, []);  
1100                            mark(I.FBINARY{binOp=oper,                (* Try to fold in the operand if possible.
1101                                           src=if sameEA(t1, t2) then ST                 * This only applies to commutative operations.
1102                                               else #2(leafEA t2),                 *)
1103                                           dst=ST}, an)                and suComBinary(fty, binop, ibinop, t1, t2) =
1104                           )                    let val (t1, t2) = if foldable t2 then (t1, t2) else (t2, t1)
1105                    in                    in  suBinary(fty, binop, ibinop, t1, t2) end
1106                      case t of  
1107                         T.FADD(_, t1, t2) => doit(I.FADD, t1, t2)                and sameTree(LEAF(_, T.FREG(t1,f1), []),
1108                       | T.FMUL(_, t1, t2) => doit(I.FMUL, t1, t2)                             LEAF(_, T.FREG(t2,f2), [])) = t1=t2 andalso f1=f2
1109                       | T.FSUB(_, t1, t2) => doit(I.FSUB, t1, t2)                  | sameTree _ = false
1110                       | T.FDIV(_, t1, t2) => doit(I.FDIV, t1, t2)  
1111                       | _ => error "gencode.BINARY"                (* Traverse tree and generate code *)
1112                    end                fun gencode(LEAF(_, t, an)) = mark(fxld(leafEA t), an)
1113                  | gencode(fexp, BINARY(fty, su1, su2), an) =                  | gencode(BINARY(_, _, binop, x, t2 as LEAF(0, y, a1), a2)) =
1114                    let fun doit(t1, t2, oper, operP, operRP) = let                    let val _          = gencode x
1115                       (* oper[P] =>  ST(1) := ST oper ST(1); [pop]                        val (_, fty, src) = leafEA y
1116                          fun gen(code) = mark(code, a1 @ a2)
1117                          fun binary(oper32, oper64) =
1118                              if sameTree(x, t2) then
1119                                 gen(I.FBINARY{binOp=oper64, src=ST, dst=ST})
1120                              else
1121                                 let val oper =
1122                                       if isMemOpnd src then
1123                                          case fty of
1124                                            32 => oper32
1125                                          | 64 => oper64
1126                                          | _  => error "gencode: BINARY"
1127                                       else oper64
1128                                 in gen(I.FBINARY{binOp=oper, src=src, dst=ST}) end
1129                          fun ibinary(oper16, oper32) =
1130                              let val oper = case fty of
1131                                               16 => oper16
1132                                             | 32 => oper32
1133                                             | _  => error "gencode: IBINARY"
1134                              in  gen(I.FIBINARY{binOp=oper, src=src}) end
1135                      in  case binop of
1136                            FADD => binary(I.FADDS, I.FADDL)
1137                          | FSUB => binary(I.FDIVS, I.FSUBL)
1138                          | FMUL => binary(I.FMULS, I.FMULL)
1139                          | FDIV => binary(I.FDIVS, I.FDIVL)
1140                          | FIADD => ibinary(I.FIADDS, I.FIADDL)
1141                          | FISUB => ibinary(I.FIDIVS, I.FISUBL)
1142                          | FIMUL => ibinary(I.FIMULS, I.FIMULL)
1143                          | FIDIV => ibinary(I.FIDIVS, I.FIDIVL)
1144                      end
1145                    | gencode(BINARY(_, fty, binop, t1, t2, an)) =
1146                      let fun doit(t1, t2, oper, operP, operRP) =
1147                          let (* oper[P] =>  ST(1) := ST oper ST(1); [pop]
1148                        * operR[P] => ST(1) := ST(1) oper ST; [pop]                        * operR[P] => ST(1) := ST(1) oper ST; [pop]
1149                        *)                        *)
1150                        val n1 = label su1                             val n1 = label t1
1151                        val n2 = label su2                             val n2 = label t2
1152                      in                        in if n1 < n2 andalso n1 <= 7 then
1153                        if n1 < n2 andalso n1 <= 7 then                             (gencode t2;
1154                          (gencode(t2, su2, []);                              gencode t1;
                          gencode(t1, su1, []);  
1155                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operP, src=ST, dst=ST1}, an))
1156                        else if n2 <= n1 andalso n2 <= 7 then                        else if n2 <= n1 andalso n2 <= 7 then
1157                          (gencode(t1, su1, []);                             (gencode t1;
1158                           gencode(t2, su2, []);                              gencode t2;
1159                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))                           mark(I.FBINARY{binOp=operRP, src=ST, dst=ST1}, an))
1160                        else let (* both labels > 7 *)                           else
1161                             let (* both labels > 7 *)
1162                            val fs = I.FDirect(newFreg())                            val fs = I.FDirect(newFreg())
1163                          in                           in  gencode t2;
                           gencode (t2, su2, []);  
1164                            emit(fstp(fty, fs));                            emit(fstp(fty, fs));
1165                            gencode (t1, su1, []);                               gencode t1;
1166                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)                            mark(I.FBINARY{binOp=oper, src=fs, dst=ST}, an)
1167                          end                          end
1168                      end                      end
1169                    in                    in case binop of
1170                      case fexp                         FADD => doit(t1,t2,I.FADDL,I.FADDP,I.FADDP)
1171                      of T.FADD(_, t1, t2) => doit(t1, t2,I.FADD,I.FADDP,I.FADDP)                       | FMUL => doit(t1,t2,I.FMULL,I.FMULP,I.FMULP)
1172                       | T.FMUL(_, t1, t2) => doit(t1, t2,I.FMUL,I.FMULP,I.FMULP)                       | FSUB => doit(t1,t2,I.FSUBL,I.FSUBP,I.FSUBRP)
1173                       | 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)  
1174                       | _ => error "gencode.BINARY"                       | _ => error "gencode.BINARY"
1175                    end                    end
1176                  | gencode(fexp, UNARY(_, LEAF 0), an) =                  | gencode(UNARY(_, _, unaryOp, su, an)) =
1177                    (case fexp                     (gencode(su); mark(I.FUNARY(unaryOp),an))
1178                      of T.FABS(fty, t) =>  
1179                           (emit(fld(leafEA t)); mark(I.FUNARY(I.FABS),an))                (* Generate code for a leaf.
1180                       | T.FNEG(fty, t) =>                 * Returns the type and an effective address
1181                           (emit(fld(leafEA t)); mark(I.FUNARY(I.FCHS),an))                 *)
1182                       | T.CVTI2F(_,_,t) => cvti2d(t,an) (* XXX *)                and leafEA(T.FREG(fty, f)) = (REAL, fty, I.FDirect f)
1183                       | _ => error "gencode.UNARY"                  | leafEA(T.FLOAD(fty, ea, mem)) = (REAL, fty, address(ea, mem))
1184                     (*esac*))                  | leafEA(T.CVTI2F(_, 32, t)) = int2real(32, t)
1185                  | gencode(fexp, UNARY(_, su), an) =                  | leafEA(T.CVTI2F(_, 16, t)) = int2real(16, t)
1186                    let fun doit(oper, t) =                  | leafEA(T.CVTI2F(_, 8, t))  = int2real(8, t)
1187                         (gencode(t, su, []); mark(I.FUNARY(oper),an))                  | leafEA _ = error "leafEA"
                   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"  
1188    
1189                val labels = suNumbering(fexp, LEFT)                (* Move integer t of size ty into a memory location *)
1190            in  gencode(fexp, labels, an)                and int2real(ty, t) =
1191                      let val opnd = operand t
1192                      in  if isMemOpnd opnd andalso (ty = 16 orelse ty = 32)
1193                          then (INTEGER, ty, opnd)
1194                          else
1195                            let val {instrs, tempMem, cleanup} =
1196                                       cvti2f{ty=ty, src=opnd}
1197                            in  app emit instrs;
1198                                cleanupCode := !cleanupCode @ cleanup;
1199                                (INTEGER, 32, tempMem)
1200                            end
1201                      end
1202              in  gencode(su fexp);
1203                  app emit(!cleanupCode)
1204            end (*reduceFexp*)            end (*reduceFexp*)
1205    
1206            (* generate code for a statement *)            (* generate code for a statement *)
# Line 1128  Line 1210 
1210          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)
1211          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)          | stmt(T.FCOPY(fty, dst, src), an) = fcopy(fty, dst, src, an)
1212          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)          | stmt(T.JMP(ctrl, e, labs), an) = jmp(e, labs, an)
1213          | stmt(T.CALL(e, flow, def, use, cdef, cuse, mem), an) =          | stmt(T.CALL{funct, targets, defs, uses, cdefs, cuses, region}, an) =
1214               call(e,flow,def,use,mem,an)               call(funct,targets,defs,uses,region,an)
1215          | stmt(T.RET _, an) = mark(I.RET NONE, an)          | stmt(T.RET _, an) = mark(I.RET NONE, an)
1216          | 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)
1217          | 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 1220 
1220          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)          | stmt(T.BCC(ctrl, cc, lab), an) = branch(cc, lab, an)
1221          | stmt(T.DEFINE l, _) = defineLabel l          | stmt(T.DEFINE l, _) = defineLabel l
1222          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)          | stmt(T.ANNOTATION(s, a), an) = stmt(s, a::an)
1223            | stmt(T.EXT s, an) =
1224                 ExtensionComp.compileSext (reducer()) {stm=s, an=an}
1225          | stmt(s, _) = doStmts(Gen.compileStm s)          | stmt(s, _) = doStmts(Gen.compileStm s)
1226    
1227        and doStmt s = stmt(s, [])        and doStmt s = stmt(s, [])

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

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