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 651, Thu Jun 1 18:34:03 2000 UTC revision 788, Wed Feb 28 04:09:48 2001 UTC
# Line 31  Line 31 
31    
32     structure T = T     structure T = T
33     structure Size = MLTreeSize(structure T = T val intTy = intTy)     structure Size = MLTreeSize(structure T = T val intTy = intTy)
34     structure LE = T.LabelExp     structure C  = CellsBasis
35    
36     exception Unsupported of string     exception Unsupported of string
37    
38     fun error msg = MLRiscErrorMsg.error("MLTreeGen",msg)     fun error msg = MLRiscErrorMsg.error("MLTreeGen",msg)
39    
40       val zeroT = T.LI(T.I.int_0)
41       fun LI i = T.LI(T.I.fromInt(intTy, i))
42    
43     fun condOf(T.CC(cc,_)) = cc     fun condOf(T.CC(cc,_)) = cc
44       | condOf(T.CMP(_,cc,_,_)) = cc       | condOf(T.CMP(_,cc,_,_)) = cc
45       | condOf(T.CCMARK(cc,_)) = condOf cc       | condOf(T.CCMARK(cc,_)) = condOf cc
# Line 59  Line 62 
62      * Lal showed me this neat trick!      * Lal showed me this neat trick!
63      *)      *)
64     fun arith(rightShift,f,ty,a,b) =     fun arith(rightShift,f,ty,a,b) =
65         let val shift = T.LI(W-ty)         let val shift = LI(W-ty)
66         in  rightShift(W,f(W,T.SLL(W,a,shift),T.SLL(W,b,shift)),shift)         in  rightShift(W,f(W,T.SLL(W,a,shift),T.SLL(W,b,shift)),shift)
67         end         end
68    
# Line 81  Line 84 
84    
85     fun compileRexp(exp) =     fun compileRexp(exp) =
86         case exp of         case exp of
87           T.CONST c => T.LABEL(T.LabelExp.CONST c)           T.CONST c => T.LABEXP exp
88    
89           (* non overflow trapping ops *)           (* non overflow trapping ops *)
90         | T.NEG(ty,a)    => T.SUB(ty,T.LI 0,a)         | T.NEG(ty,a)    => T.SUB(ty, zeroT, a)
91         | T.ADD(ty,a,b)  => promotable T.SRA (exp,T.ADD,ty,a,b)         | T.ADD(ty,a,b)  => promotable T.SRA (exp,T.ADD,ty,a,b)
92         | T.SUB(ty,a,b)  => promotable T.SRA (exp,T.SUB,ty,a,b)         | T.SUB(ty,a,b)  => promotable T.SRA (exp,T.SUB,ty,a,b)
93         | T.MULS(ty,a,b) => promotable T.SRA (exp,T.MULS,ty,a,b)         | T.MULS(ty,a,b) => promotable T.SRA (exp,T.MULS,ty,a,b)
# Line 95  Line 98 
98         | T.REMU(ty,a,b) => promotable T.SRL (exp,T.REMU,ty,a,b)         | T.REMU(ty,a,b) => promotable T.SRL (exp,T.REMU,ty,a,b)
99    
100           (* for overflow trapping ops; we have to do the simulation *)           (* for overflow trapping ops; we have to do the simulation *)
101         | T.NEGT(ty,a)   => T.SUBT(ty,T.LI 0,a)         | T.NEGT(ty,a)   => T.SUBT(ty,zeroT,a)
102         | T.ADDT(ty,a,b) => arith (T.SRA,T.ADDT,ty,a,b)         | T.ADDT(ty,a,b) => arith (T.SRA,T.ADDT,ty,a,b)
103         | T.SUBT(ty,a,b) => arith (T.SRA,T.SUBT,ty,a,b)         | T.SUBT(ty,a,b) => arith (T.SRA,T.SUBT,ty,a,b)
104         | 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)
# Line 103  Line 106 
106         | T.REMT(ty,a,b) => arith (T.SRA,T.REMT,ty,a,b)         | T.REMT(ty,a,b) => arith (T.SRA,T.REMT,ty,a,b)
107    
108           (* conditional evaluation rules *)           (* conditional evaluation rules *)
109    (*** XXX: Seems wrong.
110         | T.COND(ty,T.CC(cond,r),x,y) =>         | T.COND(ty,T.CC(cond,r),x,y) =>
111             T.COND(ty,T.CMP(ty,cond,T.REG(ty,r),T.LI 0),x,y)             T.COND(ty,T.CMP(ty,cond,T.REG(ty,r),zeroT),x,y)
112    ***)
113         | T.COND(ty,T.CCMARK(cc,a),x,y) => T.MARK(T.COND(ty,cc,x,y),a)         | T.COND(ty,T.CCMARK(cc,a),x,y) => T.MARK(T.COND(ty,cc,x,y),a)
114    (*** XXX: TODO
115         | T.COND(ty,T.CMP(t,cc,e1,e2),x as (T.LI 0 | T.LI32 0w0),y) =>         | T.COND(ty,T.CMP(t,cc,e1,e2),x as (T.LI 0 | T.LI32 0w0),y) =>
116             T.COND(ty,T.CMP(t,T.Basis.negateCond cc,e1,e2),y,T.LI 0)             T.COND(ty,T.CMP(t,T.Basis.negateCond cc,e1,e2),y,T.LI 0)
117             (* we'll let others strength reduce the multiply *)             (* we'll let others strength reduce the multiply *)
118           | T.COND(ty,cc as T.FCMP _, yes, no) =>
119             let val tmp = C.newReg()
120             in  T.LET(T.SEQ[T.MV(ty, tmp, no),
121                             T.IF(cc, T.MV(ty, tmp, yes), T.SEQ [])],
122                       T.REG(ty,tmp)
123                      )
124             end
125         | T.COND(ty,cc,e1,(T.LI 0 | T.LI32 0w0)) =>         | T.COND(ty,cc,e1,(T.LI 0 | T.LI32 0w0)) =>
126             T.MULU(ty,T.COND(ty,cc,T.LI 1,T.LI 0),e1)             T.MULU(ty,T.COND(ty,cc,T.LI 1,T.LI 0),e1)
127         | T.COND(ty,cc,T.LI m,T.LI n) =>         | T.COND(ty,cc,T.LI m,T.LI n) =>
128             T.ADD(ty,T.MULU(ty,T.COND(ty,cc,T.LI 1,T.LI 0),T.LI(m-n)),T.LI n)             T.ADD(ty,T.MULU(ty,T.COND(ty,cc,T.LI 1,T.LI 0),T.LI(m-n)),T.LI n)
129    ***)
130    
131         | T.COND(ty,cc,e1,e2) =>         | T.COND(ty,cc,e1,e2) =>
132             T.ADD(ty,T.MULU(ty,T.COND(ty,cc,T.LI 1,T.LI 0),T.SUB(ty,e1,e2)),e2)             T.ADD(ty,T.MULU(ty,T.COND(ty,cc,T.LI T.I.int_1,zeroT),T.SUB(ty,e1,e2)),e2)
133    
134         (* ones-complement.         (* ones-complement.
135          * WARNING: we are assuming two's complement architectures here.          * WARNING: we are assuming two's complement architectures here.
136          * Are there any architectures in use nowadays that doesn't use          * Are there any architectures in use nowadays that doesn't use
137          * two's complement for integer arithmetic?          * two's complement for integer arithmetic?
138          *)          *)
139         | T.NOTB(ty,e) => T.XORB(ty,e,T.LI ~1)         | T.NOTB(ty,e) => T.XORB(ty,e,T.LI T.I.int_m1)
140    
141         (*         (*
142          * Default ways of converting integers to integers          * Default ways of converting integers to integers
143          *)          *)
144         | T.CVTI2I(ty,T.SIGN_EXTEND,fromTy,e) =>         | T.SX(ty,fromTy,e) =>
145           if fromTy = ty then e           if fromTy = ty then e
146           else if rep = SE andalso fromTy < ty andalso           else if rep = SE andalso fromTy < ty andalso
147                fromTy >= hd naturalWidths then e                fromTy >= hd naturalWidths then e
148           else           else
149               let val shift = T.LI(W - fromTy)               let val shift = T.LI(T.I.fromInt(intTy, W - fromTy))
150               in  T.SRA(W,T.SLL(W,e,shift),shift)               in  T.SRA(W,T.SLL(W,e,shift),shift)
151               end               end
152         | T.CVTI2I(ty,T.ZERO_EXTEND,fromTy,e) =>         | T.ZX(ty,fromTy,e) =>
153           if fromTy <= ty then e else           if fromTy <= ty then e else
154              (case ty of (* ty < fromTy *)              (case ty of (* ty < fromTy *)
155                  8  => T.ANDB(ty,e,T.LI32 0wxff)                  8  => T.ANDB(ty,e,T.LI T.I.int_0xff)
156                | 16 => T.ANDB(ty,e,T.LI32 0wxffff)                | 16 => T.ANDB(ty,e,T.LI T.I.int_0xffff)
157                | 32 => T.ANDB(ty,e,T.LI32 0wxffffffff)                | 32 => T.ANDB(ty,e,T.LI T.I.int_0xffffffff)
158                | 64 => e                | 64 => e
159                | _  => raise Unsupported("unknown expression")                | _  => raise Unsupported("unknown expression")
160              )              )
# Line 151  Line 166 
166          *)          *)
167         | T.CVTF2I(ty,round,fty,e) =>         | T.CVTF2I(ty,round,fty,e) =>
168           let val ty' = promoteTy(exp,ty)           let val ty' = promoteTy(exp,ty)
169           in  T.CVTI2I(ty,T.SIGN_EXTEND,ty',T.CVTF2I(ty',round,fty,e))           in  T.SX(ty,ty',T.CVTF2I(ty',round,fty,e))
170           end           end
171    
172         | exp => raise Unsupported("unknown expression")         | exp => raise Unsupported("unknown expression")
# Line 162  Line 177 
177       | mark(s,a::an) = mark(T.ANNOTATION(s,a),an)       | mark(s,a::an) = mark(T.ANNOTATION(s,a),an)
178    
179     fun compileStm (T.SEQ s) = s     fun compileStm (T.SEQ s) = s
180       | compileStm (T.IF(ctrl,cond,T.JMP(_,T.LABEL(LE.LABEL L),_),T.SEQ [])) =       | compileStm (T.IF(cond,T.JMP(T.LABEL L,_),T.SEQ [])) =
181             [T.BCC(ctrl,cond,L)]             [T.BCC(cond,L)]
182       | compileStm (T.IF(ctrl,cond,yes,no)) =       | compileStm (T.IF(cond,yes,no)) =
183         let val L1 = Label.newLabel ""         let val L1 = Label.newLabel ""
184             val L2 = Label.newLabel ""             val L2 = Label.newLabel ""
185         in  [T.BCC(ctrl,cond,L1),         in  [T.BCC(cond,L1),
186              no,              no,
187              T.JMP([],T.LABEL(LE.LABEL L2),[]),              T.JMP(T.LABEL L2,[]),
188              T.DEFINE L1,              T.DEFINE L1,
189              yes,              yes,
190              T.DEFINE L2              T.DEFINE L2
# Line 186  Line 201 
201     fun compileCond{exp=(ty,ccexp,e1,e2),rd,an} =     fun compileCond{exp=(ty,ccexp,e1,e2),rd,an} =
202     let val L1 = Label.newLabel ""     let val L1 = Label.newLabel ""
203     in  [T.MV(ty,rd,e1),     in  [T.MV(ty,rd,e1),
204          mark(T.BCC([],ccexp,L1),an),          mark(T.BCC(ccexp,L1),an),
205          T.MV(ty,rd,e2),          T.MV(ty,rd,e2),
206          T.DEFINE L1          T.DEFINE L1
207         ]         ]
# Line 194  Line 209 
209     fun compileFcond{exp=(fty,ccexp,e1,e2),fd,an} =     fun compileFcond{exp=(fty,ccexp,e1,e2),fd,an} =
210     let val L1 = Label.newLabel ""     let val L1 = Label.newLabel ""
211     in  [T.FMV(fty,fd,e1),     in  [T.FMV(fty,fd,e1),
212          mark(T.BCC([],ccexp,L1),an),          mark(T.BCC(ccexp,L1),an),
213          T.FMV(fty,fd,e2),          T.FMV(fty,fd,e2),
214          T.DEFINE L1          T.DEFINE L1
215         ]         ]

Legend:
Removed from v.651  
changed lines
  Added in v.788

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