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 513, Tue Feb 8 21:23:01 2011 UTC revision 514, Tue Feb 8 22:54:00 2011 UTC
# Line 18  Line 18 
18      structure V = LowIL.Var      structure V = LowIL.Var
19      structure Op = LowOps      structure Op = LowOps
20      structure Nd = LowIL.Node      structure Nd = LowIL.Node
21      structure CFG = LowIL.Node      structure CFG = LowIL.CFG
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 26  Line 26 
26      structure VDefTbl : sig      structure VDefTbl : sig
27          type tbl          type tbl
28    
29            datatype binding = C of T.cond | E of T.exp
30    
31          val newTbl : unit -> tbl          val newTbl : unit -> tbl
32          val getDefOf : tbl -> V.var -> T.exp          val getDefOf : tbl -> IL.var -> binding
33          val useDefOf : tbl -> V.var -> T.exp          val useDefOf : tbl -> IL.var -> binding
34          val setDefOf : tbl -> (V.var * T.exp) -> unit          val setDefOf : tbl -> (IL.var * T.exp) -> unit
35    
36          val clear : tbl -> unit          val clear : tbl -> unit
37    
38          val bind : tbl -> (V.var * T.exp) -> T.stm list          val assign : tbl -> (IL.var * T.exp) -> T.stm list
39            val bind : tbl -> (IL.var * T.exp) -> T.stm list
40            val cbind : tbl -> (IL.var * T.cond) -> T.stm list
41    
42        (* force all pending expressions into variables *)        (* force all pending expressions into variables *)
43          val flush : tbl -> T.stm list          val flush : tbl -> T.stm list
44    
45        end = struct        end = struct
46    
47            datatype binding = C of T.cond | E of T.exp
48    
49          type info = {          type info = {
50              cnt : int ref,      (* count of oustanding uses (usually 1) *)              cnt : int ref,      (* count of oustanding uses (usually 1) *)
51              bind : T.exp              bind : binding
52            }            }
53    
54          type tbl = info V.Tbl.hash_table          type tbl = info V.Tbl.hash_table
# Line 50  Line 56 
56          fun newTbl () = V.Tbl.mkTable (512, Fail "vtbl")          fun newTbl () = V.Tbl.mkTable (512, Fail "vtbl")
57    
58          fun getDefOf tbl x = (case V.Tbl.find tbl x          fun getDefOf tbl x = (case V.Tbl.find tbl x
59                 of NONE => ??                 of NONE => raise Fail(concat["getDefOf(", V.toString x, ")"])
60                  | SOME{bind, cnt} => bind                  | SOME{bind, cnt} => bind
61                (* end case *))                (* end case *))
62    
63          fun useDefOf tbl x = (case V.Tbl.find tbl x          fun useDefOf tbl x = (case V.Tbl.find tbl x
64                 of NONE => ??                 of NONE => raise Fail(concat["useDefOf(", V.toString x, ")"])
65                  | SOME{cnt=ref 1, bind} => (                  | SOME{cnt=ref 1, bind} => (
66                      ignore (V.Tbl.remove tbl x);                      ignore (V.Tbl.remove tbl x);
67                      bind)                      bind)
68                  | SOME{cnt, bind} =>  => (                  | SOME{cnt, bind} => (
69                      cnt := !cnt - 1;                      cnt := !cnt - 1;
70                      bind)                      bind)
71                (* end case *))                (* end case *))
72    
73          fun setDefOf tbl (x, exp) =          fun setDefOf tbl (x, exp) =
74                V.Tbl.insert tbl (x, {cnt = ref(V.useCount x), bind = exp})                V.Tbl.insert tbl (x, {cnt = ref(V.useCount x), bind = E exp})
75    
76          fun assign tbl (x, exp) = let          fun assign tbl (x, exp) = let
77                      val lhs : T.local_var = ??                      val lhs = T.Var.tmpVar()
78                      in                      in
79                        V.Tbl.insert tbl                        V.Tbl.insert tbl
80                          (x, {cnt = V.useCount x, bind = T.Expr.var lhs});                          (x, {cnt = ref(V.useCount x), bind = E(T.Expr.var lhs)});
81                        [T.Stmt.assign(lhs, exp)]                        [T.Stmt.assign(lhs, exp)]
82                      end                      end
83    
84          fun bind tbl (x, exp) = (case V.useCount lhs          fun bind tbl (x, exp) = (case V.useCount x
85                 of 1 => (V.Tbl.insert tbl (x, {cnt = 1, bind = exp}); [])                 of 1 => (V.Tbl.insert tbl (x, {cnt = ref 1, bind = E exp}); [])
86                  | n => let (* bind exp to a new target variable *)                  | n => let (* bind exp to a new target variable *)
87                      val lhs : T.local_var = ??                      val lhs = T.Var.tmpVar()
88                      in                      in
89                        V.Tbl.insert tbl (x, {cnt = n, bind = T.Expr.var lhs});                        V.Tbl.insert tbl (x, {cnt = ref n, bind = E(T.Expr.var lhs)});
90                        [T.Stmt.assign(lhs, exp)]                        [T.Stmt.assign(lhs, exp)]
91                      end                      end
92                (* end case *))                (* end case *))
93    
94            fun cbind tbl (x, cond) = (case V.useCount x
95                   of 1 => (V.Tbl.insert tbl (x, {cnt = ref 1, bind = C cond}); [])
96                    | n => let (* bind exp to a new target variable *)
97                        val lhs = T.Var.tmpVar()
98                        in
99                          V.Tbl.insert tbl (x, {cnt = ref n, bind = C(T.Cond.var lhs)});
100                          [T.Stmt.assignb(lhs, cond)]
101                        end
102                  (* end case *))
103    
104            val clear = V.Tbl.clear
105    
106            fun flush tbl = raise Fail "flush"
107    
108        end (*  VDefTbl *)        end (*  VDefTbl *)
109    
110  (* FIXME: what about splitting code where the target width doesn't match the  (* FIXME: what about splitting code where the target width doesn't match the
111   * source width?   * source width?
112   *)   *)
113      fun doRator (vtbl, lhs, rator, args) = let      fun doRator vtbl = let
114            val args' = List.map (VDefTbl.useDefOf vtbl) args            val useDefOf = VDefTbl.useDefOf vtbl
115            val rhs' = (case (rator, args)            val bind = VDefTbl.bind vtbl
116                   of (Op.Add ty, [a, b]) =>            val cbind = VDefTbl.cbind vtbl
117                    | (Op.Sub ty, [a, b]) =>            fun f (lhs, rator, args) = let
118                    | (Op.Mul ty, [a, b]) =>                  fun exp x = (case useDefOf x
119                    | (Op.Div ty, [a, b]) =>                         of VDefTbl.E e => e
120                    | (Op.Neg ty, [a]) =>                          | _ => raise Fail "expected exp"
121                    | (Op.LT ty, [a, b]) =>                        (* end case *))
122                    | (Op.LTE ty, [a, b]) =>                  fun cond x = (case useDefOf x
123                    | (Op.EQ ty, [a, b]) =>                         of VDefTbl.C c => c
124                    | (Op.NEQ ty, [a, b]) =>                          | _ => raise Fail "expected cond"
125                    | (Op.GT ty, [a, b]) =>                        (* end case *))
126                    | (Op.GTE ty, [a, b]) =>                  in
127                    | (Op.Not, [a]) =>                    case (rator, args)
128                    | (Op.Max, [a, b]) =>                     of (Op.Add ty, [a, b])       => bind (lhs, T.Expr.add(exp a, exp b))
129                    | (Op.Min, [a, b]) =>                      | (Op.Sub ty, [a, b])       => bind (lhs, T.Expr.sub(exp a, exp b))
130                    | (Op.Sin, [a]) =>                      | (Op.Mul ty, [a, b])       => bind (lhs, T.Expr.mul(exp a, exp b))
131                    | (Op.Cos, [a]) =>                      | (Op.Div ty, [a, b])       => bind (lhs, T.Expr.divide(exp a, exp b))
132                    | (Op.Pow, [a, b]) =>                      | (Op.Neg ty, [a])          => bind (lhs, T.Expr.neg(exp a))
133                    | (Op.Dot d, [a, b]) =>                      | (Op.LT ty, [a, b])        => cbind (lhs, T.Cond.lt(exp a, exp b))
134                    | (Op.Cross, [a, b]) =>                      | (Op.LTE ty, [a, b])       => cbind (lhs, T.Cond.lte(exp a, exp b))
135                    | (Op.Select(ty, i), [a]) =>                      | (Op.EQ ty, [a, b])        => cbind (lhs, T.Cond.equ(exp a, exp b))
136                    | (Op.Norm d, [a]) =>                      | (Op.NEQ ty, [a, b])       => cbind (lhs, T.Cond.neq(exp a, exp b))
137                    | (Op.Scale d, [a, b]) =>                      | (Op.GT ty, [a, b])        => cbind (lhs, T.Cond.gt(exp a, exp b))
138                    | (Op.InvScale d, [a, b]) =>                      | (Op.GTE ty, [a, b])       => cbind (lhs, T.Cond.gte(exp a, exp b))
139                    | (Op.CL                      | (Op.Not, [a])             => cbind (lhs, T.Cond.not(cond a))
140                    | (Op.PrincipleEvec of ty                      | (Op.Max, [a, b])          => bind (lhs, T.Expr.max(exp a, exp b))
141                    | (Op.Subscript of ty                      | (Op.Min, [a, b])          => bind (lhs, T.Expr.min(exp a, exp b))
142                    | (Op.Floor of int                      | (Op.Sin, [a])             => bind (lhs, T.Expr.sin(exp a))
143                    | (Op.IntToReal                      | (Op.Cos, [a])             => bind (lhs, T.Expr.cos(exp a))
144                    | (Op.TruncToInt of int                      | (Op.Pow, [a, b])          => bind (lhs, T.Expr.pow(exp a, exp b))
145                    | (Op.RoundToInt of int                      | (Op.Dot d, [a, b])        => bind (lhs, T.Expr.dot(exp a, exp b))
146                    | (Op.CeilToInt of int                      | (Op.Cross, [a, b])        => bind (lhs, T.Expr.cross(exp a, exp b))
147                    | (Op.FloorToInt of int                      | (Op.Select(ty, i), [a])   => bind (lhs, T.Expr.select(i, exp a))
148                        | (Op.Norm d, [a])          => bind (lhs, T.Expr.length(exp a))
149                        | (Op.Scale d, [a, b])      => bind (lhs, T.Expr.mul(exp a, exp b))
150                        | (Op.InvScale d, [a, b])   => bind (lhs, T.Expr.divide(exp a, exp b))
151                        | (Op.CL, _)                => raise Fail "CL unimplemented"
152                        | (Op.PrincipleEvec ty, _)  => raise Fail "PrincipleEvec unimplemented"
153    (*
154                        | (Op.Subscript ty,
155    *)
156                        | (Op.Floor d, [a])         => bind (lhs, T.Expr.floor(exp a))
157                        | (Op.IntToReal, [a])       => bind (lhs, T.Expr.toReal(exp a))
158                        | (Op.TruncToInt d, [a])    => bind (lhs, T.Expr.truncToInt(exp a))
159                        | (Op.RoundToInt d, [a])    => bind (lhs, T.Expr.roundToInt(exp a))
160                        | (Op.CeilToInt d, [a])     => bind (lhs, T.Expr.ceilToInt(exp a))
161                        | (Op.FloorToInt d, [a])    => bind (lhs, T.Expr.floorToInt(exp a))
162    (*
163                    | (Op.ImageAddress of ImageInfo.info                    | (Op.ImageAddress of ImageInfo.info
164                    | (Op.LoadVoxels of RawTypes.ty * int                    | (Op.LoadVoxels of RawTypes.ty * int
165                    | (Op.PosToImgSpace of ImageInfo.info                    | (Op.PosToImgSpace of ImageInfo.info
# Line 133  Line 168 
168                    | (Op.Inside of ImageInfo.info                    | (Op.Inside of ImageInfo.info
169                    | (Op.Input of ty * string                    | (Op.Input of ty * string
170                    | (Op.InputWithDefault of ty * string                    | (Op.InputWithDefault of ty * string
171                  (* end case *))  *)
172                      (* end case *)
173                    end
174            in            in
175              VDefTbl.bind vtbl (lhs, rhs')              f
176            end            end
177    
178    (* translate a LowIL assignment to a list of zero or more target statements *)    (* translate a LowIL assignment to a list of zero or more target statements *)
179      fun doAssign vtbl (lhs, rhs) = let      fun doAssign vtbl (lhs, rhs) = let
180            fun setDef rhs = (VTbl.setDefOf vtbl (lhs, rhs); [])            val setDefOf = VDefTbl.setDefOf vtbl
181              val doRator = doRator vtbl
182              fun assign (lhs, rhs) = let
183                    fun setDef rhs = (setDefOf (lhs, rhs); [])
184            in            in
185              case rhs              case rhs
186               of IL.VAR x => setDef (T.Expr.var(VDefTbl.useDefOf vtbl x))               of IL.VAR x => setDef (T.Expr.var(VDefTbl.useDefOf vtbl x))
# Line 148  Line 188 
188                | IL.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)                | IL.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)
189                | IL.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)                | IL.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)
190                | IL.LIT(Literal.String s) => setDef (T.Expr.stringLit s)                | IL.LIT(Literal.String s) => setDef (T.Expr.stringLit s)
191                | IL.OP(rator, args) => doRator(vtbl, lhs, rator, args)                      | IL.OP(rator, args) => doRator(lhs, rator, args)
192                | IL.CONS args =>                | IL.CONS args =>
193                    VTbl.assign ctbl (lhs, T.Expr.vector (List.map (VDefTbl.useDefOf vtbl) args))                          VDefTbl.assign vtbl
194                              (lhs, T.Expr.vector (List.map (VDefTbl.useDefOf vtbl) args))
195              (* end case *)              (* end case *)
196            end            end
197              in
198      datatype open_if = T.stm list * IL.node -> stm              assign
199              end
200    
201      fun gen (vtbl, cfg) = let      fun gen (vtbl, cfg) = let
202            val doAssign = doAssign vtbl            val doAssign = doAssign vtbl
203            fun doNode (vtbl, ifCont, stms, nd) = (case Nd.kind nd            fun doNode (vtbl, ifCont, stms, nd) = (case Nd.kind nd
204                   of IL.NULL => raise Fail "unexpected NULL"                   of IL.NULL => raise Fail "unexpected NULL"
205                    | IL.ENTRY{succ} => doNode (vtbl, ifStk, stms, !succ)                    | IL.ENTRY{succ} => doNode (vtbl, ifCont, stms, !succ)
206                    | IL.JOIN{phis, succ, ...} => ifCont (stms, nd)                    | IL.JOIN{phis, succ, ...} => ifCont (stms, Node.kind nd)
207                    | IL.COND{cond, trueBranch, falseBranch, ...} => let                    | IL.COND{cond, trueBranch, falseBranch, ...} => let
208                        fun kThen (stms', _) = let                        fun kThen (stms', _) = let
209                              val thenBlk = T.Stmt.block (List.rev stms')                              val thenBlk = T.Stmt.block (List.rev stms')
# Line 172  Line 214 
214                                          T.Stmt.block (List.rev stms'))                                          T.Stmt.block (List.rev stms'))
215                                    in                                    in
216  (* FIXME: what do we do about phis? *)  (* FIXME: what do we do about phis? *)
217                                      doNode (vtbl, ifStk, stm::stms, !succ)                                      doNode (vtbl, ifCont, stm::stms, !succ)
218                                    end                                    end
219                              in                              in
220                                doNode (vtbl, kElse::ifStk, [], !falseBranch)                                doNode (vtbl, kElse, [], !falseBranch)
221                              end                              end
222                        in                        in
223                          doNode (vtbl, kThen::ifStk, [], !trueBranch)                          doNode (vtbl, kThen, [], !trueBranch)
224                        end                        end
225                    | IL.COM {text, succ, ...} =>                    | IL.COM {text, succ, ...} =>
226                        doNode (vtbl, ifStk, T.Stmt.comment text :: stms, !succ)                        doNode (vtbl, ifCont, T.Stmt.comment text :: stms, !succ)
227                    | IL.ASSIGN{stm, succ, ...} =>                    | IL.ASSIGN{stm, succ, ...} =>
228                        doNode (vtbl, ifStk, doAssign stm :: stms, !succ)                        doNode (vtbl, ifCont, doAssign stm :: stms, !succ)
229                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
230                    | IL.DIE _ =>                    | IL.DIE _ =>
231                        doNode (vtbl, ifStk, T.Stmt.die() :: stms, !succ)                        T.Stmt.block (List.rev (T.Stmt.die() :: stms))
232                    | IL.STABILIZE _ =>                    | IL.STABILIZE _ =>
233                        doNode (vtbl, ifStk, T.Stmt.stabilize() :: stms, !succ)                        T.Stmt.block (List.rev stms)
234                    | IL.EXIT _ => T.Stmt.mkBlock (List.rev stms)                    | IL.EXIT _ => T.Stmt.block (List.rev (T.Stmt.stabilize() :: stms))
235                  (* end case *))                  (* end case *))
236            in            in
237              doNode (vtbl, fn _ => raise Fail "bogus ifCont at JOIN node", [], CFG.entry cfg)              doNode (vtbl, fn _ => raise Fail "bogus ifCont at JOIN node", [], CFG.entry cfg)

Legend:
Removed from v.513  
changed lines
  Added in v.514

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