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

SCM Repository

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

Diff of /branches/pure-cfg/src/compiler/codegen/codegen-fn.sml

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

revision 511, Tue Feb 8 17:01:43 2011 UTC revision 512, Tue Feb 8 19:32:42 2011 UTC
# Line 14  Line 14 
14    
15    end = struct    end = struct
16    
17      structure Src = LowIL      structure IL = LowIL
18      structure SrcV = LowIL.Var      structure V = LowIL.Var
19      structure SrcOp = LowOps      structure Op = LowOps
20      structure SrcNd = LowIL.Node      structure Nd = LowIL.Node
21        structure CFG = LowIL.Node
   (* a property marking nodes that are directly referenced by statememts. *)  
     local  
       val {getFn, setFn, ...} = SrcNd.newFlag ()  
     in  
     val isFirst = getFn  
     fun markFirst nd = setFn(nd, true)  
     end  
   
   (* walk the statements, marking the first nodes of the statements *)  
     fun markNodes (stm as SrcIL.STM{kind, next}) = (  
           case kind  
            of SrcIL.S_SIMPLE nd => markFirst (nd, stm)  
             | SrcIL.S_IF{cond, thenBranch, elseBranch} => (  
                 markFirst (cond, stm);  
                 markNodes thenBranch;  
                 markNodes elseBranch)  
             | SrcIL.S_LOOP{hdr, cond, body} => (  
                 markNodes hdr;  
                 markFirst (cond, stm);  
                 markNodes body)  
           (* end case *);  
           case next  
            of NONE => ()  
             | SOME stm => markNodes stm  
           (* end case *))  
22    
23    (* a mapping from LowIL variables to target expressions.  Variables get    (* a mapping from LowIL variables to target expressions.  Variables get
24     * removed when the expressions are used as arguments.     * removed when the expressions are used as arguments.
# Line 52  Line 27 
27          type tbl          type tbl
28    
29          val newTbl : unit -> tbl          val newTbl : unit -> tbl
30          val getDefOf : tbl -> SrcV.var -> T.exp          val getDefOf : tbl -> V.var -> T.exp
31          val useDefOf : tbl -> SrcV.var -> T.exp          val useDefOf : tbl -> V.var -> T.exp
32          val setDefOf : tbl -> (SrcV.var * T.exp) -> unit          val setDefOf : tbl -> (V.var * T.exp) -> unit
33    
34          val clear : tbl -> unit          val clear : tbl -> unit
35    
36          val bind : tbl -> (SrcV.var * T.exp) -> T.stm list          val bind : tbl -> (V.var * T.exp) -> T.stm list
37    
38        (* force all pending expressions into variables *)        (* force all pending expressions into variables *)
39          val flush : tbl -> T.stm list          val flush : tbl -> T.stm list
# Line 70  Line 45 
45              bind : T.exp              bind : T.exp
46            }            }
47    
48          type tbl = info SrcV.Tbl.hash_table          type tbl = info V.Tbl.hash_table
49    
50          fun newTbl () = SrcV.Tbl.mkTable (512, Fail "vtbl")          fun newTbl () = V.Tbl.mkTable (512, Fail "vtbl")
51    
52          fun getDefOf tbl x = (case SrcV.Tbl.find tbl x          fun getDefOf tbl x = (case V.Tbl.find tbl x
53                 of NONE => ??                 of NONE => ??
54                  | SOME{bind, cnt} => bind                  | SOME{bind, cnt} => bind
55                (* end case *))                (* end case *))
56    
57          fun useDefOf tbl x = (case SrcV.Tbl.find tbl x          fun useDefOf tbl x = (case V.Tbl.find tbl x
58                 of NONE => ??                 of NONE => ??
59                  | SOME{cnt=ref n, bind} => (                  | SOME{cnt=ref 1, bind} => (
60                      ignore (SrcV.Tbl.remove tbl x);                      ignore (V.Tbl.remove tbl x);
61                      bind)                      bind)
62                  | SOME{cnt, bind} =>  => (                  | SOME{cnt, bind} =>  => (
63                      cnt := !cnt - 1;                      cnt := !cnt - 1;
# Line 90  Line 65 
65                (* end case *))                (* end case *))
66    
67          fun setDefOf tbl (x, exp) =          fun setDefOf tbl (x, exp) =
68                SrcV.Tbl.insert tbl (x, {cnt = ref(SrcV.useCount x), bind = exp})                V.Tbl.insert tbl (x, {cnt = ref(V.useCount x), bind = exp})
69    
70          fun assign tbl (x, exp) = let          fun assign tbl (x, exp) = let
71                      val lhs : T.local_var = ??                      val lhs : T.local_var = ??
72                      in                      in
73                        SrcV.Tbl.insert tbl                        V.Tbl.insert tbl
74                          (x, {cnt = SrcV.useCount x, bind = T.Expr.var lhs});                          (x, {cnt = V.useCount x, bind = T.Expr.var lhs});
75                        [T.Stmt.assign(lhs, exp)]                        [T.Stmt.assign(lhs, exp)]
76                      end                      end
77    
78          fun bind tbl (x, exp) = (case SrcV.useCount lhs          fun bind tbl (x, exp) = (case V.useCount lhs
79                 of 1 => (SrcV.Tbl.insert tbl (x, {cnt = 1, bind = exp}); [])                 of 1 => (V.Tbl.insert tbl (x, {cnt = 1, bind = exp}); [])
80                  | n => let (* bind exp to a new target variable *)                  | n => let (* bind exp to a new target variable *)
81                      val lhs : T.local_var = ??                      val lhs : T.local_var = ??
82                      in                      in
83                        SrcV.Tbl.insert tbl (x, {cnt = n, bind = T.Expr.var lhs});                        V.Tbl.insert tbl (x, {cnt = n, bind = T.Expr.var lhs});
84                        [T.Stmt.assign(lhs, exp)]                        [T.Stmt.assign(lhs, exp)]
85                      end                      end
86                (* end case *))                (* end case *))
# Line 129  Line 104 
104            fun setDef rhs = (VTbl.setDefOf vtbl (lhs, rhs); [])            fun setDef rhs = (VTbl.setDefOf vtbl (lhs, rhs); [])
105            in            in
106              case rhs              case rhs
107               of Src.VAR x => setDef (T.Expr.var(VDefTbl.useDefOf vtbl x))               of IL.VAR x => setDef (T.Expr.var(VDefTbl.useDefOf vtbl x))
108                | Src.LIT(Literal.Int n) => setDef (T.Expr.intLit n)                | IL.LIT(Literal.Int n) => setDef (T.Expr.intLit n)
109                | Src.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)                | IL.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)
110                | Src.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)                | IL.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)
111                | Src.LIT(Literal.String s) => setDef (T.Expr.stringLit s)                | IL.LIT(Literal.String s) => setDef (T.Expr.stringLit s)
112                | Src.OP(rator, args) => doRator(vtbl, lhs, rator, args)                | IL.OP(rator, args) => doRator(vtbl, lhs, rator, args)
113                | Src.CONS args =>                | IL.CONS args =>
114                    VTbl.assign ctbl (lhs, T.Expr.vector (List.map (VDefTbl.useDefOf vtbl) args))                    VTbl.assign ctbl (lhs, T.Expr.vector (List.map (VDefTbl.useDefOf vtbl) args))
115              (* end case *)              (* end case *)
116            end            end
117    
118        datatype open_if = T.stm list * IL.node -> stm
119    
120        fun gen (vtbl, cfg) = let
121              val doAssign = doAssign vtbl
122              fun doNode (vtbl, ifStk, stms, nd) = (case Nd.kind nd
123                     of IL.NULL =>
124                      | IL.ENTRY{succ} =>
125                      | IL.JOIN{phis, succ, ...} =>
126                      | IL.COND{cond, trueBranch, falseBranch, ...} => let
127                          fun kThen (stms', _) = let
128                                val thenBlk = T.Stmt.block (List.rev stms')
129                                fun kElse (stms', succ) = let
130                                      val stm = T.Stmt.ifthenelse (
131                                            VDefTbl.useDefOf vtbl cond,
132                                            thenBlk,
133                                            T.Stmt.block (List.rev stms'))
134                                      in
135                                        doNode (vtbl, ifStk, stm::stms, succ)
136                                      end
137                                in
138                                  doNode (vtbl, kElse::ifStk, [], !falseBranch)
139                                end
140                          in
141                            doNode (vtbl, kThen::ifStk, [], !trueBranch)
142                          end
143                      | IL.COM {text, succ, ...} =>
144                      | IL.ASSIGN{stm, succ, ...} =>
145                      | IL.NEW{strand, args, succ, ...} =>
146                      | IL.DIE _ =>
147                      | IL.STABILIZE _ =>
148                      | IL.EXIT _ =>
149                    (* end case *))
150              in
151              end
152    
153      fun gen (vtbl, stm) = let      fun gen (vtbl, stm) = let
154            val doAssign = doAssign vtbl            val doAssign = doAssign vtbl
155            fun mkBlock [] = ?            fun mkBlock [] = ?
156              | mkBlock [s] = s              | mkBlock [s] = s
157              | mkBlock stms = T.Stmt.block stms              | mkBlock stms = T.Stmt.block stms
158            fun doStmt (SrcIL.STM{kind, next, ...}) = let            fun doStmt (IL.STM{kind, next, ...}) = let
159                  val stms = (case kind                  val stms = (case kind
160                         of SrcIL.S_SIMPLE nd => doNode nd                         of IL.S_SIMPLE nd => doNode nd
161                          | SrcIL.S_IF{cond, thenBranch, elseBranch} => let                          | IL.S_IF{cond, thenBranch, elseBranch} => let
162                              val SrcIL.ND{kind=SrcIL.COND{cond, ...}, ...} = cond                              val IL.ND{kind=IL.COND{cond, ...}, ...} = cond
163                              val s1 = mkBlock(doStmt thenBranch)                              val s1 = mkBlock(doStmt thenBranch)
164                              val s2 = mkBlock(doStmt elseBranch)                              val s2 = mkBlock(doStmt elseBranch)
165                              in                              in
166  (* FIXME: check for empty else branch *)  (* FIXME: check for empty else branch *)
167                                T.ifthenelse(VDefTbl.useDefOf vtbl cond, s1, s2)                                T.ifthenelse(VDefTbl.useDefOf vtbl cond, s1, s2)
168                              end                              end
169                          | SrcIL.S_LOOP{hdr, cond, body} => raise Fail "LOOP not supported yet"                          | IL.S_LOOP{hdr, cond, body} => raise Fail "LOOP not supported yet"
170                        (* end case *))                        (* end case *))
171                  val rest = (case next                  val rest = (case next
172                         of NONE => VDefTbl.flush vtbl                         of NONE => VDefTbl.flush vtbl
# Line 165  Line 175 
175                  in                  in
176                    stms @ rest                    stms @ rest
177                  end                  end
178            and doNode (SrcIL.ND{kind, ...}) = (case kind            and doNode (IL.ND{kind, ...}) = (case kind
179                   of SrcIL.NULL => ??                   of IL.NULL => ??
180                    | SrcIL.ENTRY{succ} => nextNode succ                    | IL.ENTRY{succ} => nextNode succ
181                    | SrcIL.JOIN{succ, ...} =>                    | IL.JOIN{succ, ...} =>
182                    | SrcIL.COND{cond, ...} =>                    | IL.COND{cond, ...} =>
183                    | SrcIL.BLOCK{body, succ, ...} =>                    | IL.BLOCK{body, succ, ...} =>
184                        List.app doAssign body @ nextNode succ                        List.app doAssign body @ nextNode succ
185                    | SrcIL.NEW{strand, args, ...} =>                    | IL.NEW{strand, args, ...} =>
186                    | SrcIL.DIE _ =>                    | IL.DIE _ =>
187                    | SrcIL.STABILIZE _ =>                    | IL.STABILIZE _ =>
188                    | SrcIL.EXIT _ =>                    | IL.EXIT _ =>
189                  (* end case *))                  (* end case *))
190            and nextNode nd = if isFirst nd then [] else doNode nd            and nextNode nd = if isFirst nd then [] else doNode nd
191            in            in

Legend:
Removed from v.511  
changed lines
  Added in v.512

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