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

Diff of /sml/trunk/src/MLRISC/mltree/mltree-gen.sml

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

revision 1182, Thu Mar 28 16:41:29 2002 UTC revision 1183, Fri Mar 29 19:09:48 2002 UTC
# Line 36  Line 36 
36     structure Size = MLTreeSize(structure T = T val intTy = intTy)     structure Size = MLTreeSize(structure T = T val intTy = intTy)
37     structure C  = CellsBasis     structure C  = CellsBasis
38    
    exception Unsupported of string  
   
39     fun error msg = MLRiscErrorMsg.error("MLTreeGen",msg)     fun error msg = MLRiscErrorMsg.error("MLTreeGen",msg)
40       fun unsupported what = error ("unsupported: " ^ what)
41    
42     val zeroT = T.LI(T.I.int_0)     val zeroT = T.LI(T.I.int_0)
43     fun LI i = T.LI(T.I.fromInt(intTy, i))     fun LI i = T.LI(T.I.fromInt(intTy, i))
# Line 71  Line 70 
70    
71     fun promoteTy(ty) =     fun promoteTy(ty) =
72     let fun loop([]) =     let fun loop([]) =
73             raise Unsupported("can't promote integer width "^Int.toString ty)             unsupported("can't promote integer width "^Int.toString ty)
74           | loop(t::ts) = if t > ty then t else loop ts           | loop(t::ts) = if t > ty then t else loop ts
75     in  loop(naturalWidths) end     in  loop(naturalWidths) end
76    
# Line 80  Line 79 
79           [] => arith(rightShift,f,ty,a,b)           [] => arith(rightShift,f,ty,a,b)
80         | _  => f(promoteTy(ty), a, b)         | _  => f(promoteTy(ty), a, b)
81    
82       fun isNatural w = let
83           fun loop [] = false
84             | loop (h :: t) = h = w orelse w > h andalso loop t
85       in
86           loop naturalWidths
87       end
88    
89     (* Implement division with round-to-negative-infinity in terms     (* Implement division with round-to-negative-infinity in terms
90      * of division with round-to-zero. *)      * of division with round-to-zero. *)
91     fun divinf (xdiv, ty, aexp, bexp) = let     fun divinf (xdiv, ty, aexp, bexp) = let
# Line 106  Line 112 
112                T.REG(ty,q))                T.REG(ty,q))
113     end     end
114    
115     (* Same for rem when rounding to negative infinity. *)     (* Same for rem when rounding to negative infinity.
116     fun reminf (xdiv, ty, aexp, bexp) = let      * The odd case is when a = MININT and b = -1 in which case the DIVS op
117        * will overflow.  But the subsequent MULS will overflow in such a way that
118        * the results cancel.  Thus, the correct result of 0 will come out. *)
119       fun reminf (ty, aexp, bexp) = let
120         val a = Cells.newReg ()         val a = Cells.newReg ()
121         val b = Cells.newReg ()         val b = Cells.newReg ()
122         val q = Cells.newReg ()         val q = Cells.newReg ()
# Line 116  Line 125 
125     in     in
126         T.LET (T.SEQ [T.MV (ty, a, aexp),         T.LET (T.SEQ [T.MV (ty, a, aexp),
127                       T.MV (ty, b, bexp),                       T.MV (ty, b, bexp),
128                       T.MV (ty, q, xdiv (T.DIV_TO_ZERO, ty, T.REG (ty, a),                       T.MV (ty, q, T.DIVS (T.DIV_TO_ZERO, ty, T.REG (ty, a),
129                                                             T.REG (ty, b))),                                                             T.REG (ty, b))),
130                       T.MV (ty, r, T.SUB (ty, T.REG (ty, a),                       T.MV (ty, r, T.SUB (ty, T.REG (ty, a),
131                                               T.MULS (ty, T.REG (ty, q),                                               T.MULS (ty, T.REG (ty, q),
132                                                           T.REG (ty, b)))),                                                           T.REG (ty, b)))),
133                       T.IF (T.OR (T.CMP (ty, T.Basis.GE, T.REG (ty, q), zero),                       T.IF (T.CMP (ty, T.Basis.GE, T.REG (ty, q), zero),
134                                   T.CMP (ty, T.Basis.EQ, T.REG (ty, r), zero)),                             T.SEQ [],
135                               T.IF (T.CMP (ty, T.Basis.EQ, T.REG (ty, r), zero),
136                             T.SEQ [],                             T.SEQ [],
137                             T.MV (ty, r, T.ADD (ty, T.REG (ty, r),                             T.MV (ty, r, T.ADD (ty, T.REG (ty, r),
138                                                     T.REG (ty, b))))],                                                           T.REG (ty, b)))))],
139                T.REG (ty, r))                T.REG (ty, r))
140     end     end
141    
# Line 162  Line 172 
172                             promotable T.SRA (exp,DIVREMz T.DIVS,ty,a,b)                             promotable T.SRA (exp,DIVREMz T.DIVS,ty,a,b)
173         | T.DIVS(T.DIV_TO_NEGINF,ty,a,b) => divinf (T.DIVS,ty,a,b)         | T.DIVS(T.DIV_TO_NEGINF,ty,a,b) => divinf (T.DIVS,ty,a,b)
174         | T.REMS(T.DIV_TO_ZERO,ty,a,b) =>         | T.REMS(T.DIV_TO_ZERO,ty,a,b) =>
175           if ty = intTy then remzero (T.DIVS,T.MULS,ty,a,b)           if isNatural ty then remzero (T.DIVS,T.MULS,ty,a,b)
176           else promotable T.SRA (exp,DIVREMz T.REMS,ty,a,b)           else promotable T.SRA (exp,DIVREMz T.REMS,ty,a,b)
177         | T.REMS(T.DIV_TO_NEGINF,ty,a,b) => reminf (T.DIVS,ty,a,b)         | T.REMS(T.DIV_TO_NEGINF,ty,a,b) => reminf (ty,a,b)
178         | T.MULU(ty,a,b) => promotable T.SRL (exp,T.MULU,ty,a,b)         | T.MULU(ty,a,b) => promotable T.SRL (exp,T.MULU,ty,a,b)
179         | T.DIVU(ty,a,b) => promotable T.SRL (exp,T.DIVU,ty,a,b)         | T.DIVU(ty,a,b) => promotable T.SRL (exp,T.DIVU,ty,a,b)
180         | T.REMU(ty,a,b) =>         | T.REMU(ty,a,b) =>
181           if ty = intTy then           if isNatural ty then
182               remzero (fn (_,ty,a,b) => T.DIVU (ty,a,b),T.MULU,ty,a,b)               remzero (fn (_,ty,a,b) => T.DIVU (ty,a,b),T.MULU,ty,a,b)
183           else promotable T.SRL (exp,T.REMU,ty,a,b)           else promotable T.SRL (exp,T.REMU,ty,a,b)
184    
# Line 179  Line 189 
189         | T.MULT(ty,a,b) => arith (T.SRA,T.MULT,ty,a,b)         | T.MULT(ty,a,b) => arith (T.SRA,T.MULT,ty,a,b)
190         | T.DIVT(T.DIV_TO_ZERO,ty,a,b) => arith (T.SRA,DIVREMz T.DIVT,ty,a,b)         | T.DIVT(T.DIV_TO_ZERO,ty,a,b) => arith (T.SRA,DIVREMz T.DIVT,ty,a,b)
191         | T.DIVT(T.DIV_TO_NEGINF,ty,a,b) => divinf (T.DIVT,ty,a,b)         | T.DIVT(T.DIV_TO_NEGINF,ty,a,b) => divinf (T.DIVT,ty,a,b)
        | T.REMT(T.DIV_TO_ZERO,ty,a,b) =>  
          if ty = intTy then remzero (T.DIVT,T.MULS,ty,a,b)  
          else arith (T.SRA,DIVREMz T.REMT,ty,a,b)  
        | T.REMT(T.DIV_TO_NEGINF,ty,a,b) => reminf (T.DIVT,ty,a,b)  
192    
193           (* conditional evaluation rules *)           (* conditional evaluation rules *)
194  (*** XXX: Seems wrong.  (*** XXX: Seems wrong.
# Line 237  Line 243 
243                | 16 => T.ANDB(ty,e,T.LI T.I.int_0xffff)                | 16 => T.ANDB(ty,e,T.LI T.I.int_0xffff)
244                | 32 => T.ANDB(ty,e,T.LI T.I.int_0xffffffff)                | 32 => T.ANDB(ty,e,T.LI T.I.int_0xffffffff)
245                | 64 => e                | 64 => e
246                | _  => raise Unsupported("unknown expression")                | _  => unsupported("unknown expression")
247              )              )
248    
249         (*         (*
# Line 255  Line 261 
261           let val ty' = promoteTy(ty)           let val ty' = promoteTy(ty)
262           in  T.ZX(ty, ty', T.SLL(ty', data, shift)) end           in  T.ZX(ty, ty', T.SLL(ty', data, shift)) end
263    
264         | exp => raise Unsupported("unknown expression")         | exp => unsupported("unknown expression")
265    
266     fun compileFexp fexp = raise Unsupported("unknown expression")     fun compileFexp fexp = unsupported("unknown expression")
267    
268     fun mark(s,[]) = s     fun mark(s,[]) = s
269       | mark(s,a::an) = mark(T.ANNOTATION(s,a),an)       | mark(s,a::an) = mark(T.ANNOTATION(s,a),an)

Legend:
Removed from v.1182  
changed lines
  Added in v.1183

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