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 529, Mon Feb 14 15:03:54 2011 UTC revision 552, Fri Feb 18 15:09:08 2011 UTC
# Line 14  Line 14 
14    
15    end = struct    end = struct
16    
17      structure IL = LowIL      structure IL = TreeIL
18      structure Ty = LowILTypes      structure Ty = IL.Ty
19      structure V = LowIL.Var      structure Op = IL.Op
20      structure Op = LowOps      structure V = IL.Var
     structure Nd = LowIL.Node  
     structure CFG = LowIL.CFG  
21    
22    (* convert LowIL types to T types *)    (* convert LowIL types to T types *)
23      fun cvtTy ty = (case ty      fun cvtTy ty = (case ty
24             of Ty.BoolTy => T.boolTy             of Ty.BoolTy => T.boolTy
25              | Ty.StringTy => raise Fail "FIXME: StringTy"              | Ty.StringTy => T.stringTy
26              | Ty.IVecTy 1 => T.intTy              | Ty.IVecTy 1 => T.intTy
27              | Ty.IVecTy n => T.ivecTy n         (* FIXME: what about vector splits? *)              | Ty.IVecTy n => T.ivecTy n         (* FIXME: what about vector splits? *)
28              | Ty.VecTy 1 => T.realTy              | Ty.VecTy 1 => T.realTy
29              | Ty.VecTy n => T.vecTy n           (* FIXME: what about vector splits? *)              | Ty.VecTy n => T.vecTy n           (* FIXME: what about vector splits? *)
30              | Ty.AddrTy => raise Fail "FIXME: AddrTy"              | Ty.AddrTy info => T.imageDataTy info
31              | Ty.ImageTy =>  raise Fail "FIXME: ImageTy"              | Ty.ImageTy info => T.imageTy info
32            (* end case *))            (* end case *))
33    
34    (* a flag to mark global IL variables, since they need to be treated differently *)      fun addBindings (env, xs, ys) =
35      local            ListPair.foldlEq (fn (x, y, env) => V.Map.insert(env, x, y)) env (xs, ys)
       val {getFn, setFn} = V.newFlag ()  
     in  
     val isGlobal = getFn  
     fun markGlobal x = setFn(x, true)  
     end  
   
   (* a mapping from LowIL variables to target expressions.  Variables get  
    * removed when the expressions are used as arguments.  
    *)  
     structure VDefTbl : sig  
         type tbl  
   
         val newTbl : T.program -> tbl  
         val getDefOf : tbl -> IL.var -> T.exp  
         val useDefOf : tbl -> IL.var -> T.exp  
         val setDefOf : tbl -> (IL.var * T.exp) -> unit  
   
         val clear : tbl -> unit  
   
         val assign : tbl -> (IL.var * T.exp) -> T.stm list  
         val bind : tbl -> (IL.var * T.exp) -> T.stm list  
   
       (* force all pending expressions into variables *)  
         val flush : tbl -> T.stm list  
   
       end = struct  
   
         type info = {  
             cnt : int ref,      (* count of oustanding uses (usually 1) *)  
             bind : T.exp  
           }  
   
         datatype tbl = VT of  
             prog : T.program,  
             defs : info V.Tbl.hash_table  
           }  
   
         fun newTbl prog = VT{  
                 prog = prog,  
                 defs = V.Tbl.mkTable (512, Fail "vtbl")  
               }  
   
         fun getDefOf (VT{defs, ...}) x = (case V.Tbl.find defs x  
                of NONE => raise Fail(concat["getDefOf(", V.toString x, ")"])  
                 | SOME{bind, cnt} => bind  
               (* end case *))  
   
         fun useDefOf (VT{defs, ...}) x = (case V.Tbl.find defs x  
                of NONE => raise Fail(concat["useDefOf(", V.toString x, ")"])  
                 | SOME{cnt=ref 1, bind} => (  
                     ignore (V.Tbl.remove defs x);  
                     bind)  
                 | SOME{cnt, bind} => (  
                     cnt := !cnt - 1;  
                     bind)  
               (* end case *))  
   
         fun defineGlobal ((VT{prog, defs}), x, rhs) = let  
               val x' = T.Var.global (prog, cvtTy(V.ty x), V.name x)  
               in  
   
         fun setDefOf tbl (x, exp) =  
               V.Tbl.insert tbl (x, {cnt = ref(V.useCount x), bind = exp})  
   
         fun assign tbl (x, exp) = let  
                     val lhs = T.Var.tmp(cvtTy(V.ty x))  
                     in  
                       V.Tbl.insert tbl  
                         (x, {cnt = ref(V.useCount x), bind = T.Expr.var lhs});  
                       [T.Stmt.assign(lhs, exp)]  
                     end  
   
         fun bind tbl (x, exp) = if isGlobal x  
               then  
               else (case V.useCount x  
                  of 1 => (V.Tbl.insert tbl (x, {cnt = ref 1, bind = exp}); [])  
                   | n => let (* bind exp to a new target variable *)  
                       val lhs = T.Var.tmp(cvtTy(V.ty x))  
                       in  
                         V.Tbl.insert tbl (x, {cnt = ref n, bind = T.Expr.var lhs});  
                         [T.Stmt.assign(lhs, exp)]  
                       end  
                 (* end case *))  
   
         val clear = V.Tbl.clear  
36    
37          fun flush tbl = raise Fail "flush"      fun lookup (env, x) = (case V.Map.find (env, x)
38               of SOME x' => x'
39        end (*  VDefTbl *)              | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
40              (* end case *))
41  (* FIXME: what about splitting code where the target width doesn't match the  
42   * source width?      fun trExp (env, e) = (case e
43   *)             of IL.E_Var x => (case V.kind x
44      fun doRator vtbl = let                   of IL.VK_Global => T.Expr.global(lookup(env, x))
45            val exp = VDefTbl.useDefOf vtbl                    | IL.VK_State strand => T.Expr.getState(lookup(env, x))
46            val bind = VDefTbl.bind vtbl                    | IL.VK_Local => T.Expr.var(lookup(env, x))
47            fun f (lhs, rator, args) = (case (rator, args)                  (* end case *))
48                   of (Op.Add ty, [a, b])         => bind (lhs, T.Expr.add(exp a, exp b))              | IL.E_Lit(Literal.Int n) => T.Expr.intLit n
49                    | (Op.Sub ty, [a, b])         => bind (lhs, T.Expr.sub(exp a, exp b))              | IL.E_Lit(Literal.Bool b) => T.Expr.boolLit b
50                    | (Op.Mul ty, [a, b])         => bind (lhs, T.Expr.mul(exp a, exp b))              | IL.E_Lit(Literal.Float f) => T.Expr.floatLit f
51                    | (Op.Div ty, [a, b])         => bind (lhs, T.Expr.divide(exp a, exp b))              | IL.E_Lit(Literal.String s) => T.Expr.stringLit s
52                    | (Op.Neg ty, [a])            => bind (lhs, T.Expr.neg(exp a))              | IL.E_Op(rator, args) => (case (rator, trExps(env, args))
53                    | (Op.LT ty, [a, b])          => bind (lhs, T.Expr.lt(exp a, exp b))                   of (Op.Add ty, [a, b])         => T.Expr.add(a, b)
54                    | (Op.LTE ty, [a, b])         => bind (lhs, T.Expr.lte(exp a, exp b))                    | (Op.Sub ty, [a, b])         => T.Expr.sub(a, b)
55                    | (Op.EQ ty, [a, b])          => bind (lhs, T.Expr.equ(exp a, exp b))                    | (Op.Mul ty, [a, b])         => T.Expr.mul(a, b)
56                    | (Op.NEQ ty, [a, b])         => bind (lhs, T.Expr.neq(exp a, exp b))                    | (Op.Div ty, [a, b])         => T.Expr.divide(a, b)
57                    | (Op.GT ty, [a, b])          => bind (lhs, T.Expr.gt(exp a, exp b))                    | (Op.Neg ty, [a])            => T.Expr.neg a
58                    | (Op.GTE ty, [a, b])         => bind (lhs, T.Expr.gte(exp a, exp b))                    | (Op.LT ty, [a, b])          => T.Expr.lt(a, b)
59                    | (Op.Not, [a])               => bind (lhs, T.Expr.not(exp a))                    | (Op.LTE ty, [a, b])         => T.Expr.lte(a, b)
60                    | (Op.Max, [a, b])            => bind (lhs, T.Expr.max(exp a, exp b))                    | (Op.EQ ty, [a, b])          => T.Expr.equ(a, b)
61                    | (Op.Min, [a, b])            => bind (lhs, T.Expr.min(exp a, exp b))                    | (Op.NEQ ty, [a, b])         => T.Expr.neq(a, b)
62                    | (Op.Sin, [a])               => bind (lhs, T.Expr.sin(exp a))                    | (Op.GT ty, [a, b])          => T.Expr.gt(a, b)
63                    | (Op.Cos, [a])               => bind (lhs, T.Expr.cos(exp a))                    | (Op.GTE ty, [a, b])         => T.Expr.gte(a, b)
64                    | (Op.Pow, [a, b])            => bind (lhs, T.Expr.pow(exp a, exp b))                    | (Op.Not, [a])               => T.Expr.not a
65                    | (Op.Dot d, [a, b])          => bind (lhs, T.Expr.dot(exp a, exp b))                    | (Op.Max, [a, b])            => T.Expr.max(a, b)
66                    | (Op.Cross, [a, b])          => bind (lhs, T.Expr.cross(exp a, exp b))                    | (Op.Min, [a, b])            => T.Expr.min(a, b)
67                    | (Op.Select(ty, i), [a])     => bind (lhs, T.Expr.select(i, exp a))                    | (Op.Sin, [a])               => T.Expr.sin a
68                    | (Op.Norm d, [a])            => bind (lhs, T.Expr.length(exp a))                    | (Op.Cos, [a])               => T.Expr.cos a
69                    | (Op.Scale d, [a, b])        => bind (lhs, T.Expr.mul(exp a, exp b))                    | (Op.Pow, [a, b])            => T.Expr.pow(a, b)
70                    | (Op.InvScale d, [a, b])     => bind (lhs, T.Expr.divide(exp a, exp b))                    | (Op.Dot d, [a, b])          => T.Expr.dot(a, b)
71                      | (Op.Cross, [a, b])          => T.Expr.cross(a, b)
72                      | (Op.Select(ty, i), [a])     => T.Expr.select(i, a)
73                      | (Op.Norm d, [a])            => T.Expr.length a
74                      | (Op.Scale d, [a, b])        => T.Expr.mul(a, b)
75                      | (Op.InvScale d, [a, b])     => T.Expr.divide(a, b)
76                    | (Op.CL, _)                  => raise Fail "CL unimplemented"                    | (Op.CL, _)                  => raise Fail "CL unimplemented"
77                    | (Op.PrincipleEvec ty, _)    => raise Fail "PrincipleEvec unimplemented"                    | (Op.PrincipleEvec ty, _)    => raise Fail "PrincipleEvec unimplemented"
78  (*  (*
79                    | (Op.Subscript ty,                    | (Op.Subscript ty,
80  *)  *)
81                    | (Op.Floor d, [a])           => bind (lhs, T.Expr.floor(exp a))                    | (Op.Floor d, [a])           => T.Expr.floor a
82                    | (Op.IntToReal, [a])         => bind (lhs, T.Expr.toReal(exp a))                    | (Op.IntToReal, [a])         => T.Expr.toReal a
83                    | (Op.TruncToInt d, [a])      => bind (lhs, T.Expr.truncToInt(exp a))                    | (Op.TruncToInt d, [a])      => T.Expr.truncToInt a
84                    | (Op.RoundToInt d, [a])      => bind (lhs, T.Expr.roundToInt(exp a))                    | (Op.RoundToInt d, [a])      => T.Expr.roundToInt a
85                    | (Op.CeilToInt d, [a])       => bind (lhs, T.Expr.ceilToInt(exp a))                    | (Op.CeilToInt d, [a])       => T.Expr.ceilToInt a
86                    | (Op.FloorToInt d, [a])      => bind (lhs, T.Expr.floorToInt(exp a))                    | (Op.FloorToInt d, [a])      => T.Expr.floorToInt a
87                    | (Op.ImageAddress, [a])      => bind (lhs, T.Expr.imageAddr(exp a))                    | (Op.ImageAddress d, [a])    => T.Expr.imageAddr a
88                    | (Op.LoadVoxels(rTy, n), [a]) => [] (* FIXME *)                    | (Op.LoadVoxels(info, 1), [a]) => T.Expr.getImgData a
89                    | (Op.PosToImgSpace d, [v, x]) => [] (* FIXME *)                    | (Op.LoadVoxels _, [a])      => raise Fail "impossible"
90                    | (Op.GradToWorldSpace d, [v, x]) => [] (* FIXME *)                    | (Op.PosToImgSpace d, [v, x]) => T.Expr.posToImgSpace(v, x)
91                    | (Op.LoadImage info, [a]) => [] (* FIXME *)                    | (Op.GradToWorldSpace d, [v, x]) => T.Expr.intLit 0 (* FIXME *)
92                    | (Op.Inside d, [v, x]) => [] (* FIXME *)                    | (Op.LoadImage info, [a])    => raise Fail "impossible"
93                    | (Op.Input(ty, name), []) => [] (* FIXME *)                    | (Op.Inside(d, s), [x, v])   => T.Expr.inside(x, v, s)
94                    | (Op.InputWithDefault(ty, name), [a]) => [] (* FIXME *)                    | (Op.Input(ty, name), [])    => raise Fail "impossible"
95                      | (Op.InputWithDefault(ty, name), [a]) => T.Expr.intLit 0 (* FIXME *)
96                    | _ => raise Fail(concat[                    | _ => raise Fail(concat[
97                          "incorrect number of arguments for ", Op.toString rator                          "incorrect number of arguments for ", Op.toString rator
98                        ])                        ])
99                  (* end case *))                  (* end case *))
           in  
             f  
           end  
   
   (* translate a LowIL assignment to a list of zero or more target statements *)  
     fun doAssign vtbl = let  
           val setDefOf = VDefTbl.setDefOf vtbl  
           val doRator = doRator vtbl  
           fun assign (lhs, rhs) = let  
                 fun setDef rhs = (setDefOf (lhs, rhs); [])  
                 in  
                   case rhs  
                    of IL.VAR x => setDef (VDefTbl.useDefOf vtbl x)  
                     | IL.LIT(Literal.Int n) => setDef (T.Expr.intLit n)  
                     | IL.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)  
                     | IL.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)  
                     | IL.LIT(Literal.String s) => setDef (T.Expr.stringLit s)  
                     | IL.OP(rator, args) => doRator(lhs, rator, args)  
                     | IL.CONS args =>  
                         VDefTbl.assign vtbl  
                           (lhs, T.Expr.vector (List.map (VDefTbl.useDefOf vtbl) args))  
                   (* end case *)  
                 end  
           in  
             assign  
           end  
   
     fun gen (vtbl, cfg) = let  
           val doAssign = doAssign vtbl  
           fun doNode (vtbl, ifCont, stms, nd) = (case Nd.kind nd  
                  of IL.NULL => raise Fail "unexpected NULL"  
                   | IL.ENTRY{succ} => doNode (vtbl, ifCont, stms, !succ)  
                   | IL.JOIN{phis, succ, ...} => ifCont (stms, Nd.kind nd)  
                   | IL.COND{cond, trueBranch, falseBranch, ...} => let  
                       fun kThen (stms', _) = let  
                             val thenBlk = T.Stmt.block (List.rev stms')  
                             fun kElse (stms', IL.JOIN{phis, succ, ...}) = let  
                                   val stm = T.Stmt.ifthenelse (  
                                         VDefTbl.useDefOf vtbl cond,  
                                         thenBlk,  
                                         T.Stmt.block (List.rev stms'))  
                                   in  
 (* FIXME: what do we do about phis? *)  
                                     doNode (vtbl, ifCont, stm::stms, !succ)  
                                   end  
                             in  
                               doNode (vtbl, kElse, [], !falseBranch)  
                             end  
                       in  
                         doNode (vtbl, kThen, [], !trueBranch)  
                       end  
                   | IL.COM {text, succ, ...} =>  
                       doNode (vtbl, ifCont, T.Stmt.comment text :: stms, !succ)  
                   | IL.ASSIGN{stm, succ, ...} =>  
                       doNode (vtbl, ifCont, doAssign stm @ stms, !succ)  
                   | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"  
                   | IL.DIE _ =>  
                       T.Stmt.block (List.rev (T.Stmt.die() :: stms))  
                   | IL.STABILIZE _ =>  
                       T.Stmt.block (List.rev stms)  
                   | IL.EXIT _ => T.Stmt.block (List.rev (T.Stmt.stabilize() :: stms))  
100                  (* end case *))                  (* end case *))
           in  
             doNode (vtbl, fn _ => raise Fail "bogus ifCont at JOIN node", [], CFG.entry cfg)  
           end  
101    
102    (* generate the global-variable declarations and initialization code *)      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
     fun genGlobals (vtbl, prog, globals, globalInit) = let  
 (* FIXME: we should put the initialization code in a function! *)  
           in  
             List.app markGlobal globals;  
             gen (vtbl, globalInit)  
           end  
103    
104      fun generate (fileStem, IL.Program{globals, globalInit, strands}) = let      fun trStmt (env, stm) = (case stm
105               of IL.S_Comment text => [T.Stmt.comment text]
106                | IL.S_Assign(x, exp) => (case V.kind x
107                     of IL.VK_Global => [T.Stmt.assign(lookup(env, x), trExp(env, exp))]
108                      | IL.VK_State strand =>
109                          [T.Stmt.assignState(lookup(env, x), trExp(env, exp))]
110                      | IL.VK_Local => [T.Stmt.assign(lookup(env, x), trExp(env, exp))]
111                    (* end case *))
112                | IL.S_Cons(lhs, args) =>
113                    [T.Stmt.cons(lookup(env, lhs), trExps(env, args))]
114                | IL.S_LoadVoxels(lhs, dim, addr) =>
115                    [T.Stmt.getImgData(lookup(env, lhs), dim, trExp(env, addr))]
116                | IL.S_LoadImage(lhs, dim, name) =>
117                    T.Stmt.loadImage (lookup(env, lhs), dim, trExp(env, name))
118                | IL.S_Input(lhs, name, optDflt) =>
119                    T.Stmt.input(lookup(env, lhs), name, Option.map (fn e => trExp(env, e)) optDflt)
120                | IL.S_IfThen(cond, thenBlk) =>
121                    [T.Stmt.ifthen(trExp(env, cond), trBlock(env, thenBlk))]
122                | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
123                    [T.Stmt.ifthenelse(trExp(env, cond),
124                      trBlock(env, thenBlk),
125                      trBlock(env, elseBlk))]
126                | IL.S_Die => [T.Stmt.die()]
127                | IL.S_Stabilize => [T.Stmt.stabilize()]
128              (* end case *))
129    
130        and trBlock (env, IL.Block{locals, body}) = let
131              val env = List.foldl
132                    (fn (x, env) => V.Map.insert(env, x, T.Var.var(cvtTy(V.ty x), V.name x)))
133                      env locals
134              in
135                T.Stmt.block(List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body)
136              end
137    
138        fun trMethod (strand, env) (IL.Method{name, body}) =
139              T.Strand.method (strand, Atom.toString name, trBlock (env, body))
140    
141        fun trStrand (prog, env) (IL.Strand{name, params, state, stateInit, methods}) = let
142              val strand = T.Strand.define(prog, Atom.toString name)
143              val state' =
144                    List.map (fn x => T.Var.state(strand, cvtTy(V.ty x), V.name x)) state
145              val env = addBindings (env, state, state')
146            (* define the parameters and add them to the environment *)
147              val params' = List.map (fn x => T.Var.param(cvtTy(V.ty x), V.name x)) params
148              val env = addBindings (env, params, params')
149              in
150                T.Strand.init (strand, params', trBlock (env, stateInit));
151                List.app (trMethod (strand, env)) methods
152              end
153    
154        fun generate (fileStem, srcProg) = let
155              val treeProg as TreeIL.Program{globals, globalInit, strands} = LowToTree.translate srcProg
156    val _ = (
157    TextIO.output(Log.logFile(), "********** After translation to TreeIL **********\n");
158    TreeILPP.program (Log.logFile(), treeProg))
159            val prog = T.newProgram ()            val prog = T.newProgram ()
160            val vtbl = VDefTbl.newTbl prog          (* define the globals and initialize the environment *)
161              val env = let
162                    fun gvar (x, env) =
163                          V.Map.insert(env, x, T.Var.global(prog, cvtTy(V.ty x), V.name x))
164                    in
165                      List.foldl gvar V.Map.empty globals
166                    end
167            in            in
168              genGlobals (vtbl, prog, globals, globalInit);            (* global initialization *)
169                T.globalInit (prog, trBlock (env, globalInit));
170              (* translate strands *)
171                List.app (trStrand (prog, env)) strands;
172            (* output the program *)            (* output the program *)
173              T.generate (fileStem, prog)              T.generate (fileStem, prog)
174            end            end

Legend:
Removed from v.529  
changed lines
  Added in v.552

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