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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1115, Thu May 5 04:42:18 2011 UTC revision 1232, Mon May 16 23:37:52 2011 UTC
# Line 21  Line 21 
21    end = struct    end = struct
22    
23      structure IL = D.IL      structure IL = D.IL
24      structure HC = HashCons      structure E = ExprFn (IL)
25        structure ValueMap = E.Map
26      datatype exp = E of {      structure ST = Stats
27          uid : word,             (* unique ID *)  
28          hash : word,            (* hash value *)      type expr = E.expr
29          term : exp_node  
30        }    (********** Counters for statistics **********)
31        val cntMeaninglessPhi       = ST.newCounter (IL.ilName ^ ":meaningless-phi")
32      and exp_node      val cntRedundantPhi         = ST.newCounter (IL.ilName ^ ":redundant-phi")
33        = VAR of IL.var      val cntRedundantAssign      = ST.newCounter (IL.ilName ^ ":redundant-assign")
34        | LIT of Literal.literal  
35        | OP of Op.rator * exp list    (* adjust a variable's use count *)
36        | APPLY of ILBasis.name * exp list      fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
37        | CONS of IL.Ty.ty * exp list      fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)
       | PHI of exp list  
   
     fun hashArgs (args, base) =  
           List.foldl (fn (E{uid, ...}, h) => uid+h) base args  
   
     fun hashNode (VAR x) = IL.Var.hash x  
       | hashNode (LIT l) = Literal.hash l  
       | hashNode (OP(rator, args)) = hashArgs (IL.Op.hash rator, args)  
       | hashNode (APPLY(f, args)) = hashArgs (ILBasis.hash f, args)  
       | hashNode (CONS(ty, args)) = hashArgs (IL.Ty.hash ty + 0w49, args)  
       | hashNode (PHI args) = hashArgs (0w57, args)  
   
     fun sameNode (VAR x, VAR y) = IL.Var.same(x, y)  
       | sameNode (LIT l1, LIT l2) = Literal.same(l1, l2)  
       | sameNode (OP(rator1, args1), OP(rator2, args2)) =  
           IL.Op.same(rator1, rator2) andalso ListPair.allEq sameNode (args1, args2)  
       | sameNode (APPLY(f1, args1), APPLY(f2, args2)) =  
           ILBasis.same(f1, f2) andalso ListPair.allEq sameNode (args1, args2)  
       | sameNode (CONS(ty1, args1), CONS(ty2, args2)) =  
           IL.Ty.same(ty1, ty2) andalso ListPair.allEq sameNode (args1, args2)  
       | sameNode (PHI args1, PHI args2) = ListPair.allEq sameNode (args1, args2)  
   
     structure Tbl = HashTableFn (  
       struct  
         type hash_key = (word * exp_node)  
         fun hashVal (h, _) = h  
         fun sameKey ((_, e1), (_, e2)) = sameNode(e1, e2)  
       end)  
   
   (* hashConsExp : unit -> exp_node -> exp  
    * returns the hash-consed representation of an expression.  
    *)  
     fun hashConsExp () = let  
           val uidCnt = ref 0w0  
           val tbl = Tbl.mkTable (1024, raise Fail "Value Table")  
           val find = Tbl.find tbl  
           val insert = Tbl.insert tbl  
           fun mk e = let  
                 val h = hashNode e  
                 val key = (h, e)  
                 in  
                   case find key  
                    of SOME exp => exp  
                     | NONE => let  
                         val uid = !uidCnt  
                         val exp = E{uid=uid, hash=h, term=e}  
                         in  
                           insert (key, exp);  
                           exp  
                         end  
                   (* end case *)  
                 end  
           in  
             mk  
           end  
38    
39      local      local
   
       fun compareExp (E{uid=a, ...}, E{uid=b, ...}) = Word.compare(a, b)  
   
       structure ValueSet = RedBlackSetFn (  
         struct  
           type ord_key = exp  
           val compare = compareExp  
         end)  
       structure ValueMap = RedBlackMapFn (  
         struct  
           type ord_key = exp  
           val compare = compareExp  
         end)  
   
40      (* property for mapping variables to their value number (VN), which is represented as a      (* 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.       * 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)        val {getFn=getVN, setFn=setVN, clrFn=clrVN, ...} = IL.Var.newProp (fn x => x)
44    
45      (* property for mapping value numbers to hash-consed expressions. *)      (* property for mapping value numbers to hash-consed expressions. *)
46        val {getFn : IL.var -> exp =getExp, setFn=setExp, clrFn=clrExp, ...} =        val {getFn=getExp : IL.var -> expr, setFn=setExp, clrFn=clrExp, ...} =
47              IL.Var.newProp (fn x => raise Fail "getExp")              IL.Var.newProp (fn x => raise Fail(concat["getExp(", IL.Var.toString x, ")"]))
48    
49        datatype env = ENV of {        datatype env = ENV of {
50            avail : IL.Var ValueMap.map   (* map from expressions to their value numbers, which *)            avail : IL.var ValueMap.map   (* map from expressions to their value numbers, which *)
51                                          (* are represented as SSA vars.  The domain are those *)                                          (* are represented as SSA vars.  The domain are those *)
52                                          (* expressions that are available. *)                                          (* expressions that are available. *)
53          }          }
54      in      in
55        val emptyEnv = ENV{avail = ValueMap.empty}
56    (* map variables to their hash-consed definition *)    (* map variables to their hash-consed definition *)
57      val getVN = getVN      val getVN = getVN
58        val setVN = setVN
59      fun varToExp x = getExp(getVN x)      fun varToExp x = getExp(getVN x)
60      fun bindVarToExp (E{avail}, x, e) = (      fun bindVarToExp (ENV{avail}, x, e) = (
61            setVN(x, x); setExp(x, e);            setVN(x, x); setExp(x, e);
62            E{avail=ValueMap.insert(avail, e, x))            ENV{avail = ValueMap.insert(avail, e, x)})
63      fun expToVN (E{avail}, e) = ValueMap.find(avail, e)      fun expToVN (ENV{avail}, e) = ValueMap.find(avail, e)
64      (* rename a variable if it's value number is different than itself *)
65        fun rename x = let
66              val x' = getVN x
67              in
68                if IL.Var.same(x, x')
69                  then x
70                  else (
71    (*DEBUG Log.msg(concat["** rename ", IL.Var.toString x, " to ", IL.Var.toString x', "\n"]);*)
72                    decUse x; incUse x';
73                    x')
74              end
75      (* does a variable change? *)
76        fun changed x = not(IL.Var.same(x, getVN x))
77      (* clear the properties of a variable *)
78        fun clearVar x = (clrVN x; clrExp x)
79      (* clear the properties from the variables of a node *)
80        fun clearNode nd = List.app clearVar (IL.Node.defs nd)
81      end (* local *)      end (* local *)
82    
83      fun rewrite nd = (case IL.Node.kind nd      fun rewriteCFG cfg = let
84            (* in case the exit node get rewritten, we need to reset it *)
85              val exitNd = ref(IL.CFG.exit cfg)
86            (* rewrite or delete a node, if necessary.  Note that we have already rewritten the JOIN nodes *)
87              fun doNode nd = (case IL.Node.kind nd
88                     of IL.COND{pred, cond, trueBranch, falseBranch} =>
89                          if changed cond
90                            then let
91                              val newNd = IL.Node.mkCOND {
92                                      cond = rename cond,
93                                      trueBranch = !trueBranch,
94                                      falseBranch = !falseBranch
95                                    }
96                              in
97                                IL.Node.replaceInEdge {src = !pred, oldDst = nd, dst = newNd};
98                                IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !trueBranch};
99                                IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !falseBranch}
100                              end
101                            else ()
102                      | IL.ASSIGN{stm=(y, rhs), succ, ...} =>
103                          if changed y
104                            then IL.CFG.deleteNode nd (* deleting redundant assignment *)
105                          else if (List.exists changed (IL.RHS.vars rhs))
106                          (* rewrite node to rename variables *)
107                            then IL.CFG.replaceNode(nd, IL.Node.mkASSIGN(y, IL.RHS.map rename rhs))
108                            else ()
109                      | IL.NEW{strand, args, ...} =>
110                          if List.exists changed args
111                            then IL.CFG.replaceNode(nd, IL.Node.mkNEW{
112                                strand=strand, args=List.map rename args
113                              })
114                            else ()
115                      | IL.EXIT{kind, live, ...} =>
116                          if List.exists changed live
117                            then let
118                              val newNd = IL.Node.mkEXIT(kind, List.map rename live)
119                              in
120                                if IL.Node.same(nd, !exitNd)
121                                  then exitNd := newNd
122                                  else ();
123                                IL.CFG.replaceNode (nd, newNd)
124                              end
125                            else ()
126                      | _ => ()
127            (* end case *))            (* end case *))
128              val _ = List.app doNode (IL.CFG.sort cfg)
129              val cfg = IL.CFG{entry = IL.CFG.entry cfg, exit = !exitNd}
130              in
131                IL.CFG.apply clearNode cfg;
132                cfg
133              end
134    
135      fun transform prog = let      fun transformCFG (liveIn, renameIn, cfg) = let
136            val hashConsExp = hashConsExp()            val tbl = E.new()
137            fun varsToExp (env, xs) = List.map (fn x => varToExp(env, x)) xs            val mkVAR = E.mkVAR tbl
138              val mkLIT = E.mkLIT tbl
139              val mkOP = E.mkOP tbl
140              val mkAPPLY = E.mkAPPLY tbl
141              val mkCONS = E.mkCONS tbl
142              val mkPHI = E.mkPHI tbl
143            (* convert a list of variables to a list of expressions *)
144              fun varsToExp (env, xs) = List.map varToExp xs
145          (* convert an SSA RHS into a hash-consed expression *)          (* convert an SSA RHS into a hash-consed expression *)
146            fun mkExp (env, rhs) = (case rhs            fun mkExp (env, rhs) = (case rhs
147                   of IL.VAR x => varToExp(env, x)                   of IL.VAR x => varToExp x
148                    | IL.LIT l => hashConsExp(LIT l)                    | IL.LIT l => mkLIT l
149                    | IL.OP(rator, args) => hashConsExp(OP(rator, varsToExp(env, args)))                    | IL.OP(rator, args) => mkOP(rator, varsToExp(env, args))
150                    | IL.APPLY(f, args) => hashConsExp(APPLY(f, varsToExp(env, args)))                    | IL.APPLY(f, args) => mkAPPLY(f, varsToExp(env, args))
151                    | IL.CONS(ty, args) => hashConsExp(CONS(ty, varsToExp(env, args)))                    | IL.CONS(ty, args) => mkCONS(ty, varsToExp(env, args))
152                  (* end case *))                  (* end case *))
153            (* walk the dominator tree computing value numbers *)
154            fun vn (env, nd) = let            fun vn (env, nd) = let
155                  val env = (case IL.Node.kind nd                  val env = (case IL.Node.kind nd
156                         of IL.JOIN{succ, phis, ...} => let                         of IL.JOIN{succ, phis, ...} => let
157                              fun doPhi ((y, xs), env) = let                              fun doPhi ((y, xs), (env, phis)) = let
158                                    val vn::vns = List.map getVN xs                                    val vn::vns = List.map getVN xs
159                                    in                                    in
160                                      if List.all (fn vn' => IL.Var.same(vn, vn')) vns                                      if List.all (fn vn' => IL.Var.same(vn, vn')) vns
161                                        then (* a meaningless phi node; map y to vn *)                                        then ((* a meaningless phi node; map y to vn *)
162    (* DEBUG Log.msg(concat["** meaningless phi node: ", IL.phiToString (y, xs), "\n"]);*)
163                                            ST.tick cntMeaninglessPhi;
164                                            List.map decUse xs;
165                                            setVN(y, vn);
166                                            (env, phis))
167                                        else let                                        else let
168                                          val exp = hashConsExp(PHI(varsToExp(env, args)))                                          val exp = mkPHI(varsToExp(env, xs))
169                                          in                                          in
170                                            case expToVN(env, exp)                                            case expToVN(env, exp)
171                                             of SOME x => (* a redundant phi node *)                                             of SOME vn' => ((* a redundant phi node *)
172                                              | NONE => bindVarToExp(env, y, exp)  (* DEBUG Log.msg(concat["** redundant phi node: ", IL.phiToString (y, xs), "\n"]);*)
173                                                    ST.tick cntRedundantPhi;
174                                                    List.map decUse xs;
175                                                    setVN(y, vn');
176                                                    (env, phis))
177                                                | NONE => let
178                                                    val xs = List.map rename xs
179                                                    in
180                                                      (bindVarToExp(env, y, exp), (y, xs)::phis)
181                                                    end
182                                            (* end case *)                                            (* end case *)
183                                          end                                          end
184                                    end                                    end
185                                val (env, remainingPhis) = List.foldl doPhi (env, []) (!phis)
186                              in                              in
187                                List.foldl doPhi env (!phis)                                phis := List.rev remainingPhis;
188                                  env
189                              end                              end
190                          | IL.ASSIGN{stm=(y, rhs), succ, ...} => let                          | IL.ASSIGN{stm=(y, rhs), succ, ...} => let
191                              val exp = mkExp(env, rhs)                              val exp = mkExp(env, rhs)
192                              in                              in
193                                case expToVN(env, exp)                                case expToVN(env, exp)
194                                 of SOME x => (* y is redundant, so map it to x *)                                 of SOME vn => ((* y is redundant, so map it to vn *)
195                                  | NONE => bindVarToExp(env, y, exp)  (* DEBUG Log.msg(concat["** redundant assignment: ", IL.assignToString (y, rhs),*)
196    (* DEBUG "; VN[", IL.Var.toString y, "] = ", IL.Var.toString vn, "\n"]);*)
197                                        ST.tick cntRedundantAssign;
198                                        setVN(y, vn);
199                                        env)
200                                    | NONE => (
201                                        bindVarToExp(env, y, exp))
202                                (* end case *)                                (* end case *)
203                              end                              end
204                          | _ => env                          | _ => env
# Line 177  Line 206 
206                  in                  in
207                    List.app (fn nd => vn (env, nd)) (D.children nd)                    List.app (fn nd => vn (env, nd)) (D.children nd)
208                  end                  end
209          (* value number a CFG *)          (* define the initial environment by mapping the liveIn variables to themselves *)
210            fun vnCFG (env, cfg) = (            val env = List.foldl (fn (x, env) => bindVarToExp(env, x, mkVAR x)) emptyEnv liveIn
211            (* set the VN of the incoming renamed variables accordingly *)
212              val _ = List.app setVN renameIn
213              in
214                  D.computeTree cfg;                  D.computeTree cfg;
215                  vn (env, IL.CFG.entryNode cfg);            (* compute value numbers over the dominance tree *)
216                  D.clear cfg)              vn (env, IL.CFG.entry cfg);
217                D.clear cfg;
218              (* delete and rewrite nodes as necessary *)
219                rewriteCFG cfg before
220                  (List.app clearVar liveIn; List.app (clearVar o #1) renameIn)
221              end
222    
223        fun transformCFG' (liveIn, renameIn, cfg) = let
224              val origLiveOut = IL.CFG.liveAtExit cfg
225              val cfg = transformCFG (liveIn, renameIn, cfg)
226              val liveOut = IL.CFG.liveAtExit cfg
227            (* compute a mapping from the original liveOut variables to their new names *)
228              val rename = let
229                    fun findDups (x, x', rename) =
230                          if IL.Var.same(x, x')
231                            then rename
232                            else IL.Var.Map.insert(rename, x, x')
233                    in
234                      ListPair.foldl findDups IL.Var.Map.empty (origLiveOut, liveOut)
235                    end
236            (* filter out duplicate names from the liveOut list *)
237              val foundDup = ref false
238              val liveOut' = let
239                    fun f (x, ys) = if List.exists (fn y => IL.Var.same(x, y)) ys
240                            then (foundDup := true; ys)
241                            else x::ys
242                    in
243                      List.foldr f [] liveOut
244                    end
245            (* if there were any duplicates, then rewrite the exit node *)
246              val cfg = if !foundDup
247                    then IL.CFG.updateExit(cfg, fn _ => liveOut')
248                    else cfg
249              in
250                {cfg = cfg, rename = IL.Var.Map.foldli (fn (x, y, l) => (x, y)::l) renameIn rename}
251              end
252    
253        fun transform prog = let
254              val IL.Program{globalInit, initially, strands} = prog
255              val {cfg=globalInit, rename} = transformCFG' ([], [], globalInit)
256              val globals = IL.CFG.liveAtExit globalInit
257            (* transform the strand initialization code *)
258              val initially = if List.null rename
259                    then initially
260                    else let
261                      val IL.Initially{isArray, rangeInit, iters, create} = initially
262                    (* first process the range initialization code *)
263                      val {cfg=rangeInit, rename} = transformCFG' (globals, rename, rangeInit)
264                      val live = IL.CFG.liveAtExit rangeInit @ globals
265                    (* create a function for renaming variables *)
266                      fun mkRenameFn rename = let
267                            val vMap = List.foldl IL.Var.Map.insert' IL.Var.Map.empty rename
268                            fun renameVar x = (case IL.Var.Map.find (vMap, x)
269                                   of NONE => x
270                                    | SOME x' => x'
271                                  (* end case *))
272            in            in
273                              renameVar
274                            end
275                    (* rename the bounds of the iterators *)
276                      val iters = let
277                            val renameVar = mkRenameFn rename
278                            in
279                              List.map (fn (x, lo, hi) => (x, renameVar lo, renameVar hi)) iters
280                            end
281                    (* process the body *)
282                      val (cfg, strand, args) = create
283                      val {cfg, rename} = transformCFG' (live, rename, cfg)
284                      val create = (cfg, strand, List.map (mkRenameFn rename) args)
285                      in
286                        IL.Initially{
287                            isArray = isArray, rangeInit = rangeInit,
288                            iters = iters, create= create
289                          }
290                      end
291            (* transform a strand *)
292              fun transformStrand (IL.Strand{name, params, state, stateInit, methods}) = let
293                    val liveIn = params @ globals
294                    val stateInit = transformCFG (liveIn, rename, stateInit)
295    (* FIXME: what if a state variable becomes redundant? *)
296                    fun transformMeth (IL.Method{name, stateIn, body}) = let
297                          val liveIn = stateIn @ liveIn
298                          val body = transformCFG (liveIn, rename, body)
299                          in
300                            IL.Method{name=name, stateIn=stateIn, body=body}
301                          end
302                    in
303                      IL.Strand{
304                          name = name,
305                          params = params,
306                          state = state,
307                          stateInit = stateInit,
308                          methods = List.map transformMeth methods
309                        }
310                    end
311              val strands = List.map transformStrand strands
312              in
313                IL.Program{
314                    globalInit = globalInit,
315                    initially = initially,
316                    strands = strands
317                  }
318            end            end
319    
320    end    end

Legend:
Removed from v.1115  
changed lines
  Added in v.1232

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