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 1958, Tue Jul 10 13:01:03 2012 UTC revision 2051, Mon Oct 22 14:14:10 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 174  Line 180 
180                    CL.mkSubscript(vecExp, ix)                    CL.mkSubscript(vecExp, ix)
181                  end                  end
182              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)
183                | (Op.Subscript(Ty.DynSeqTy ty), [v, ix]) => let
184                    val elemTy = trType ty
185                    in
186                      CL.mkUnOp (CL.%*,
187                        CL.mkCast(CL.T_Ptr elemTy,
188                          CL.mkApply("Diderot_DynSeqAddr", [CL.mkSizeof elemTy, v, ix])))
189                    end
190              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
191                  val unionTy = CL.T_Named(N.unionTy n)                  val unionTy = CL.T_Named(N.unionTy n)
192                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")
# Line 223  Line 236 
236                  CL.mkApply(N.toImageSpace(ImageInfo.dim info), [img, pos])                  CL.mkApply(N.toImageSpace(ImageInfo.dim info), [img, pos])
237              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
238                  CL.mkApply(N.toWorldSpace ty, [v, x])                  CL.mkApply(N.toWorldSpace ty, [v, x])
             | (Op.LoadImage info, [a]) =>  
                 raise Fail("impossible " ^ Op.toString rator)  
239              | (Op.Inside(info, s), [pos, img]) =>              | (Op.Inside(info, s), [pos, img]) =>
240                  CL.mkApply(N.inside(ImageInfo.dim info), [pos, img, intExp s])                  CL.mkApply(N.inside(ImageInfo.dim info), [pos, img, intExp s])
241              | (Op.Input(ty, desc, name), []) =>              | (Op.LoadSeq(ty, nrrd), []) =>
242                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
243              | (Op.InputWithDefault(ty, desc, name), [a]) =>              | (Op.LoadImage(ty, nrrd, info), []) =>
244                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
245                | (Op.Input _, []) => raise Fail("impossible " ^ Op.toString rator)
246              | _ => raise Fail(concat[              | _ => raise Fail(concat[
247                    "unknown or incorrect operator ", Op.toString rator                    "unknown or incorrect operator ", Op.toString rator
248                  ])                  ])
# Line 507  Line 519 
519            val env = trLocals (env, locals)            val env = trLocals (env, locals)
520            fun trStmt (env, stm) = (case stm            fun trStmt (env, stm) = (case stm
521                   of IL.S_Comment text => [CL.mkComment text]                   of IL.S_Comment text => [CL.mkComment text]
522    (* DEPRECATED
523                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let
524                        val lhs = VarToC.lvalueVar (env, lhs)                        val lhs = VarToC.lvalueVar (env, lhs)
525                        val imgTy = CL.T_Named(N.imageTy dim)                        val imgTy = CL.T_Named(N.imageTy dim)
# Line 519  Line 532 
532                                addrOf lhs                                addrOf lhs
533                              ]))))                              ]))))
534                        ] end)                        ] end)
535    *)
536                      | IL.S_LoadNrrd _ => [] (* FIXME *)
537                      | IL.S_InputNrrd _ => [] (* FIXME *)
538                    | _ => []                    | _ => []
539                  (* end case *))                  (* end case *))
540            val stms = List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body            val stms = List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body
# Line 547  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                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let                    | IL.S_LoadNrrd(lhs, Ty.DynSeqTy ty, nrrd) => let
567                        val lhs = VarToC.lvalueVar (env, lhs)                        val lhs = VarToC.lvalueVar (env, lhs)
568                        val name = trExp(env, name)                        val (nDims, dimInit, dimExp, elemTy) = (case ty
569                        val imgTy = CL.T_Named(N.imageTy dim)                               of Ty.TensorTy(dims as _::_) => let
570                        val loadFn = N.loadImage dim                                    val nDims = List.length dims
571                        in [                                    fun lp (_, [], init) = CL.I_Array(List.rev init)
572                          CL.mkDecl(                                      | lp (i, d::dd, init) =
573                            CL.T_Named N.statusTy, sts,                                          lp(i+1, dd, (i, CL.I_Exp(CL.mkInt(IntInf.fromInt d)))::init)
574                            SOME(CL.I_Exp(CL.E_Apply(loadFn, [                                    val dimInit = CL.mkDecl(
575                                            CL.T_Ptr(CL.T_Named "unsigned int"), "_dims",
576                                            SOME(lp(0, dims, [])))
577                                      in
578                                        (nDims, [dimInit], CL.mkVar "_dims", Ty.TensorTy[])
579                                      end
580                                  | Ty.SeqTy ty' => raise Fail "type not supported yet"
581                                  | _ => (0, [], CL.mkInt 0, ty)
582                                (* end case *))
583                          val loadFn = N.loadDynSeqFromFile elemTy
584                          in [CL.mkBlock (
585                            dimInit @ [
586                                CL.mkAssign(
587                                  lhs,
588                                  CL.E_Apply(loadFn, [
589                                CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),                                CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),
590                                name, addrOf lhs                                    CL.mkStr nrrd,
591                              ]))))                                    CL.mkInt(IntInf.fromInt nDims),
592                        ] end)                                    dimExp
593                                    ])),
594                                CL.mkIfThen(
595                                  CL.mkBinOp(lhs, CL.#==, CL.mkInt 0),
596                                  CL.mkReturn(SOME(CL.mkVar "true")))
597                              ]
598                          )] end
599                      | IL.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) =>
600                          [GenLoadNrrd.loadImage (VarToC.lvalueVar (env, lhs), info, CL.E_Str nrrd)]
601                    | IL.S_Input(_, _, _, NONE) => []                    | IL.S_Input(_, _, _, NONE) => []
602                    | IL.S_Input(lhs, name, _, SOME dflt) => [                    | IL.S_Input(lhs, name, _, SOME dflt) => [
603                          CL.mkAssign(VarToC.lvalueVar(env, lhs), trExp(env, dflt))                          CL.mkAssign(VarToC.lvalueVar(env, lhs), trExp(env, dflt))
604                        ]                        ]
605                      | IL.S_InputNrrd _ => []
606                    | IL.S_Exit args => []                    | IL.S_Exit args => []
607                    | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]                    | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]
608                    | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]                    | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]
# Line 600  Line 639 
639      val trBlock = trBlk      val trBlock = trBlk
640    
641    end    end
642    
643    (* FIXME: once we can consolidate the OpenCL and C backends, then we can get rid of the
644     * functor application.
645     *)
646    local
647      structure IL = TreeIL
648      structure V = IL.Var
649      structure CL = CLang
650    (* variable translation *)
651      structure TrVar =
652        struct
653          type env = CL.typed_var V.Map.map
654          fun lookup (env, x) = (case V.Map.find (env, x)
655                 of SOME(CL.V(_, x')) => x'
656                  | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
657                (* end case *))
658        (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
659          fun lvalueVar (env, x) = CL.mkVar(lookup(env, x))
660        (* translate a variable that occurs in an r-value context *)
661          fun rvalueVar (env, x) = CL.mkVar(lookup(env, x))
662        (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
663          fun lvalueVar (env, x) = (case V.kind x
664                 of IL.VK_Local => CL.mkVar(lookup(env, x))
665                  | _ => CL.mkIndirect(CL.mkVar "glob", lookup(env, x))
666                (* end case *))
667        (* translate a variable that occurs in an r-value context *)
668          fun rvalueVar (env, x) = (case V.kind x
669                 of IL.VK_Local => CL.mkVar(lookup(env, x))
670                  | _ => CL.mkIndirect(CL.mkVar "glob", lookup(env, x))
671                (* end case *))
672        (* translate a strand state variable that occurs in an l-value context *)
673          fun lvalueStateVar x = CL.mkIndirect(CL.mkVar "selfOut", IL.StateVar.name x)
674        (* translate a strand state variable that occurs in an r-value context *)
675          fun rvalueStateVar x = CL.mkIndirect(CL.mkVar "selfIn", IL.StateVar.name x)
676        end
677    in
678    structure TreeToC = TreeToCFn (TrVar)
679    end

Legend:
Removed from v.1958  
changed lines
  Added in v.2051

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