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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 909 - (view) (download)

1 : george 546 (*
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 :     val intTy : T.ty (* size of integer word *)
14 :    
15 :     (* This is a list of possible data widths to promote to.
16 :     * The list must be in increasing sizes.
17 :     * We'll try to promote to the next largest size.
18 :     *)
19 :     val naturalWidths : T.ty list
20 :    
21 :     (*
22 :     * Are integers of widths less than the size of integer word.
23 :     * automatically sign extended, zero extended, or neither.
24 :     * When in doubt, choose neither since it is conservative.
25 :     *)
26 :     datatype rep = SE | ZE | NEITHER
27 :     val rep : rep
28 :    
29 :     ) : MLTREEGEN =
30 :     struct
31 :    
32 :     structure T = T
33 : leunga 624 structure Size = MLTreeSize(structure T = T val intTy = intTy)
34 : leunga 744 structure C = CellsBasis
35 : george 546
36 :     exception Unsupported of string
37 :    
38 :     fun error msg = MLRiscErrorMsg.error("MLTreeGen",msg)
39 :    
40 : george 761 val zeroT = T.LI(T.I.int_0)
41 :     fun LI i = T.LI(T.I.fromInt(intTy, i))
42 :    
43 : george 546 fun condOf(T.CC(cc,_)) = cc
44 :     | condOf(T.CMP(_,cc,_,_)) = cc
45 :     | condOf(T.CCMARK(cc,_)) = condOf cc
46 :     | condOf _ = error "condOf"
47 :    
48 :     fun fcondOf(T.FCC(fcc,_)) = fcc
49 :     | fcondOf(T.FCMP(_,fcc,_,_)) = fcc
50 :     | fcondOf(T.CCMARK(cc,_)) = fcondOf cc
51 :     | fcondOf _ = error "fcondOf"
52 :    
53 :     val W = intTy
54 :    
55 :     (* To compute f.ty(a,b)
56 :     *
57 :     * let r1 <- a << (intTy - ty)
58 :     * r2 <- b << (intTy - ty)
59 :     * r3 <- f(a,b)
60 :     * in r3 ~>> (intTy - ty) end
61 :     *
62 :     * Lal showed me this neat trick!
63 :     *)
64 :     fun arith(rightShift,f,ty,a,b) =
65 : george 761 let val shift = LI(W-ty)
66 : george 546 in rightShift(W,f(W,T.SLL(W,a,shift),T.SLL(W,b,shift)),shift)
67 :     end
68 :    
69 : leunga 796 fun promoteTy(ty) =
70 : george 546 let fun loop([]) =
71 :     raise Unsupported("can't promote integer width "^Int.toString ty)
72 :     | loop(t::ts) = if t > ty then t else loop ts
73 :     in loop(naturalWidths) end
74 :    
75 :     fun promotable rightShift (e, f, ty, a, b) =
76 :     case naturalWidths of
77 :     [] => arith(rightShift,f,ty,a,b)
78 : leunga 796 | _ => f(promoteTy(ty), a, b)
79 : george 546
80 :     (*
81 :     * Translate integer expressions of unknown types into the appropriate
82 :     * term.
83 :     *)
84 :    
85 : george 761 fun compileRexp(exp) =
86 : george 546 case exp of
87 : leunga 775 T.CONST c => T.LABEXP exp
88 : george 546
89 :     (* non overflow trapping ops *)
90 : george 761 | T.NEG(ty,a) => T.SUB(ty, zeroT, a)
91 : george 546 | 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)
93 :     | T.MULS(ty,a,b) => promotable T.SRA (exp,T.MULS,ty,a,b)
94 :     | T.DIVS(ty,a,b) => promotable T.SRA (exp,T.DIVS,ty,a,b)
95 :     | T.REMS(ty,a,b) => promotable T.SRA (exp,T.REMS,ty,a,b)
96 :     | T.MULU(ty,a,b) => promotable T.SRL (exp,T.MULU,ty,a,b)
97 :     | T.DIVU(ty,a,b) => promotable T.SRL (exp,T.DIVU,ty,a,b)
98 :     | 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 *)
101 : george 761 | T.NEGT(ty,a) => T.SUBT(ty,zeroT,a)
102 : george 546 | 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)
104 :     | T.MULT(ty,a,b) => arith (T.SRA,T.MULT,ty,a,b)
105 :     | T.DIVT(ty,a,b) => arith (T.SRA,T.DIVT,ty,a,b)
106 :     | T.REMT(ty,a,b) => arith (T.SRA,T.REMT,ty,a,b)
107 :    
108 :     (* conditional evaluation rules *)
109 : george 761 (*** XXX: Seems wrong.
110 : george 546 | T.COND(ty,T.CC(cond,r),x,y) =>
111 : george 761 T.COND(ty,T.CMP(ty,cond,T.REG(ty,r),zeroT),x,y)
112 :     ***)
113 : george 546 | T.COND(ty,T.CCMARK(cc,a),x,y) => T.MARK(T.COND(ty,cc,x,y),a)
114 : george 761 (*** XXX: TODO
115 : george 546 | 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)
117 :     (* we'll let others strength reduce the multiply *)
118 : leunga 788 | 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 : george 546 | 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)
127 :     | 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)
129 : george 761 ***)
130 : george 546
131 : george 761 | T.COND(ty,cc,e1,e2) =>
132 :     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 : george 546 (* ones-complement.
135 :     * WARNING: we are assuming two's complement architectures here.
136 :     * Are there any architectures in use nowadays that doesn't use
137 :     * two's complement for integer arithmetic?
138 :     *)
139 : george 761 | T.NOTB(ty,e) => T.XORB(ty,e,T.LI T.I.int_m1)
140 : george 546
141 :     (*
142 :     * Default ways of converting integers to integers
143 :     *)
144 : leunga 744 | T.SX(ty,fromTy,e) =>
145 : george 546 if fromTy = ty then e
146 :     else if rep = SE andalso fromTy < ty andalso
147 :     fromTy >= hd naturalWidths then e
148 :     else
149 : george 761 let val shift = T.LI(T.I.fromInt(intTy, W - fromTy))
150 : george 546 in T.SRA(W,T.SLL(W,e,shift),shift)
151 :     end
152 : leunga 744 | T.ZX(ty,fromTy,e) =>
153 : george 546 if fromTy <= ty then e else
154 :     (case ty of (* ty < fromTy *)
155 : george 761 8 => T.ANDB(ty,e,T.LI T.I.int_0xff)
156 :     | 16 => T.ANDB(ty,e,T.LI T.I.int_0xffff)
157 :     | 32 => T.ANDB(ty,e,T.LI T.I.int_0xffffffff)
158 : george 546 | 64 => e
159 :     | _ => raise Unsupported("unknown expression")
160 :     )
161 :    
162 :     (*
163 :     * Converting floating point to integers.
164 :     * The following rule handles the case when ty is not
165 :     * one of the naturally supported widths on the machine.
166 :     *)
167 :     | T.CVTF2I(ty,round,fty,e) =>
168 : leunga 796 let val ty' = promoteTy(ty)
169 : leunga 744 in T.SX(ty,ty',T.CVTF2I(ty',round,fty,e))
170 : george 546 end
171 :    
172 : leunga 796 (* Promote to higher width and zero high bits *)
173 :     | T.SLL(ty, data, shift) =>
174 :     let val ty' = promoteTy(ty)
175 :     in T.ZX(ty, ty', T.SLL(ty', data, shift)) end
176 :    
177 : george 546 | exp => raise Unsupported("unknown expression")
178 :    
179 :     fun compileFexp fexp = raise Unsupported("unknown expression")
180 :    
181 :     fun mark(s,[]) = s
182 :     | mark(s,a::an) = mark(T.ANNOTATION(s,a),an)
183 :    
184 :     fun compileStm (T.SEQ s) = s
185 : leunga 775 | compileStm (T.IF(cond,T.JMP(T.LABEL L,_),T.SEQ [])) =
186 : leunga 744 [T.BCC(cond,L)]
187 :     | compileStm (T.IF(cond,yes,no)) =
188 : george 909 let val L1 = Label.anon()
189 :     val L2 = Label.anon()
190 : leunga 744 in [T.BCC(cond,L1),
191 : george 546 no,
192 : leunga 775 T.JMP(T.LABEL L2,[]),
193 : george 546 T.DEFINE L1,
194 :     yes,
195 :     T.DEFINE L2
196 :     ]
197 :     end
198 :     | compileStm stm = error "compileStm"
199 :    
200 :     (*
201 :     * This function translations conditional expressions into a
202 :     * branch sequence.
203 :     * Note: we'll actually take advantage of the fact that
204 :     * e1 and e2 are allowed to be eagerly evaluated.
205 :     *)
206 :     fun compileCond{exp=(ty,ccexp,e1,e2),rd,an} =
207 : george 909 let val L1 = Label.anon()
208 : george 546 in [T.MV(ty,rd,e1),
209 : leunga 744 mark(T.BCC(ccexp,L1),an),
210 : george 546 T.MV(ty,rd,e2),
211 :     T.DEFINE L1
212 :     ]
213 :     end
214 :     fun compileFcond{exp=(fty,ccexp,e1,e2),fd,an} =
215 : george 909 let val L1 = Label.anon()
216 : george 546 in [T.FMV(fty,fd,e1),
217 : leunga 744 mark(T.BCC(ccexp,L1),an),
218 : george 546 T.FMV(fty,fd,e2),
219 :     T.DEFINE L1
220 :     ]
221 :     end
222 :    
223 :     end

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