SCM Repository

[diderot] Diff of /branches/lamont_dev/src/compiler/translate/translate.sml

[diderot] / branches / lamont_dev / src / compiler / translate / translate.sml

Diff of /branches/lamont_dev/src/compiler/translate/translate.sml

-revision 1231, Mon May 16 13:49:17 2011 UTC
+revision 1232, Mon May 16 23:37:52 2011 UTC
 Line 70
     * that flow into the join node.
     *)
      datatype join = JOIN of {
+         env : env,                      (* the environment that was current at the conditional *)
+                                         (* associated with this node. *)
          arity : int ref,                (* actual number of predecessors *)
          nd : IL.node,                   (* the CFG node for this pending join *)
          phiMap : IL.phi VMap.map ref,   (* a mapping from Simple AST variables that are assigned *)
-Line 83
+Line 85
      type pending_joins = (int * join) list
    (* create a new pending-join node *)
-     fun newJoin arity = JOIN{
+     fun newJoin (env, arity) = JOIN{
-             arity = ref arity, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty,
+             env = env, arity = ref arity, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty,
              predKill = Array.array(arity, false)
            }
-Line 98
+Line 100
     * srcVar) in the current pending-join node.  The predIndex specifies which path into the
     * JOIN node this assignment occurs on.
     *)
-     fun recordAssign (_, [], _, _) = ()
+     fun recordAssign ([], _, _) = ()
-       | recordAssign (env, (predIndex, JOIN{phiMap, predKill, ...})::_, srcVar, dstVar) = let
+       | recordAssign ((predIndex, JOIN{env, phiMap, predKill, nd, ...})::_, srcVar, dstVar) = let
            val arity = Array.length predKill (* the original arity before any killPath calls *)
            val m = !phiMap
            in
-Line 110
+Line 112
                          val lhs = newVar srcVar
                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')
                          in
+ (*
+ print(concat["recordAssign: ", Var.uniqueNameOf srcVar, " --> ", IL.Var.toString lhs,
+ " @ ", IL.Node.toString nd, "\n"]);
+ *)
                            phiMap := VMap.insert (m, srcVar, (lhs, rhs))
                          end
                      | SOME(lhs, rhs) => let
-Line 127
+Line 133
    (* complete a pending join operation by filling in the phi nodes from the phi map and
     * updating the environment.
     *)
-     fun commitJoin (env, joinStk, JOIN{arity, nd, phiMap, predKill}) = (case !arity
+     fun commitJoin (joinStk, JOIN{env, arity, nd, phiMap, predKill}) = (case !arity
             of 0 => (env, NONE)
              | 1 => (* there is only one path to the join, so we do not need phi nodes *)
                  (env, SOME nd)
-Line 135
+Line 141
                  then let
                    val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd
                    fun doVar (srcVar, phi as (dstVar, _), (env, phis)) = (
-                         recordAssign (env, joinStk, srcVar, dstVar);
+ (*
+ print(concat["doVar (", Var.uniqueNameOf srcVar, ", ", IL.phiToString phi, ", _) @ ", IL.Node.toString nd, "\n"]);
+ *)
+                         recordAssign (joinStk, srcVar, dstVar);
                          (VMap.insert (env, srcVar, dstVar), phi::phis))
                    val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)
                    in
-Line 186
+Line 195
                        val lhs' = newVar lhs
                        val assigns = cvtExp (env, lhs', rhs)
                        in
-                         recordAssign (env, joinStk, lhs, lhs');
+ (*
+ print "doAssign\n";
+ *)
+                         recordAssign (joinStk, lhs, lhs');
                          cvt (
                            VMap.insert(env, lhs, lhs'),
                            IL.CFG.concat(cfg, IL.CFG.mkBlock assigns),
-Line 194
+Line 206
                        end
                    | S.S_IfThenElse(x, b0, b1) => let
                        val x' = lookup env x
-                       val join = newJoin 2
+                       val join = newJoin (env, 2)
                        val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)
                        val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)
                        val cond = IL.Node.mkCOND {
-Line 204
+Line 216
                              }
                        in
                          IL.Node.addEdge (IL.CFG.exit cfg, cond);
-                         case commitJoin (env, joinStk, join)
+                         case commitJoin (joinStk, join)
                           of (env, SOME joinNd) => (
                                if IL.CFG.isEmpty cfg0
                                  then (
-Line 254
+Line 266
              cvt (env, IL.CFG.empty, stms)
            end
-     fun cvtTopLevelBlock (env, blk) = let
+     fun cvtTopLevelBlock (env, blk, mkExit) = let
            val (cfg, env) = cvtBlock ([], env, [], blk)
            val entry = IL.Node.mkENTRY ()
-           val exit = IL.Node.mkRETURN (VMap.listItems env)
+           val exit = mkExit env
            in
              if IL.CFG.isEmpty cfg
                then IL.Node.addEdge (entry, exit)
-Line 271
+Line 283
            end
  (* FIXME: the following function could be refactored with cvtTopLevelBlock to share code *)
-     fun cvtFragmentBlock (env, blk) = let
+     fun cvtFragmentBlock (env0, blk) = let
-           val (cfg, env) = cvtBlock ([], env, [], blk)
+           val (cfg, env) = cvtBlock ([], env0, [], blk)
            val entry = IL.Node.mkENTRY ()
-           val exit = IL.Node.mkFRAGMENT []
+         (* the live variables out are those that were not live coming in *)
+           val liveOut = VMap.foldli
+                 (fn (x, x', xs) => if VMap.inDomain(env0, x) then xs else x'::xs)
+                   [] env
+           val exit = IL.Node.mkFRAGMENT liveOut
            in
              if IL.CFG.isEmpty cfg
                then IL.Node.addEdge (entry, exit)
                else (
                  IL.Node.addEdge (entry, IL.CFG.entry cfg);
-               (* NOTE: this addEdge could fail if all control paths end in DIE or STABILIZE,
+                 IL.Node.addEdge (IL.CFG.exit cfg, exit));
-                * so we wrap it in a handler
-                *)
-                 IL.Node.addEdge (IL.CFG.exit cfg, exit) handle _ => ());
              (IL.CFG{entry = entry, exit = exit}, env)
            end
-Line 335
+Line 348
            end
      fun translate (S.Program{globals, globalInit, init, strands}) = let
-           val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)
+           val (globalInit, env) =
+                 cvtTopLevelBlock (
+                   VMap.empty, globalInit,
+                   fn env => IL.Node.mkRETURN(VMap.listItems env))
          (* construct a reduced environment that just defines the globals. *)
            val env = let
                  val lookup = lookup env
-Line 346
+Line 362
                  end
            val init = cvtInitially (env, init)
            fun cvtStrand (S.Strand{name, params, state, stateInit, methods}) = let
+               (* extend the global environment with the strand's parameters *)
                  val (env, params) = let
                        fun cvtParam (x, (env, xs)) = let
                              val x' = newVar x
-Line 356
+Line 373
                        in
                          (env, List.rev params)
                        end
-                 val (stateInit, env) = cvtTopLevelBlock (env, stateInit)
+               (* convert the state initialization code *)
+                 val (stateInit, env) = let
+                       fun mkExit env = IL.Node.mkSINIT(List.map (lookup env) state)
+                       in
+                         cvtTopLevelBlock (env, stateInit, mkExit)
+                       end
+               (* the state-variable list is constructed by generating fresh variables for the
+                * state variables and pairing them with a boolean that is true if the variable
+                * is an output variable.  Note that these IL variables are not defined or used.
+                *)
                  val state' = let
-                       fun cvtStateVar x = (Var.kindOf x = S.StrandOutputVar, lookup env x)
+                       fun cvtStateVar x = (Var.kindOf x = S.StrandOutputVar, newVar x)
                        in
                          List.map cvtStateVar state
                        end

 Legend:



Removed from v.1231
 


changed lines


 
Added in v.1232
 Legend:



Removed from v.1231
 


changed lines


 
Added in v.1232
-Removed from v.1231
+Added in v.1232

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