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/ppc/mltree/ppc.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/ppc/mltree/ppc.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 410, Fri Sep 3 00:25:03 1999 UTC revision 411, Fri Sep 3 00:25:03 1999 UTC
# Line 1  Line 1 
1    (*
2     * I've substantially modified this code generator to support the new MLTREE.
3     * Please see the file README.hppa for the ugly details.
4     *
5     * -- Allen
6     *)
7    
8  functor PPC  functor PPC
9    (structure PPCInstr : PPCINSTR    (structure PPCInstr : PPCINSTR
10     structure PPCMLTree : MLTREE     structure PPCMLTree : MLTREE
11        where Region = PPCInstr.Region        where Region = PPCInstr.Region
12          and Constant = PPCInstr.Constant          and Constant = PPCInstr.Constant
13     structure Flowgen : FLOWGRAPH_GEN          and type cond          = MLTreeBasis.cond
14        where I = PPCInstr          and type fcond         = MLTreeBasis.fcond
15          and T = PPCMLTree          and type ext           = MLTreeBasis.ext
16          and B = PPCMLTree.BNames          and type rounding_mode = MLTreeBasis.rounding_mode
17       structure Stream : INSTRUCTION_STREAM
18         where B = PPCMLTree.BNames
19           and P = PPCMLTree.PseudoOp
20     structure PseudoInstrs : PPC_PSEUDO_INSTR     structure PseudoInstrs : PPC_PSEUDO_INSTR
21        where I = PPCInstr        where I = PPCInstr
22     val rs6000flag : bool  
23       (*
24        * Support 64 bit mode?
25        * This should be set to false for SML/NJ
26        *)
27       val bit64mode : bool
28    
29       (*
30        * Cost of multiplication in cycles
31        *)
32       val multCost : int ref
33    ) : MLTREECOMP =    ) : MLTREECOMP =
34  struct  struct
35    structure I = PPCInstr    structure I = PPCInstr
36    structure F = Flowgen    structure S   = Stream
37    structure T = PPCMLTree    structure T = PPCMLTree
38    structure C = PPCInstr.C    structure C = PPCInstr.C
39    structure LE = LabelExp    structure LE = LabelExp
40    structure W32 = Word32    structure W32 = Word32
41    
42    (* label where trap is generated *)    fun error msg = MLRiscErrorMsg.error("PPC",msg)
43    val trapLabel : Label.label option ref = ref NONE  
44    (* true if a trap label is required  *)    structure Gen = MLTreeGen
45    val trapsPresent = ref false      (structure T = T
46         val (intTy,naturalWidths) = if bit64mode then (64,[32,64]) else (32,[32])
47        )
48    
49      (*
50       * Special instructions
51       *)
52      fun MTLR r = I.MTSPR{rs=r, spr=C.lr}
53      fun MFLR r = I.MFSPR{rt=r, spr=C.lr}
54      val CR0 = C.Reg C.CC 0
55      val RET = I.BCLR{bo=I.ALWAYS, bf=CR0, bit=I.LT, LK=false, labels=[]}
56      fun SLLI32{r,i,d} =
57          I.ROTATEI{oper=I.RLWINM,ra=d,rs=r,sh=I.ImmedOp i,mb=0,me=SOME(31-i)}
58      fun SRLI32{r,i,d} =
59          I.ROTATEI{oper=I.RLWINM,ra=d,rs=r,sh=I.ImmedOp(32-i),mb=i,me=SOME(31)}
60    
61      val _ = if C.lr = 80 then () else error "LR must be encoded as 80!"
62    
63    fun error msg = MLRiscErrorMsg.impossible ("PPC." ^ msg)    (*
64       * Integer multiplication
65       *)
66      functor Multiply32 = MLTreeMult
67        (structure I = I
68         structure T = T
69         val intTy = 32
70         type arg  = {r1:C.register,r2:C.register,d:C.register}
71         type argi = {r:C.register,i:int,d:C.register}
72    
73         fun mov{r,d} = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}
74         fun add{r1,r2,d}= I.ARITH{oper=I.ADD,ra=r1,rb=r2,rt=d,Rc=false,OE=false}
75         fun slli{r,i,d} = [SLLI32{r=r,i=i,d=d}]
76         fun srli{r,i,d} = [SRLI32{r=r,i=i,d=d}]
77         fun srai{r,i,d} = [I.ARITHI{oper=I.SRAWI,rt=d,ra=r,im=I.ImmedOp i}]
78        )
79    
80      structure Mulu32 = Multiply32
81        (val trapping = false
82         val signed   = false
83         val multCost = multCost
84         fun addv{r1,r2,d}=[I.ARITH{oper=I.ADD,ra=r1,rb=r2,rt=d,Rc=false,OE=false}]
85         fun subv{r1,r2,d}=[I.ARITH{oper=I.SUBF,ra=r2,rb=r1,rt=d,Rc=false,OE=false}]
86         val sh1addv = NONE
87         val sh2addv = NONE
88         val sh3addv = NONE
89        )
90    
91      structure Mult32 = Multiply32
92        (val trapping = true
93         val signed   = true
94         val multCost = multCost
95         fun addv{r1,r2,d} = error "Mult32.addv"
96         fun subv{r1,r2,d} = error "Mult32.subv"
97         val sh1addv = NONE
98         val sh2addv = NONE
99         val sh3addv = NONE
100        )
101    
102      fun selectInstructions
103          (S.STREAM{emit,defineLabel,entryLabel,blockName,pseudoOp,annotation,
104                    init,finish,exitBlock,...}) =
105      let val emit = emit(fn r => r)
106    
107          (* mark an instruction with annotations *)
108          fun mark'(instr,[]) = instr
109            | mark'(instr,a::an) = mark'(I.ANNOTATION{i=instr,a=a},an)
110          fun mark(instr,an) = emit(mark'(instr,an))
111    
112          (* Label where trap is generated.
113           * For overflow trapping instructions, we generate a branch
114           * to this label.
115           *)
116          val trapLabel : Label.label option ref = ref NONE
117    
118    val newReg = C.newReg    val newReg = C.newReg
119    val newFreg = C.newFreg    val newFreg = C.newFreg
120    val newCCreg = C.newCCreg        val newCCreg = C.newCell C.CC
   val emit = F.emitInstr  
   
   val emitInstr = emit  
121    
122    fun signed16 i = ~32768 <= i andalso i < 32768    fun signed16 i = ~32768 <= i andalso i < 32768
123          fun signed12 i = ~2048 <= i andalso i < 2048
124    fun unsigned16 i = 0 <= i andalso i < 65536    fun unsigned16 i = 0 <= i andalso i < 65536
125          fun unsigned5  i = 0 <= i andalso i < 32
126          fun unsigned6  i = 0 <= i andalso i < 64
127    
128          fun move(rs,rd,an) =
129            if rs=rd then ()
130            else mark(I.COPY{dst=[rd],src=[rs],impl=ref NONE,tmp=NONE},an)
131    
132    fun emitBranch{bo, bf, bit, addr, LK} = let        fun fmove(fs,fd,an) =
133      val fallThrLab = Label.newLabel""          if fs=fd then ()
134            else mark(I.FCOPY{dst=[fd],src=[fs],impl=ref NONE,tmp=NONE},an)
135    
136          fun ccmove(ccs,ccd,an) =
137            if ccd = ccs then () else mark(I.MCRF{bf=ccd, bfa=ccs},an)
138    
139          fun copy(dst, src, an) =
140              mark(I.COPY{dst=dst, src=src, impl=ref NONE,
141                          tmp=case dst of [_] => NONE
142                                        | _ => SOME(I.Direct(newReg()))},an)
143          fun fcopy(dst, src, an) =
144              mark(I.FCOPY{dst=dst, src=src, impl=ref NONE,
145                           tmp=case dst of [_] => NONE
146                                         | _ => SOME(I.FDirect(newFreg()))},an)
147    
148          fun emitBranch{bo, bf, bit, addr, LK} =
149          let val fallThrLab = Label.newLabel""
150      val fallThrOpnd = I.LabelOp(LE.LABEL fallThrLab)      val fallThrOpnd = I.LabelOp(LE.LABEL fallThrLab)
151    in    in
152      emit(I.BC{bo=bo, bf=bf, bit=bit, addr=addr, LK=LK, fall=fallThrOpnd});      emit(I.BC{bo=bo, bf=bf, bit=bit, addr=addr, LK=LK, fall=fallThrOpnd});
153      F.defineLabel fallThrLab            defineLabel fallThrLab
154    end    end
155    
156    fun split n = let        fun split n =
157      val wtoi = Word.toIntX        let val wtoi = Word.toIntX
158      val w = Word.fromInt n      val w = Word.fromInt n
159      val hi = Word.~>>(w, 0w16)      val hi = Word.~>>(w, 0w16)
160      val lo = Word.andb(w, 0w65535)      val lo = Word.andb(w, 0w65535)
161      val (high, low) = if lo < 0w32768 then (hi, lo) else (hi+0w1, lo-0w65536)            val (high, low) = if lo < 0w32768 then (hi, lo)
162    in (wtoi high, wtoi low)                              else (hi+0w1, lo-0w65536)
163    end        in (wtoi high, wtoi low) end
164    
165    fun loadImmedHiLo(0, lo, rt) =        fun loadImmedHiLo(0, lo, rt, an) =
166          emit(I.ARITHI{oper=I.ADD, rt=rt, ra=0, im=I.ImmedOp lo})              mark(I.ARITHI{oper=I.ADDI, rt=rt, ra=0, im=I.ImmedOp lo}, an)
167      | loadImmedHiLo(hi, lo, rt) =          | loadImmedHiLo(hi, lo, rt, an) =
168         (emit(I.ARITHI{oper=I.ADDS, rt=rt, ra=0, im=I.ImmedOp hi});             (mark(I.ARITHI{oper=I.ADDIS, rt=rt, ra=0, im=I.ImmedOp hi}, an);
169          if lo = 0 then ()          if lo = 0 then ()
170          else emit(I.ARITHI{oper=I.ADD, rt=rt, ra=rt, im=I.ImmedOp lo}))                 else emit(I.ARITHI{oper=I.ADDI, rt=rt, ra=rt, im=I.ImmedOp lo}))
171    
172    fun loadImmed(n, rt) =        fun loadImmed(n, rt, an) =
173      if signed16 n then      if signed16 n then
174         emit(I.ARITHI{oper=I.ADD, rt=rt, ra=0 , im=I.ImmedOp n})             mark(I.ARITHI{oper=I.ADDI, rt=rt, ra=0 , im=I.ImmedOp n}, an)
175      else let          else let val (hi, lo) = split n
176          val (hi, lo) = split n               in loadImmedHiLo(hi, lo, rt, an) end
177        in loadImmedHiLo(hi, lo, rt)  
178          fun loadImmedw(w, rt, an) =
179              let val wtoi = Word32.toIntX
180              in  if w < 0w32768 then
181                     mark(I.ARITHI{oper=I.ADDI,rt=rt,ra=0,im=I.ImmedOp(wtoi w)}, an)
182                  else
183                   let val hi = Word32.~>>(w, 0w16)
184                       val lo = Word32.andb(w, 0w65535)
185                       val (high, low) =
186                        if lo < 0w32768 then (hi, lo) else (hi+0w1, lo-0w65536)
187                   in loadImmedHiLo(wtoi high, wtoi low, rt, an)
188                   end
189        end        end
190    
191    fun immedOpnd range (e1, e2 as T.LI i, _) =        fun loadLabel(lexp, rt, an) =
192         (reduceExp e1,            mark(I.ARITHI{oper=I.ADDI, rt=rt, ra=0, im=I.LabelOp lexp}, an)
193          if range i then I.ImmedOp i else I.RegOp(reduceExp e2))  
194      | immedOpnd _ (e1, T.CONST c, _) = (reduceExp e1, I.ConstOp c)        fun loadConst(c, rt, an) =
195      | immedOpnd _ (e1, T.LABEL lexp, _) = (reduceExp e1, I.LabelOp lexp)            mark(I.ARITHI{oper=I.ADDI, rt=rt, ra=0, im=I.ConstOp c}, an)
196      | immedOpnd range (e1, e2 as T.LI32 w, _) = let  
197          fun opnd2() = I.RegOp(reduceExpRd(e2, newReg()))        fun immedOpnd range (e1, e2 as T.LI i) =
198        in             (expr e1, if range i then I.ImmedOp i else I.RegOp(expr e2))
199         (reduceExp e1,          | immedOpnd _ (e1, T.CONST c) = (expr e1, I.ConstOp c)
200            | immedOpnd _ (e1, T.LABEL lexp) = (expr e1, I.LabelOp lexp)
201            | immedOpnd range (e1, e2 as T.LI32 w) =
202              let fun opnd2() = I.RegOp(expr e2)
203              in (expr e1,
204          let val i = Word32.toIntX w          let val i = Word32.toIntX w
205          in if range i then I.ImmedOp i else opnd2()          in if range i then I.ImmedOp i else opnd2()
206          end handle Overflow => opnd2())          end handle Overflow => opnd2())
207        end        end
208      | immedOpnd _ (e1, e2, T.LR) = (reduceExp e1, I.RegOp(reduceExp e2))          | immedOpnd _ (e1, e2) = (expr e1, I.RegOp(expr e2))
     | immedOpnd _ (e1, e2, T.RL) = let  
         val r2 = I.RegOp(reduceExp e2)  
       in (reduceExp e1, r2)  
       end  
209    
210    and commImmedOpnd range (e1 as T.LI _, e2, ord) =        and commImmedOpnd range (e1 as T.LI _, e2) =
211         immedOpnd range (e2, e1, ord)             immedOpnd range (e2, e1)
212      | commImmedOpnd range (e1 as T.CONST _, e2, ord) =          | commImmedOpnd range (e1 as T.CONST _, e2) =
213         immedOpnd range (e2, e1, ord)             immedOpnd range (e2, e1)
214      | commImmedOpnd range (e1 as T.LABEL _, e2, ord) =          | commImmedOpnd range (e1 as T.LABEL _, e2) =
215         immedOpnd range (e2, e1, ord)             immedOpnd range (e2, e1)
216      | commImmedOpnd range arg = immedOpnd range arg      | commImmedOpnd range arg = immedOpnd range arg
217    
218    and eCommImmedOpnd range (oper, e1, e2, rt, ord) =        and eCommImm range (oper, operi, e1, e2, rt, an) =
219     (case commImmedOpnd range (e1, e2, ord)         (case commImmedOpnd range (e1, e2)
220      of (ra, I.RegOp rb) =>      of (ra, I.RegOp rb) =>
221          emit(I.ARITH{oper=oper, ra=ra, rb=rb, rt=rt, Rc=false, OE=false})              mark(I.ARITH{oper=oper, ra=ra, rb=rb, rt=rt, Rc=false, OE=false},an)
222       | (ra, opnd) =>       | (ra, opnd) =>
223          emit(I.ARITHI{oper=oper, ra=ra, im=opnd, rt=rt})              mark(I.ARITHI{oper=operi, ra=ra, im=opnd, rt=rt},an)
224      (*esac*))      (*esac*))
225    
226    and orderedFF(fe1, fe2, T.LR) = (reduceFexp fe1, reduceFexp fe2)        (*
227      | orderedFF(fe1, fe2, T.RL) = let         * Compute a base/displacement effective address
228          val f2 = reduceFexp fe2         *)
229        in (reduceFexp fe1, f2)        and addr(size,T.ADD(_, e, T.LI i)) =
230        end            let val ra = expr e
231              in  if size i then (ra, I.ImmedOp i) else
232    and reduceCCexpCd(ccexp, ccd) =                let val (hi, lo) = split i
233     (case ccexp                    val tmpR = newReg()
234       of T.CMP(cc, e1, e2, ord) => let                in  emit(I.ARITHI{oper=I.ADDIS, rt=tmpR, ra=ra, im=I.ImmedOp hi});
235            val (opnds, cmp) =                    (tmpR, I.ImmedOp lo)
             (case cc  
               of (T.LT | T.LE | T.EQ | T.NEQ | T.GT | T.GE) =>  
                    (immedOpnd signed16, I.CMP)  
                | _ => (immedOpnd unsigned16, I.CMPL)  
             (*esac*))  
           val (opndA, opndB) = opnds(e1, e2, ord)  
         in emit(I.COMPARE{cmp=cmp, bf=ccd, ra=opndA, rb=opndB}); ccd  
236          end          end
       | T.FCMP(fcc, fe1, fe2, ord) => let  
           val (f1, f2) = orderedFF(fe1, fe2, ord)  
         in emit(I.FCOMPARE{cmp=I.FCMPU, bf=ccd, fa=f1, fb=f2}); ccd  
237          end          end
238        | T.CC cc => cc          | addr(size,T.ADD(ty, T.LI i, e)) = addr(size,T.ADD(ty, e, T.LI i))
239        | _ => error "reduceCCexpCd: Not implemented"          | addr(size,exp as T.SUB(ty, e, T.LI i)) =
240     (*esac*))              (addr(size,T.ADD(ty, e, T.LI (~i)))
241                   handle Overflow => (expr exp, I.ImmedOp 0))
242            | addr(size,T.ADD(_, e1, e2)) = (expr e1, I.RegOp (expr e2))
243            | addr(size,e) = (expr e, I.ImmedOp 0)
244    
245    and reduceStm exp = let        (*
246    in         * Translate a statement, and annotate it
247      case exp of         *)
248         T.MV(rd, rexp) => let        and stmt(T.MV(_, rd, e),an) = doExpr(e, rd, an)
249           val rs = reduceExpRd(rexp, rd)          | stmt(T.FMV(_, fd, e),an) = doFexpr(e, fd, an)
250         in          | stmt(T.CCMV(ccd, ccexp), an) = doCCexpr(ccexp, ccd, an)
251           if rs=rd then ()          | stmt(T.COPY(_, dst, src), an) = copy(dst, src, an)
252           else emit(I.ARITH{oper=I.OR, rt=rd, ra=rs, rb=rs, Rc=false, OE=false})          | stmt(T.FCOPY(_, dst, src), an) = fcopy(dst, src, an)
253         end          | stmt(T.JMP(T.LABEL lexp, labs),an) =
254       | T.FMV(fd, fexp)  => let               mark(I.B{addr=I.LabelOp lexp, LK=false},an)
255           val fs = reduceFexpFd(fexp, fd)          | stmt(T.JMP(rexp, labs),an) =
256         in            let val rs = expr(rexp)
257           if fs = fd then ()            in  emit(MTLR(rs));
258           else emit(I.FUNARY{oper=I.FMR, ft=fd, fb=fs, Rc=false})                mark(I.BCLR{bo=I.ALWAYS,bf=CR0,bit=I.LT,LK=false,labels=labs},an)
        end  
      | T.CCMV(ccd, ccexp) => let  
          val ccs = reduceCCexpCd(ccexp, ccd)  
        in  
          if ccd = ccs then () else emit(I.MCRF{bf=ccd, bfa=ccs})  
        end  
      | T.COPY(dst, src) =>  
          emit(I.COPY  
           {dst=dst, src=src, impl=ref NONE,  
            tmp = case dst of [_] => NONE | _ => SOME(I.Direct(newReg()))})  
      | T.FCOPY(dst, src) =>  
          emit(I.FCOPY  
            {dst=dst, src=src, impl=ref NONE,  
             tmp = case dst of [_] => NONE | _ => SOME(I.FDirect(newFreg()))})  
      | T.JMP(T.LABEL lexp, labs) =>  
          emit(I.B{addr=I.LabelOp lexp, LK=false})  
      | T.JMP(rexp,  labs) => let  
          val rs = reduceExp(rexp)  
        in  
          emit(I.mtlr(rs));  
          emit(I.BCLR{bo=I.ALWAYS, bf=0, bit=I.LT, LK=false, labels=labs})  
259         end         end
260       | T.CALL(rexp, defs, uses) => let          | stmt(T.CALL(rexp, defs, uses, mem), an) =
261            val addCCreg = C.addCell C.CC            let val addCCreg = C.addCell C.CC
262            fun live([],acc) = acc            fun live([],acc) = acc
263              | live(T.GPR(T.REG r)::regs,acc) = live(regs, C.addReg(r,acc))                  | live(T.GPR(T.REG(_,r))::regs,acc) = live(regs,C.addReg(r,acc))
264              | live(T.CCR(T.CC cc)::regs,acc) = live(regs, addCCreg(cc,acc))              | live(T.CCR(T.CC cc)::regs,acc) = live(regs, addCCreg(cc,acc))
265              | live(T.FPR(T.FREG f)::regs,acc) = live(regs, C.addFreg(f,acc))                  | live(T.FPR(T.FREG(_,f))::regs,acc) = live(regs,C.addFreg(f,acc))
266              | live(_::regs, acc) = live(regs, acc)              | live(_::regs, acc) = live(regs, acc)
267            val defs=live(defs,C.empty)            val defs=live(defs,C.empty)
268            val uses=live(uses,C.empty)            val uses=live(uses,C.empty)
269         in emit(I.mtlr(reduceExp rexp));             in emit(MTLR(expr rexp));
270            emit(I.CALL{def=defs, use=uses})                mark(I.CALL{def=defs, use=uses, mem=mem}, an)
271         end         end
272       | T.RET => emit(I.ret())           | stmt(T.RET,an) = mark(RET,an)
273       | T.STORE8(addr, data, mem) => store(I.Byte, addr, data, mem)           | stmt(T.STORE(ty,ea,data,mem),an) = store(ty,ea,data,mem,an)
274       | T.STORE32(addr, data, mem) => store(I.Word, addr, data, mem)           | stmt(T.FSTORE(ty,ea,data,mem),an) = fstore(ty,ea,data,mem,an)
275       | T.STORED(addr, data, mem) => let           | stmt(T.BCC(_, T.CMP(_, _, T.LI _, T.LI _), _),_) = error "BCC"
276           val (r, disp) = ea addr           | stmt(T.BCC(cc, T.CMP(ty, _, T.ANDB(_, e1, e2), T.LI 0), lab),an) =
277         in emit(I.ST{sz=I.Double, rs=reduceFexp data, ra=r, d=disp, mem=mem})             (case commImmedOpnd unsigned16 (e1, e2)
        end  
      | T.STORECC _ => error "STORECC: Not implemented"  
      | T.BCC(_, T.CMP(_, T.LI _, T.LI _, _), _) => error "BCC"  
      | T.BCC(cc, T.CMP(_, T.ANDB(e1, e2), T.LI 0, _), lab) =>  
        (case commImmedOpnd unsigned16 (e1, e2, T.LR)  
278           of (ra, I.RegOp rb) =>           of (ra, I.RegOp rb) =>
279               emit(I.ARITH{oper=I.AND, ra=ra, rb=rb, rt=newReg(), Rc=true, OE=false})                   emit(I.ARITH{oper=I.AND, ra=ra, rb=rb, rt=newReg(),
280                                  Rc=true, OE=false})
281            | (ra, opnd) =>            | (ra, opnd) =>
282               emit(I.ARITHI{oper=I.AND, ra=ra, im=opnd, rt=newReg()})                   emit(I.ARITHI{oper=I.ANDI_Rc, ra=ra, im=opnd, rt=newReg()})
283          (*esac*);          (*esac*);
284          reduceStm(T.BCC(cc, T.CC 0, lab)))               stmt(T.BCC(cc, T.CC CR0, lab),an))
285       | T.BCC(cc, T.CMP(_, e1 as T.LI _, e2, ord), lab) => let           | stmt(T.BCC(cc, T.CMP(ty, _, e1 as T.LI _, e2), lab), an) =
286          val cc' =             let val cc' = MLTreeUtil.swapCond cc
287            (case cc             in  stmt(T.BCC(cc', T.CMP(ty, cc', e2, e1), lab), an)
             of T.LT => T.GT  
              | T.LTU => T.GTU  
              | T.LE => T.GE  
              | T.LEU => T.GEU  
              | T.EQ => T.EQ  
              | T.NEQ => T.NEQ  
              | T.GE => T.LE  
              | T.GEU => T.LEU  
              | T.GT => T.LT  
              | T.GTU => T.LTU  
           (*esac*))  
        in reduceStm(T.BCC(cc', T.CMP(cc', e2, e1, ord), lab))  
288         end         end
289       | T.BCC(_, cmp as T.CMP(cond, _, _, _), lab) => let           | stmt(T.BCC(_, cmp as T.CMP(ty, cond, _, _), lab), an) =
290           val ccreg = if true then 0 else newCCreg() (* XXX *)             let val ccreg = if true then CR0 else newCCreg() (* XXX *)
291           val (bo, cf) =           val (bo, cf) =
292             (case cond                   (case cond of
293               of T.LT =>  (I.TRUE,  I.LT)                      T.LT =>  (I.TRUE,  I.LT)
294                | T.LE =>  (I.FALSE, I.GT)                | T.LE =>  (I.FALSE, I.GT)
295                | T.EQ =>  (I.TRUE,  I.EQ)                | T.EQ =>  (I.TRUE,  I.EQ)
296                | T.NEQ => (I.FALSE, I.EQ)                    | T.NE =>  (I.FALSE, I.EQ)
297                | T.GT =>  (I.TRUE,  I.GT)                | T.GT =>  (I.TRUE,  I.GT)
298                | T.GE =>  (I.FALSE, I.LT)                | T.GE =>  (I.FALSE, I.LT)
299                | T.LTU => (I.TRUE,  I.LT)                | T.LTU => (I.TRUE,  I.LT)
# Line 226  Line 302 
302                | T.GEU => (I.FALSE, I.LT)                | T.GEU => (I.FALSE, I.LT)
303              (*esac*))              (*esac*))
304           val addr = I.LabelOp(LE.LABEL lab)           val addr = I.LabelOp(LE.LABEL lab)
305         in             in doCCexpr(cmp, ccreg, []);
          reduceCCexpCd(cmp, ccreg);  
306           emitBranch{bo=bo, bf=ccreg, bit=cf, addr=addr, LK=false}           emitBranch{bo=bo, bf=ccreg, bit=cf, addr=addr, LK=false}
307         end         end
308       | T.BCC(cc, T.CC cr, lab) => let           | stmt(T.BCC(cc, T.CC cr, lab), an) =
309          val addr=I.LabelOp(LE.LABEL lab)             let val addr=I.LabelOp(LE.LABEL lab)
310          fun branch(bo, bit) =          fun branch(bo, bit) =
311            emitBranch{bo=bo, bf=cr, bit=bit, addr=addr, LK=false}            emitBranch{bo=bo, bf=cr, bit=bit, addr=addr, LK=false}
312         in             in  case cc of
313           case cc                   T.EQ => branch(I.TRUE, I.EQ)
314           of T.EQ  => branch(I.TRUE, I.EQ)                 | T.NE => branch(I.FALSE, I.EQ)
           | T.NEQ => branch(I.FALSE, I.EQ)  
315            | (T.LT | T.LTU) => branch(I.TRUE, I.LT)            | (T.LT | T.LTU) => branch(I.TRUE, I.LT)
316            | (T.LE | T.LEU) => branch(I.FALSE, I.GT)            | (T.LE | T.LEU) => branch(I.FALSE, I.GT)
317            | (T.GE | T.GEU) => branch(I.FALSE, I.LT)            | (T.GE | T.GEU) => branch(I.FALSE, I.LT)
318            | (T.GT | T.GTU) => branch(I.TRUE, I.GT)            | (T.GT | T.GTU) => branch(I.TRUE, I.GT)
319         end         end
320       | T.FBCC(_, cmp as T.FCMP(cond, _, _, _), lab) => let           | stmt(T.FBCC(_, cmp as T.FCMP(fty, cond, _, _), lab),an) =
321           val ccreg = if true then 0 else newCCreg() (* XXX *)             let val ccreg = if true then CR0 else newCCreg() (* XXX *)
322           val labOp = I.LabelOp(LE.LABEL lab)           val labOp = I.LabelOp(LE.LABEL lab)
323           fun branch(bo, bf, bit) =           fun branch(bo, bf, bit) =
324             emitBranch{bo=bo, bf=bf, bit=bit, addr=labOp, LK=false}             emitBranch{bo=bo, bf=bf, bit=bit, addr=labOp, LK=false}
325                   fun test2bits(bit1, bit2) =
326           fun test2bits(bit1, bit2) = let                 let val ba=(ccreg, bit1)
            val ba=(ccreg, bit1)  
327             val bb=(ccreg, bit2)             val bb=(ccreg, bit2)
328             val bt=(ccreg, I.FL)             val bt=(ccreg, I.FL)
329           in                 in  emit(I.CCARITH{oper=I.CROR, bt=bt, ba=ba, bb=bb});
330             (emit(I.CCARITH{oper=I.CROR, bt=bt, ba=ba, bb=bb});                     branch(I.TRUE, ccreg, I.FL)
             branch(I.TRUE, ccreg, I.FL))  
331           end           end
332         in             in  doCCexpr(cmp, ccreg, []);
333           reduceCCexpCd(cmp, ccreg);                 case cond of
334           case cond                   T.==  => branch(I.TRUE,  ccreg, I.FE)
           of T.==  => branch(I.TRUE,  ccreg, I.FE)  
335             | T.?<> => branch(I.FALSE,  ccreg, I.FE)             | T.?<> => branch(I.FALSE,  ccreg, I.FE)
336             | T.?   => branch(I.TRUE,  ccreg, I.FU)             | T.?   => branch(I.TRUE,  ccreg, I.FU)
337             | T.<=> => branch(I.FALSE,  ccreg, I.FU)             | T.<=> => branch(I.FALSE,  ccreg, I.FU)
# Line 276  Line 347 
347             | T.?=  => test2bits(I.FU, I.FE)             | T.?=  => test2bits(I.FU, I.FE)
348           (*esac*)           (*esac*)
349         end         end
      | _ => error "reduceStm"  
   end (* reduceStm *)  
350    
351    and ea(T.ADD(e, T.LI i)) = let           | stmt(T.ANNOTATION(s,a),an) = stmt(s,a::an)
352          val ra = reduceExp e           | stmt _ = error "stmt"
       in  
        if ~32768 <= i andalso i < 32768 then (ra, I.ImmedOp i)  
        else let  
            val (hi, lo) = split i  
            val tmpR = newReg()  
          in  
            emit(I.ARITHI{oper=I.ADDS, rt=tmpR, ra=ra, im=I.ImmedOp hi});  
            (tmpR, I.ImmedOp lo)  
          end  
       end  
     | ea(T.ADD(T.LI i, e)) = ea(T.ADD(e, T.LI i))  
     | ea(exp as T.SUB(e, T.LI i, _)) =  
         (ea(T.ADD(e, T.LI (~i)))  
            handle Overflow => (reduceExp exp, I.ImmedOp 0))  
     | ea(T.ADD(e1, e2)) = (reduceExp e1, I.RegOp (reduceExp e2))  
     | ea e = (reduceExp e, I.ImmedOp 0)  
   
   and store(sz, addr, data, mem) = let  
     val (r, disp) = ea addr  
   in emit(I.ST{sz=sz, rs=reduceExp data, ra=r, d=disp, mem=mem})  
   end  
353    
354    and subfImmed(i, ra, rt) =        and doStmt(s) = stmt(s,[])
     emit(  
       if signed16 i then  
          I.ARITHI{oper=I.SUBF, rt=rt, ra=ra, im=I.ImmedOp i}  
       else  
          I.ARITH{oper=I.SUBF, rt=rt, ra=ra, rb=reduceExp(T.LI i),  
                  Rc=false, OE=false})  
355    
356            (* Emit an integer store *)
357          and store(ty, ea, data, mem, an) =
358              let val (st,size) = case (ty,Gen.size ea) of
359                             (8,32)  => (I.STB,signed16)
360                           | (8,64)  => (I.STBE,signed12)
361                           | (16,32) => (I.STH,signed16)
362                           | (16,64) => (I.STHE,signed12)
363                           | (32,32) => (I.STW,signed16)
364                           | (32,64) => (I.STWE,signed12)
365                           | (64,64) => (I.STDE,signed12)
366                           | _  => error "store"
367                  val (r, disp) = addr(size,ea)
368              in  mark(I.ST{st=st, rs=expr data, ra=r, d=disp, mem=mem}, an) end
369    
370            (* Emit a floating point store *)
371          and fstore(ty, ea, data, mem, an) =
372              let val (st,size) = case (ty,Gen.size ea) of
373                             (32,32) => (I.STFS,signed16)
374                           | (32,64) => (I.STFSE,signed12)
375                           | (64,32) => (I.STFD,signed16)
376                           | (64,64) => (I.STFDE,signed12)
377                           | _  => error "fstore"
378                  val (r, disp) = addr(size,ea)
379              in  mark(I.STF{st=st,fs=fexpr data, ra=r, d=disp, mem=mem},an) end
380    
381    and orderedRR(e1, e2, T.LR) = (reduceExp e1, reduceExp e2)        and subfImmed(i, ra, rt, an) =
382      | orderedRR(e1, e2, T.RL) = let            if signed16 i then
383          val rb = reduceExp e2               mark(I.ARITHI{oper=I.SUBFIC, rt=rt, ra=ra, im=I.ImmedOp i}, an)
384        in (reduceExp e1, rb)            else
385        end               mark(I.ARITH{oper=I.SUBF, rt=rt, ra=ra, rb=expr(T.LI i),
386                              Rc=false, OE=false}, an)
387    
388    and arithTrapping(oper, e1, e2, rt, ord) = let        (*  Generate an arithmetic instruction *)
389      val (ra, rb) = orderedRR(e1, e2, ord)        and arith(oper, e1, e2, rt, an) =
390    in            mark(I.ARITH{oper=oper,ra=expr e1,rb=expr e2,rt=rt,OE=false,Rc=false},
391      if !trapsPresent = false then                 an)
392       (trapsPresent:=true;  
393        trapLabel := SOME(Label.newLabel""))        (*  Generate a trapping instruction *)
394      else ();        and arithTrapping(oper, e1, e2, rt, an) =
395      emit(I.ARITH{oper=oper, ra=ra, rb=rb, rt=rt, OE=true, Rc=true});            let val ra = expr e1 val rb = expr e2
396      emitBranch{bo=I.TRUE, bf=0, bit=I.SO, LK=false,            in  mark(I.ARITH{oper=oper,ra=ra,rb=rb,rt=rt,OE=true,Rc=true},an);
397                addr=I.LabelOp(LE.LABEL(Option.valOf (!trapLabel)))}                overflowTrap()
398    end            end
399    
400    and reduceExp(exp as T.REG 72) = reduceExpRd(exp, newReg())        (*  Generate an overflow trap *)
401      | reduceExp(T.REG r) = r        and overflowTrap() =
402      | reduceExp rexp = reduceExpRd(rexp, newReg())            let val label = case !trapLabel of
403                                NONE => let val l = Label.newLabel ""
404    (* reduceExpRd(rexp, rd) -- reduce the expression rexp, giving                                      in  trapLabel := SOME l; l end
405     *    preference to register rd as the destination.                            | SOME l => l
406     *)            in  emitBranch{bo=I.TRUE, bf=CR0, bit=I.SO, LK=false,
407    and reduceExpRd(e, 72) = let                           addr=I.LabelOp(LE.LABEL label)}
408         val rd = newReg()            end
409        in reduceExpRd(e, rd); emit(I.mtlr rd); 72  
410        end        (* Generate a load and annotate the instruction *)
411      | reduceExpRd(T.REG 72, rd) = (emit(I.mflr rd); rd)        and load(ld32, ld64, ea, mem, rt, an) =
412      | reduceExpRd(T.REG r, _) = r            let val (ld,size) =
413      | reduceExpRd(T.SEQ(stm, e), rt) = (reduceStm stm; reduceExpRd(e, rt))                if bit64mode andalso Gen.size ea = 64
414      | reduceExpRd(exp, rt) =                then (ld64,signed12)
415        (case exp                else (ld32,signed16)
416         of T.LI i => loadImmed(i, rt)                val (r, disp) = addr(size,ea)
417          | T.LI32 w => let            in  mark(I.L{ld=ld, rt=rt, ra=r, d=disp, mem=mem},an)
418              val wtoi = Word32.toIntX            end
419            in  
420             if w < 0w32768 then        (* Generate a SRA shift operation and annotate the instruction *)
421               emit(I.ARITHI{oper=I.ADD, rt=rt, ra=0, im=I.ImmedOp (wtoi w)})        and sra(oper, operi, e1, e2, rt, an) =
422             else let            case immedOpnd unsigned5 (e1, e2) of
423                val hi = Word32.~>>(w, 0w16)              (ra, I.RegOp rb) =>
424                val lo = Word32.andb(w, 0w65535)                mark(I.ARITH{oper=oper,rt=rt,ra=ra,rb=rb,Rc=false,OE=false},an)
425                val (high, low) =            | (ra, rb) =>
426                  if lo < 0w32768 then (hi, lo) else (hi+0w1, lo-0w65536)                mark(I.ARITHI{oper=operi, rt=rt, ra=ra, im=rb},an)
427              in loadImmedHiLo(wtoi high, wtoi low, rt)  
428              end        (* Generate a SRL shift operation and annotate the instruction *)
429            end        and srl32(e1, e2, rt, an) =
430          | T.LABEL lexp =>            case immedOpnd unsigned5 (e1, e2) of
431             emit(I.ARITHI{oper=I.ADD, rt=rt, ra=0, im=I.LabelOp lexp})              (ra, I.ImmedOp n) =>
432          | T.CONST c =>                mark(SRLI32{r=ra,i=n,d=rt},an)
433             emit(I.ARITHI{oper=I.ADD, rt=rt, ra=0, im=I.ConstOp c})            | (ra, rb) =>
434          | T.ADD(e1, e2) => eCommImmedOpnd signed16 (I.ADD, e1, e2, rt, T.LR)                mark(I.ARITH{oper=I.SRW,rt=rt,ra=ra,rb=reduceOpn rb,
435          | T.SUB(e1, e2 as T.LI i, ord) =>                             Rc=false,OE=false},an)
436            ((reduceExpRd(T.ADD(e1, T.LI (~i)), rt); ())  
437          and sll32(e1, e2, rt, an) =
438              case immedOpnd unsigned5 (e1, e2) of
439                (ra, rb as I.ImmedOp n) =>
440                  mark(SLLI32{r=ra,i=n,d=rt},an)
441              | (ra, rb) =>
442                  mark(I.ARITH{oper=I.SLW,rt=rt,ra=ra,rb=reduceOpn rb,
443                               Rc=false,OE=false},an)
444    
445          (* Generate a subtract operation *)
446          and subtract(ty, e1, e2 as T.LI i, rt, an) =
447                (doExpr(T.ADD(ty, e1, T.LI (~i)), rt, an)
448               handle Overflow =>               handle Overflow =>
449                (emit(I.ARITH{oper=I.SUBF, rt=rt, ra=reduceExp e2,                mark(I.ARITH{oper=I.SUBF, rt=rt, ra=expr e2,
450                              rb=reduceExp e1, OE=false, Rc=false})))                             rb=expr e1, OE=false, Rc=false}, an)
451                )
452          | T.SUB(e1 as T.LI i, e2, ord) => subfImmed(i, reduceExp e2, rt)          | subtract(ty, T.LI i, e2, rt, an) = subfImmed(i, expr e2, rt, an)
453          | T.SUB(e1, e2, ord) =>          | subtract(ty, T.CONST c, e2, rt, an) =
454            (case e1               mark(I.ARITHI{oper=I.SUBFIC,rt=rt,ra=expr e2,im=I.ConstOp c},an)
455              of T.CONST c =>          | subtract(ty, T.LI32 w, e2, rt, an) =
456                   emit(I.ARITHI{oper=I.SUBF, rt=rt, ra=reduceExp e2, im=I.ConstOp c})               subfImmed(Word32.toIntX w, expr e2, rt, an)
457               | T.LI32 w => subfImmed(Word32.toIntX w, reduceExp e2, rt)          | subtract(ty, e1, e2, rt, an) =
458               | _ => let            let val rb = expr e1 val ra = expr e2
459                     val (rb, ra) = orderedRR(e1, e2, ord)            in  mark(I.ARITH{oper=I.SUBF,rt=rt,ra=ra,rb=rb,Rc=false,OE=false},an)
460                   in emit(I.ARITH{oper=I.SUBF, rt=rt, ra=ra, rb=rb, Rc=false, OE=false})            end
461    
462              (* Generate optimized multiplication code *)
463          and multiply(ty,oper,operi,genMult,e1,e2,rt,an) =
464              let fun nonconst(e1,e2) =
465                      [mark'(
466                         case commImmedOpnd signed16 (e1,e2) of
467                           (ra,I.RegOp rb) =>
468                             I.ARITH{oper=oper,ra=ra,rb=rb,rt=rt,OE=false,Rc=false}
469                         | (ra,im) => I.ARITHI{oper=operi,ra=ra,im=im,rt=rt},
470                         an)]
471                  fun const(e,i) =
472                      let val r = expr e
473                      in  genMult{r=r,i=i,d=rt}
474                          handle _ => nonconst(T.REG(ty,r),T.LI i)
475                      end
476                  fun constw(e,i) = const(e,Word32.toInt i)
477                                     handle _ => nonconst(e,T.LI32 i)
478                  val instrs =
479                     case (e1,e2) of
480                       (_,T.LI i)   => const(e1,i)
481                     | (_,T.LI32 i) => constw(e1,i)
482                     | (T.LI i,_)   => const(e2,i)
483                     | (T.LI32 i,_) => constw(e2,i)
484                     | _            => nonconst(e1,e2)
485              in  app emit instrs end
486    
487          and divu32 x = Mulu32.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
488    
489          and divt32 x = Mult32.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
490    
491          and roundToZero{ty,r,i,d} =
492          let val L = Label.newLabel ""
493              val dReg = T.REG(ty,d)
494          in  stmt(T.MV(ty,d,T.REG(ty,r)),[]);
495              stmt(T.BCC(T.GE,T.CMP(ty,T.GE,dReg,T.LI 0),L),[]);
496              stmt(T.MV(ty,d,T.ADD(ty,dReg,T.LI i)),[]);
497              defineLabel L
498          end
499    
500              (* Generate optimized division code *)
501          and divide(ty,oper,genDiv,e1,e2,rt,overflow,an) =
502              let fun nonconst(e1,e2) =
503                     (mark(I.ARITH{oper=oper,ra=expr e1,rb=expr e2,rt=rt,
504                                   OE=overflow,Rc=overflow},an);
505                      if overflow then overflowTrap() else ()
506                      )
507                  fun const(e,i) =
508                      let val r = expr e
509                      in  app emit (genDiv{r=r,i=i,d=rt})
510                          handle _ => nonconst(T.REG(ty,r),T.LI i)
511                      end
512                  fun constw(e,i) = const(e,Word32.toInt i)
513                                    handle _ => nonconst(e,T.LI32 i)
514              in  case (e1,e2) of
515                    (_,T.LI i)   => const(e1,i)
516                  | (_,T.LI32 i) => constw(e1,i)
517                  | _            => nonconst(e1,e2)
518              end
519    
520          (* Reduce an operand into a register *)
521          and reduceOpn(I.RegOp r) = r
522            | reduceOpn opn =
523              let val rt = newReg()
524              in  emit(I.ARITHI{oper=I.ADDI, rt=rt, ra=0, im=opn});
525                  rt
526                   end                   end
           (*esac*))  
         | T.MULU(e1, e2) => eCommImmedOpnd signed16 (I.MULL, e1, e2, rt, T.LR)  
         | T.DIVU(e1, e2, ord) => arithTrapping(I.DIVWU, e1, e2, rt, ord)  
         | T.ADDT(e1, e2) => arithTrapping(I.ADD, e1, e2, rt, T.LR)  
         | T.SUBT(e1, e2, ord) => arithTrapping(I.SUBF, e2, e1, rt, ord)  
         | T.MULT(e1, e2) => arithTrapping(I.MULL, e1, e2, rt, T.LR)  
         | T.DIVT(e1, e2, ord) => arithTrapping(I.DIVW, e1, e2, rt, ord)  
   
         | T.LOAD8(addr, mem) => let  
             val (r, disp) = ea addr  
           in emit(I.L{sz=I.Byte, rt=rt, ra=r, d=disp, mem=mem})  
           end  
         | T.LOAD32(addr, mem) => let  
             val (r, disp) = ea addr  
           in emit(I.L{sz=I.Word, rt=rt, ra=r, d=disp, mem=mem})  
           end  
         | T.ANDB(e1, e2) => eCommImmedOpnd unsigned16 (I.AND, e1, e2, rt, T.LR)  
   
         | T.ORB(e1, e2) => eCommImmedOpnd unsigned16 (I.OR, e1, e2, rt, T.LR)  
         | T.XORB(e1, e2) => eCommImmedOpnd unsigned16 (I.XOR, e1, e2, rt, T.LR)  
   
         | T.SRA(e1, e2, ord) => shift (I.SRAW, e1, e2, rt, ord)  
         | T.SRL(e1, e2, ord) => shift (I.SRW,  e1, e2, rt, ord)  
         | T.SLL(e1, e2, ord) => shift (I.SLW,  e1, e2, rt, ord)  
         | _ => error "reduceExpRd"  
       (*esac*);  
       rt)  
   
   and shift(oper, e1, e2, rt, ord) =  
     emit  
      (case immedOpnd unsigned16 (e1, e2, ord)  
        of (opndA, I.RegOp rb) =>  
             I.ARITH{oper=oper, rt=rt, ra=opndA, rb=rb, Rc=false, OE=false}  
         | (opndA, opndB) =>  
             I.ARITHI{oper=oper, rt=rt, ra=opndA, im=opndB}  
       (*esac*))  
527    
528    and reduceFexp(T.FREG f) = f        (* Reduce an expression, and returns the register that holds
529      | reduceFexp(e) = reduceFexpFd(e, newFreg())         * the value.
   
   (* reduceFexpRd(fexp, fd) -- reduce the expression fexp, giving  
    *    preference to register fd as the destination.  
530     *)     *)
531    and reduceFexpFd(T.FREG f, _) = f        and expr(rexp as T.REG(_,80)) =
532      | reduceFexpFd(T.FSEQ(stm, e), fd) = (reduceStm stm; reduceFexpFd(e, fd))            let val rt = newReg()
533      | reduceFexpFd(fexp, fd) = let            in  doExpr(rexp, rt, []); rt end
534         fun fbinary(oper, fe1, fe2, ord) = let          | expr(T.REG(_,r)) = r
535           val (fa, fb) = orderedFF(fe1, fe2, ord)          | expr(rexp) =
536         in emit(I.FARITH{oper=oper, fa=fa, fb=fb, ft=fd, Rc=false})            let val rt = newReg()
537         end            in  doExpr(rexp, rt, []); rt end
538         fun funary(oper, fe) =  
539           emit(I.FUNARY{oper=oper, ft=fd, fb=reduceFexp fe, Rc=false})        (* doExpr(e, rt, an) --
540        in         *    reduce the expression e, assigns it to rd,
541         case fexp         *    and annotate the expression with an
542          of T.LOADD(addr, mem) => let         *)
543               val (r, opnd) = ea addr        and doExpr(e, 80, an) =
544             in emit(I.L{sz=I.Double, rt=fd, ra=r, d=opnd, mem=mem})             let val rt = newReg() in doExpr(e,rt,[]); mark(MTLR rt,an) end
545             end          | doExpr(e, rt, an) =
546           | T.FADDD(e1, e2) => fbinary(I.FADD, e1, e2, T.LR)             case e of
547           | T.FMULD(e1, e2) => fbinary(I.FMUL, e1, e2, T.LR)               T.REG(_,80)  => mark(MFLR rt,an)
548           | T.FSUBD(e1, e2, ord) => fbinary(I.FSUB, e1, e2, ord)             | T.REG(_,rs)  => move(rs,rt,an)
549           | T.FDIVD(e1, e2, ord) => fbinary(I.FDIV, e1, e2, ord)             | T.LI i       => loadImmed(i, rt, an)
550           | T.FABSD e => funary(I.FABS, e)             | T.LI32 w     => loadImmedw(w, rt, an)
551           | T.FNEGD e => funary(I.FNEG, e)             | T.LABEL lexp => loadLabel(lexp, rt, an)
552           | T.CVTI2D e => app emit (PseudoInstrs.cvti2d{reg=reduceExp e, fd=fd})             | T.CONST c    => loadConst(c, rt, an)
553           | _ => error "reduceFexpFd"  
554         (*esac*);               (* All data widths *)
555         fd             | T.ADD(_, e1, e2) => eCommImm signed16 (I.ADD,I.ADDI,e1,e2,rt,an)
556      end             | T.SUB(ty, e1, e2) => subtract(ty, e1, e2, rt, an)
557    
558                 (* Special PPC bit operations *)
559               | T.ANDB(_,e1,T.NOTB(_,e2)) => arith(I.ANDC,e1,e2,rt,an)
560               | T.ORB(_,e1,T.NOTB(_,e2))  => arith(I.ORC,e1,e2,rt,an)
561               | T.XORB(_,e1,T.NOTB(_,e2)) => arith(I.EQV,e1,e2,rt,an)
562               | T.ANDB(_,T.NOTB(_,e1),e2) => arith(I.ANDC,e2,e1,rt,an)
563               | T.ORB(_,T.NOTB(_,e1),e2)  => arith(I.ORC,e2,e1,rt,an)
564               | T.XORB(_,T.NOTB(_,e1),e2) => arith(I.EQV,e2,e1,rt,an)
565               | T.NOTB(_,T.ANDB(_,e1,e2)) => arith(I.NAND,e1,e2,rt,an)
566               | T.NOTB(_,T.ORB(_,e1,e2))  => arith(I.NOR,e1,e2,rt,an)
567               | T.NOTB(_,T.XORB(_,e1,e2)) => arith(I.EQV,e1,e2,rt,an)
568    
569               | T.ANDB(_, e1, e2) =>
570                   eCommImm unsigned16(I.AND,I.ANDI_Rc,e1,e2,rt,an)
571               | T.ORB(_, e1, e2) => eCommImm unsigned16(I.OR,I.ORI,e1,e2,rt,an)
572               | T.XORB(_, e1, e2) => eCommImm unsigned16(I.XOR,I.XORI,e1,e2,rt,an)
573    
574                 (* 32 bit support *)
575               | T.MULU(32, e1, e2) => multiply(32,I.MULLW,I.MULLI,
576                                                Mulu32.multiply,e1,e2,rt,an)
577               | T.DIVU(32, e1, e2) => divide(32,I.DIVWU,divu32,e1,e2,rt,false,an)
578               | T.ADDT(32, e1, e2) => arithTrapping(I.ADD, e1, e2, rt, an)
579               | T.SUBT(32, e1, e2) => arithTrapping(I.SUBF, e2, e1, rt, an)
580               | T.MULT(32, e1, e2) => arithTrapping(I.MULLW, e1, e2, rt, an)
581               | T.DIVT(32, e1, e2) => divide(32,I.DIVW,divt32,e1,e2,rt,true,an)
582    
583               | T.SRA(32, e1, e2)  => sra(I.SRAW, I.SRAWI, e1, e2, rt, an)
584               | T.SRL(32, e1, e2)  => srl32(e1, e2, rt, an)
585               | T.SLL(32, e1, e2)  => sll32(e1, e2, rt, an)
586    
587                  (* 64 bit support *)
588               | T.SRA(64, e1, e2) => sra(I.SRAD, I.SRADI, e1, e2, rt, an)
589               (*| T.SRL(64, e1, e2) => srl(32, I.SRD, I.RLDINM, e1, e2, rt, an)
590               | T.SLL(64, e1, e2) => sll(32, I.SLD, I.RLDINM, e1, e2, rt, an)*)
591    
592                  (* loads *)
593               | T.LOAD(8,ea,mem)   => load(I.LBZ,I.LBZE,ea,mem,rt,an)
594               | T.LOAD(16,ea, mem) => load(I.LHZ,I.LHZE,ea,mem,rt,an)
595               | T.LOAD(32,ea, mem) => load(I.LWZ,I.LWZE,ea,mem,rt,an)
596               | T.LOAD(64,ea, mem) => load(I.LDE,I.LDE,ea,mem,rt,an)
597    
598                  (* Conditional expression *)
599               | T.COND exp =>
600                  Gen.compileCond{exp=exp,stm=stmt,defineLabel=defineLabel,
601                                  annotations=an,rd=rt}
602    
603                  (* Misc *)
604               | T.SEQ(stm, e) => (stmt(stm,[]); doExpr(e, rt, an))
605               | T.MARK(e, a) => doExpr(e, rt, a::an)
606               | e => doExpr(Gen.compile e,rt,an)
607    
608          (* Generate a floating point load *)
609          and fload(ld32, ld64, ea, mem, ft, an) =
610              let val (ld,size) =
611                   if bit64mode andalso Gen.size ea = 64 then (ld64,signed12)
612                   else (ld32,signed16)
613                  val (r, disp) = addr(size,ea)
614              in  mark(I.LF{ld=ld, ft=ft, ra=r, d=disp, mem=mem}, an) end
615    
616          (* Generate a floating-point binary operation *)
617          and fbinary(oper, e1, e2, ft, an) =
618              mark(I.FARITH{oper=oper,fa=fexpr e1,fb=fexpr e2,ft=ft,Rc=false}, an)
619    
620          (* Generate a floating-point 3-operand operation
621           * These are of the form
622           *     +/- e1 * e3 +/- e2
623           *)
624          and f3(oper, e1, e2, e3, ft, an) =
625              mark(I.FARITH3{oper=oper,fa=fexpr e1,fb=fexpr e2,fc=fexpr e3,
626                             ft=ft,Rc=false}, an)
627    
628          (* Generate a floating-point unary operation *)
629          and funary(oper, e, ft, an) =
630              mark(I.FUNARY{oper=oper, ft=ft, fb=fexpr e, Rc=false}, an)
631    
632    fun mltreeComp mltree = let        (* Reduce the expression fexp, return the register that holds
633      fun emitTrap() = emit(I.TWI{to=31,ra=0,si=I.ImmedOp 0})         * the value.
634      fun mltc(T.PSEUDO_OP pOp)    = F.pseudoOp pOp         *)
635        | mltc(T.DEFINELABEL lab)  = F.defineLabel lab        and fexpr(T.FREG(_,f)) = f
636        | mltc(T.ENTRYLABEL lab)   = F.entryLabel lab          | fexpr(e) =
637        | mltc(T.ORDERED mlts)     = F.ordered mlts            let val ft = newFreg()
638        | mltc(T.BEGINCLUSTER)     =            in  doFexpr(e, ft, []); ft end
639           (F.beginCluster();  
640            trapLabel := NONE;        (* doExpr(fexp, ft, an) --
641            trapsPresent := false)         *   reduce the expression fexp, and assigns
642        | mltc(T.CODE stms)        = app reduceStm stms         *   it to ft. Also annotate fexp.
643        | mltc(T.BLOCK_NAME name)  = F.blockName name         *)
644        | mltc(T.ENDCLUSTER regmap)=        and doFexpr(e, ft, an) =
645           (if !trapsPresent then            case e of
646              (F.defineLabel(Option.valOf (!trapLabel));              T.FREG(_,fs) => fmove(fs,ft,an)
647               emitTrap();  
648               trapsPresent := false;              (* Single precision support *)
649               trapLabel := NONE)            | T.FLOAD(32, ea, mem) => fload(I.LFS,I.LFSE,ea,mem,ft,an)
650            else ();  
651            F.endCluster regmap)              (* special 3 operand floating point arithmetic *)
652        | mltc(T.ESCAPEBLOCK regs) = F.exitBlock regs            | T.FADD(32,T.FMUL(32,a,c),b) => f3(I.FMADDS,a,b,c,ft,an)
653    in mltc mltree            | T.FADD(32,b,T.FMUL(32,a,c)) => f3(I.FMADDS,a,b,c,ft,an)
654              | T.FSUB(32,T.FMUL(32,a,c),b) => f3(I.FMSUBS,a,b,c,ft,an)
655              | T.FSUB(32,b,T.FMUL(32,a,c)) => f3(I.FNMADDS,a,b,c,ft,an)
656              | T.FNEG(32,T.FADD(32,T.FMUL(32,a,c),b)) => f3(I.FNMSUBS,a,b,c,ft,an)
657              | T.FNEG(32,T.FADD(32,b,T.FMUL(32,a,c))) => f3(I.FNMSUBS,a,b,c,ft,an)
658              | T.FSUB(32,T.FNEG(32,T.FMUL(32,a,c)),b) => f3(I.FNMSUBS,a,b,c,ft,an)
659    
660              | T.FADD(32, e1, e2) => fbinary(I.FADDS, e1, e2, ft, an)
661              | T.FSUB(32, e1, e2) => fbinary(I.FSUBS, e1, e2, ft, an)
662              | T.FMUL(32, e1, e2) => fbinary(I.FMULS, e1, e2, ft, an)
663              | T.FDIV(32, e1, e2) => fbinary(I.FDIVS, e1, e2, ft, an)
664    
665                (* Double precision support *)
666              | T.FLOAD(64, ea, mem) => fload(I.LFD,I.LFDE,ea,mem,ft,an)
667    
668                (* special 3 operand floating point arithmetic *)
669              | T.FADD(64,T.FMUL(64,a,c),b) => f3(I.FMADD,a,b,c,ft,an)
670              | T.FADD(64,b,T.FMUL(64,a,c)) => f3(I.FMADD,a,b,c,ft,an)
671              | T.FSUB(64,T.FMUL(64,a,c),b) => f3(I.FMSUB,a,b,c,ft,an)
672              | T.FSUB(64,b,T.FMUL(64,a,c)) => f3(I.FNMADD,a,b,c,ft,an)
673              | T.FNEG(64,T.FADD(64,T.FMUL(64,a,c),b)) => f3(I.FNMSUB,a,b,c,ft,an)
674              | T.FNEG(64,T.FADD(64,b,T.FMUL(64,a,c))) => f3(I.FNMSUB,a,b,c,ft,an)
675              | T.FSUB(64,T.FNEG(64,T.FMUL(64,a,c)),b) => f3(I.FNMSUB,a,b,c,ft,an)
676    
677              | T.FADD(64, e1, e2) => fbinary(I.FADD, e1, e2, ft, an)
678              | T.FSUB(64, e1, e2) => fbinary(I.FSUB, e1, e2, ft, an)
679              | T.FMUL(64, e1, e2) => fbinary(I.FMUL, e1, e2, ft, an)
680              | T.FDIV(64, e1, e2) => fbinary(I.FDIV, e1, e2, ft, an)
681              | T.CVTI2F(64,_,e) => app emit (PseudoInstrs.cvti2d{reg=expr e,fd=ft})
682    
683                (* Single/double precision support *)
684              | T.FABS((32|64), e) => funary(I.FABS, e, ft, an)
685              | T.FNEG((32|64), e) => funary(I.FNEG, e, ft, an)
686    
687                (* Misc *)
688              | T.FSEQ(stm, e) => (doStmt stm; doFexpr(e, ft, an))
689              | T.FMARK(e, a) => doFexpr(e, ft, a::an)
690              | _ => error "doFexpr"
691    
692           and ccExpr(T.CC cc) = cc
693             | ccExpr(ccexp) =
694               let val cc = newCCreg()
695               in  doCCexpr(ccexp,cc,[]); cc end
696    
697           (* Reduce an condition expression, and assigns the result to ccd *)
698           and doCCexpr(ccexp, ccd, an) =
699               case ccexp of
700                  T.CMP(ty, cc, e1, e2) =>
701                  let val (opnds, cmp) =
702                       case cc of
703                         (T.LT | T.LE | T.EQ | T.NE | T.GT | T.GE) =>
704                           (immedOpnd signed16, I.CMP)
705                       | _ => (immedOpnd unsigned16, I.CMPL)
706                      val (opndA, opndB) = opnds(e1, e2)
707                      val l  = case ty of
708                                 32 => false
709                               | 64 => true
710                               | _  => error "doCCexpr"
711                  in mark(I.COMPARE{cmp=cmp, l=l, bf=ccd, ra=opndA, rb=opndB},an)
712                  end
713              | T.FCMP(fty, fcc, e1, e2) =>
714                 mark(I.FCOMPARE{cmp=I.FCMPU, bf=ccd, fa=fexpr e1, fb=fexpr e2},an)
715              | T.CC cc => ccmove(cc,ccd,an)
716              | T.CCMARK(cc,a) => doCCexpr(cc,ccd,a::an)
717              | _ => error "doCCexpr: Not implemented"
718    
719          and emitTrap() = emit(I.TW{to=31,ra=0,si=I.ImmedOp 0})
720    
721          fun mltreeComp(T.PSEUDO_OP pOp)    = pseudoOp pOp
722            | mltreeComp(T.DEFINELABEL lab)  = defineLabel lab
723            | mltreeComp(T.ENTRYLABEL lab)   = entryLabel lab
724            | mltreeComp(T.BEGINCLUSTER)     = (init(0); trapLabel := NONE)
725            | mltreeComp(T.CODE stms)        = app doStmt stms
726            | mltreeComp(T.BLOCK_NAME name)  = blockName name
727            | mltreeComp(T.BLOCK_ANNOTATION a) = annotation a
728            | mltreeComp(T.ENDCLUSTER regmap)=
729               (case !trapLabel of
730                  SOME label =>
731                  (defineLabel label; emitTrap(); trapLabel := NONE)
732                | NONE => ();
733               finish regmap)
734            | mltreeComp(T.ESCAPEBLOCK regs) = exitBlock regs
735            | mltreeComp _ = error "mltreeComp"
736       in
737           { mltreeComp = mltreeComp,
738             mlriscComp = doStmt,
739             emitInstr  = emit
740           }
741    end    end
742    
   fun mlriscComp stm = reduceStm stm  
743  end  end
744    

Legend:
Removed from v.410  
changed lines
  Added in v.411

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