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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2246 - (download) (annotate)
Sun Mar 3 14:51:31 2013 UTC (6 years, 7 months ago) by lamonts
File size: 14735 byte(s)
Added Reductions into its own block and allow strands to use the strand pool correctly when allocating new strands
(* value-numbering-fn.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * This file contains an implementation of the hash-based value numbering
 * algorithm described in
 *
 *	Value Numbering
 *	by Preston Briggs, Keith Cooper, and Taylor Simpson
 *	CRPC-TR94517-S
 *	November 1994
 *)

functor ValueNumberingFn (D : DOMINANCE_TREE) : sig

    structure IL : SSA

    val transform : IL.program -> IL.program

  end = struct

    structure IL = D.IL
    structure E = ExprFn (IL)
    structure ValueMap = E.Map
    structure ST = Stats

    type expr = E.expr

  (********** Counters for statistics **********)
    val cntMeaninglessPhi	= ST.newCounter (IL.ilName ^ ":meaningless-phi")
    val cntRedundantPhi		= ST.newCounter (IL.ilName ^ ":redundant-phi")
    val cntRedundantAssign	= ST.newCounter (IL.ilName ^ ":redundant-assign")

  (* adjust a variable's use count *)
    fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
    fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)

    local
    (* property for mapping variables to their value number (VN), which is represented as a
     * SSA variable.  If their VN is different from themselves, then they are redundant.
     *)
      val {getFn=getVN, setFn=setVN, clrFn=clrVN, ...} = IL.Var.newProp (fn x => x)

    (* property for mapping value numbers to hash-consed expressions. *)
      val {getFn=getExp : IL.var -> expr, setFn=setExp, clrFn=clrExp, ...} =
	    IL.Var.newProp (fn x => raise Fail(concat["getExp(", IL.Var.toString x, ")"]))

      datatype env = ENV of {
	  avail : IL.var ValueMap.map	(* map from expressions to their value numbers, which *)
					(* are represented as SSA vars.  The domain are those *)
					(* expressions that are available. *)
	}
    in
    val emptyEnv = ENV{avail = ValueMap.empty}
  (* map variables to their hash-consed definition *)
    val getVN = getVN
    val setVN = setVN
    fun varToExp x = getExp(getVN x)
    fun bindVarToExp (ENV{avail}, x, e) = (
(*DEBUG**Log.msg(concat["** bindVarToExp: ", IL.Var.toString x, " --> ", E.toString e, "\n"]);*)
	  setVN(x, x); setExp(x, e);
	  ENV{avail = ValueMap.insert(avail, e, x)})
    fun expToVN (ENV{avail}, e) = ValueMap.find(avail, e)
  (* rename a variable if it's value number is different than itself *)
    fun rename x = let
	  val x' = getVN x
	  in
	    if IL.Var.same(x, x')
	      then x
	      else (
(*DEBUG**Log.msg(concat["** rename ", IL.Var.toString x, " to ", IL.Var.toString x', "\n"]);*)
		decUse x; incUse x';
		x')
	  end
  (* does a variable change? *)
    fun changed x = not(IL.Var.same(x, getVN x))
  (* clear the properties of a variable *)
    fun clearVar x = (clrVN x; clrExp x)
  (* clear the properties from the variables of a node *)
    fun clearNode nd = List.app clearVar (IL.Node.defs nd)
    end (* local *)

    fun rewriteCFG cfg = let
	(* in case the exit node get rewritten, we need to reset it *)
	  val exitNd = ref(IL.CFG.exit cfg)
	(* rewrite or delete a node, if necessary.  Note that we have already rewritten the JOIN nodes *)
	  fun doNode nd = (case IL.Node.kind nd
		 of IL.COND{pred, cond, trueBranch, falseBranch} =>
		      if changed cond
			then let
			  val newNd = IL.Node.mkCOND {
				  cond = rename cond,
				  trueBranch = !trueBranch,
				  falseBranch = !falseBranch
				}
			  in
			    IL.Node.replaceInEdge {src = !pred, oldDst = nd, dst = newNd};
			    IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !trueBranch};
			    IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !falseBranch}
			  end
			else ()

          | IL.FOREACH{pred,cond,phis,stmBranch,succ,...} => 
            if changed cond 
            then let 
              val newNd = IL.Node.mkFOREACH{ 
                   cond = rename cond,
                   phis = !phis,
                   sName = "",
                   stmBranch = !stmBranch
                }
              in 
                IL.Node.replaceInEdge {src = !pred, oldDst = nd, dst = newNd};
			    IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !stmBranch};
                IL.Node.replaceOutEdge {oldSrc = nd, src = newNd, dst = !succ}
              end 
             else ()
		  | IL.ASSIGN{stm=(y, rhs), succ, ...} =>
		      if changed y
			then IL.CFG.deleteNode nd (* deleting redundant assignment *)
		      else if (List.exists changed (IL.RHS.vars rhs))
		      (* rewrite node to rename variables *)
			then IL.CFG.replaceNode(nd, IL.Node.mkASSIGN(y, IL.RHS.map rename rhs))
			else ()
                  | IL.MASSIGN{stm=([], rator, xs), succ, ...} =>
                      if (List.exists changed xs)
		      (* rewrite node to rename variables *)
			then IL.CFG.replaceNode(nd, IL.Node.mkMASSIGN([], rator, List.map rename xs))
			else ()
                  | IL.MASSIGN{stm=(ys, rator, xs), succ, ...} =>
		      if List.all changed ys
			then IL.CFG.deleteNode nd (* deleting redundant assignment *)
		      else if (List.exists changed xs)
		      (* rewrite node to rename variables *)
			then IL.CFG.replaceNode(nd, IL.Node.mkMASSIGN(ys, rator, List.map rename xs))
			else ()
		  | IL.NEW{strand, args, ...} =>
		      if List.exists changed args
			then IL.CFG.replaceNode(nd, IL.Node.mkNEW{
			    strand=strand, args=List.map rename args
			  })
			else ()
		  | IL.SAVE{lhs, rhs, ...} =>
		      if changed rhs
			then IL.CFG.replaceNode(nd, IL.Node.mkSAVE(lhs, rename rhs))
			else ()
		  | IL.EXIT{kind, live, ...} =>
		      if List.exists changed live
			then let
			  val newNd = IL.Node.mkEXIT(kind, List.map rename live)
			  in
			    if IL.Node.same(nd, !exitNd)
			      then exitNd := newNd
			      else ();
			    IL.CFG.replaceNode (nd, newNd)
			  end
			else ()
		  | _ => ()
		(* end case *))
	  val _ = List.app doNode (IL.CFG.sort cfg)
	  val cfg = IL.CFG{entry = IL.CFG.entry cfg, exit = !exitNd}
	  in
	    IL.CFG.apply clearNode cfg;
	    cfg
	  end

    datatype loop_stk =
        FOREACH of {cond : IL.node}
    
    fun transformCFG (liveIn, renameIn, cfg) = let
	  val tbl = E.new()
          val mkSTATE = E.mkSTATE tbl
	  val mkVAR = E.mkVAR tbl
	  val mkLIT = E.mkLIT tbl
      val mkSELECTOR = E.mkSELECTOR tbl 
      val mkSTRAND_SET = E.mkSTRAND_SET tbl 
   (*   val mkREDUCTION = E.mkREDUCTION tbl *)  
	  val mkOP = E.mkOP tbl
	  val mkMULTIOP = E.mkMULTIOP tbl
	  val mkAPPLY = E.mkAPPLY tbl
	  val mkCONS = E.mkCONS tbl
	  val mkPHI = E.mkPHI tbl
	(* convert a list of variables to a list of expressions *)
	  fun varsToExp (env, xs) = List.map varToExp xs
	(* convert an SSA RHS into a hash-consed expression *)
	  fun mkExp (env, rhs) = (case rhs
		 of IL.STATE x => mkSTATE x
                  | IL.VAR x => varToExp x
		  | IL.LIT l => mkLIT l
          | IL.SELECTOR (x,f) => mkSELECTOR(x,f) 
          | IL.STRAND_SET(s) => mkSTRAND_SET(s)
        (*  | IL.REDUCTION (r,s,x,xExp) => mkREDUCTION(r,s,x,xExp) *) 
		  | IL.OP(rator, args) => mkOP(rator, varsToExp(env, args))
		  | IL.APPLY(f, args) => mkAPPLY(f, varsToExp(env, args))
		  | IL.CONS(ty, args) => mkCONS(ty, varsToExp(env, args))
		(* end case *))
	(* walk the dominator tree computing value numbers *)
	  fun vn (env,nd) = let
        fun setPhisIntialVN([]) = env
          | setPhisIntialVN((y,[])::phis) = env 
          | setPhisIntialVN((y,(y0::xs))::phis) = let 
              val vn = getVN y0
              in 
              setVN(y,vn); 
              setPhisIntialVN(phis)
              end
        fun processJoin(succ,phis) = let
			    fun doPhi ((y, xs), (env, phis)) = let
				  val vn::vns = List.map getVN xs
				  in
				    if List.all (fn vn' => IL.Var.same(vn, vn')) vns
				      then ((* a meaningless phi node; map y to vn *)
(* DEBUG Log.msg(concat["** meaningless phi node: ", IL.phiToString (y, xs), "\n"]);*)
					ST.tick cntMeaninglessPhi;
					List.map decUse xs;
					setVN(y, vn);
					(env, phis))
				      else let
					val exp = mkPHI(varsToExp(env, xs))
					in
					  case expToVN(env, exp)
					   of SOME vn' => ((* a redundant phi node *)
(* DEBUG Log.msg(concat["** redundant phi node: ", IL.phiToString (y, xs), "\n"]);*)
						ST.tick cntRedundantPhi;
						List.map decUse xs;
						setVN(y, vn');
						(env, phis))
					    | NONE => let
						val xs = List.map rename xs
						in
						  (bindVarToExp(env, y, exp), (y, xs)::phis)
						end
					  (* end case *)
					end
				  end
			    val (env, remainingPhis) = List.foldl doPhi (env, []) (!phis)
			    in
			      phis := List.rev remainingPhis;
			      env
			    end
		val env = (case IL.Node.kind nd
		       of IL.JOIN{succ, phis, ...} => processJoin(succ,phis) 
            | IL.FOREACH{succ,phis,shouldReplace,...} =>  
                        if (!shouldReplace) 
                        then (shouldReplace := false; processJoin(succ,phis)) 
                        else (shouldReplace := true; setPhisIntialVN(!phis))
			| IL.ASSIGN{stm=(y, rhs), succ, ...} => let
			    val exp = mkExp(env, rhs)
			    in
			      case expToVN(env, exp)
			       of SOME vn => ((* y is redundant, so map it to vn *)
(* DEBUG ** Log.msg(concat["** redundant assignment: ", IL.assignToString (y, rhs),*)
(* DEBUG **"; VN[", IL.Var.toString y, "] = ", IL.Var.toString vn, "\n"]);*)
				    ST.tick cntRedundantAssign;
				    setVN(y, vn);
				    env)
				| NONE => bindVarToExp(env, y, exp)
			      (* end case *)
			    end
                        | IL.MASSIGN{stm=(ys, rator, xs), succ, ...} => let
                            val xs = varsToExp(env, xs)
                            fun mkExps (env, _, []) = env
                              | mkExps (env, i, y::ys) = let
                                  val exp = mkMULTIOP(i, rator, xs)
                                  in
                                    case expToVN(env, exp)
                                     of SOME vn => ((* y is redundant, so map it to vn *)
                                          ST.tick cntRedundantAssign;
                                          setVN(y, vn);
                                          mkExps (env, i+1, ys))
                                      | NONE => mkExps (bindVarToExp(env, y, exp), i+1, ys)
                                    (* end case *)
                                  end
                            in
                              mkExps (env, 0, ys)
                            end
			| _ => env
		      (* end case *))
		in
		  List.app (fn nd => vn (env, nd)) (D.children nd)
		end
	(* define the initial environment by mapping the liveIn variables to themselves *)
	  val env = List.foldl (fn (x, env) => bindVarToExp(env, x, mkVAR x)) emptyEnv liveIn
	(* set the VN of the incoming renamed variables accordingly *)
	  val _ = List.app setVN renameIn
	  in
	    D.computeTree cfg;
	  (* compute value numbers over the dominance tree *)
	    vn (env, IL.CFG.entry cfg);
	    D.clear cfg;
	  (* delete and rewrite nodes as necessary *)
	    rewriteCFG cfg before
	      (List.app clearVar liveIn; List.app (clearVar o #1) renameIn)
	  end

    fun transformCFG' (liveIn, renameIn, cfg) = let
	  val origLiveOut = IL.CFG.liveAtExit cfg
	  val cfg = transformCFG (liveIn, renameIn, cfg)
	  val liveOut = IL.CFG.liveAtExit cfg
	(* compute a mapping from the original liveOut variables to their new names *)
	  val rename = let
		fun findDups (x, x', rename) =
		      if IL.Var.same(x, x')
			then rename
			else IL.Var.Map.insert(rename, x, x')
		in
		  ListPair.foldl findDups IL.Var.Map.empty (origLiveOut, liveOut)
		end
	(* filter out duplicate names from the liveOut list *)
	  val foundDup = ref false
	  val liveOut' = let
		fun f (x, ys) = if List.exists (fn y => IL.Var.same(x, y)) ys
			then (foundDup := true; ys)
			else x::ys
		in
		  List.foldr f [] liveOut
		end
	(* if there were any duplicates, then rewrite the exit node *)
	  val cfg = if !foundDup
		then IL.CFG.updateExit(cfg, fn _ => liveOut')
		else cfg
	  in
	    {cfg = cfg, rename = IL.Var.Map.foldli (fn (x, y, l) => (x, y)::l) renameIn rename}
	  end

    fun transform prog = let
	  val IL.Program{props, globalInit, globalBlock, globalReduce, initially, strands} = prog
	  val {cfg=globalInit, rename} = transformCFG' ([], [], globalInit)
	  val globals = (IL.CFG.liveAtExit globalInit) 
      val {cfg=globalBlock, rename} = transformCFG' (globals, rename, globalBlock)
      val globals = (IL.CFG.liveAtExit globalBlock)
      val {cfg=globalBlock, rename} = transformCFG' (globals, rename, globalReduce)
      val globals = (IL.CFG.liveAtExit globalReduce)

	(* transform the strand initialization code *)
	  val initially = if List.null rename
		then initially
		else let
		  val IL.Initially{isArray, rangeInit, iters, create} = initially
		(* first process the range initialization code *)
		  val {cfg=rangeInit, rename} = transformCFG' (globals, rename, rangeInit)
		  val live = IL.CFG.liveAtExit rangeInit @ globals
		(* create a function for renaming variables *)
		  fun mkRenameFn rename = let
			val vMap = List.foldl IL.Var.Map.insert' IL.Var.Map.empty rename
			fun renameVar x = (case IL.Var.Map.find (vMap, x)
			       of NONE => x
				| SOME x' => x'
			      (* end case *))
			in
			  renameVar
			end
		(* rename the bounds of the iterators *)
		  val iters = let
			val renameVar = mkRenameFn rename
			in
			  List.map (fn (x, lo, hi) => (x, renameVar lo, renameVar hi)) iters
			end
                (* add the iteration variables to the live list *)
                  val live = List.foldl (fn ((x, _, _), lv) => x::lv) live iters
		(* process the body *)
		  val (cfg, strand, args) = create
		  val {cfg, rename} = transformCFG' (live, rename, cfg)
		  val create = (cfg, strand, List.map (mkRenameFn rename) args)
		  in
		    IL.Initially{
			isArray = isArray, rangeInit = rangeInit,
			iters = iters, create= create
		      }
		  end
	(* transform a strand *)
	  fun transformStrand (IL.Strand{name, params, state, stateInit, methods}) = let
		val liveIn = params @ globals
		val stateInit = transformCFG (liveIn, rename, stateInit)
(* FIXME: what if a state variable becomes redundant? *)
		fun transformMeth (IL.Method{name, body}) = let
		      val body = transformCFG (liveIn, rename, body)
		      in
			IL.Method{name=name, body=body}
		      end
		in
		  IL.Strand{
		      name = name,
		      params = params,
		      state = state,
		      stateInit = stateInit,
		      methods = List.map transformMeth methods
		    }
		end
	  val strands = List.map transformStrand strands
	  in
	    IL.Program{
		props = props,
		globalInit = globalInit,
        globalBlock = globalBlock,
        globalReduce = globalReduce,  
		initially = initially,
		strands = strands
	      }
	  end

  end

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