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 512, Tue Feb 8 19:32:42 2011 UTC revision 513, Tue Feb 8 21:23:01 2011 UTC
# Line 92  Line 92 
92   *)   *)
93      fun doRator (vtbl, lhs, rator, args) = let      fun doRator (vtbl, lhs, rator, args) = let
94            val args' = List.map (VDefTbl.useDefOf vtbl) args            val args' = List.map (VDefTbl.useDefOf vtbl) args
95            val rhs' = (case rator            val rhs' = (case (rator, args)
96  (* ??? *)                   of (Op.Add ty, [a, b]) =>
97                      | (Op.Sub ty, [a, b]) =>
98                      | (Op.Mul ty, [a, b]) =>
99                      | (Op.Div ty, [a, b]) =>
100                      | (Op.Neg ty, [a]) =>
101                      | (Op.LT ty, [a, b]) =>
102                      | (Op.LTE ty, [a, b]) =>
103                      | (Op.EQ ty, [a, b]) =>
104                      | (Op.NEQ ty, [a, b]) =>
105                      | (Op.GT ty, [a, b]) =>
106                      | (Op.GTE ty, [a, b]) =>
107                      | (Op.Not, [a]) =>
108                      | (Op.Max, [a, b]) =>
109                      | (Op.Min, [a, b]) =>
110                      | (Op.Sin, [a]) =>
111                      | (Op.Cos, [a]) =>
112                      | (Op.Pow, [a, b]) =>
113                      | (Op.Dot d, [a, b]) =>
114                      | (Op.Cross, [a, b]) =>
115                      | (Op.Select(ty, i), [a]) =>
116                      | (Op.Norm d, [a]) =>
117                      | (Op.Scale d, [a, b]) =>
118                      | (Op.InvScale d, [a, b]) =>
119                      | (Op.CL
120                      | (Op.PrincipleEvec of ty
121                      | (Op.Subscript of ty
122                      | (Op.Floor of int
123                      | (Op.IntToReal
124                      | (Op.TruncToInt of int
125                      | (Op.RoundToInt of int
126                      | (Op.CeilToInt of int
127                      | (Op.FloorToInt of int
128                      | (Op.ImageAddress of ImageInfo.info
129                      | (Op.LoadVoxels of RawTypes.ty * int
130                      | (Op.PosToImgSpace of ImageInfo.info
131                      | (Op.GradToWorldSpace of ImageInfo.info
132                      | (Op.LoadImage of ImageInfo.info
133                      | (Op.Inside of ImageInfo.info
134                      | (Op.Input of ty * string
135                      | (Op.InputWithDefault of ty * string
136                  (* end case *))                  (* end case *))
137            in            in
138              VDefTbl.bind vtbl (lhs, rhs')              VDefTbl.bind vtbl (lhs, rhs')
# Line 119  Line 158 
158    
159      fun gen (vtbl, cfg) = let      fun gen (vtbl, cfg) = let
160            val doAssign = doAssign vtbl            val doAssign = doAssign vtbl
161            fun doNode (vtbl, ifStk, stms, nd) = (case Nd.kind nd            fun doNode (vtbl, ifCont, stms, nd) = (case Nd.kind nd
162                   of IL.NULL =>                   of IL.NULL => raise Fail "unexpected NULL"
163                    | IL.ENTRY{succ} =>                    | IL.ENTRY{succ} => doNode (vtbl, ifStk, stms, !succ)
164                    | IL.JOIN{phis, succ, ...} =>                    | IL.JOIN{phis, succ, ...} => ifCont (stms, nd)
165                    | IL.COND{cond, trueBranch, falseBranch, ...} => let                    | IL.COND{cond, trueBranch, falseBranch, ...} => let
166                        fun kThen (stms', _) = let                        fun kThen (stms', _) = let
167                              val thenBlk = T.Stmt.block (List.rev stms')                              val thenBlk = T.Stmt.block (List.rev stms')
168                              fun kElse (stms', succ) = let                              fun kElse (stms', IL.JOIN{phis, succ, ...}) = let
169                                    val stm = T.Stmt.ifthenelse (                                    val stm = T.Stmt.ifthenelse (
170                                          VDefTbl.useDefOf vtbl cond,                                          VDefTbl.useDefOf vtbl cond,
171                                          thenBlk,                                          thenBlk,
172                                          T.Stmt.block (List.rev stms'))                                          T.Stmt.block (List.rev stms'))
173                                    in                                    in
174                                      doNode (vtbl, ifStk, stm::stms, succ)  (* FIXME: what do we do about phis? *)
175                                        doNode (vtbl, ifStk, stm::stms, !succ)
176                                    end                                    end
177                              in                              in
178                                doNode (vtbl, kElse::ifStk, [], !falseBranch)                                doNode (vtbl, kElse::ifStk, [], !falseBranch)
# Line 141  Line 181 
181                          doNode (vtbl, kThen::ifStk, [], !trueBranch)                          doNode (vtbl, kThen::ifStk, [], !trueBranch)
182                        end                        end
183                    | IL.COM {text, succ, ...} =>                    | IL.COM {text, succ, ...} =>
184                          doNode (vtbl, ifStk, T.Stmt.comment text :: stms, !succ)
185                    | IL.ASSIGN{stm, succ, ...} =>                    | IL.ASSIGN{stm, succ, ...} =>
186                    | IL.NEW{strand, args, succ, ...} =>                        doNode (vtbl, ifStk, doAssign stm :: stms, !succ)
187                      | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"
188                    | IL.DIE _ =>                    | IL.DIE _ =>
189                          doNode (vtbl, ifStk, T.Stmt.die() :: stms, !succ)
190                    | IL.STABILIZE _ =>                    | IL.STABILIZE _ =>
191                    | IL.EXIT _ =>                        doNode (vtbl, ifStk, T.Stmt.stabilize() :: stms, !succ)
192                      | IL.EXIT _ => T.Stmt.mkBlock (List.rev stms)
193                  (* end case *))                  (* end case *))
194            in            in
195            end              doNode (vtbl, fn _ => raise Fail "bogus ifCont at JOIN node", [], CFG.entry cfg)
   
     fun gen (vtbl, stm) = let  
           val doAssign = doAssign vtbl  
           fun mkBlock [] = ?  
             | mkBlock [s] = s  
             | mkBlock stms = T.Stmt.block stms  
           fun doStmt (IL.STM{kind, next, ...}) = let  
                 val stms = (case kind  
                        of IL.S_SIMPLE nd => doNode nd  
                         | IL.S_IF{cond, thenBranch, elseBranch} => let  
                             val IL.ND{kind=IL.COND{cond, ...}, ...} = cond  
                             val s1 = mkBlock(doStmt thenBranch)  
                             val s2 = mkBlock(doStmt elseBranch)  
                             in  
 (* FIXME: check for empty else branch *)  
                               T.ifthenelse(VDefTbl.useDefOf vtbl cond, s1, s2)  
                             end  
                         | IL.S_LOOP{hdr, cond, body} => raise Fail "LOOP not supported yet"  
                       (* end case *))  
                 val rest = (case next  
                        of NONE => VDefTbl.flush vtbl  
                         | SOME stm = doStmt stm  
                       (* end case *))  
                 in  
                   stms @ rest  
                 end  
           and doNode (IL.ND{kind, ...}) = (case kind  
                  of IL.NULL => ??  
                   | IL.ENTRY{succ} => nextNode succ  
                   | IL.JOIN{succ, ...} =>  
                   | IL.COND{cond, ...} =>  
                   | IL.BLOCK{body, succ, ...} =>  
                       List.app doAssign body @ nextNode succ  
                   | IL.NEW{strand, args, ...} =>  
                   | IL.DIE _ =>  
                   | IL.STABILIZE _ =>  
                   | IL.EXIT _ =>  
                 (* end case *))  
           and nextNode nd = if isFirst nd then [] else doNode nd  
           in  
             mkBlock (doStmt stm)  
196            end            end
197    
198    end    end

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

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