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

Diff of /sml/trunk/src/MLRISC/sparc/mltree/sparc.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   * Machine code generator for SPARC.   * This is a new instruction selection module for Sparc,
3   *   * using the new instruction representation and the new MLTREE representation.
4   * The SPARC architecture has 32 general purpose registers (%g0 is always 0)   * Support for V9 has been added.
  * and 32 single precision floating point registers.  
  *  
  * Some Ugliness: double precision floating point registers are  
  * register pairs.  There are no double precision moves, negation and absolute  
  * values.  These require two single precision operations.  I've created  
  * composite instructions FMOVd, FNEGd and FABSd to stand for these.  
5   *   *
6   * All integer arithmetic instructions can optionally set the condition   * The cc bit in arithmetic op are now embedded within the arithmetic
7   * code register.  We use this to simplify certain comparisons with zero.   * opcode.  This should save some space.
  *  
  * Integer multiplication, division and conversion from integer to floating  
  * go thru the pseudo instruction interface, since older sparcs do not  
  * implement these instructions in hardware.  
  *  
  * In addition, the trap instruction for detecting overflow is a parameter.  
  * This allows different trap vectors to be used.  
  *  
  * The virtual register 65 is used to represent the %psr register.  
8   *   *
9   * -- Allen   * -- Allen
10   *)   *)
11    
12  functor Sparc  functor Sparc
13    (structure SparcInstr : SPARCINSTR    (structure SparcInstr : SPARCINSTR
14     structure SparcMLTree : MLTREE where Region = SparcInstr.Region     structure SparcMLTree : MLTREE
15          where Region = SparcInstr.Region
16                                    and Constant = SparcInstr.Constant                                    and Constant = SparcInstr.Constant
17     structure Flowgen : FLOWGRAPH_GEN where I = SparcInstr          and type cond = MLTreeBasis.cond
18                                       and T = SparcMLTree          and type fcond = MLTreeBasis.fcond
19                                       and B = SparcMLTree.BNames          and type rounding_mode = MLTreeBasis.rounding_mode
20     structure PseudoInstrs : SPARC_PSEUDO_INSTR where I = SparcInstr     structure Stream : INSTRUCTION_STREAM
21  (* DBM: sharing/defn conflict:        where B = SparcMLTree.BNames
22       sharing SparcInstr.Region = SparcMLTree.Region          and P = SparcMLTree.PseudoOp
23       sharing Flowgen.I=PseudoInstrs.I=SparcInstr     structure PseudoInstrs : SPARC_PSEUDO_INSTR
24       sharing Flowgen.T=SparcMLTree        where I = SparcInstr
25       sharing SparcMLTree.Constant = SparcInstr.Constant     (*
26       sharing SparcMLTree.BNames = Flowgen.B      * The client should also specify these parameters.
27        * These are the estimated cost of these instructions.
28        * The code generator will use alternative sequences that are
29        * cheaper when their costs are lower.
30        *)
31       val muluCost : int ref  (* cost of unsigned multiplication in cycles *)
32       val divuCost : int ref (* cost of unsigned division in cycles *)
33       val multCost : int ref (* cost of trapping/signed multiplication in cycles *)
34       val divtCost : int ref (* cost of trapping/signed division in cycles *)
35    
36       (*
37        * If you don't want to use register windows at all, set this to false.
38        *)
39       val registerwindow : bool ref (* should we use register windows? *)
40    
41       val V9 : bool (* should we use V9 instruction set? *)
42       val useBR : bool ref
43            (* should we use the BR instruction (when in V9)?
44             * I think it is a good idea to use it.
45  *)  *)
    val overflowtrap : SparcInstr.instruction list  
46    ) : MLTREECOMP =    ) : MLTREECOMP =
47  struct  struct
48    structure F = Flowgen    structure S  = Stream
49    structure T = SparcMLTree    structure T = SparcMLTree
50    structure R = SparcMLTree.Region    structure R = SparcMLTree.Region
51    structure I = SparcInstr    structure I = SparcInstr
52    structure C = SparcInstr.C    structure C  = I.C
53    structure LE = LabelExp    structure LE = LabelExp
54    structure W  = Word32    structure W  = Word32
55    structure P  = PseudoInstrs    structure P  = PseudoInstrs
56    
57    datatype trapping = TRAPS | SILENT    structure Gen = MLTreeGen(structure T = T
58    datatype commutative = COMMUTE | DONTCOMMUTE                              val intTy = if V9 then 64 else 32
59    datatype target =                              val naturalWidths = if V9 then [32,64] else [32]
60        CC     (* condition code only *)                             )
61      | REG    (* register only *)  
62      | CC_REG (* conditional code and register *)    functor Multiply32 = MLTreeMult
63        (structure I = I
64    fun error msg = MLRiscErrorMsg.impossible ("Sparc." ^ msg)       structure T = T
65         type arg  = {r1:C.register,r2:C.register,d:C.register}
66    val emitInstr = F.emitInstr       type argi = {r:C.register,i:int,d:C.register}
67    val emit = F.emitInstr  
68    fun newReg () = C.newReg()       val intTy = 32
69    fun newFreg() = C.newFreg()       fun mov{r,d} = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}
70         fun add{r1,r2,d} = I.ARITH{a=I.ADD,r=r1,i=I.REG r2,d=d}
71    (* load/store has 13 bits sign extended immediates *)       fun slli{r,i,d} = [I.SHIFT{s=I.SLL,r=r,i=I.IMMED i,d=d}]
72         fun srli{r,i,d} = [I.SHIFT{s=I.SRL,r=r,i=I.IMMED i,d=d}]
73         fun srai{r,i,d} = [I.SHIFT{s=I.SRA,r=r,i=I.IMMED i,d=d}]
74        )
75    
76      functor Multiply64 = MLTreeMult
77        (structure I = I
78         structure T = T
79         type arg  = {r1:C.register,r2:C.register,d:C.register}
80         type argi = {r:C.register,i:int,d:C.register}
81    
82         val intTy = 64
83         fun mov{r,d} = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}
84         fun add{r1,r2,d} = I.ARITH{a=I.ADD,r=r1,i=I.REG r2,d=d}
85         fun slli{r,i,d} = [I.SHIFT{s=I.SLLX,r=r,i=I.IMMED i,d=d}]
86         fun srli{r,i,d} = [I.SHIFT{s=I.SRLX,r=r,i=I.IMMED i,d=d}]
87         fun srai{r,i,d} = [I.SHIFT{s=I.SRAX,r=r,i=I.IMMED i,d=d}]
88        )
89    
90      (* signed, trapping version of multiply and divide *)
91      structure Mult32 = Multiply32
92        (val trapping = true
93         val signed = true
94         val multCost = multCost
95         fun addv{r1,r2,d} =
96             I.ARITH{a=I.ADDCC,r=r1,i=I.REG r2,d=d}::PseudoInstrs.overflowtrap32
97         fun subv{r1,r2,d} =
98             I.ARITH{a=I.SUBCC,r=r1,i=I.REG r2,d=d}::PseudoInstrs.overflowtrap32
99         val sh1addv = NONE
100         val sh2addv = NONE
101         val sh3addv = NONE
102        )
103    
104      (* unsigned, non-trapping version of multiply and divide *)
105      structure Mulu32 = Multiply32
106        (val trapping = false
107         val signed = false
108         val multCost = muluCost
109         fun addv{r1,r2,d} = [I.ARITH{a=I.ADD,r=r1,i=I.REG r2,d=d}]
110         fun subv{r1,r2,d} = [I.ARITH{a=I.SUB,r=r1,i=I.REG r2,d=d}]
111         val sh1addv = NONE
112         val sh2addv = NONE
113         val sh3addv = NONE
114        )
115    
116      (* signed, trapping version of multiply and divide *)
117      structure Mult64 = Multiply64
118        (val trapping = true
119         val signed = true
120         val multCost = multCost
121         fun addv{r1,r2,d} =
122             I.ARITH{a=I.ADDCC,r=r1,i=I.REG r2,d=d}::PseudoInstrs.overflowtrap64
123         fun subv{r1,r2,d} =
124             I.ARITH{a=I.SUBCC,r=r1,i=I.REG r2,d=d}::PseudoInstrs.overflowtrap64
125         val sh1addv = NONE
126         val sh2addv = NONE
127         val sh3addv = NONE
128        )
129    
130      (* unsigned, non-trapping version of multiply and divide *)
131      structure Mulu64 = Multiply64
132        (val trapping = false
133         val signed = false
134         val multCost = muluCost
135         fun addv{r1,r2,d} = [I.ARITH{a=I.ADD,r=r1,i=I.REG r2,d=d}]
136         fun subv{r1,r2,d} = [I.ARITH{a=I.SUB,r=r1,i=I.REG r2,d=d}]
137         val sh1addv = NONE
138         val sh2addv = NONE
139         val sh3addv = NONE
140        )
141    
142      datatype commutative = COMMUTE | NOCOMMUTE
143      datatype cc = REG    (* write to register *)
144                  | CC     (* set condition code *)
145                  | CC_REG (* do both *)
146    
147      fun error msg = MLRiscErrorMsg.error("Sparc",msg)
148    
149      fun selectInstructions
150           (S.STREAM{emit,defineLabel,entryLabel,blockName,pseudoOp,annotation,
151                     init,finish,exitBlock,...}) =
152      let
153          (* Flags *)
154          val useBR          = !useBR
155          val registerwindow = !registerwindow
156    
157          val trap32 = PseudoInstrs.overflowtrap32
158          val trap64 = PseudoInstrs.overflowtrap64
159          val emit = emit(fn _ => 0)
160          val newReg = C.newReg
161          val newFreg = C.newFreg
162    fun immed13 n = ~4096 <= n andalso n < 4096    fun immed13 n = ~4096 <= n andalso n < 4096
163    fun immed13w w = let        fun immed13w w = let val x = W.~>>(w,0w12)
164      val x = W.~>>(w,0w12)                         in  x = 0w0 orelse (W.notb x) = 0w0 end
165    in x=0w0 orelse (W.notb x)=0w0        fun splitw w = {hi=W.toInt(W.>>(w,0w10)),lo=W.toInt(W.andb(w,0wx3ff))}
166    end        fun split n  = splitw(W.fromInt n)
167    
   (* split into 22 high bits/10 low bits *)  
168    
169    fun splitw w =        val zeroOpn = I.REG 0 (* zero value operand *)
170        {hi=W.toInt(W.>>(w,0w10)), lo=W.toInt(W.andb(w,0wx3ff))}        val _ = if C.psr <> 65 then error "Wrong encoding for psr" else ()
171    
172    fun split n = splitw(W.fromInt n)        fun cond T.LT  = I.BL
173            | cond T.LTU = I.BCS
174            | cond T.LE  = I.BLE
175            | cond T.LEU = I.BLEU
176            | cond T.EQ  = I.BE
177            | cond T.NE  = I.BNE
178            | cond T.GE  = I.BGE
179            | cond T.GEU = I.BCC
180            | cond T.GT  = I.BG
181            | cond T.GTU = I.BGU
182    
183    (* load immediate *)        fun rcond T.LT  = I.RLZ
184    fun loadImmed(n,d) =          | rcond T.LE  = I.RLEZ
185        if immed13 n then emit(I.ARITH{a=I.OR,r=0,i=I.IMMED n,cc=false,d=d})          | rcond T.EQ  = I.RZ
186        else let          | rcond T.NE  = I.RNZ
187            val t = newReg()          | rcond T.GE  = I.RGEZ
188            val {hi,lo} = split n          | rcond T.GT  = I.RGZ
189          in          | rcond _ = error "rcond"
           if lo = 0 then emit(I.SETHI{i=hi,d=d})  
           else  
             (emit(I.SETHI{i=hi,d=t});  
              emit(I.ARITH{a=I.OR,r=t,i=I.IMMED lo,cc=false,d=d}))  
         end  
190    
191    (* load word constant *)        fun signedCmp(T.LT | T.LE | T.EQ | T.NE | T.GE | T.GT) = true
192    fun loadImmed32(w,d) =          | signedCmp _ = false
       if immed13w w then  
          emit(I.ARITH{a=I.OR,r=0,i=I.IMMED(W.toIntX w),cc=false,d=d})  
       else let  
           val t = newReg()  
           val {hi,lo} = splitw w  
         in  
           if lo = 0 then emit(I.SETHI{i=hi,d=d})  
           else  
             (emit(I.SETHI{i=hi,d=t});  
              emit(I.ARITH{a=I.OR,r=t,i=I.IMMED lo,cc=false,d=d}))  
         end  
193    
194    (* load constant *)        fun fcond T.==  = I.FBE
195    fun loadConst(c,d) = emit(I.ARITH{a=I.OR,r=0,i=I.CONST c,cc=false,d=d})          | fcond T.?<> = I.FBNE
196            | fcond T.?   = I.FBU
197            | fcond T.<=> = I.FBO
198            | fcond T.>   = I.FBG
199            | fcond T.>=  = I.FBGE
200            | fcond T.?>  = I.FBUG
201            | fcond T.?>= = I.FBUGE
202            | fcond T.<   = I.FBL
203            | fcond T.<=  = I.FBLE
204            | fcond T.?<  = I.FBUL
205            | fcond T.?<= = I.FBULE
206            | fcond T.<>  = I.FBLG
207            | fcond T.?=  = I.FBUE
208            | fcond fc = error("fcond "^MLTreeUtil.fcondToString fc)
209    
210    (* load label expression *)        fun mark'(i,[]) = i
211    fun loadLabel(lab,d) = emit(I.ARITH{a=I.OR,r=0,i=I.LAB lab,cc=false,d=d})          | mark'(i,a::an) = mark'(I.ANNOTATION{i=i,a=a},an)
212    
213          fun mark(i,an) = emit(mark'(i,an))
214    
215          (* convert an operand into a register *)
216          fun reduceOpn(I.REG r) = r
217            | reduceOpn(I.IMMED 0) = 0
218            | reduceOpn i =
219              let val d = newReg()
220              in  emit(I.ARITH{a=I.OR,r=0,i=i,d=d}); d end
221    
222    (* emit parallel copies *)    (* emit parallel copies *)
223    fun copy(dst,src) =        fun copy(dst,src,an) =
224      emit(I.COPY{dst=dst, src=src, impl=ref NONE,           mark(I.COPY{dst=dst,src=src,impl=ref NONE,
225                  tmp=case dst                      tmp=case dst of [_] => NONE
226                      of [_] => NONE                                 | _ => SOME(I.Direct(newReg()))},an)
227                       | _ => SOME(I.Direct(newReg()))})        fun fcopy(dst,src,an) =
228             mark(I.FCOPY{dst=dst,src=src,impl=ref NONE,
229    fun fcopy(dst,src) =                       tmp=case dst of [_] => NONE
230      emit(I.FCOPY{dst=dst, src=src, impl=ref NONE,                                   | _ => SOME(I.FDirect(newFreg()))},an)
               tmp=case dst  
                    of [_] => NONE  
                     | _ => SOME(I.FDirect(newReg()))})  
231    
232    (* move register s to register d *)    (* move register s to register d *)
233    fun move(s,d) =        fun move(s,d,an) =
234      if s = d orelse d = 0 then ()      if s = d orelse d = 0 then ()
235      else emit(I.COPY{dst=[d],src=[s],tmp=NONE, impl=ref NONE})            else mark(I.COPY{dst=[d],src=[s],tmp=NONE,impl=ref NONE},an)
236    
237    (* move floating point register s to register d *)    (* move floating point register s to register d *)
238    fun fmove(s,d) =        fun fmoved(s,d,an) =
239      if s = d then ()      if s = d then ()
240      else emit(I.FCOPY{dst=[d],src=[s],tmp=NONE,impl=ref NONE})            else mark(I.FCOPY{dst=[d],src=[s],tmp=NONE,impl=ref NONE},an)
241          fun fmoves(s,d,an) = error "fmoves"
242          fun fmoveq(s,d,an) = error "fmoveq"
243    
244    (* order the generation of instructions *)        (* load word constant *)
245    fun order(gen,e1,e2,T.LR) = (gen e1, gen e2)        fun loadImmedw(w,d,cc,an) =
246      | order(gen,e1,e2,T.RL) = let        let val or = if cc <> REG then I.ORCC else I.OR
247          val y = gen e2        in  if immed13w w then
248        in (gen e1, y)               mark(I.ARITH{a=or,r=0,i=I.IMMED(W.toIntX w),d=d},an)
249        end            else let val {hi,lo} = splitw w
250                   in  if lo = 0 then
251    (* generate arithmetic *)                        (mark(I.SETHI{i=hi,d=d},an); genCmp0(cc,d))
252    fun arith(opcode,e1,e2,ord,d,cc,commutative,checkOverflow) =                     else let val t = newReg()
253       let val d = case cc of                          in  emit(I.SETHI{i=hi,d=t});
254                     CC => 0                              mark(I.ARITH{a=or,r=t,i=I.IMMED lo,d=d},an)
255                   | _  => d                          end
256           val cc = case cc of                 end
257                      CC => true        end
258                    | CC_REG => true  
259                    | REG => false        (* load immediate *)
260       in  case (order(genOperand,e1,e2,ord),commutative) of        and loadImmed(n,d,cc,an) =
261             ((i,I.REG r),COMMUTE) => emit(I.ARITH{a=opcode,r=r,i=i,d=d,cc=cc})        let val or = if cc <> REG then I.ORCC else I.OR
262           | ((I.REG r,i),_)       => emit(I.ARITH{a=opcode,r=r,i=i,d=d,cc=cc})        in  if immed13 n then mark(I.ARITH{a=or,r=0,i=I.IMMED n,d=d},an)
263           | ((a,i),_) =>            else let val {hi,lo} = split n
264             let val r = newReg()                 in  if lo = 0 then
265             in  emit(I.ARITH{a=I.OR,r=0,i=a,d=r,cc=false});                        (mark(I.SETHI{i=hi,d=d},an); genCmp0(cc,d))
266                 emit(I.ARITH{a=opcode,r=r,i=i,d=d,cc=cc})                     else let val t = newReg()
267             end;                          in  emit(I.SETHI{i=hi,d=t});
268           case checkOverflow of                              mark(I.ARITH{a=or,r=t,i=I.IMMED lo,d=d},an)
             TRAPS => app emit overflowtrap  
           | SILENT => ()  
      end  
   
   (* generate shift *)  
   and shift(opcode,e1,e2,ord,d) =  
       case order(genOperand,e1,e2,ord) of  
          (I.REG r,i) => emit(I.SHIFT{s=opcode,r=r,i=i,d=d})  
       |  (a,i) => let val r = newReg()  
                   in  emit(I.ARITH{a=I.OR,r=0,i=a,d=r,cc=false});  
                       emit(I.SHIFT{s=opcode,r=r,i=i,d=d})  
                   end  
   
   (* generate external arithmetic operation *)  
   and externalarith(gen,e1,e2,ord,d,cc,commutative) =  
       let val instrs =  
             case (order(genOperand,e1,e2,ord),commutative) of  
               ((i,I.REG r),COMMUTE) => gen({r=r,i=i,d=d},reduceOperand)  
             | ((I.REG r,i),_) => gen({r=r,i=i,d=d},reduceOperand)  
             | ((a,i),_)   => let val r = newReg()  
                              in  emit(I.ARITH{a=I.OR,r=0,i=a,d=r,cc=false});  
                                  gen({r=r,i=i,d=d},reduceOperand)  
269                               end                               end
270                   end
271          end
272    
273          (* load constant *)
274          and loadConst(c,d,cc,an) =
275          let val or = if cc <> REG then I.ORCC else I.OR
276          in  mark(I.ARITH{a=or,r=0,i=I.CONST c,d=d},an) end
277    
278          (* load label expression *)
279          and loadLabel(lab,d,cc,an) =
280          let val or = if cc <> REG then I.ORCC else I.OR
281          in  mark(I.ARITH{a=or,r=0,i=I.LAB lab,d=d},an) end
282    
283          (* emit an arithmetic op *)
284          and arith(a,acc,e1,e2,d,cc,comm,trap,an) =
285          let val (a,d) = case cc of
286                             REG    => (a,d)
287                          |  CC     => (acc,0)
288                          |  CC_REG => (acc,d)
289          in  case (opn e1,opn e2,comm) of
290                (i,I.REG r,COMMUTE)=> mark(I.ARITH{a=a,r=r,i=i,d=d},an)
291              | (I.REG r,i,_)      => mark(I.ARITH{a=a,r=r,i=i,d=d},an)
292              | (r,i,_)            => mark(I.ARITH{a=a,r=reduceOpn r,i=i,d=d},an)
293              ;
294              case trap of [] => () | _ => app emit trap
295          end
296    
297          (* emit a shift op *)
298          and shift(s,e1,e2,d,cc,an) =
299             (mark(I.SHIFT{s=s,r=expr e1,i=opn e2,d=d},an);
300              genCmp0(cc,d)
301             )
302    
303          (* emit externally defined multiply or division operation (V8) *)
304          and extarith(gen,genConst,e1,e2,d,cc,comm) =
305              let fun nonconst(e1,e2) =
306                      case (opn e1,opn e2,comm) of
307                        (i,I.REG r,COMMUTE) => gen({r=r,i=i,d=d},reduceOpn)
308                      | (I.REG r,i,_) => gen({r=r,i=i,d=d},reduceOpn)
309                      | (r,i,_) => gen({r=reduceOpn r,i=i,d=d},reduceOpn)
310                  fun const(e,i) =
311                      let val r = expr e
312                      in  genConst{r=r,i=i,d=d}
313                          handle _ => gen({r=r,i=opn(T.LI i),d=d},reduceOpn)
314                     end
315                  fun constw(e,i) = const(e,Word32.toInt i)
316                                    handle _ => nonconst(e,T.LI32 i)
317                  val instrs =
318                     case (comm,e1,e2) of
319                       (_,e1,T.LI i) => const(e1,i)
320                     | (_,e1,T.LI32 i) => constw(e1,i)
321                     | (COMMUTE,T.LI i,e2) => const(e2,i)
322                     | (COMMUTE,T.LI32 i,e2) => constw(e2,i)
323                     |  _ => nonconst(e1,e2)
324        in  app emit instrs;        in  app emit instrs;
325            genCmp0(cc,d)            genCmp0(cc,d)
326        end        end
327    
328    (* Convert an operand into a register *)        (* emit 64-bit multiply or division operation (V9) *)
329    and reduceOperand(I.REG r) = r        and muldiv64(a,genConst,e1,e2,d,cc,comm,an) =
330      | reduceOperand(I.IMMED 0) = 0 (* %g0 *)            let fun nonconst(e1,e2) =
331      | reduceOperand i = let val d = newReg()                   [mark'(
332                          in  emit(I.ARITH{a=I.OR,r=0,i=i,d=d,cc=false}); d end                    case (opn e1,opn e2,comm) of
333                        (i,I.REG r,COMMUTE) => I.ARITH{a=a,r=r,i=i,d=d}
334    (* floating point arithmetic *)                    | (I.REG r,i,_) => I.ARITH{a=a,r=r,i=i,d=d}
335    and funary(opcode,e,d) = emit(I.FPop1{a=opcode,r=genFexpr e,d=d})                    | (r,i,_) => I.ARITH{a=a,r=reduceOpn r,i=i,d=d},an)
336                     ]
337    and farith(opcode,e1,e2,d,ord) =                fun const(e,i) =
338        let val (r1,r2) = order(genFexpr,e1,e2,ord)                    let val r = expr e
339        in  emit(I.FPop2{a=opcode,r1=r1,r2=r2,d=d})                    in  genConst{r=r,i=i,d=d}
340                          handle _ => [mark'(I.ARITH{a=a,r=r,i=opn(T.LI i),d=d},an)]
341                      end
342                  fun constw(e,i) = const(e,Word32.toInt i)
343                                    handle _ => nonconst(e,T.LI32 i)
344                  val instrs =
345                     case (comm,e1,e2) of
346                       (_,e1,T.LI i) => const(e1,i)
347                     | (_,e1,T.LI32 i) => constw(e1,i)
348                     | (COMMUTE,T.LI i,e2) => const(e2,i)
349                     | (COMMUTE,T.LI32 i,e2) => constw(e2,i)
350                     |  _ => nonconst(e1,e2)
351              in  app emit instrs;
352                  genCmp0(cc,d)
353        end        end
354    
355    (* compute addressing mode            (* divisions *)
356     * Sparc has only two addressing modes: displacement and indexed.        and divu32 x = Mulu32.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
357     *)        and divt32 x = Mult32.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
358    and addrMode(T.ADD(e,T.LI n))      =        and divu64 x = Mulu64.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
359          if immed13 n then (genExpr e,I.IMMED n)        and divt64 x = Mult64.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
360          else let val t = newReg()  
361                   val _ = loadImmed(n,t)        and roundToZero{ty,r,i,d} =
362               in  (t,genOperand e) end            let val L = Label.newLabel ""
363      | addrMode(T.ADD(e,T.CONST c))   = (genExpr e,I.CONST c)            in  doStmt(T.MV(ty,d,T.REG(ty,r)));
364      | addrMode(T.ADD(e,T.LABEL l))   = (genExpr e,I.LAB l)                doStmt(T.BCC(T.GE,T.CMP(ty,T.GE,T.REG(ty,d),T.LI 0),L));
365      | addrMode(T.ADD(i as T.LI _,e)) = addrMode(T.ADD(e,i))                doStmt(T.MV(ty,d,T.ADD(ty,T.REG(ty,d),T.LI i)));
366      | addrMode(T.ADD(T.CONST c,e))   = (genExpr e,I.CONST c)                defineLabel L
367      | addrMode(T.ADD(T.LABEL l,e))   = (genExpr e,I.LAB l)            end
368      | addrMode(T.ADD(e1,e2))         = (genExpr e1,I.REG(genExpr e2))  
369      | addrMode(T.SUB(e,T.LI n,_))    = addrMode(T.ADD(e,T.LI(~n)))        (* emit an unary floating point op *)
370      | addrMode(T.LABEL l)            = (0,I.LAB l)        and funary(a,e,d,an) = mark(I.FPop1{a=a,r=fexpr e,d=d},an)
371      | addrMode addr                  = (genExpr addr,I.IMMED 0)  
372          (* emit a binary floating point op *)
373    (* load integer values *)        and farith(a,e1,e2,d,an) =
374    and load(opcode,addr,mem,d) =            mark(I.FPop2{a=a,r1=fexpr e1,r2=fexpr e2,d=d},an)
375        let val (r,i) = addrMode addr  
376        in  emit(I.LOAD{l=opcode,r=r,i=i,d=d,mem=mem}) end        (* convert an expression into an addressing mode *)
377          and addr(T.ADD(_,e,T.LI n)) =
378    (* store integer values *)            if immed13 n then (expr e,I.IMMED n)
379    and store(opcode,addr,data,mem) =            else let val d = newReg()
380        let val (r,i) = addrMode addr                 in  loadImmed(n,d,REG,[]); (d,opn e) end
381        in  emit(I.STORE{s=opcode,d=data,r=r,i=i,mem=mem}) end          | addr(T.ADD(_,e,T.CONST c)) = (expr e,I.CONST c)
382            | addr(T.ADD(_,e,T.LABEL l)) = (expr e,I.LAB l)
383    (* load floating point value *)          | addr(T.ADD(ty,i as T.LI _,e)) = addr(T.ADD(ty,e,i))
384    and fload(opcode,addr,mem,d) =          | addr(T.ADD(_,T.CONST c,e)) = (expr e,I.CONST c)
385        let val (r,i) = addrMode addr          | addr(T.ADD(_,T.LABEL l,e)) = (expr e,I.LAB l)
386        in  emit(I.FLOAD{l=opcode,r=r,i=i,d=d,mem=mem}) end          | addr(T.ADD(_,e1,e2))       = (expr e1,I.REG(expr e2))
387            | addr(T.SUB(ty,e,T.LI n))   = addr(T.ADD(ty,e,T.LI(~n)))
388    (* store floating point value *)          | addr(T.LABEL l)            = (0,I.LAB l)
389    and fstore(opcode,addr,data,mem) =          | addr a                     = (expr a,zeroOpn)
390        let val (r,i) = addrMode addr  
391        in  emit(I.FSTORE{s=opcode,d=data,r=r,i=i,mem=mem}) end        (* emit an integer load *)
392          and load(l,a,d,mem,cc,an) =
393    and jmp(addr,labs) =            let val (r,i) = addr a
394        let val (r,i) = addrMode addr            in  mark(I.LOAD{l=l,r=r,i=i,d=d,mem=mem},an);
395        in  emit(I.JMP{r=r,i=i,labs=labs,nop=true}) end                genCmp0(cc,d)
396              end
397    
398    and call(addr,defs,uses) =        (* emit an integer store *)
399        let val (r,i) = addrMode addr        and store(s,a,d,mem,an) =
400              let val (r,i) = addr a
401              in  mark(I.STORE{s=s,r=r,i=i,d=expr d,mem=mem},an) end
402          (*and storecc(a,d,mem,an) =
403              let val (r,i) = addr a
404              in  mark(I.STORE{s=I.ST,r=r,i=i,d=ccExpr d,mem=mem},an) end*)
405    
406          (* emit a floating point load *)
407          and fload(l,a,d,mem,an) =
408              let val (r,i) = addr a
409              in  mark(I.FLOAD{l=l,r=r,i=i,d=d,mem=mem},an) end
410    
411          (* emit a floating point store *)
412          and fstore(s,a,d,mem,an) =
413              let val (r,i) = addr a
414              in  mark(I.FSTORE{s=s,r=r,i=i,d=fexpr d,mem=mem},an) end
415    
416          (* emit a jump *)
417          and jmp(a,labs,an) =
418              let val (r,i) = addr a
419              in  mark(I.JMP{r=r,i=i,labs=labs,nop=true},an) end
420    
421          (* emit a function call *)
422          and call(a,defs,uses,mem,an) =
423          let val (r,i) = addr a
424            fun live([],acc) = acc            fun live([],acc) = acc
425              | live(T.GPR(T.REG r)::regs,acc) = live(regs, C.addReg(r,acc))              | live(T.GPR(T.REG(32,r))::regs,acc) = live(regs, C.addReg(r,acc))
426              | live(T.CCR(T.CC 65)::regs,acc) = live(regs, acc)              | live(T.FPR(T.FREG(64,f))::regs,acc) = live(regs, C.addFreg(f,acc))
427                | live(T.CCR(T.CC 65)::regs,acc) = live(regs, C.addPSR(65,acc))
428              | live(T.CCR(T.CC cc)::regs,acc) = live(regs, C.addReg(cc,acc))              | live(T.CCR(T.CC cc)::regs,acc) = live(regs, C.addReg(cc,acc))
429              | live(T.FPR(T.FREG f)::regs,acc) = live(regs, C.addFreg(f,acc))              | live(T.GPR _::_,_) = error "live:GPR"
430                | live(T.FPR _::_,_) = error "live:FPR"
431              | live(_::regs, acc) = live(regs, acc)              | live(_::regs, acc) = live(regs, acc)
432            val defs=live(defs,C.empty)            val defs=live(defs,C.empty)
433            val uses=live(uses,C.empty)            val uses=live(uses,C.empty)
434        in  case (r,i) of        in  case (r,i) of
435              (0,I.LAB(LE.LABEL l)) =>              (0,I.LAB(LE.LABEL l)) =>
436               emit(I.CALL{label=l,defs=C.addReg(C.linkReg,defs),uses=uses,               mark(I.CALL{label=l,defs=C.addReg(C.linkReg,defs),uses=uses,
437                           nop=true})                           mem=mem,nop=true},an)
438            | _ => emit(I.JMPL{r=r,i=i,d=C.linkReg,defs=defs,uses=uses,nop=true})            | _ => mark(I.JMPL{r=r,i=i,d=C.linkReg,defs=defs,uses=uses,mem=mem,
439        end                               nop=true},an)
440          end
   (* Generate code for a statement *)  
   and doStmt stmt =  
       case stmt of  
          T.MV(d,e)        => doExpr(e,d,REG)  
       |  T.FMV(d,e)       => doFexpr(e,d)  
       |  T.CCMV(d,e)      => doCCexpr(e,d)  
       |  T.COPY(dst,src)  => copy(dst,src)  
       |  T.FCOPY(dst,src) => fcopy(dst,src)  
       |  T.JMP(T.LABEL(LE.LABEL l),_) =>  
              emit(I.Bicc{b=I.BA,a=true,label=l,nop=false})  
       |  T.JMP(e,labs) => jmp(e,labs)  
       |  T.CALL(e,def,use) => call(e,def,use)  
       |  T.RET => emit(I.RET{leaf=false,nop=true})  
       |  T.STORE8(addr,data,mem) => store(I.STB,addr,genExpr data,mem)  
       |  T.STORE32(addr,data,mem) => store(I.ST,addr,genExpr data,mem)  
       |  T.STORED(addr,data,mem) => fstore(I.STDF,addr,genFexpr data,mem)  
       |  T.STORECC(addr,data,mem) => store(I.ST,addr,genCCexpr data,mem)  
       |  T.BCC(cond,cc,lab) => branch(cond,cc,lab)  
       |  T.FBCC(cond,cc,lab) => fbranch(cond,cc,lab)  
441    
442         (*        (* emit an integer branch instruction *)
443          * generate conditional branches        and branch(_,T.CMP(ty,cond,a,b),lab,an) =
444          * Perform a subtract (with cc), then branch on cc.            let val (cond,a,b) =
445          * Note: when we are comparing with zero, do something smarter.                    case a of
446          *)                      (T.LI _ | T.LI32 _ | T.CONST _ | T.LABEL _) =>
447     and branch(_,T.CMP(cond,e1,e2,order),lab) =                        (MLTreeUtil.swapCond cond,b,a)
448         let val (cond,e1,e2) =                    | _ => (cond,a,b)
449              case e1 of            in  if V9 then
450                (T.LI _ | T.LI32 _ | T.CONST _ | T.LABEL _) => (flip cond,e2,e1)                   branchV9(cond,a,b,lab,an)
451              | _ => (cond,e1,e2)                else
452         in  doExpr(T.SUB(e1,e2,order),newReg(),CC); br(cond,lab)                   (doExpr(T.SUB(ty,a,b),newReg(),CC,[]); br(cond,lab,an))
453         end            end
454       | branch(cond,T.CC 65,lab) = (* psr *)          | branch(cond,T.CC 65,lab,an) = br(cond,lab,an)
455           br(cond,lab)          | branch(cond,T.CC r,lab,an) = (genCmp0(CC,r); br(cond,lab,an))
      | branch(cond,T.CC r,lab) =  
          (genCmp0(CC,r); br(cond,lab))  
456       | branch _ = error "branch"       | branch _ = error "branch"
457    
458     and cond T.LT  = I.BL        and branchV9(cond,a,b,lab,an) =
459       | cond T.LTU = I.BCS            let val size = Gen.size a
460       | cond T.LE  = I.BLE            in  if useBR andalso signedCmp cond then
461       | cond T.LEU = I.BLEU                   let val r = newReg()
462       | cond T.EQ  = I.BE                   in  doExpr(T.SUB(size,a,b),r,REG,[]);
463       | cond T.NEQ = I.BNE                       brcond(cond,r,lab,an)
464       | cond T.GE  = I.BGE                   end
465       | cond T.GEU = I.BCC                else
466       | cond T.GT  = I.BG                   let val cc = case size of 32 => I.ICC
467       | cond T.GTU = I.BGU                                           | 64 => I.XCC
468                                             | _ => error "branchV9"
469         (* exchange the order of the arguments to a comparison *)                   in  doExpr(T.SUB(size,a,b),newReg(),CC,[]);
470     and flip T.LT  = T.GT                       bp(cond,cc,lab,an)
471       | flip T.LTU = T.GTU                   end
472       | flip T.LE  = T.GE           end
      | flip T.LEU = T.GEU  
      | flip T.EQ  = T.EQ  
      | flip T.NEQ = T.NEQ  
      | flip T.GE  = T.LE  
      | flip T.GEU = T.LEU  
      | flip T.GT  = T.LT  
      | flip T.GTU = T.LTU  
   
    and fcond T.==  = I.FBE  
      | fcond T.?<> = I.FBNE  
      | fcond T.?   = I.FBU  
      | fcond T.<=> = I.FBO  
      | fcond T.>   = I.FBG  
      | fcond T.>=  = I.FBGE  
      | fcond T.?>  = I.FBUG  
      | fcond T.?>= = I.FBUGE  
      | fcond T.<   = I.FBL  
      | fcond T.<=  = I.FBLE  
      | fcond T.?<  = I.FBUL  
      | fcond T.?<= = I.FBULE  
      | fcond T.<>  = I.FBLG  
      | fcond T.?=  = I.FBUE  
   
    and br(c,lab) = emit(I.Bicc{b=cond c,a=true,label=lab,nop=true})  
473    
474     and fbranch(_,T.FCMP(cond,e1,e2,ord),lab) =        and br(c,lab,an) = mark(I.Bicc{b=cond c,a=true,label=lab,nop=true},an)
475          let val (r1,r2) = order(genFexpr,e1,e2,ord)  
476          in  emit(I.FCMP{cmp=I.FCMPd,r1=r1,r2=r2,nop=true});        and brcond(c,r,lab,an) =
477              emit(I.FBfcc{b=fcond cond,a=false,label=lab,nop=true})             mark(I.BR{rcond=rcond c,r=r,p=I.PT,a=true,label=lab,nop=true},an)
478    
479          and bp(c,cc,lab,an) =
480               mark(I.BP{b=cond c,cc=cc,p=I.PT,a=true,label=lab,nop=true},an)
481    
482          (* emit a floating point branch instruction *)
483          and fbranch(c,T.FCMP(fty,cond,a,b),lab,an) =
484              let val cmp = case fty of
485                              32 => I.FCMPs
486                            | 64 => I.FCMPd
487                            | _  => error "fbranch"
488              in  emit(I.FCMP{cmp=cmp,r1=fexpr a,r2=fexpr b,nop=true});
489                  mark(I.FBfcc{b=fcond cond,a=false,label=lab,nop=true},an)
490          end          end
491       | fbranch _ = error "fbranch"       | fbranch _ = error "fbranch"
492    
493         (* compute expr and write the result to register d,            (* generate code for a statement *)
494          * optionally set the condition code register.        and stmt(T.MV(_,d,e),an) = doExpr(e,d,REG,an)
495          *)          | stmt(T.FMV(_,d,e),an) = doFexpr(e,d,an)
496     and doExpr(expr,d,cc) =          | stmt(T.CCMV(d,e),an) = doCCexpr(e,d,an)
497         case expr of          | stmt(T.COPY(_,dst,src),an) = copy(dst,src,an)
498            T.REG r          => (move(r,d); genCmp0(cc,r))          | stmt(T.FCOPY(64,dst,src),an) = fcopy(dst,src,an)
499         |  T.LI n           => (loadImmed(n,d); genCmp0(cc,d))          | stmt(T.JMP(T.LABEL(LE.LABEL l),_),an) =
500         |  T.LI32 w         => (loadImmed32(w,d); genCmp0(cc,d))              mark(I.Bicc{b=I.BA,a=true,label=l,nop=false},an)
501         |  T.LABEL lab      => (loadLabel(lab,d); genCmp0(cc,d))          | stmt(T.JMP(e,labs),an) = jmp(e,labs,an)
502         |  T.CONST c        => (loadConst(c,d); genCmp0(cc,d))          | stmt(T.CALL(e,def,use,mem),an) = call(e,def,use,mem,an)
503         |  T.ADD(e1,e2)     => arith(I.ADD,e1,e2,T.LR,d,cc,COMMUTE,SILENT)          | stmt(T.RET,an) = mark(I.RET{leaf=not registerwindow,nop=true},an)
504         |  T.SUB(e1,T.LI 0,_) => doExpr(e1,d,cc)          | stmt(T.STORE(8,a,d,mem),an)   = store(I.STB,a,d,mem,an)
505         |  T.SUB(e1,T.LI32 0w0,_) => doExpr(e1,d,cc)          | stmt(T.STORE(16,a,d,mem),an)  = store(I.STH,a,d,mem,an)
506         |  T.SUB(e1,e2,ord) => arith(I.SUB,e1,e2,ord,d,cc,DONTCOMMUTE,SILENT)          | stmt(T.STORE(32,a,d,mem),an)  = store(I.ST,a,d,mem,an)
507         |  T.ADDT(e1,e2)    => arith(I.ADD,e1,e2,T.LR,d,CC_REG,COMMUTE,TRAPS)          | stmt(T.STORE(64,a,d,mem),an)  =
508         |  T.SUBT(e1,e2,ord)=> arith(I.SUB,e1,e2,ord,d,CC_REG,DONTCOMMUTE,TRAPS)               store(if V9 then I.STX else I.STD,a,d,mem,an)
509         |  T.ANDB(e1,e2)    => arith(I.AND,e1,e2,T.LR,d,cc,COMMUTE,SILENT)          | stmt(T.FSTORE(32,a,d,mem),an) = fstore(I.STF,a,d,mem,an)
510         |  T.ORB(e1,e2)     => arith(I.OR,e1,e2,T.LR,d,cc,COMMUTE,SILENT)          | stmt(T.FSTORE(64,a,d,mem),an) = fstore(I.STDF,a,d,mem,an)
511         |  T.XORB(e1,e2)    => arith(I.XOR,e1,e2,T.LR,d,cc,COMMUTE,SILENT)          | stmt(T.BCC(cond,cc,lab),an)   = branch(cond,cc,lab,an)
512         |  T.SRA(e1,e2,ord) => (shift(I.SRA,e1,e2,ord,d); genCmp0(cc,d))          | stmt(T.FBCC(cond,cc,lab),an)  = fbranch(cond,cc,lab,an)
513         |  T.SRL(e1,e2,ord) => (shift(I.SRL,e1,e2,ord,d); genCmp0(cc,d))          | stmt(T.ANNOTATION(s,a),an) = stmt(s,a::an)
514         |  T.SLL(e1,e2,ord) => (shift(I.SLL,e1,e2,ord,d); genCmp0(cc,d))          | stmt _ = error "stmt"
515         |  T.LOAD8(addr,mem) => (load(I.LDUB,addr,mem,d); genCmp0(cc,d))  
516         |  T.LOAD32(addr,mem) => (load(I.LD,addr,mem,d); genCmp0(cc,d))        and doStmt s = stmt(s,[])
517         |  T.SEQ(stmt,e) => (doStmt stmt; doExpr(e,d,cc))  
518         |  T.MULU(e1,e2)    => externalarith(P.umul,e1,e2,T.LR,d,cc,COMMUTE)  
519         |  T.MULT(e1,e2)    => externalarith(P.smul,e1,e2,T.LR,d,cc,COMMUTE)            (* convert an expression into a register *)
520         |  T.DIVU(e1,e2,ord)=> externalarith(P.udiv,e1,e2,ord,d,cc,DONTCOMMUTE)        and expr(T.REG(_,r)) = r
521         |  T.DIVT(e1,e2,ord)=> externalarith(P.sdiv,e1,e2,ord,d,cc,DONTCOMMUTE)          | expr(T.LI 0)     = 0
522            | expr(T.LI32 0w0) = 0
523        (* Compare with zero if cc is set *)          | expr e           = let val d = newReg()
524    and genCmp0(cc,d) =                               in  doExpr(e,d,REG,[]); d end
       case cc of  
          REG => ()  
       |  _   => emit(I.ARITH{a=I.SUB,r=d,i=I.IMMED 0,d=0,cc=true})  
   
   and doFexpr(expr,d) =  
       case expr of  
          T.FREG r           => fmove(r,d)  
       |  T.LOADD(addr,mem)  => fload(I.LDDF,addr,mem,d)  
       |  T.FADDD(e1,e2)     => farith(I.FADDd,e1,e2,d,T.LR)  
       |  T.FMULD(e1,e2)     => farith(I.FMULd,e1,e2,d,T.LR)  
       |  T.FSUBD(e1,e2,ord) => farith(I.FSUBd,e1,e2,d,ord)  
       |  T.FDIVD(e1,e2,ord) => farith(I.FDIVd,e1,e2,d,ord)  
       |  T.FABSD e          => funary(I.FABSd,e,d)  
       |  T.FNEGD e          => funary(I.FNEGd,e,d)  
       |  T.CVTI2D e         => app emit  
                                  (P.cvti2d({i=genOperand e,d=d},reduceOperand))  
       |  T.FSEQ(stmt,e)     => (doStmt stmt; doFexpr(e,d))  
   
    and doCCexpr(T.CMP(cond,e1,e2,ord),65) = (* psr *)  
          doExpr(T.SUB(e1,e2,ord),newReg(),CC)  
      | doCCexpr(_,65) = error "doCCexpr 65"  
      | doCCexpr(expr,d) =  
        case expr of  
           T.CC r => move(r,d)  
        |  T.LOADCC(addr,mem) => load(I.LD,addr,mem,d)  
        |  _ => error "doCCexpr"  
525    
526        (*            (* compute an integer expression and put the result in register d
527         * generate an expression and return the register that holds its value             * If cc is set then set the condition code with the result.
528         *)         *)
529    and genExpr(T.LI 0) = 0 (* register %g0 *)        and doExpr(e,d,cc,an) =
530      | genExpr(T.LI32 0w0) = 0 (* register %g0 *)            case e of
531      | genExpr(T.REG r) = r              T.REG(_,r) => (move(r,d,an); genCmp0(cc,r))
532      | genExpr expr = let val r = newReg() in doExpr(expr,r,REG); r end            | T.LI n     => loadImmed(n,d,cc,an)
533              | T.LI32 w   => loadImmedw(w,d,cc,an)
534    and genFexpr(T.FREG r) = r            | T.LABEL l  => loadLabel(l,d,cc,an)
535      | genFexpr expr = let val r = newFreg() in doFexpr(expr,r); r end            | T.CONST c  => loadConst(c,d,cc,an)
536    
537    and genCCexpr(T.CC 65) = error "genCCexpr"                  (* generic 32/64 bit support *)
538      | genCCexpr(T.CC r) = r            | T.ADD(_,a,b) => arith(I.ADD,I.ADDCC,a,b,d,cc,COMMUTE,[],an)
539      | genCCexpr expr = let val r = newReg() in doCCexpr(expr,r); r end            | T.SUB(_,a,T.LI 0) => doExpr(a,d,cc,an)
540              | T.SUB(_,a,T.LI32 0w0) => doExpr(a,d,cc,an)
541              | T.SUB(_,a,b) => arith(I.SUB,I.SUBCC,a,b,d,cc,NOCOMMUTE,[],an)
542    
543              | T.ANDB(_,a,T.NOTB(_,b)) =>
544                   arith(I.ANDN,I.ANDNCC,a,b,d,cc,NOCOMMUTE,[],an)
545              | T.ORB(_,a,T.NOTB(_,b)) =>
546                   arith(I.ORN,I.ORNCC,a,b,d,cc,NOCOMMUTE,[],an)
547              | T.XORB(_,a,T.NOTB(_,b)) =>
548                   arith(I.XNOR,I.XNORCC,a,b,d,cc,COMMUTE,[],an)
549              | T.ANDB(_,T.NOTB(_,a),b) =>
550                   arith(I.ANDN,I.ANDNCC,b,a,d,cc,NOCOMMUTE,[],an)
551              | T.ORB(_,T.NOTB(_,a),b) =>
552                   arith(I.ORN,I.ORNCC,b,a,d,cc,NOCOMMUTE,[],an)
553              | T.XORB(_,T.NOTB(_,a),b) =>
554                   arith(I.XNOR,I.XNORCC,b,a,d,cc,COMMUTE,[],an)
555              | T.NOTB(_,T.XORB(_,a,b)) =>
556                   arith(I.XNOR,I.XNORCC,a,b,d,cc,COMMUTE,[],an)
557    
558              | T.ANDB(_,a,b) => arith(I.AND,I.ANDCC,a,b,d,cc,COMMUTE,[],an)
559              | T.ORB(_,a,b) => arith(I.OR,I.ORCC,a,b,d,cc,COMMUTE,[],an)
560              | T.XORB(_,a,b) => arith(I.XOR,I.XORCC,a,b,d,cc,COMMUTE,[],an)
561              | T.NOTB(_,a) => arith(I.XNOR,I.XNORCC,a,T.LI 0,d,cc,COMMUTE,[],an)
562    
563                   (* 32 bit support *)
564              | T.SRA(32,a,b) => shift(I.SRA,a,b,d,cc,an)
565              | T.SRL(32,a,b) => shift(I.SRL,a,b,d,cc,an)
566              | T.SLL(32,a,b) => shift(I.SLL,a,b,d,cc,an)
567              | T.ADDT(32,a,b)=>
568                   arith(I.ADDCC,I.ADDCC,a,b,d,CC_REG,COMMUTE,trap32,an)
569              | T.SUBT(32,a,b)=>
570                   arith(I.SUBCC,I.SUBCC,a,b,d,CC_REG,NOCOMMUTE,trap32,an)
571              | T.MULU(32,a,b) => extarith(P.umul,Mulu32.multiply,a,b,d,cc,COMMUTE)
572              | T.MULT(32,a,b) => extarith(P.smul,Mult32.multiply,a,b,d,cc,COMMUTE)
573              | T.DIVU(32,a,b) => extarith(P.udiv,divu32,a,b,d,cc,NOCOMMUTE)
574              | T.DIVT(32,a,b) => extarith(P.sdiv,divt32,a,b,d,cc,NOCOMMUTE)
575    
576                   (* 64 bit support *)
577              | T.SRA(64,a,b) => shift(I.SRAX,a,b,d,cc,an)
578              | T.SRL(64,a,b) => shift(I.SRLX,a,b,d,cc,an)
579              | T.SLL(64,a,b) => shift(I.SLLX,a,b,d,cc,an)
580              | T.ADDT(64,a,b)=>
581                   arith(I.ADDCC,I.ADDCC,a,b,d,CC_REG,COMMUTE,trap64,an)
582              | T.SUBT(64,a,b)=>
583                   arith(I.SUBCC,I.SUBCC,a,b,d,CC_REG,NOCOMMUTE,trap64,an)
584              | T.MULU(64,a,b) =>
585                  muldiv64(I.MULX,Mulu64.multiply,a,b,d,cc,COMMUTE,an)
586              | T.MULT(64,a,b) =>
587                  (muldiv64(I.MULX,Mult64.multiply,a,b,d,CC_REG,COMMUTE,an);
588                   app emit trap64)
589              | T.DIVU(64,a,b) => muldiv64(I.UDIVX,divu64,a,b,d,cc,NOCOMMUTE,an)
590              | T.DIVT(64,a,b) => muldiv64(I.SDIVX,divt64,a,b,d,cc,NOCOMMUTE,an)
591    
592                  (* loads *)
593              | T.LOAD(8,a,mem) => load(I.LDUB,a,d,mem,cc,an)
594              | T.CVTI2I(_,T.SIGN_EXTEND,T.LOAD(8,a,mem)) =>
595                   load(I.LDSB,a,d,mem,cc,an)
596              | T.LOAD(16,a,mem) => load(I.LDUH,a,d,mem,cc,an)
597              | T.CVTI2I(_,T.SIGN_EXTEND,T.LOAD(16,a,mem)) =>
598                   load(I.LDSH,a,d,mem,cc,an)
599              | T.LOAD(32,a,mem) => load(I.LD,a,d,mem,cc,an)
600              | T.LOAD(64,a,mem) => load(if V9 then I.LDX else I.LDD,a,d,mem,cc,an)
601    
602                 (* conditional expression *)
603              | T.COND exp =>
604                 Gen.compileCond{exp=exp,stm=stmt,defineLabel=defineLabel,
605                                 annotations=an,rd=d}
606    
607                 (* misc *)
608              | T.SEQ(s,e) => (doStmt s; doExpr(e,d,cc,an))
609              | T.MARK(e,a) => doExpr(e,d,cc,a::an)
610              | e => doExpr(Gen.compile e,d,cc,an)
611    
612             (* generate a comparison with zero *)
613          and genCmp0(REG,_) = ()
614            | genCmp0(_,d) = emit(I.ARITH{a=I.SUBCC,r=d,i=zeroOpn,d=0})
615    
616              (* convert an expression into a floating point register *)
617          and fexpr(T.FREG(_,r)) = r
618            | fexpr e            = let val d = newFreg() in doFexpr(e,d,[]); d end
619    
620              (* compute a floating point expression and put the result in d *)
621          and doFexpr(e,d,an) =
622              case e of
623                (* single precision *)
624                T.FREG(32,r)    => fmoves(r,d,an)
625              | T.FLOAD(32,ea,mem)  => fload(I.LDF,ea,d,mem,an)
626              | T.FLOAD_UNALIGNED(32,ea,mem) => fload(I.LDF,ea,d,mem,an)
627              | T.FADD(32,a,b)  => farith(I.FADDs,a,b,d,an)
628              | T.FSUB(32,a,b)  => farith(I.FSUBs,a,b,d,an)
629              | T.FMUL(32,a,b)  => farith(I.FMULs,a,b,d,an)
630              | T.FDIV(32,a,b)  => farith(I.FDIVs,a,b,d,an)
631              | T.FABS(32,a)    => funary(I.FABSs,a,d,an)
632              | T.FNEG(32,a)    => funary(I.FNEGs,a,d,an)
633              | T.FSQRT(32,a)   => funary(I.FSQRTs,a,d,an)
634    
635                (* double precision *)
636              | T.FREG(64,r)    => fmoved(r,d,an)
637              | T.FLOAD(64,ea,mem)  => fload(I.LDDF,ea,d,mem,an)
638              | T.FLOAD_UNALIGNED(64,ea,mem) => fload(I.LDDF,ea,d,mem,an)
639              | T.FADD(64,a,b)  => farith(I.FADDd,a,b,d,an)
640              | T.FSUB(64,a,b)  => farith(I.FSUBd,a,b,d,an)
641              | T.FMUL(64,a,b)  => farith(I.FMULd,a,b,d,an)
642              | T.FDIV(64,a,b)  => farith(I.FDIVd,a,b,d,an)
643              | T.FABS(64,a)    => funary(I.FABSd,a,d,an)
644              | T.FNEG(64,a)    => funary(I.FNEGd,a,d,an)
645              | T.FSQRT(64,a)   => funary(I.FSQRTd,a,d,an)
646    
647                (* quad precision *)
648              | T.FREG(128,r)   => fmoveq(r,d,an)
649              | T.FADD(128,a,b) => farith(I.FADDq,a,b,d,an)
650              | T.FSUB(128,a,b) => farith(I.FSUBq,a,b,d,an)
651              | T.FMUL(128,a,b) => farith(I.FMULq,a,b,d,an)
652              | T.FDIV(128,a,b) => farith(I.FDIVq,a,b,d,an)
653              | T.FABS(128,a)   => funary(I.FABSq,a,d,an)
654              | T.FNEG(128,a)   => funary(I.FNEGq,a,d,an)
655              | T.FSQRT(128,a)  => funary(I.FSQRTq,a,d,an)
656    
657                (* floating point to floating point *)
658              | T.CVTF2F(ty,_,e) =>
659                  (case (ty,Gen.fsize e) of
660                     (32,32) =>  doFexpr(e,d,an)
661                   | (64,32) =>  funary(I.FsTOd,e,d,an)
662                   | (128,32) => funary(I.FsTOq,e,d,an)
663                   | (32,64) =>  funary(I.FdTOs,e,d,an)
664                   | (64,64) =>  doFexpr(e,d,an)
665                   | (128,64) => funary(I.FdTOq,e,d,an)
666                   | (32,128) => funary(I.FqTOs,e,d,an)
667                   | (64,128) => funary(I.FqTOd,e,d,an)
668                   | (128,128) => doFexpr(e,d,an)
669                   | _ => error "CVTF2F"
670                  )
671    
672                (* integer to floating point *)
673              | T.CVTI2F(32,T.SIGN_EXTEND,e) =>
674                   app emit (P.cvti2s({i=opn e,d=d},reduceOpn))
675              | T.CVTI2F(64,T.SIGN_EXTEND,e) =>
676                   app emit (P.cvti2d({i=opn e,d=d},reduceOpn))
677              | T.CVTI2F(128,T.SIGN_EXTEND,e) =>
678                   app emit (P.cvti2q({i=opn e,d=d},reduceOpn))
679    
680              | T.FSEQ(s,e)     => (doStmt s; doFexpr(e,d,an))
681              | T.FMARK(e,a)    => doFexpr(e,d,a::an)
682              | _               => error "doFexpr"
683    
684          and doCCexpr(T.CMP(ty,cond,e1,e2),65,an) =
685                doExpr(T.SUB(ty,e1,e2),newReg(),CC,an)
686            | doCCexpr(T.CMP _,d,an) = error "doCCexpr"
687            | doCCexpr(_,65,an) = error "doCCexpr"
688            | doCCexpr(T.CC 65,d,an) = error "doCCexpr"
689            | doCCexpr(T.CC r,d,an) = move(r,d,an)
690            | doCCexpr(T.CCMARK(e,a),d,an) = doCCexpr(e,d,a::an)
691            | doCCexpr e = error "doCCexpr"
692    
693          and ccExpr e = let val d = newReg() in doCCexpr(e,d,[]); d end
694    
695              (* convert an expression into an operand *)
696          and opn(T.LI 0)        = zeroOpn
697            | opn(T.LI32 0w0)    = zeroOpn
698            | opn(T.CONST c)     = I.CONST c
699            | opn(T.LABEL l)     = I.LAB l
700            | opn(e as T.LI n)   = if immed13 n then I.IMMED n else I.REG(expr e)
701            | opn(e as T.LI32 n) =
702                 if immed13w n then I.IMMED(W.toIntX n) else I.REG(expr e)
703            | opn e              = I.REG(expr e)
704    
       (*  
        * generate an expression and returns it as an operand  
        *)  
   and genOperand(T.LI 0)     = I.REG 0  
     | genOperand(T.LI32 0w0) = I.REG 0  
     | genOperand(e as T.LI n) =  
           if immed13 n then I.IMMED n else I.REG(genExpr e)  
     | genOperand(e as T.LI32 w)  =  
           if immed13w w then I.IMMED(W.toIntX w) else I.REG(genExpr e)  
     | genOperand(T.CONST c) = I.CONST c  
     | genOperand(T.LABEL l) = I.LAB l  
     | genOperand(e)         = I.REG(genExpr e)  
705    
706    fun mltreeComp mltree =    fun mltreeComp mltree =
707    let (* condition code registers are mapped onto general registers *)        let fun cc((r as T.CCR(T.CC 65))::l) = r::cc l
708        fun cc (x as T.CCR(T.CC 65),l) = l              | cc(T.CCR(T.CC r)::l) = T.GPR(T.REG(32,r))::cc l
709          | cc (T.CCR(T.CC cc),l) = T.GPR(T.REG cc)::l              | cc(r::l) = r::cc l
710          | cc (x,l) = x::l              | cc []    = []
711        fun comp(T.BEGINCLUSTER)      = F.beginCluster()            fun comp(T.BEGINCLUSTER)      = init 0
712          | comp(T.PSEUDO_OP p)       = F.pseudoOp p              | comp(T.PSEUDO_OP p)       = pseudoOp p
713          | comp(T.DEFINELABEL lab)   = F.defineLabel lab              | comp(T.DEFINELABEL l)     = defineLabel l
714          | comp(T.ENTRYLABEL lab)    = F.entryLabel lab              | comp(T.ENTRYLABEL l)      = entryLabel l
715          | comp(T.CODE stmts)        = app doStmt stmts          | comp(T.CODE stmts)        = app doStmt stmts
716          | comp(T.BLOCK_NAME name)  = F.blockName name              | comp(T.BLOCK_NAME n)      = blockName n
717          | comp(T.ORDERED mltrees)   = F.ordered mltrees              | comp(T.BLOCK_ANNOTATION a)= annotation a
718          | comp(T.ESCAPEBLOCK regs)  = F.exitBlock(foldl cc [] regs)              | comp(T.ESCAPEBLOCK regs)  = exitBlock(cc regs)
719          | comp(T.ENDCLUSTER regmap) = F.endCluster regmap              | comp(T.ENDCLUSTER regmap) = finish regmap
720    in  comp mltree              | comp _                    = error "mltreeComp"
721          in  comp mltree end
722    
723      in  { mltreeComp = mltreeComp,
724            mlriscComp = doStmt,
725            emitInstr  = emit
726          }
727    end    end
728    
   val mlriscComp = doStmt  
   
729  end  end
730    
731  (*  (*
732   * $Log: sparc.sml,v $   * Machine code generator for SPARC.
  * Revision 1.1.1.1  1999/01/04 21:56:27  george  
  *   Version 110.12  
  *  
  * Revision 1.4  1998/09/30 19:36:54  dbm  
  * fixing sharing/defspec conflict  
733   *   *
734   * Revision 1.3  1998/08/12 13:36:15  leunga   * The SPARC architecture has 32 general purpose registers (%g0 is always 0)
735     * and 32 single precision floating point registers.
736   *   *
737     * Some Ugliness: double precision floating point registers are
738     * register pairs.  There are no double precision moves, negation and absolute
739     * values.  These require two single precision operations.  I've created
740     * composite instructions FMOVd, FNEGd and FABSd to stand for these.
741   *   *
742   *   Fixed the 2.0 + 2.0 == nan bug by treating FCMP as instrs with delay slots   * All integer arithmetic instructions can optionally set the condition
743     * code register.  We use this to simplify certain comparisons with zero.
744   *   *
745   * Revision 1.2  1998/08/11 14:03:25  george   * Integer multiplication, division and conversion from integer to floating
746   *   Exposed emitInstr in MLTREECOMP to allow a client to directly   * go thru the pseudo instruction interface, since older sparcs do not
747   *   inject native instructions into the flowgraph.   * implement these instructions in hardware.
748   *   *
749   * Revision 1.1.1.1  1998/08/05 19:38:49  george   * In addition, the trap instruction for detecting overflow is a parameter.
750   *   Release 110.7.4   * This allows different trap vectors to be used.
751   *   *
752     * -- Allen
753   *)   *)

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