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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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