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

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