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

SCM Repository

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

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

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

revision 1231, Mon May 16 13:49:17 2011 UTC revision 1232, Mon May 16 23:37:52 2011 UTC
# Line 70  Line 70 
70     * that flow into the join node.     * that flow into the join node.
71     *)     *)
72      datatype join = JOIN of {      datatype join = JOIN of {
73            env : env,                      (* the environment that was current at the conditional *)
74                                            (* associated with this node. *)
75          arity : int ref,                (* actual number of predecessors *)          arity : int ref,                (* actual number of predecessors *)
76          nd : IL.node,                   (* the CFG node for this pending join *)          nd : IL.node,                   (* the CFG node for this pending join *)
77          phiMap : IL.phi VMap.map ref,   (* a mapping from Simple AST variables that are assigned *)          phiMap : IL.phi VMap.map ref,   (* a mapping from Simple AST variables that are assigned *)
# Line 83  Line 85 
85      type pending_joins = (int * join) list      type pending_joins = (int * join) list
86    
87    (* create a new pending-join node *)    (* create a new pending-join node *)
88      fun newJoin arity = JOIN{      fun newJoin (env, arity) = JOIN{
89              arity = ref arity, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty,              env = env, arity = ref arity, nd = IL.Node.mkJOIN [], phiMap = ref VMap.empty,
90              predKill = Array.array(arity, false)              predKill = Array.array(arity, false)
91            }            }
92    
# Line 98  Line 100 
100     * srcVar) in the current pending-join node.  The predIndex specifies which path into the     * srcVar) in the current pending-join node.  The predIndex specifies which path into the
101     * JOIN node this assignment occurs on.     * JOIN node this assignment occurs on.
102     *)     *)
103      fun recordAssign (_, [], _, _) = ()      fun recordAssign ([], _, _) = ()
104        | recordAssign (env, (predIndex, JOIN{phiMap, predKill, ...})::_, srcVar, dstVar) = let        | recordAssign ((predIndex, JOIN{env, phiMap, predKill, nd, ...})::_, srcVar, dstVar) = let
105            val arity = Array.length predKill (* the original arity before any killPath calls *)            val arity = Array.length predKill (* the original arity before any killPath calls *)
106            val m = !phiMap            val m = !phiMap
107            in            in
# Line 110  Line 112 
112                          val lhs = newVar srcVar                          val lhs = newVar srcVar
113                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')                          val rhs = List.tabulate (arity, fn i => if (i = predIndex) then dstVar else dstVar')
114                          in                          in
115    (*
116    print(concat["recordAssign: ", Var.uniqueNameOf srcVar, " --> ", IL.Var.toString lhs,
117    " @ ", IL.Node.toString nd, "\n"]);
118    *)
119                            phiMap := VMap.insert (m, srcVar, (lhs, rhs))                            phiMap := VMap.insert (m, srcVar, (lhs, rhs))
120                          end                          end
121                      | SOME(lhs, rhs) => let                      | SOME(lhs, rhs) => let
# Line 127  Line 133 
133    (* complete a pending join operation by filling in the phi nodes from the phi map and    (* complete a pending join operation by filling in the phi nodes from the phi map and
134     * updating the environment.     * updating the environment.
135     *)     *)
136      fun commitJoin (env, joinStk, JOIN{arity, nd, phiMap, predKill}) = (case !arity      fun commitJoin (joinStk, JOIN{env, arity, nd, phiMap, predKill}) = (case !arity
137             of 0 => (env, NONE)             of 0 => (env, NONE)
138              | 1 => (* there is only one path to the join, so we do not need phi nodes *)              | 1 => (* there is only one path to the join, so we do not need phi nodes *)
139                  (env, SOME nd)                  (env, SOME nd)
# Line 135  Line 141 
141                  then let                  then let
142                    val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd                    val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd
143                    fun doVar (srcVar, phi as (dstVar, _), (env, phis)) = (                    fun doVar (srcVar, phi as (dstVar, _), (env, phis)) = (
144                          recordAssign (env, joinStk, srcVar, dstVar);  (*
145    print(concat["doVar (", Var.uniqueNameOf srcVar, ", ", IL.phiToString phi, ", _) @ ", IL.Node.toString nd, "\n"]);
146    *)
147                            recordAssign (joinStk, srcVar, dstVar);
148                          (VMap.insert (env, srcVar, dstVar), phi::phis))                          (VMap.insert (env, srcVar, dstVar), phi::phis))
149                    val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)                    val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)
150                    in                    in
# Line 186  Line 195 
195                        val lhs' = newVar lhs                        val lhs' = newVar lhs
196                        val assigns = cvtExp (env, lhs', rhs)                        val assigns = cvtExp (env, lhs', rhs)
197                        in                        in
198                          recordAssign (env, joinStk, lhs, lhs');  (*
199    print "doAssign\n";
200    *)
201                            recordAssign (joinStk, lhs, lhs');
202                          cvt (                          cvt (
203                            VMap.insert(env, lhs, lhs'),                            VMap.insert(env, lhs, lhs'),
204                            IL.CFG.concat(cfg, IL.CFG.mkBlock assigns),                            IL.CFG.concat(cfg, IL.CFG.mkBlock assigns),
# Line 194  Line 206 
206                        end                        end
207                    | S.S_IfThenElse(x, b0, b1) => let                    | S.S_IfThenElse(x, b0, b1) => let
208                        val x' = lookup env x                        val x' = lookup env x
209                        val join = newJoin 2                        val join = newJoin (env, 2)
210                        val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)                        val (cfg0, _) = cvtBlock (state, env, (0, join)::joinStk, b0)
211                        val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)                        val (cfg1, _) = cvtBlock (state, env, (1, join)::joinStk, b1)
212                        val cond = IL.Node.mkCOND {                        val cond = IL.Node.mkCOND {
# Line 204  Line 216 
216                              }                              }
217                        in                        in
218                          IL.Node.addEdge (IL.CFG.exit cfg, cond);                          IL.Node.addEdge (IL.CFG.exit cfg, cond);
219                          case commitJoin (env, joinStk, join)                          case commitJoin (joinStk, join)
220                           of (env, SOME joinNd) => (                           of (env, SOME joinNd) => (
221                                if IL.CFG.isEmpty cfg0                                if IL.CFG.isEmpty cfg0
222                                  then (                                  then (
# Line 254  Line 266 
266              cvt (env, IL.CFG.empty, stms)              cvt (env, IL.CFG.empty, stms)
267            end            end
268    
269      fun cvtTopLevelBlock (env, blk) = let      fun cvtTopLevelBlock (env, blk, mkExit) = let
270            val (cfg, env) = cvtBlock ([], env, [], blk)            val (cfg, env) = cvtBlock ([], env, [], blk)
271            val entry = IL.Node.mkENTRY ()            val entry = IL.Node.mkENTRY ()
272            val exit = IL.Node.mkRETURN (VMap.listItems env)            val exit = mkExit env
273            in            in
274              if IL.CFG.isEmpty cfg              if IL.CFG.isEmpty cfg
275                then IL.Node.addEdge (entry, exit)                then IL.Node.addEdge (entry, exit)
# Line 271  Line 283 
283            end            end
284    
285  (* FIXME: the following function could be refactored with cvtTopLevelBlock to share code *)  (* FIXME: the following function could be refactored with cvtTopLevelBlock to share code *)
286      fun cvtFragmentBlock (env, blk) = let      fun cvtFragmentBlock (env0, blk) = let
287            val (cfg, env) = cvtBlock ([], env, [], blk)            val (cfg, env) = cvtBlock ([], env0, [], blk)
288            val entry = IL.Node.mkENTRY ()            val entry = IL.Node.mkENTRY ()
289            val exit = IL.Node.mkFRAGMENT []          (* the live variables out are those that were not live coming in *)
290              val liveOut = VMap.foldli
291                    (fn (x, x', xs) => if VMap.inDomain(env0, x) then xs else x'::xs)
292                      [] env
293              val exit = IL.Node.mkFRAGMENT liveOut
294            in            in
295              if IL.CFG.isEmpty cfg              if IL.CFG.isEmpty cfg
296                then IL.Node.addEdge (entry, exit)                then IL.Node.addEdge (entry, exit)
297                else (                else (
298                  IL.Node.addEdge (entry, IL.CFG.entry cfg);                  IL.Node.addEdge (entry, IL.CFG.entry cfg);
299                (* 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 _ => ());  
300              (IL.CFG{entry = entry, exit = exit}, env)              (IL.CFG{entry = entry, exit = exit}, env)
301            end            end
302    
# Line 335  Line 348 
348            end            end
349    
350      fun translate (S.Program{globals, globalInit, init, strands}) = let      fun translate (S.Program{globals, globalInit, init, strands}) = let
351            val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)            val (globalInit, env) =
352                    cvtTopLevelBlock (
353                      VMap.empty, globalInit,
354                      fn env => IL.Node.mkRETURN(VMap.listItems env))
355          (* construct a reduced environment that just defines the globals. *)          (* construct a reduced environment that just defines the globals. *)
356            val env = let            val env = let
357                  val lookup = lookup env                  val lookup = lookup env
# Line 346  Line 362 
362                  end                  end
363            val init = cvtInitially (env, init)            val init = cvtInitially (env, init)
364            fun cvtStrand (S.Strand{name, params, state, stateInit, methods}) = let            fun cvtStrand (S.Strand{name, params, state, stateInit, methods}) = let
365                  (* extend the global environment with the strand's parameters *)
366                  val (env, params) = let                  val (env, params) = let
367                        fun cvtParam (x, (env, xs)) = let                        fun cvtParam (x, (env, xs)) = let
368                              val x' = newVar x                              val x' = newVar x
# Line 356  Line 373 
373                        in                        in
374                          (env, List.rev params)                          (env, List.rev params)
375                        end                        end
376                  val (stateInit, env) = cvtTopLevelBlock (env, stateInit)                (* convert the state initialization code *)
377                    val (stateInit, env) = let
378                          fun mkExit env = IL.Node.mkSINIT(List.map (lookup env) state)
379                          in
380                            cvtTopLevelBlock (env, stateInit, mkExit)
381                          end
382                  (* the state-variable list is constructed by generating fresh variables for the
383                   * state variables and pairing them with a boolean that is true if the variable
384                   * is an output variable.  Note that these IL variables are not defined or used.
385                   *)
386                  val state' = let                  val state' = let
387                        fun cvtStateVar x = (Var.kindOf x = S.StrandOutputVar, lookup env x)                        fun cvtStateVar x = (Var.kindOf x = S.StrandOutputVar, newVar x)
388                        in                        in
389                          List.map cvtStateVar state                          List.map cvtStateVar state
390                        end                        end

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

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