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

SCM Repository

[diderot] Diff of /branches/vis12-cl/src/compiler/c-util/tree-to-c.sml
ViewVC logotype

Diff of /branches/vis12-cl/src/compiler/c-util/tree-to-c.sml

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

revision 2037, Sun Oct 14 14:44:46 2012 UTC revision 2053, Tue Oct 23 04:40:18 2012 UTC
# Line 23  Line 23 
23    
24      type env = CLang.typed_var TreeIL.Var.Map.map      type env = CLang.typed_var TreeIL.Var.Map.map
25    
26        val empty : env
27    
28      val trType : TreeIL.Ty.ty -> CLang.ty      val trType : TreeIL.Ty.ty -> CLang.ty
29    
30      val trBlock : env * TreeIL.block -> CLang.stm      val trBlock : env * TreeIL.block -> CLang.stm
# Line 33  Line 35 
35    
36      val trExp : env * TreeIL.exp -> CLang.exp      val trExp : env * TreeIL.exp -> CLang.exp
37    
38        val trAssign : env * CLang.exp * TreeIL.exp -> CLang.stm list
39    
40    (* vector indexing support.  Arguments are: vector, arity, index *)    (* vector indexing support.  Arguments are: vector, arity, index *)
41      val ivecIndex : CLang.exp * int * int -> CLang.exp      val ivecIndex : CLang.exp * int * int -> CLang.exp
42      val vecIndex : CLang.exp * int * int -> CLang.exp      val vecIndex : CLang.exp * int * int -> CLang.exp
# Line 49  Line 53 
53      datatype var = datatype CLang.typed_var      datatype var = datatype CLang.typed_var
54      type env = CLang.typed_var TreeIL.Var.Map.map      type env = CLang.typed_var TreeIL.Var.Map.map
55    
56        val empty = TreeIL.Var.Map.empty
57    
58      fun lookup (env, x) = (case V.Map.find (env, x)      fun lookup (env, x) = (case V.Map.find (env, x)
59             of SOME(V(_, x')) => x'             of SOME(V(_, x')) => x'
60              | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])              | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
# Line 557  Line 563 
563                    | IL.S_Save([x], exp) => trAssign (env, VarToC.lvalueStateVar x, exp)                    | IL.S_Save([x], exp) => trAssign (env, VarToC.lvalueStateVar x, exp)
564                    | IL.S_Save(xs, exp) =>                    | IL.S_Save(xs, exp) =>
565                        trMultiAssign (env, List.map VarToC.lvalueStateVar xs, exp)                        trMultiAssign (env, List.map VarToC.lvalueStateVar xs, exp)
566  (* DEPRECATED                    | IL.S_LoadNrrd(lhs, Ty.DynSeqTy ty, nrrd) =>
567                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let                        [GenLoadNrrd.loadSeqFromFile (VarToC.lvalueVar (env, lhs), ty, CL.mkStr nrrd)]
568                        val lhs = VarToC.lvalueVar (env, lhs)                    | IL.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) =>
569                        val name = trExp(env, name)                        [GenLoadNrrd.loadImage (VarToC.lvalueVar (env, lhs), info, CL.E_Str nrrd)]
                       val imgTy = CL.T_Named(N.imageTy dim)  
                       val loadFn = N.loadImage dim  
                       in [  
                         CL.mkDecl(  
                           CL.T_Named N.statusTy, sts,  
                           SOME(CL.I_Exp(CL.E_Apply(loadFn, [  
                               CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),  
                               name, addrOf lhs  
                             ]))))  
                       ] end)  
 *)  
                   | IL.S_LoadNrrd(lhs, Ty.DynSeqTy ty, nrrd) => let  
                       val lhs = VarToC.lvalueVar (env, lhs)  
                       val (nDims, dimInit, dimExp, elemTy) = (case ty  
                              of Ty.TensorTy(dims as _::_) => let  
                                   val nDims = List.length dims  
                                   fun lp (_, [], init) = CL.I_Array(List.rev init)  
                                     | lp (i, d::dd, init) =  
                                         lp(i+1, dd, (i, CL.I_Exp(CL.mkInt(IntInf.fromInt d)))::init)  
                                   val dimInit = CL.mkDecl(  
                                         CL.T_Ptr(CL.T_Named "unsigned int"), "_dims",  
                                         SOME(lp(0, dims, [])))  
                                   in  
                                     (nDims, [dimInit], CL.mkVar "_dims", Ty.TensorTy[])  
                                   end  
                               | Ty.SeqTy ty' => raise Fail "type not supported yet"  
                               | _ => (0, [], CL.mkInt 0, ty)  
                             (* end case *))  
                       val loadFn = N.loadDynSeqFromFile elemTy  
                       in [CL.mkBlock (  
                         dimInit @ [  
                             CL.mkAssign(  
                               lhs,  
                               CL.E_Apply(loadFn, [  
                                   CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),  
                                   CL.mkStr nrrd,  
                                   CL.mkInt(IntInf.fromInt nDims),  
                                   dimExp  
                                 ])),  
                             CL.mkIfThen(  
                               CL.mkBinOp(lhs, CL.#==, CL.mkInt 0),  
                               CL.mkReturn(SOME(CL.mkVar "true")))  
                           ]  
                       )] end  
                   | IL.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) => checkSts (fn sts => let  
                       val lhs = VarToC.lvalueVar (env, lhs)  
                       val name = CL.E_Str nrrd  
                       val dim = ImageInfo.dim info  
                       val imgTy = CL.T_Named(N.imageTy dim)  
                       val loadFn = N.loadImage dim  
                       in [  
                         CL.mkDecl(  
                           CL.T_Named N.statusTy, sts,  
                           SOME(CL.I_Exp(CL.E_Apply(loadFn, [  
                               CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),  
                               name, addrOf lhs  
                             ]))))  
                       ] end)  
570                    | IL.S_Input(_, _, _, NONE) => []                    | IL.S_Input(_, _, _, NONE) => []
571                    | IL.S_Input(lhs, name, _, SOME dflt) => [                    | IL.S_Input(lhs, name, _, SOME dflt) => [
572                          CL.mkAssign(VarToC.lvalueVar(env, lhs), trExp(env, dflt))                          CL.mkAssign(VarToC.lvalueVar(env, lhs), trExp(env, dflt))
# Line 660  Line 608 
608      val trBlock = trBlk      val trBlock = trBlk
609    
610    end    end
611    
612    (* FIXME: once we can consolidate the OpenCL and C backends, then we can get rid of the
613     * functor application.
614     *)
615    local
616      structure IL = TreeIL
617      structure V = IL.Var
618      structure CL = CLang
619    (* variable translation *)
620      structure TrVar =
621        struct
622          type env = CL.typed_var V.Map.map
623          fun lookup (env, x) = (case V.Map.find (env, x)
624                 of SOME(CL.V(_, x')) => x'
625                  | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
626                (* end case *))
627        (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
628          fun lvalueVar (env, x) = CL.mkVar(lookup(env, x))
629        (* translate a variable that occurs in an r-value context *)
630          fun rvalueVar (env, x) = CL.mkVar(lookup(env, x))
631        (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
632          fun lvalueVar (env, x) = (case V.kind x
633                 of IL.VK_Local => CL.mkVar(lookup(env, x))
634                  | _ => CL.mkIndirect(CL.mkVar "glob", lookup(env, x))
635                (* end case *))
636        (* translate a variable that occurs in an r-value context *)
637          fun rvalueVar (env, x) = (case V.kind x
638                 of IL.VK_Local => CL.mkVar(lookup(env, x))
639                  | _ => CL.mkIndirect(CL.mkVar "glob", lookup(env, x))
640                (* end case *))
641        (* translate a strand state variable that occurs in an l-value context *)
642          fun lvalueStateVar x = CL.mkIndirect(CL.mkVar "selfOut", IL.StateVar.name x)
643        (* translate a strand state variable that occurs in an r-value context *)
644          fun rvalueStateVar x = CL.mkIndirect(CL.mkVar "selfIn", IL.StateVar.name x)
645        end
646    in
647    structure TreeToC = TreeToCFn (TrVar)
648    end

Legend:
Removed from v.2037  
changed lines
  Added in v.2053

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