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 514, Tue Feb 8 22:54:00 2011 UTC revision 518, Thu Feb 10 17:38:35 2011 UTC
# Line 10  Line 10 
10    
11  functor CodeGenFn (T : TARGET) : sig  functor CodeGenFn (T : TARGET) : sig
12    
13      val generate : LowIL.program -> T.program      val generate : string * LowIL.program -> unit
14    
15    end = struct    end = struct
16    
# Line 26  Line 26 
26      structure VDefTbl : sig      structure VDefTbl : sig
27          type tbl          type tbl
28    
         datatype binding = C of T.cond | E of T.exp  
   
29          val newTbl : unit -> tbl          val newTbl : unit -> tbl
30          val getDefOf : tbl -> IL.var -> binding          val getDefOf : tbl -> IL.var -> T.exp
31          val useDefOf : tbl -> IL.var -> binding          val useDefOf : tbl -> IL.var -> T.exp
32          val setDefOf : tbl -> (IL.var * T.exp) -> unit          val setDefOf : tbl -> (IL.var * T.exp) -> unit
33    
34          val clear : tbl -> unit          val clear : tbl -> unit
35    
36          val assign : tbl -> (IL.var * T.exp) -> T.stm list          val assign : tbl -> (IL.var * T.exp) -> T.stm list
37          val bind : tbl -> (IL.var * T.exp) -> T.stm list          val bind : tbl -> (IL.var * T.exp) -> T.stm list
         val cbind : tbl -> (IL.var * T.cond) -> T.stm list  
38    
39        (* force all pending expressions into variables *)        (* force all pending expressions into variables *)
40          val flush : tbl -> T.stm list          val flush : tbl -> T.stm list
41    
42        end = struct        end = struct
43    
         datatype binding = C of T.cond | E of T.exp  
   
44          type info = {          type info = {
45              cnt : int ref,      (* count of oustanding uses (usually 1) *)              cnt : int ref,      (* count of oustanding uses (usually 1) *)
46              bind : binding              bind : T.exp
47            }            }
48    
49          type tbl = info V.Tbl.hash_table          type tbl = info V.Tbl.hash_table
# Line 71  Line 66 
66                (* end case *))                (* end case *))
67    
68          fun setDefOf tbl (x, exp) =          fun setDefOf tbl (x, exp) =
69                V.Tbl.insert tbl (x, {cnt = ref(V.useCount x), bind = E exp})                V.Tbl.insert tbl (x, {cnt = ref(V.useCount x), bind = exp})
70    
71          fun assign tbl (x, exp) = let          fun assign tbl (x, exp) = let
72                      val lhs = T.Var.tmpVar()                      val lhs = T.Var.tmpVar()
73                      in                      in
74                        V.Tbl.insert tbl                        V.Tbl.insert tbl
75                          (x, {cnt = ref(V.useCount x), bind = E(T.Expr.var lhs)});                          (x, {cnt = ref(V.useCount x), bind = T.Expr.var lhs});
76                        [T.Stmt.assign(lhs, exp)]                        [T.Stmt.assign(lhs, exp)]
77                      end                      end
78    
79          fun bind tbl (x, exp) = (case V.useCount x          fun bind tbl (x, exp) = (case V.useCount x
80                 of 1 => (V.Tbl.insert tbl (x, {cnt = ref 1, bind = E exp}); [])                 of 1 => (V.Tbl.insert tbl (x, {cnt = ref 1, bind = exp}); [])
81                  | n => let (* bind exp to a new target variable *)                  | n => let (* bind exp to a new target variable *)
82                      val lhs = T.Var.tmpVar()                      val lhs = T.Var.tmpVar()
83                      in                      in
84                        V.Tbl.insert tbl (x, {cnt = ref n, bind = E(T.Expr.var lhs)});                        V.Tbl.insert tbl (x, {cnt = ref n, bind = T.Expr.var lhs});
85                        [T.Stmt.assign(lhs, exp)]                        [T.Stmt.assign(lhs, exp)]
86                      end                      end
87                (* end case *))                (* end case *))
88    
         fun cbind tbl (x, cond) = (case V.useCount x  
                of 1 => (V.Tbl.insert tbl (x, {cnt = ref 1, bind = C cond}); [])  
                 | n => let (* bind exp to a new target variable *)  
                     val lhs = T.Var.tmpVar()  
                     in  
                       V.Tbl.insert tbl (x, {cnt = ref n, bind = C(T.Cond.var lhs)});  
                       [T.Stmt.assignb(lhs, cond)]  
                     end  
               (* end case *))  
   
89          val clear = V.Tbl.clear          val clear = V.Tbl.clear
90    
91          fun flush tbl = raise Fail "flush"          fun flush tbl = raise Fail "flush"
# Line 111  Line 96 
96   * source width?   * source width?
97   *)   *)
98      fun doRator vtbl = let      fun doRator vtbl = let
99            val useDefOf = VDefTbl.useDefOf vtbl            val exp = VDefTbl.useDefOf vtbl
100            val bind = VDefTbl.bind vtbl            val bind = VDefTbl.bind vtbl
101            val cbind = VDefTbl.cbind vtbl            fun f (lhs, rator, args) = (case (rator, args)
           fun f (lhs, rator, args) = let  
                 fun exp x = (case useDefOf x  
                        of VDefTbl.E e => e  
                         | _ => raise Fail "expected exp"  
                       (* end case *))  
                 fun cond x = (case useDefOf x  
                        of VDefTbl.C c => c  
                         | _ => raise Fail "expected cond"  
                       (* end case *))  
                 in  
                   case (rator, args)  
102                     of (Op.Add ty, [a, b])       => bind (lhs, T.Expr.add(exp a, exp b))                     of (Op.Add ty, [a, b])       => bind (lhs, T.Expr.add(exp a, exp b))
103                      | (Op.Sub ty, [a, b])       => bind (lhs, T.Expr.sub(exp a, exp b))                      | (Op.Sub ty, [a, b])       => bind (lhs, T.Expr.sub(exp a, exp b))
104                      | (Op.Mul ty, [a, b])       => bind (lhs, T.Expr.mul(exp a, exp b))                      | (Op.Mul ty, [a, b])       => bind (lhs, T.Expr.mul(exp a, exp b))
105                      | (Op.Div ty, [a, b])       => bind (lhs, T.Expr.divide(exp a, exp b))                      | (Op.Div ty, [a, b])       => bind (lhs, T.Expr.divide(exp a, exp b))
106                      | (Op.Neg ty, [a])          => bind (lhs, T.Expr.neg(exp a))                      | (Op.Neg ty, [a])          => bind (lhs, T.Expr.neg(exp a))
107                      | (Op.LT ty, [a, b])        => cbind (lhs, T.Cond.lt(exp a, exp b))                    | (Op.LT ty, [a, b])          => bind (lhs, T.Expr.lt(exp a, exp b))
108                      | (Op.LTE ty, [a, b])       => cbind (lhs, T.Cond.lte(exp a, exp b))                    | (Op.LTE ty, [a, b])         => bind (lhs, T.Expr.lte(exp a, exp b))
109                      | (Op.EQ ty, [a, b])        => cbind (lhs, T.Cond.equ(exp a, exp b))                    | (Op.EQ ty, [a, b])          => bind (lhs, T.Expr.equ(exp a, exp b))
110                      | (Op.NEQ ty, [a, b])       => cbind (lhs, T.Cond.neq(exp a, exp b))                    | (Op.NEQ ty, [a, b])         => bind (lhs, T.Expr.neq(exp a, exp b))
111                      | (Op.GT ty, [a, b])        => cbind (lhs, T.Cond.gt(exp a, exp b))                    | (Op.GT ty, [a, b])          => bind (lhs, T.Expr.gt(exp a, exp b))
112                      | (Op.GTE ty, [a, b])       => cbind (lhs, T.Cond.gte(exp a, exp b))                    | (Op.GTE ty, [a, b])         => bind (lhs, T.Expr.gte(exp a, exp b))
113                      | (Op.Not, [a])             => cbind (lhs, T.Cond.not(cond a))                    | (Op.Not, [a])               => bind (lhs, T.Expr.not(exp a))
114                      | (Op.Max, [a, b])          => bind (lhs, T.Expr.max(exp a, exp b))                      | (Op.Max, [a, b])          => bind (lhs, T.Expr.max(exp a, exp b))
115                      | (Op.Min, [a, b])          => bind (lhs, T.Expr.min(exp a, exp b))                      | (Op.Min, [a, b])          => bind (lhs, T.Expr.min(exp a, exp b))
116                      | (Op.Sin, [a])             => bind (lhs, T.Expr.sin(exp a))                      | (Op.Sin, [a])             => bind (lhs, T.Expr.sin(exp a))
# Line 159  Line 133 
133                      | (Op.RoundToInt d, [a])    => bind (lhs, T.Expr.roundToInt(exp a))                      | (Op.RoundToInt d, [a])    => bind (lhs, T.Expr.roundToInt(exp a))
134                      | (Op.CeilToInt d, [a])     => bind (lhs, T.Expr.ceilToInt(exp a))                      | (Op.CeilToInt d, [a])     => bind (lhs, T.Expr.ceilToInt(exp a))
135                      | (Op.FloorToInt d, [a])    => bind (lhs, T.Expr.floorToInt(exp a))                      | (Op.FloorToInt d, [a])    => bind (lhs, T.Expr.floorToInt(exp a))
136                      | (Op.ImageAddress, [a])      => bind (lhs, T.Expr.imageAddr(exp a))
137  (*  (*
138                      | (Op.ImageAddress of ImageInfo.info                    | (Op.LoadVoxels(rTy, n), [a]) =>
139                      | (Op.LoadVoxels of RawTypes.ty * int                    | (Op.PosToImgSpace d, [v, x]) =>
140                      | (Op.PosToImgSpace of ImageInfo.info                    | (Op.GradToWorldSpace d, [v, x]) =>
141                      | (Op.GradToWorldSpace of ImageInfo.info                    | (Op.LoadImage info, [a]) =>
142                      | (Op.LoadImage of ImageInfo.info                    | (Op.Inside d, [v, x]) =>
143                      | (Op.Inside of ImageInfo.info                    | (Op.Input(ty, name), []) =>
144                      | (Op.Input of ty * string                    | (Op.InputWithDefault(ty, name), [a]) =>
                     | (Op.InputWithDefault of ty * string  
145  *)  *)
146                    (* end case *)                  (* end case *))
                 end  
147            in            in
148              f              f
149            end            end
150    
151    (* 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 *)
152      fun doAssign vtbl (lhs, rhs) = let      fun doAssign vtbl = let
153            val setDefOf = VDefTbl.setDefOf vtbl            val setDefOf = VDefTbl.setDefOf vtbl
154            val doRator = doRator vtbl            val doRator = doRator vtbl
155            fun assign (lhs, rhs) = let            fun assign (lhs, rhs) = let
156                  fun setDef rhs = (setDefOf (lhs, rhs); [])                  fun setDef rhs = (setDefOf (lhs, rhs); [])
157                  in                  in
158                    case rhs                    case rhs
159                     of IL.VAR x => setDef (T.Expr.var(VDefTbl.useDefOf vtbl x))                     of IL.VAR x => setDef (VDefTbl.useDefOf vtbl x)
160                      | IL.LIT(Literal.Int n) => setDef (T.Expr.intLit n)                      | IL.LIT(Literal.Int n) => setDef (T.Expr.intLit n)
161                      | IL.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)                      | IL.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)
162                      | IL.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)                      | IL.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)
# Line 203  Line 176 
176            fun doNode (vtbl, ifCont, stms, nd) = (case Nd.kind nd            fun doNode (vtbl, ifCont, stms, nd) = (case Nd.kind nd
177                   of IL.NULL => raise Fail "unexpected NULL"                   of IL.NULL => raise Fail "unexpected NULL"
178                    | IL.ENTRY{succ} => doNode (vtbl, ifCont, stms, !succ)                    | IL.ENTRY{succ} => doNode (vtbl, ifCont, stms, !succ)
179                    | IL.JOIN{phis, succ, ...} => ifCont (stms, Node.kind nd)                    | IL.JOIN{phis, succ, ...} => ifCont (stms, Nd.kind nd)
180                    | IL.COND{cond, trueBranch, falseBranch, ...} => let                    | IL.COND{cond, trueBranch, falseBranch, ...} => let
181                        fun kThen (stms', _) = let                        fun kThen (stms', _) = let
182                              val thenBlk = T.Stmt.block (List.rev stms')                              val thenBlk = T.Stmt.block (List.rev stms')
# Line 225  Line 198 
198                    | IL.COM {text, succ, ...} =>                    | IL.COM {text, succ, ...} =>
199                        doNode (vtbl, ifCont, T.Stmt.comment text :: stms, !succ)                        doNode (vtbl, ifCont, T.Stmt.comment text :: stms, !succ)
200                    | IL.ASSIGN{stm, succ, ...} =>                    | IL.ASSIGN{stm, succ, ...} =>
201                        doNode (vtbl, ifCont, doAssign stm :: stms, !succ)                        doNode (vtbl, ifCont, doAssign stm @ stms, !succ)
202                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"                    | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
203                    | IL.DIE _ =>                    | IL.DIE _ =>
204                        T.Stmt.block (List.rev (T.Stmt.die() :: stms))                        T.Stmt.block (List.rev (T.Stmt.die() :: stms))
# Line 237  Line 210 
210              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)
211            end            end
212    
213        fun generate (fileStem, IL.Program{globals, globalInit, strands}) = ()
214    
215    end    end

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

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