Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/charisee/src/compiler/IL/value-numbering-fn.sml
ViewVC logotype

Annotation of /branches/charisee/src/compiler/IL/value-numbering-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2632 - (view) (download)

1 : jhr 1115 (* value-numbering-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * This file contains an implementation of the hash-based value numbering
7 :     * algorithm described in
8 :     *
9 : jhr 2356 * Value Numbering
10 :     * by Preston Briggs, Keith Cooper, and Taylor Simpson
11 :     * CRPC-TR94517-S
12 :     * November 1994
13 : jhr 1115 *)
14 :    
15 :     functor ValueNumberingFn (D : DOMINANCE_TREE) : sig
16 :    
17 :     structure IL : SSA
18 :    
19 :     val transform : IL.program -> IL.program
20 :    
21 :     end = struct
22 :    
23 :     structure IL = D.IL
24 : jhr 1232 structure E = ExprFn (IL)
25 :     structure ValueMap = E.Map
26 :     structure ST = Stats
27 : cchiw 2497 structure HE=hashEin
28 : cchiw 2553 structure PE=Printer
29 : jhr 1115
30 : jhr 1232 type expr = E.expr
31 : jhr 1115
32 : jhr 1232 (********** Counters for statistics **********)
33 : jhr 2356 val cntMeaninglessPhi = ST.newCounter (IL.ilName ^ ":meaningless-phi")
34 :     val cntRedundantPhi = ST.newCounter (IL.ilName ^ ":redundant-phi")
35 :     val cntRedundantAssign = ST.newCounter (IL.ilName ^ ":redundant-assign")
36 : jhr 1115
37 : jhr 1232 (* adjust a variable's use count *)
38 :     fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
39 :     fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)
40 : jhr 1115
41 :     local
42 :     (* property for mapping variables to their value number (VN), which is represented as a
43 :     * SSA variable. If their VN is different from themselves, then they are redundant.
44 :     *)
45 :     val {getFn=getVN, setFn=setVN, clrFn=clrVN, ...} = IL.Var.newProp (fn x => x)
46 :    
47 :     (* property for mapping value numbers to hash-consed expressions. *)
48 : jhr 2632 val {getFn=getExp : IL.var -> expr, setFn=setExp, clrFn=clrExp, ...} =
49 :     IL.Var.newProp (fn x => raise Fail(concat["getExp(", IL.Var.toString x, ")"]))
50 : jhr 1115
51 :     datatype env = ENV of {
52 : jhr 2356 avail : IL.var ValueMap.map (* map from expressions to their value numbers, which *)
53 :     (* are represented as SSA vars. The domain are those *)
54 :     (* expressions that are available. *)
55 :     }
56 : jhr 1115 in
57 : jhr 1232 val emptyEnv = ENV{avail = ValueMap.empty}
58 : jhr 1115 (* map variables to their hash-consed definition *)
59 :     val getVN = getVN
60 : jhr 1232 val setVN = setVN
61 : cchiw 2553 fun varToExp x = ((*print "\n VarToExp"; print(IL.Var.toString x);*)getExp(getVN x))
62 :     fun bindVarToExp (ENV{avail}, x, e) = (
63 :     (*DEBUG**Log.msg()*)
64 :    
65 :     (*print (concat["** bindVarToExp: ", IL.Var.toString x, " --> ", E.toString e, "\n"]);*)
66 :     setVN(x, x); setExp(x, e);
67 : jhr 2356 ENV{avail = ValueMap.insert(avail, e, x)})
68 : jhr 1232 fun expToVN (ENV{avail}, e) = ValueMap.find(avail, e)
69 :     (* rename a variable if it's value number is different than itself *)
70 :     fun rename x = let
71 : jhr 2356 val x' = getVN x
72 :     in
73 :     if IL.Var.same(x, x')
74 :     then x
75 :     else (
76 : jhr 1640 (*DEBUG**Log.msg(concat["** rename ", IL.Var.toString x, " to ", IL.Var.toString x', "\n"]);*)
77 : jhr 2356 decUse x; incUse x';
78 :     x')
79 :     end
80 :     (* does a variable change; i.e., get replaced by another variable? *)
81 : jhr 1232 fun changed x = not(IL.Var.same(x, getVN x))
82 :     (* clear the properties of a variable *)
83 :     fun clearVar x = (clrVN x; clrExp x)
84 :     (* clear the properties from the variables of a node *)
85 :     fun clearNode nd = List.app clearVar (IL.Node.defs nd)
86 : jhr 1115 end (* local *)
87 :    
88 : jhr 1232 fun rewriteCFG cfg = let
89 : jhr 2356 (* in case the exit node get rewritten, we need to reset it *)
90 :     val exitNd = ref(IL.CFG.exit cfg)
91 :     (* rewrite or delete a node, if necessary. Note that we have already rewritten the JOIN nodes *)
92 :     fun doNode nd = (case IL.Node.kind nd
93 :     of IL.COND{pred, cond, trueBranch, falseBranch} =>
94 :     if changed cond
95 :     then let
96 :     val newNd = IL.Node.mkCOND {
97 :     cond = rename cond,
98 :     trueBranch = !trueBranch,
99 :     falseBranch = !falseBranch
100 :     }
101 :     in
102 :     IL.Node.replaceInEdge {src = !pred, oldDst = nd, dst = newNd};
103 :     IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !trueBranch};
104 :     IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !falseBranch}
105 :     end
106 :     else ()
107 :     | IL.ASSIGN{stm=(y, rhs), succ, ...} =>
108 :     if changed y
109 :     then (
110 :     (* deleting redundant assignment *)
111 :     IL.RHS.app decUse rhs;
112 :     IL.CFG.deleteNode nd)
113 :     else if (List.exists changed (IL.RHS.vars rhs))
114 :     (* rewrite node to rename variables *)
115 :     then IL.CFG.replaceNode(nd, IL.Node.mkASSIGN(y, IL.RHS.map rename rhs))
116 :     else ()
117 : jhr 1640 | IL.MASSIGN{stm=([], rator, xs), succ, ...} =>
118 :     if (List.exists changed xs)
119 : jhr 2356 (* rewrite node to rename variables *)
120 :     then IL.CFG.replaceNode(nd, IL.Node.mkMASSIGN([], rator, List.map rename xs))
121 :     else ()
122 : jhr 1640 | IL.MASSIGN{stm=(ys, rator, xs), succ, ...} =>
123 : jhr 2356 if List.all changed ys
124 :     then (
125 :     (* deleting redundant assignment *)
126 :     List.app decUse xs;
127 :     IL.CFG.deleteNode nd)
128 :     else if (List.exists changed xs)
129 :     (* rewrite node to rename variables *)
130 :     then IL.CFG.replaceNode(nd, IL.Node.mkMASSIGN(ys, rator, List.map rename xs))
131 :     else ()
132 :     | IL.NEW{strand, args, ...} =>
133 :     if List.exists changed args
134 :     then IL.CFG.replaceNode(nd, IL.Node.mkNEW{
135 :     strand=strand, args=List.map rename args
136 :     })
137 :     else ()
138 :     | IL.SAVE{lhs, rhs, ...} =>
139 :     if changed rhs
140 :     then IL.CFG.replaceNode(nd, IL.Node.mkSAVE(lhs, rename rhs))
141 :     else ()
142 :     | IL.EXIT{kind, live, ...} =>
143 :     if List.exists changed live
144 :     then let
145 :     val newNd = IL.Node.mkEXIT(kind, List.map rename live)
146 :     in
147 :     if IL.Node.same(nd, !exitNd)
148 :     then exitNd := newNd
149 :     else ();
150 :     IL.CFG.replaceNode (nd, newNd)
151 :     end
152 :     else ()
153 :     | _ => ()
154 :     (* end case *))
155 :     val _ = List.app doNode (IL.CFG.sort cfg)
156 :     val cfg = IL.CFG{entry = IL.CFG.entry cfg, exit = !exitNd}
157 :     in
158 :     IL.CFG.apply clearNode cfg;
159 :     cfg
160 :     end
161 : jhr 1115
162 : cchiw 2553 fun transformCFG (liveIn, renameIn, cfg) =(* cfg HERE *)let
163 : jhr 2356 val tbl = E.new()
164 : jhr 1640 val mkSTATE = E.mkSTATE tbl
165 : jhr 2356 val mkVAR = E.mkVAR tbl
166 :     val mkLIT = E.mkLIT tbl
167 :     val mkOP = E.mkOP tbl
168 :     val mkMULTIOP = E.mkMULTIOP tbl
169 :     val mkAPPLY = E.mkAPPLY tbl
170 :     val mkCONS = E.mkCONS tbl
171 :     val mkPHI = E.mkPHI tbl
172 : cchiw 2555 val mkEinOP = E.mkEinOP tbl
173 : cchiw 2497
174 :    
175 : jhr 2356 (* convert a list of variables to a list of expressions *)
176 : cchiw 2553 fun varsToExp (env, xs) = (List.map varToExp xs)
177 : jhr 2356 (* convert an SSA RHS into a hash-consed expression *)
178 :     fun mkExp (env, rhs) = (case rhs
179 :     of IL.STATE x => mkSTATE x
180 : jhr 1640 | IL.VAR x => varToExp x
181 : jhr 2356 | IL.LIT l => mkLIT l
182 : cchiw 2553 | IL.OP(rator, args) =>( mkOP(rator, varsToExp(env, args)))
183 :     | IL.APPLY(f, args) =>(mkAPPLY(f, varsToExp(env, args)))
184 :     | IL.CONS(ty, args) => ( mkCONS(ty, varsToExp(env, args)))
185 :     | IL.EINAPP(exp,args)=> ((*print "\n\n\n EINAPP \n";print(PE.printerE(exp));*)mkEinOP(exp, varsToExp(env,args)))
186 :    
187 :     (* end case *))
188 : cchiw 2497
189 :    
190 : jhr 2356 (* walk the dominator tree computing value numbers *)
191 : cchiw 2553
192 : jhr 2356 fun vn (env, nd) = let
193 :     val env = (case IL.Node.kind nd
194 :     of IL.JOIN{succ, phis, ...} => let
195 :     fun doPhi ((y, xs), (env, phis)) = let
196 :     val vn::vns = List.map getVN xs
197 :     in
198 :     if List.all (fn vn' => IL.Var.same(vn, vn')) vns
199 :     then ((* a meaningless phi node; map y to vn *)
200 : jhr 1232 (* DEBUG Log.msg(concat["** meaningless phi node: ", IL.phiToString (y, xs), "\n"]);*)
201 : jhr 2356 ST.tick cntMeaninglessPhi;
202 :     List.map decUse xs;
203 :     setVN(y, vn);
204 :     (env, phis))
205 :     else let
206 :     val exp = mkPHI(varsToExp(env, xs))
207 :     in
208 :     case expToVN(env, exp)
209 :     of SOME vn' => ((* a redundant phi node *)
210 : jhr 1232 (* DEBUG Log.msg(concat["** redundant phi node: ", IL.phiToString (y, xs), "\n"]);*)
211 : jhr 2356 ST.tick cntRedundantPhi;
212 :     List.map decUse xs;
213 :     setVN(y, vn');
214 :     (env, phis))
215 :     | NONE => let
216 :     val xs = List.map rename xs
217 :     in
218 :     (bindVarToExp(env, y, exp), (y, xs)::phis)
219 :     end
220 :     (* end case *)
221 :     end
222 :     end
223 :     val (env, remainingPhis) = List.foldl doPhi (env, []) (!phis)
224 :     in
225 :     phis := List.rev remainingPhis;
226 :     env
227 :     end
228 : cchiw 2553
229 : cchiw 2502 | IL.ASSIGN{stm=(y, rhs), succ, ...} => let
230 : cchiw 2553 (*val tester=print(String.concat["\n\n START \n ",IL.Var.toString y])*)
231 : jhr 2356 val exp = mkExp(env, rhs)
232 : cchiw 2553 (* val tester=print(String.concat["\n END \n\n "])*)
233 : jhr 2356 in
234 :     case expToVN(env, exp)
235 :     of SOME vn => ((* y is redundant, so map it to vn *)
236 : jhr 1788 (* DEBUG ** Log.msg(concat["** redundant assignment: ", IL.assignToString (y, rhs),*)
237 : jhr 1640 (* DEBUG **"; VN[", IL.Var.toString y, "] = ", IL.Var.toString vn, "\n"]);*)
238 : jhr 2356 ST.tick cntRedundantAssign;
239 :     setVN(y, vn);
240 :     env)
241 :     | NONE => bindVarToExp(env, y, exp)
242 :     (* end case *)
243 :     end
244 : jhr 1640 | IL.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
245 :     val xs = varsToExp(env, xs)
246 :     fun mkExps (env, _, []) = env
247 :     | mkExps (env, i, y::ys) = let
248 :     val exp = mkMULTIOP(i, rator, xs)
249 :     in
250 :     case expToVN(env, exp)
251 :     of SOME vn => ((* y is redundant, so map it to vn *)
252 :     ST.tick cntRedundantAssign;
253 :     setVN(y, vn);
254 :     mkExps (env, i+1, ys))
255 :     | NONE => mkExps (bindVarToExp(env, y, exp), i+1, ys)
256 :     (* end case *)
257 :     end
258 :     in
259 :     mkExps (env, 0, ys)
260 : cchiw 2502 end
261 : jhr 2356 | _ => env
262 :     (* end case *))
263 :     in
264 :     List.app (fn nd => vn (env, nd)) (D.children nd)
265 :     end
266 : cchiw 2553
267 : jhr 2356 (* define the initial environment by mapping the liveIn variables to themselves *)
268 :     val env = List.foldl (fn (x, env) => bindVarToExp(env, x, mkVAR x)) emptyEnv liveIn
269 :     (* set the VN of the incoming renamed variables accordingly *)
270 :     val _ = List.app setVN renameIn
271 :     in
272 :     D.computeTree cfg;
273 :     (* compute value numbers over the dominance tree *)
274 :     vn (env, IL.CFG.entry cfg);
275 :     D.clear cfg;
276 :     (* delete and rewrite nodes as necessary *)
277 :     rewriteCFG cfg before
278 :     (List.app clearVar liveIn; List.app (clearVar o #1) renameIn)
279 :     end
280 : jhr 1115
281 : cchiw 2553 (*here *)
282 :     fun transformCFG' (liveIn, renameIn, cfg) = let
283 : jhr 2356 val origLiveOut = IL.CFG.liveAtExit cfg
284 : cchiw 2502 val cfg = transformCFG (liveIn, renameIn, cfg)
285 : jhr 2356 val liveOut = IL.CFG.liveAtExit cfg
286 :     (* compute a mapping from the original liveOut variables to their new names *)
287 :     val rename = let
288 :     fun findDups (x, x', rename) =
289 :     if IL.Var.same(x, x')
290 :     then rename
291 :     else IL.Var.Map.insert(rename, x, x')
292 :     in
293 :     ListPair.foldl findDups IL.Var.Map.empty (origLiveOut, liveOut)
294 :     end
295 :     (* filter out duplicate names from the liveOut list *)
296 :     val foundDup = ref false
297 :     val liveOut' = let
298 :     fun f (x, ys) = if List.exists (fn y => IL.Var.same(x, y)) ys
299 :     then (foundDup := true; ys)
300 :     else x::ys
301 :     in
302 :     List.foldr f [] liveOut
303 :     end
304 :     (* if there were any duplicates, then rewrite the exit node *)
305 :     val cfg = if !foundDup
306 :     then IL.CFG.updateExit(cfg, fn _ => liveOut')
307 :     else cfg
308 :     in
309 :     {cfg = cfg, rename = IL.Var.Map.foldli (fn (x, y, l) => (x, y)::l) renameIn rename}
310 :     end
311 : jhr 1232
312 :     fun transform prog = let
313 : jhr 2356 val IL.Program{props, globalInit, initially, strands} = prog
314 :     val {cfg=globalInit, rename} = transformCFG' ([], [], globalInit)
315 :     val globals = IL.CFG.liveAtExit globalInit
316 :     (* transform the strand initialization code *)
317 :     val initially = if List.null rename
318 :     then initially
319 :     else let
320 :     val IL.Initially{isArray, rangeInit, iters, create} = initially
321 :     (* first process the range initialization code *)
322 :     val {cfg=rangeInit, rename} = transformCFG' (globals, rename, rangeInit)
323 :     val live = IL.CFG.liveAtExit rangeInit @ globals
324 :     (* create a function for renaming variables *)
325 :     fun mkRenameFn rename = let
326 :     val vMap = List.foldl IL.Var.Map.insert' IL.Var.Map.empty rename
327 :     fun renameVar x = (case IL.Var.Map.find (vMap, x)
328 :     of NONE => x
329 :     | SOME x' => x'
330 :     (* end case *))
331 :     in
332 :     renameVar
333 :     end
334 :     (* rename the bounds of the iterators *)
335 :     val iters = let
336 :     val renameVar = mkRenameFn rename
337 :     in
338 :     List.map (fn (x, lo, hi) => (x, renameVar lo, renameVar hi)) iters
339 :     end
340 : jhr 1902 (* add the iteration variables to the live list *)
341 :     val live = List.foldl (fn ((x, _, _), lv) => x::lv) live iters
342 : jhr 2356 (* process the body *)
343 :     val (cfg, strand, args) = create
344 :     val {cfg, rename} = transformCFG' (live, rename, cfg)
345 :     val create = (cfg, strand, List.map (mkRenameFn rename) args)
346 :     in
347 :     IL.Initially{
348 :     isArray = isArray, rangeInit = rangeInit,
349 :     iters = iters, create= create
350 :     }
351 :     end
352 :     (* transform a strand *)
353 :     fun transformStrand (IL.Strand{name, params, state, stateInit, methods}) = let
354 :     val liveIn = params @ globals
355 :     val stateInit = transformCFG (liveIn, rename, stateInit)
356 : jhr 1232 (* FIXME: what if a state variable becomes redundant? *)
357 : jhr 2356 fun transformMeth (IL.Method{name, body}) = let
358 :     val body = transformCFG (liveIn, rename, body)
359 :     in
360 :     IL.Method{name=name, body=body}
361 :     end
362 :     in
363 :     IL.Strand{
364 :     name = name,
365 :     params = params,
366 :     state = state,
367 :     stateInit = stateInit,
368 :     methods = List.map transformMeth methods
369 :     }
370 :     end
371 :     val strands = List.map transformStrand strands
372 :     in
373 :     IL.Program{
374 :     props = props,
375 :     globalInit = globalInit,
376 :     initially = initially,
377 :     strands = strands
378 :     }
379 :     end
380 : jhr 1232
381 : jhr 1115 end

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