Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/SMLNJ/src/MLRISC/mltree/mltreegen.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/MLRISC/mltree/mltreegen.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 429 - (view) (download)

1 : monnier 409 (*
2 :     * This is a generic module for transforming MLTREE expressions:
3 :     * (1) expressions involving non-standard type widths are promoted when
4 :     * necessary.
5 :     * (2) operators that cannot be directly handled are expanded into
6 :     * more complex instruction sequences when necessary.
7 :     *
8 :     * -- Allen
9 :     *)
10 :    
11 :     functor MLTreeGen
12 :     (structure T : MLTREE
13 :     where type cond = MLTreeBasis.cond
14 :     and type fcond = MLTreeBasis.fcond
15 :     val intTy : T.ty (* size of integer word *)
16 :    
17 :     (* This is a list of possible data widths to promote to.
18 :     * The list must be in increasing sizes.
19 :     * We'll try to promote to the next largest size.
20 :     *)
21 :     val naturalWidths : T.ty list
22 : monnier 429
23 :     (*
24 :     * Are integers of widths less than the size of integer word.
25 :     * automatically sign extended, zero extended, or neither.
26 :     * When in doubt, choose neither since it is conservative.
27 :     *)
28 :     datatype rep = SE | ZE | NEITHER
29 :     val rep : rep
30 :    
31 : monnier 409 ) : MLTREEGEN =
32 :     struct
33 :    
34 :     structure T = T
35 :    
36 :     exception SizeUnknown
37 :    
38 :     fun error msg = MLRiscErrorMsg.error("MLTreeGen",msg)
39 :    
40 :     fun size(T.REG(ty,_)) = ty
41 :     | size(T.LI _) = intTy
42 :     | size(T.LI32 _) = intTy
43 : monnier 429 | size(T.LI64 _) = intTy
44 : monnier 409 | size(T.LABEL _) = intTy
45 :     | size(T.CONST _) = intTy
46 :     | size(T.ADD(ty,_,_)) = ty
47 :     | size(T.SUB(ty,_,_)) = ty
48 :     | size(T.MULS(ty,_,_)) = ty
49 :     | size(T.DIVS(ty,_,_)) = ty
50 : monnier 429 | size(T.REMS(ty,_,_)) = ty
51 : monnier 409 | size(T.MULU(ty,_,_)) = ty
52 :     | size(T.DIVU(ty,_,_)) = ty
53 : monnier 429 | size(T.REMU(ty,_,_)) = ty
54 : monnier 409 | size(T.ADDT(ty,_,_)) = ty
55 :     | size(T.SUBT(ty,_,_)) = ty
56 :     | size(T.MULT(ty,_,_)) = ty
57 :     | size(T.DIVT(ty,_,_)) = ty
58 : monnier 429 | size(T.REMT(ty,_,_)) = ty
59 :     | size(T.ANDB(ty,_,_)) = ty
60 :     | size(T.ORB(ty,_,_)) = ty
61 :     | size(T.XORB(ty,_,_)) = ty
62 :     | size(T.NOTB(ty,_)) = ty
63 :     | size(T.SRA(ty,_,_)) = ty
64 :     | size(T.SRL(ty,_,_)) = ty
65 :     | size(T.SLL(ty,_,_)) = ty
66 :     | size(T.COND(ty,_,_,_)) = ty
67 : monnier 409 | size(T.LOAD(ty,_,_)) = ty
68 : monnier 429 | size(T.LOAD_UNALIGNED(ty,_,_)) = ty
69 : monnier 409 | size(T.CVTI2I(ty,_,_)) = ty
70 :     | size(T.CVTF2I(ty,_,_)) = ty
71 :     | size(T.SEQ(s,e)) = size e
72 : monnier 429 | size(T.EXTENSION(ty,_,_)) = ty
73 : monnier 409 | size(T.MARK(e,_)) = size e
74 :     | size _ = raise SizeUnknown
75 :    
76 :     fun fsize(T.FREG(ty,_)) = ty
77 : monnier 429 | fsize(T.FLOAD(ty,_,_)) = ty
78 :     | fsize(T.FLOAD_UNALIGNED(ty,_,_)) = ty
79 : monnier 409 | fsize(T.FADD(ty,_,_)) = ty
80 :     | fsize(T.FSUB(ty,_,_)) = ty
81 :     | fsize(T.FMUL(ty,_,_)) = ty
82 :     | fsize(T.FDIV(ty,_,_)) = ty
83 : monnier 429 | fsize(T.FABS(ty,_)) = ty
84 : monnier 409 | fsize(T.FNEG(ty,_)) = ty
85 :     | fsize(T.FSQRT(ty,_)) = ty
86 :     | fsize(T.CVTI2F(ty,_,_)) = ty
87 :     | fsize(T.CVTF2F(ty,_,_)) = ty
88 :     | fsize(T.FSEQ(_,e)) = fsize e
89 : monnier 429 | fsize(T.FEXTENSION(ty,_,_)) = ty
90 : monnier 409 | fsize(T.FMARK(e,_)) = fsize e
91 :     | fsize _ = raise SizeUnknown
92 :    
93 :     val W = intTy
94 :    
95 :     (* To compute f.ty(a,b)
96 :     *
97 :     * let r1 <- a << (intTy - ty)
98 :     * r2 <- b << (intTy - ty)
99 :     * r3 <- f(a,b)
100 :     * in r3 ~>> (intTy - ty) end
101 :     *
102 :     * Lal showed me this neat trick!
103 :     *)
104 :     fun arith rightShift (e:T.rexp,f,ty,a,b) =
105 :     let val shift = T.LI(W-ty)
106 :     in rightShift(W,f(W,T.SLL(W,a,shift),T.SLL(W,b,shift)),shift)
107 :     end
108 :    
109 :     fun promoteTy(e,ty) =
110 :     let fun loop([]) =
111 :     raise T.Unsupported
112 :     ("can't promote integer width "^Int.toString ty,e)
113 :     | loop(t::ts) = if t > ty then t else loop ts
114 :     in loop(naturalWidths) end
115 :    
116 :     fun promote(e,f,ty,a,b) = f(promoteTy(e,ty),a,b)
117 :    
118 :     val signedArith = arith T.SRA
119 :     val unsignedArith = arith T.SRL
120 :     val (promotableSignedArith, promotableUnsignedArith) =
121 :     case naturalWidths of [] => (signedArith,unsignedArith)
122 :     | _ => (promote,promote)
123 :    
124 :     (*
125 :     * Translate integer expressions of unknown types into the appropriate
126 :     * term.
127 :     *)
128 :    
129 :     fun compile(exp) =
130 :     case exp of
131 :     (* non overflow trapping ops *)
132 :     T.ADD(ty,a,b) => promotableSignedArith(exp,T.ADD,ty,a,b)
133 :     | T.SUB(ty,a,b) => promotableSignedArith(exp,T.SUB,ty,a,b)
134 :     | T.MULS(ty,a,b) => promotableSignedArith(exp,T.MULS,ty,a,b)
135 :     | T.DIVS(ty,a,b) => promotableSignedArith(exp,T.DIVS,ty,a,b)
136 :     | T.REMS(ty,a,b) => promotableSignedArith(exp,T.REMS,ty,a,b)
137 :     | T.MULU(ty,a,b) => promotableUnsignedArith(exp,T.MULU,ty,a,b)
138 :     | T.DIVU(ty,a,b) => promotableUnsignedArith(exp,T.DIVU,ty,a,b)
139 :     | T.REMU(ty,a,b) => promotableUnsignedArith(exp,T.REMU,ty,a,b)
140 :    
141 :     (* for overflow trapping ops; we have to do the simulation *)
142 :     | T.ADDT(ty,a,b) => signedArith(exp,T.ADDT,ty,a,b)
143 :     | T.SUBT(ty,a,b) => signedArith(exp,T.SUBT,ty,a,b)
144 :     | T.MULT(ty,a,b) => signedArith(exp,T.MULT,ty,a,b)
145 :     | T.DIVT(ty,a,b) => signedArith(exp,T.DIVT,ty,a,b)
146 :     | T.REMT(ty,a,b) => signedArith(exp,T.REMT,ty,a,b)
147 :    
148 :     (* conditional evaluation rules *)
149 :     | T.COND(ty,T.CC r,x,y) =>
150 :     T.COND(ty,T.CMP(ty,T.NE,T.REG(ty,r),T.LI 0),x,y)
151 :     | T.COND(ty,T.CCMARK(cc,a),x,y) => T.MARK(T.COND(ty,cc,x,y),a)
152 :     | T.COND(ty,T.CMP(t,cc,e1,e2),x as (T.LI 0 | T.LI32 0w0),y) =>
153 :     T.COND(ty,T.CMP(t,MLTreeUtil.negateCond cc,e1,e2),y,T.LI 0)
154 :     (* we'll let others strength reduce the multiply *)
155 :     | T.COND(ty,cc,e1,(T.LI 0 | T.LI32 0w0)) =>
156 :     T.MULU(ty,T.COND(ty,cc,T.LI 1,T.LI 0),e1)
157 :     | T.COND(ty,cc,T.LI m,T.LI n) =>
158 :     T.ADD(ty,T.MULU(ty,T.COND(ty,cc,T.LI 1,T.LI 0),T.LI(m-n)),T.LI n)
159 :     | T.COND(ty,cc,e1,e2) =>
160 :     T.ADD(ty,T.MULU(ty,T.COND(ty,cc,T.LI 1,T.LI 0),T.SUB(ty,e1,e2)),e2)
161 :    
162 :     (* ones-complement.
163 :     * WARNING: we are assuming two's complement architectures here.
164 :     * Are there any architectures in use nowadays that doesn't use
165 :     * two's complement for integer arithmetic?
166 :     *)
167 :     | T.NOTB(ty,e) => T.XORB(ty,e,T.LI ~1)
168 :    
169 : monnier 429 (*
170 :     * Default ways of converting integers to integers
171 :     *)
172 :     | T.CVTI2I(ty,T.SIGN_EXTEND,e) =>
173 :     let val fromTy = size e
174 :     in if fromTy = ty then e
175 :     else if rep = SE andalso fromTy < ty andalso
176 :     fromTy >= hd naturalWidths then e
177 :     else
178 :     let val shift = T.LI(W - fromTy)
179 :     in T.SRA(W,T.SLL(W,e,shift),shift)
180 :     end
181 :     end
182 :     | T.CVTI2I(ty,T.ZERO_EXTEND,e) =>
183 :     let val fromTy = size e
184 :     in if fromTy <= ty then e
185 :     else case fromTy of
186 :     8 => T.ANDB(ty,e,T.LI32 0wxff)
187 :     | 16 => T.ANDB(ty,e,T.LI32 0wxffff)
188 :     | 32 => T.ANDB(ty,e,T.LI32 0wxffffffff)
189 :     | _ => raise T.Unsupported("unknown expression",exp)
190 :     end
191 :    
192 :     (*
193 :     * Converting floating point to integers.
194 :     * The following rule handles the case when ty is not
195 :     * one of the naturally supported widths on the machine.
196 :     *)
197 :     | T.CVTF2I(ty,round,e) =>
198 :     let val ty' = promoteTy(exp,ty)
199 :     in T.CVTI2I(ty,T.SIGN_EXTEND,T.CVTF2I(ty',round,e))
200 :     end
201 :    
202 : monnier 409 | exp => raise T.Unsupported("unknown expression",exp)
203 :    
204 :     (*
205 :     * This function translations conditional expressions into a
206 :     * branch sequence.
207 :     * Note: we'll actually take advantage of the fact that
208 :     * e1 and e2 are allowed to be eagerly evaluated.
209 :     *)
210 :     fun compileCond{exp=(ty,ccexp,e1,e2),defineLabel,stm,annotations,rd} =
211 :     let val L1 = Label.newLabel ""
212 :     fun branch(T.CCMARK(cc,_)) = branch cc
213 :     | branch(T.CC _) = T.BCC(T.NE,ccexp,L1)
214 :     | branch(T.CMP(_,cc,_,_)) = T.BCC(cc,ccexp,L1)
215 :     | branch(T.FCMP(_,cc,_,_)) = T.FBCC(cc,ccexp,L1)
216 :     | branch _ = error "compileCond"
217 :     in stm(T.MV(ty,rd,e1),[]); (* true value *)
218 :     stm(branch(ccexp),annotations); (* branch if true *)
219 :     stm(T.MV(ty,rd,e2),[]); (* false value *)
220 :     defineLabel L1
221 :     end
222 :    
223 :     end

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