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-rtl.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 601 - (view) (download)

1 : leunga 591 (*
2 :     * Basic RTLs and query functions on these RTLs
3 :     *
4 :     * -- Allen
5 :     *)
6 :     structure MLTreeRTL : MLTREE_RTL =
7 :     struct
8 :    
9 :     fun error msg = MLRiscErrorMsg.error("MLTreeRTL",msg)
10 :    
11 :     (* Dummy modules *)
12 :     structure Const : CONSTANT =
13 :     struct
14 :     type const = int
15 :     fun toString s = "r"^Int.toString s
16 :     fun valueOf c = c
17 :     fun hash c = Word.fromInt c
18 :     fun ==(x:const,y:const) = x=y
19 :     end
20 :    
21 :     structure LabelExp = LabelExp(Const)
22 :    
23 :     structure Region : REGION =
24 :     struct
25 :     type region = int
26 :     val memory = ~1
27 :     val stack = ~1
28 :     val readonly = ~1
29 :     fun toString r = "mem"^Int.toString r
30 :     end
31 :    
32 :     structure PseudoOp : PSEUDO_OPS =
33 :     struct
34 :     type pseudo_op = unit
35 :     fun toString _ = ""
36 :     fun emitValue _ = ()
37 :     fun sizeOf _ = 0
38 :     fun adjustLabels _ = false
39 :     end
40 :    
41 :     structure RTLExt =
42 :     struct
43 :     structure Basis = MLTreeBasis
44 :    
45 :     datatype ('s,'r,'f,'c) sx =
46 :     ASSIGN of 'r loc * 'r
47 :     | PAR of 's * 's
48 :    
49 :     and ('s,'r,'f,'c) rx =
50 :     FORALL of 'r
51 :     | FETCH of 'r loc
52 :     | ARG of string * string
53 : leunga 601 | PARAM of int * int
54 : leunga 591 | OP of Basis.misc_op ref * 'r list
55 :     | SLICE of {from:'r, to:'r} list * Basis.ty * 'r
56 :    
57 :     and 'r loc = AGG of Basis.ty * endian * 'r cell
58 :    
59 :     and 'r cell = CELL of string * Basis.ty * 'r * 'r
60 :    
61 :     and endian = LITTLE_ENDIAN | BIG_ENDIAN
62 :    
63 :     and ('s,'r,'f,'c) fx = FX
64 :     and ('s,'r,'f,'c) ccx = CCX
65 :    
66 :     end
67 :    
68 :     structure T = MLTreeF
69 :     (structure LabelExp = LabelExp
70 :     structure Region = Region
71 :     structure Stream = InstructionStream(PseudoOp)
72 :     structure Extension = RTLExt
73 :     )
74 :    
75 :     structure W = Word
76 :    
77 :     val itow = Word.fromInt
78 :    
79 :     datatype rtlOp = datatype RTLExt.rx
80 :     datatype rtlAction = datatype RTLExt.sx
81 :     datatype rtlCell = datatype RTLExt.cell
82 :     datatype rtlLoc = datatype RTLExt.loc
83 :     datatype rtlEndian = datatype RTLExt.endian
84 :    
85 :     type action = T.stm
86 :     type rtl = action
87 :     type exp = T.rexp
88 :     type cond = T.ccexp
89 :     type loc = T.rexp rtlLoc
90 :     type cell = T.rexp rtlCell
91 :     type ty = T.ty
92 :    
93 :     type hasher = T.hasher
94 :     type equality = T.equality
95 :     type printer = T.printer
96 :    
97 :     structure Util = MLTreeUtils
98 :     (structure T = T
99 :     fun hashRtlOp hasher (FORALL e) = #rexp (hasher:hasher) e
100 :     | hashRtlOp hasher (FETCH l) = hashLoc hasher l
101 :     | hashRtlOp hasher (ARG _) = 0w3
102 : leunga 601 | hashRtlOp hasher (PARAM _) = 0w12321
103 : leunga 591 | hashRtlOp hasher (OP(ref{hash, ...}, es)) = hash + hashRexps hasher es
104 :     | hashRtlOp hasher (SLICE(sl, ty, e)) =
105 :     itow ty + hashSlices hasher sl + #rexp hasher e
106 :     and hashRexps hasher es = foldr (fn (e,h) => #rexp hasher e + h) 0w23 es
107 :     and hashSlices hasher sl = foldr (fn ({from,to},h) =>
108 :     #rexp hasher from + #rexp hasher to + h) 0w33 sl
109 :     and hashLoc hasher (AGG(t, endian, c)) = itow t + hashCell hasher c
110 :     and hashCell hasher (CELL(k, t, e, r)) =
111 :     itow t + #rexp hasher e + #rexp hasher r
112 :     and hashRtlAction hasher (ASSIGN(l, e)) =
113 :     hashLoc hasher l + #rexp hasher e
114 :     | hashRtlAction hasher (PAR(a,b)) = #stm hasher a + #stm hasher b
115 :    
116 :     fun eqRtlOp eq (FORALL x, FORALL y) = #rexp (eq:equality) (x,y)
117 :     | eqRtlOp eq (FETCH l, FETCH l') = eqLoc eq (l,l')
118 :     | eqRtlOp eq (ARG x, ARG y) = x=y
119 : leunga 601 | eqRtlOp eq (PARAM x, PARAM y) = x=y
120 : leunga 591 | eqRtlOp eq (OP(x,es), OP(x',es')) =
121 :     x=x' andalso eqRexps (#rexp eq) (es,es')
122 :     | eqRtlOp eq (SLICE(sl, t, e), SLICE(sl', t', e')) =
123 :     t=t' andalso eqSlices eq (sl,sl') andalso #rexp eq (e,e')
124 :     | eqRtlOp eq _ = false
125 :     and eqRtlAction eq (ASSIGN(l, e), ASSIGN(l', e')) =
126 :     eqLoc eq (l,l') andalso #rexp eq (e, e')
127 :     | eqRtlAction eq (PAR(a, b), PAR(a', b')) =
128 :     #stm eq (a, a') andalso #stm eq (b, b')
129 :     | eqRtlAction eq _ = false
130 :     and eqRexps eq ([],[]) = true
131 :     | eqRexps eq (x::xs,y::ys) = eq(x,y) andalso eqRexps eq (xs,ys)
132 :     | eqRexps eq _ = false
133 :     and eqSlice eq ({from=x,to=y},{from=x',to=y'}) =
134 :     #rexp eq(x,x') andalso #rexp eq(y,y')
135 :     and eqSlices eq ([], []) = true
136 :     | eqSlices eq (x::xs,y::ys) =
137 :     eqSlice eq (x,y) andalso eqSlices eq (xs,ys)
138 :     | eqSlices eq _ = false
139 :     and eqLoc eq (AGG(t,e,c), AGG(t',e',c')) =
140 :     t=t andalso e=e' andalso eqCell eq (c,c')
141 :     and eqCell eq (CELL(k, t, e, r), CELL(k', t', e', r')) =
142 :     t=t' andalso k=k' andalso #rexp eq (e,e') andalso #rexp eq (r,r')
143 :    
144 :     fun listify f es =
145 :     List.foldr (fn (e,"") => f e | (e,s) => f e^","^s) "" es
146 :    
147 :     fun showTy ty = "."^Int.toString ty
148 :     and showRtlOp pr (t,FORALL e) = "forall "^ #rexp (pr:printer) e
149 :     | showRtlOp pr (t,FETCH l) = showLoc pr l
150 :     | showRtlOp pr (t,ARG(k,x)) = k^" "^x
151 : leunga 601 | showRtlOp pr (t,PARAM(x,y)) = "r"^Int.toString x^"-"^Int.toString y
152 : leunga 591 | showRtlOp pr (t,OP(ref{name, ...}, es)) = name^showTy t^showExps pr es
153 :     | showRtlOp pr (t,SLICE(sl, ty, e)) =
154 :     #rexp pr e^" at ["^showSlices pr sl^"]"
155 :     and showSlices pr sl =
156 :     listify (fn {from,to} => #rexp pr from^".."^ #rexp pr to) sl
157 :     and showLoc pr (AGG(t', endian, CELL(k, t, e, r))) =
158 :     let val r = case r of
159 :     T.LI 0 => ""
160 :     | r => ":"^ #rexp pr r
161 :     val body = "$"^k^"["^ lhs pr e^r^"]"
162 :     in if t = t' orelse t = 0 then body else
163 : leunga 593 showEnd endian^showTy t'^showTy t^" "^body
164 : leunga 591 end
165 :     and lhs pr (T.REG(ty,r)) = #dstReg pr (ty,r)
166 :     | lhs pr e = #rexp pr e
167 :     and showEnd LITTLE_ENDIAN = "aggl"
168 :     | showEnd BIG_ENDIAN = "aggb"
169 :     and showRtlAction pr (ASSIGN(l, e)) = showLoc pr l ^ " := " ^ #rexp pr e
170 :     | showRtlAction pr (PAR(a,b)) = #stm pr a ^" || "^ #stm pr b
171 :     and showExps pr es = "("^listify (#rexp pr) es^")"
172 :    
173 :     fun noHash _ _ = 0w0
174 :     val hashSext = hashRtlAction
175 :     val hashRext = hashRtlOp
176 :     val hashFext = noHash
177 :     val hashCCext = noHash
178 :     fun noEq _ _ = true
179 :     val eqSext = eqRtlAction
180 :     val eqRext = eqRtlOp
181 :     val eqFext = noEq
182 :     val eqCCext = noEq
183 :     fun noShow _ _ = ""
184 :     val showSext = showRtlAction
185 :     val showRext = showRtlOp
186 :     val showFext = noShow
187 :     val showCCext = noShow
188 :     )
189 :    
190 : leunga 601 val hashRTL = Util.hashStm
191 :     val eqRTL = Util.eqStm
192 :     val showRTL = Util.show
193 :     val rtlToString = Util.stmToString
194 :     val expToString = Util.rexpToString
195 : leunga 591
196 :     structure Basis = T.Basis
197 :    
198 :     structure Rewrite = MLTreeRewrite
199 :     (structure T = T
200 :     fun rext rw (FETCH l) = FETCH(loc rw l)
201 :     | rext rw (FORALL e) = FORALL(#rexp rw e)
202 :     | rext {rexp, fexp, ccexp, stm} (OP(m,es)) = OP(m,map rexp es)
203 :     | rext {rexp, fexp, ccexp, stm} (SLICE(sl, ty, e)) =
204 :     SLICE(map (fn {from,to} => {from=rexp from,to=rexp to}) sl,
205 :     ty,rexp e)
206 :     | rext {rexp, fexp, ccexp, stm} e = e
207 :     and sext rw (ASSIGN(l, e)) = ASSIGN(loc rw l, #rexp rw e)
208 :     | sext rw (PAR(a,b)) = PAR(#stm rw a, #stm rw b)
209 :     and fext rw x = x
210 :     and ccext rw x = x
211 :     and loc rw (AGG(t1,t2,c)) = AGG(t1,t2,cell rw c)
212 : leunga 601 and cell rw (CELL(k,t,e,r)) = CELL(k,t,#rexp rw e,r)
213 : leunga 591 )
214 :    
215 :     val A_TRAPPING = W.<<(0w1,0w1)
216 :     val A_PINNED = W.<<(0w1,0w2)
217 :     val A_SIDEEFFECT = W.<<(0w1,0w3)
218 :     val A_MUTATOR = W.<<(0w1,0w4)
219 :     val A_LOOKER = W.<<(0w1,0w5)
220 :     val A_BRANCH = W.<<(0w1,0w6)
221 :     val A_PURE = 0wx0
222 :    
223 :     (*
224 :     * Create new RTL operators
225 :     *)
226 :     val hashCnt = ref 0w0
227 :     fun newHash() = let val h = !hashCnt in hashCnt := h + 0w124127; h end
228 :     fun newOp{name,attribs} = ref{name=name,attribs=attribs,hash=newHash()}
229 :    
230 :     (*
231 :     * Reduce a RTL to compiled internal form
232 :     *)
233 :     fun reduce rtl =
234 : leunga 601 let fun regionUse(T.REXT(_,PARAM(_,r))) = r
235 :     | regionUse(T.REG(_,r)) = r
236 :     | regionUse e = error("regionUse: "^Util.rexpToString e)
237 :     fun regionDef(T.REXT(_,PARAM(r,_))) = r
238 :     | regionDef(T.REG(_,r)) = r
239 :     | regionDef e = error("regionDef: "^Util.rexpToString e)
240 :     fun rexp _
241 :     (T.REXT(ty,FETCH(AGG(_,_,CELL("GP",_,T.REXT(_,PARAM(_,r)),_))))) =
242 : leunga 591 T.REG(ty,r)
243 : leunga 601 | rexp _
244 :     (T.REXT(ty,FETCH(AGG(_,_,CELL("GP",_,T.REG(_,r),_))))) =
245 : leunga 591 T.REG(ty,r)
246 : leunga 601 | rexp _
247 :     (T.REXT(ty,FETCH(AGG(_,_,CELL("FP",_,T.REXT(_,PARAM(_,r)),_))))) =
248 :     T.REG(ty,r)
249 :     | rexp _
250 :     (T.REXT(ty,FETCH(AGG(_,_,CELL("FP",_,T.REG(_,r),_))))) =
251 :     T.REG(ty,r)
252 : leunga 591 | rexp _ (T.REXT(ty,FETCH(AGG(_,_,CELL("MEM",_,ea,region)))))=
253 : leunga 601 T.LOAD(ty,ea,regionUse region)
254 : leunga 591 | rexp _ e = e
255 :     fun stm _ (T.SEQ[s]) = s
256 :     | stm _ (T.EXT(ASSIGN(AGG(ty,_,CELL("MEM",_,ea,region)),d))) =
257 : leunga 601 T.STORE(ty,ea,d,regionDef region)
258 :     | stm _ (T.EXT(ASSIGN(AGG(ty,_,
259 :     CELL("GP",_,T.REXT(_,PARAM(r,_)),_)),d))) =
260 :     T.MV(ty,r,d)
261 : leunga 591 | stm _ (T.EXT(ASSIGN(AGG(ty,_,CELL("GP",_,T.REG(_,r),_)),d))) =
262 :     T.MV(ty,r,d)
263 :     | stm _ (T.EXT(ASSIGN(AGG(ty,_,
264 : leunga 601 CELL(_,_,T.REXT(_,FORALL(T.REG(_,0))),_)),
265 : leunga 591 T.REXT(_,FETCH(AGG(_,_,
266 : leunga 601 CELL(_,_,T.REXT(_,FORALL(T.REG(_,0))),_))))))) =
267 : leunga 591 T.COPY(ty,[],[])
268 :     | stm _ (T.EXT(PAR(s,T.SEQ []))) = s
269 :     | stm _ (T.EXT(PAR(T.SEQ [],s))) = s
270 :     | stm _ s = s
271 :     fun ccexp _ e = e
272 :     fun NIL _ x = x
273 :     in #stm(Rewrite.rewrite{rexp=rexp,fexp=NIL,stm=stm,ccexp=ccexp}) rtl
274 :     end
275 :    
276 :     (*
277 :     * Create a uniq RTL
278 :     *)
279 :    
280 :     fun new(action) =
281 :     let val action = reduce action
282 :     val attribs = A_PURE
283 :     in case action of
284 :     T.COPY _ => action
285 :     | _ => T.RTL{e=action,hash=ref(newHash()),attribs=attribs} : rtl
286 :     end
287 :    
288 :     val COPY = T.COPY(0,[],[])
289 :     val JMP = T.JMP([],T.REG(0,0),[])
290 :    
291 :     (* Query functions *)
292 :     fun can'tMoveUp rtl = true
293 :     fun can'tMoveDown rtl = true
294 :     fun hasSideEffect rtl = true
295 :    
296 :     end

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