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

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/translate/translate.sml
[diderot] / branches / pure-cfg / src / compiler / translate / translate.sml  
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/translate/translate.sml

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

revision 500, Tue Feb 1 17:40:24 2011 UTC revision 501, Tue Feb 1 22:02:37 2011 UTC
# Line 80  Line 80 
80     * 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
81     * JOIN node this assignment occurs on.     * JOIN node this assignment occurs on.
82     *)     *)
83      fun recordAssign (_, [], _, _, _) = ()      fun recordAssign (_, [], _, _) = ()
84        | recordAssign (env, (predIndex, JOIN{arity, phiMap, ...})::_, srcVar, dstVar) = let        | recordAssign (env, (predIndex, JOIN{arity, phiMap, ...})::_, srcVar, dstVar) = let
85            val m = !phiMap            val m = !phiMap
86            val m'= (case VMap.find (m, srcVar)            val m'= (case VMap.find (m, srcVar)
# Line 110  Line 110 
110      fun commitJoin (env, joinStk, JOIN{nd, phiMap, ...}) = let      fun commitJoin (env, joinStk, JOIN{nd, phiMap, ...}) = let
111            val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd            val IL.ND{kind=IL.JOIN{phis, ...}, ...} = nd
112            fun doVar (srcVar, phi as (dstVar, _), (env, phis)) = (            fun doVar (srcVar, phi as (dstVar, _), (env, phis)) = (
113                  recordAssign (env, r, srcVar, dstVer);                  recordAssign (env, joinStk, srcVar, dstVar);
114                  (VMap.insert (env, srcVar, dstVar), phi::phis))                  (VMap.insert (env, srcVar, dstVar), phi::phis))
115            val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)            val (env, phis') = VMap.foldli doVar (env, []) (!phiMap)
116            in            in
117  (* FIXME: prune killed paths. *)  (* FIXME: prune killed paths. *)
118              phis := phis'              phis := phis';
119              (env, SOME nd)              (env, SOME nd)
120            end            end
121    
122    (* expression translation *)    (* expression translation *)
123      fun cvtExp (env, lhs, exp) = (case exp      fun cvtExp (env : env, lhs, exp) = (case exp
124             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
125              | S.E_Lit lit => [(lhs, IL.LIT lit)]              | S.E_Lit lit => [(lhs, IL.LIT lit)]
126              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
# Line 149  Line 149 
149              | S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]              | S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]
150            (* end case *))            (* end case *))
151    
152      fun cvtBlock (env, joinStk, S.Block stms) = let      fun cvtBlock (env : env, joinStk, S.Block stms) = let
153            fun cvt (env, cfg, []) = cfg            fun cvt (env : env, cfg, []) = cfg
154              | cvt (env, cfg, stm::stms) = (case stm              | cvt (env, cfg, stm::stms) = (case stm
155                   of S.S_Assign(lhs, rhs) => let                   of S.S_Assign(lhs, rhs) => let
156                        val assigns = cvtExp (env, lhs, rhs)                        val lhs' = newVar lhs
157                          val assigns = cvtExp (env, lhs', rhs)
158                        in                        in
159  (* FIXME: need to record assignments *)                          recordAssign (env, joinStk, lhs, lhs');
160                          cvt (env, IL.CFG.concat(cfg, IL.CFG.mkBlock assigns), stms)                          cvt (env, IL.CFG.concat(cfg, IL.CFG.mkBlock assigns), stms)
161                        end                        end
162                    | S.S_IfThenElse(x, b0, b1) => let                    | S.S_IfThenElse(x, b0, b1) => let
# Line 163  Line 164 
164                        val join = newJoin 2                        val join = newJoin 2
165                        val cfg0 = cvtBlock (env, (0, join)::joinStk, b0)                        val cfg0 = cvtBlock (env, (0, join)::joinStk, b0)
166                        val cfg1 = cvtBlock (env, (1, join)::joinStk, b1)                        val cfg1 = cvtBlock (env, (1, join)::joinStk, b1)
                       fun skipEmpty cfg = if IL.CFG.isEmpty cfg  
                             then join  
                             else IL.CFG.entry cfg  
167                        val cond = IL.Node.mkCOND {                        val cond = IL.Node.mkCOND {
168                                cond = x',                                cond = x',
169                                trueBranch = skipEmpty cfg0,                                trueBranch = IL.Node.dummy,
170                                elseBranch = skipEmpty cfg1                                falseBranch = IL.Node.dummy
171                              }                              }
172                        in                        in
173                          case commitJoin (env, joinStk, join)                          case commitJoin (env, joinStk, join)
174                           of (env, SOME joinNd) => (                           of (env, SOME joinNd) => (
175                                if IL.CFG.isEmpty cfg0                                if IL.CFG.isEmpty cfg0
176                                  then ()                                  then IL.Node.setTrueBranch (cond, joinNd)
177                                  else IL.CFG.addEdge (IL.CFG.exit cfg0, joinNd);                                  else (
178                                      IL.Node.setTrueBranch (cond, IL.CFG.entry cfg0);
179                                      IL.Node.addEdge (IL.CFG.exit cfg0, joinNd));
180                                if IL.CFG.isEmpty cfg1                                if IL.CFG.isEmpty cfg1
181                                  then ()                                  then IL.Node.setFalseBranch (cond, joinNd)
182                                  else IL.CFG.addEdge (IL.CFG.exit cfg1, joinNd);                                  else (
183                                      IL.Node.setFalseBranch (cond, IL.CFG.entry cfg1);
184                                      IL.Node.addEdge (IL.CFG.exit cfg1, joinNd));
185                                cvt (                                cvt (
186                                  env,                                  env,
187                                  IL.CFG{entry = IL.CFG.entry, exit = joinNd},                                  IL.CFG{entry = IL.CFG.entry cfg, exit = joinNd},
188                                  stms))                                  stms))
189                          (* the join node has only zero or one predecessors, so                          (* the join node has only zero or one predecessors, so
190                           * it was killed.                           * it was killed.
# Line 209  Line 211 
211              cvt (env, IL.CFG.empty, stms)              cvt (env, IL.CFG.empty, stms)
212            end            end
213    
214    (* FIX THIS CODE!!!! *)
215      fun cvtTopLevelBlock (env, blk) = let      fun cvtTopLevelBlock (env, blk) = let
216            fun finish (env, firstNd, lastNd) = let            fun finish (env, firstNd, lastNd) = let
217                  val entry = IL.Node.mkENTRY ()                  val entry = IL.Node.mkENTRY ()
# Line 219  Line 222 
222                   * so we wrap it in a handler                   * so we wrap it in a handler
223                   *)                   *)
224                    IL.Node.addEdge (lastNd, exit) handle _ => ();                    IL.Node.addEdge (lastNd, exit) handle _ => ();
225                    IL.CFG{entry = ref entry, exit = ref exit}                    IL.CFG{entry = entry, exit = exit}
226                  end                  end
227            in            in
228              cvtBlock (env, blk, finish)              cvtBlock (env, blk, finish)
Legend:
Removed from v.500  
changed lines
  Added in v.501
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge