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

SCM Repository

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

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

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

revision 2404, Sun Jul 28 02:29:57 2013 UTC revision 2405, Sun Jul 28 11:19:13 2013 UTC
# Line 12  Line 12 
12    
13      type env = var TreeIL.Var.Map.map      type env = var TreeIL.Var.Map.map
14    
     val trType : TreeIL.Ty.ty -> CLang.ty  
   
15      val trBlock : env * TreeIL.block -> CLang.stm      val trBlock : env * TreeIL.block -> CLang.stm
16    
17      val trFragment : env * TreeIL.block -> env * CLang.stm list      val trFragment : env * TreeIL.block -> env * CLang.stm list
18    
19      val trAssign : env * TreeIL.var * TreeIL.exp -> CLang.stm list      val trAssign : env * CLang.exp * TreeIL.exp -> CLang.stm list
20    
21      val trExp : env * TreeIL.exp -> CLang.exp      val trExp : env * TreeIL.exp -> CLang.exp
22    
# Line 28  Line 26 
26    end = struct    end = struct
27    
28      structure CL = CLang      structure CL = CLang
29      structure RN = RuntimeNames      structure CLN = CLNames
30      structure IL = TreeIL      structure IL = TreeIL
31      structure Op = IL.Op      structure Op = IL.Op
32      structure Ty = IL.Ty      structure Ty = IL.Ty
# Line 43  Line 41 
41          | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])          | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
42        (* end case *))        (* end case *))
43    
44    (* integer literal expression *)      local
45      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)        fun global env = CL.mkVar(lookup(env, PseudoVars.global))
46          fun selfIn env = CL.mkVar(lookup(env, PseudoVars.selfIn))
47    (* the type of an image-data pointer. *)        fun selfOut env = CL.mkVar(lookup(env, PseudoVars.selfOut))
48      fun imageDataPtrTy rTy = CL.T_Qual("__global", CL.T_Ptr(CL.T_Num rTy))      in
49      (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
50        fun lvalueVar (env, x) = (case V.kind x
51               of IL.VK_Local => CL.mkVar(lookup(env, x))
52                | _ => CL.mkIndirect(global env, lookup(env, x))
53              (* end case *))
54    
55    (* translate TreeIL types to CLang types *)    (* translate a variable that occurs in an r-value context *)
56      fun trType ty = (case ty      fun rvalueVar (env, x) = (case V.kind x
57             of Ty.BoolTy => CLang.T_Named "uint"             of IL.VK_Local => CL.mkVar(lookup(env, x))
58              | Ty.StringTy => CL.charPtr              | _ => CL.mkIndirect(global env, lookup(env, x))
             | Ty.IntTy => !RN.gIntTy  
             | Ty.TensorTy[] => !RN.gRealTy  
             | Ty.TensorTy[n] => CL.T_Named(RN.vecTy n)  
             | Ty.TensorTy[n, m] => CL.T_Named(RN.matTy(n,m))  
             | Ty.SeqTy(Ty.IntTy, n) => CL.T_Named(RN.ivecTy n)  
             | Ty.SeqTy(Ty.TensorTy[] , n) => CL.T_Named(RN.vecTy n)  
             | Ty.SeqTy(ty, n) => CL.T_Array(trType ty, SOME n)  
             | Ty.AddrTy info => imageDataPtrTy(ImageInfo.sampleTy info)  
             | Ty.ImageTy info => CL.T_Named(RN.imageTy(ImageInfo.dim info))  
             | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])  
59            (* end case *))            (* end case *))
60    
61      (* translate a strand state variable that occurs in an l-value context *)
62        fun lvalueStateVar (env, x) = CL.mkIndirect(selfOut env, IL.StateVar.name x)
63    
64      (* translate a strand state variable that occurs in an r-value context *)
65        fun rvalueStateVar (env, x) = CL.mkIndirect(selfIn env, IL.StateVar.name x)
66        end (* local *)
67    
68      (* integer literal expression *)
69        fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
70    
71    (* generate new variables *)    (* generate new variables *)
72      local      local
73        val count = ref 0        val count = ref 0
# Line 94  Line 97 
97      fun vecIndex (v, ix) = CL.mkSelect(v, Vector.sub(fields, ix))      fun vecIndex (v, ix) = CL.mkSelect(v, Vector.sub(fields, ix))
98      end      end
99    
   (* translate a variable use *)  
     fun trVar (env, x) = (case V.kind x  
            of IL.VK_Local => CL.mkVar(lookup(env, x))  
             | _ => CL.mkIndirect(CL.E_Var RN.globalsVarName, lookup(env, x))  
           (* end case *))  
   
100    (* matrix indexing *)    (* matrix indexing *)
101      fun matIndex (m, ix, jx) = CL.mkSelect(CL.mkSubscript(m, ix), concat["s",jx])      fun matIndex (m, ix, jx) = CL.mkSelect(CL.mkSubscript(m, ix), concat["s",jx])
102    
# Line 116  Line 113 
113              | (Op.Div ty, [a, b]) => CL.mkBinOp(a, CL.#/, b)              | (Op.Div ty, [a, b]) => CL.mkBinOp(a, CL.#/, b)
114              | (Op.Neg ty, [a]) => CL.mkUnOp(CL.%-, a)              | (Op.Neg ty, [a]) => CL.mkUnOp(CL.%-, a)
115              | (Op.Abs(Ty.IntTy), args) => CL.mkApply("abs", args)              | (Op.Abs(Ty.IntTy), args) => CL.mkApply("abs", args)
116              | (Op.Abs(Ty.TensorTy[]), args) => CL.mkApply(RN.fabs, args)              | (Op.Abs(Ty.TensorTy[]), args) => CL.mkApply(CLN.fabs, args)
117              | (Op.Abs(Ty.TensorTy[_]), args) => CL.mkApply(RN.fabs, args)              | (Op.Abs(Ty.TensorTy[_]), args) => CL.mkApply(CLN.fabs, args)
118              | (Op.Abs ty, [a]) => raise Fail(concat["Abs<", Ty.toString ty, ">"])              | (Op.Abs ty, [a]) => raise Fail(concat["Abs<", Ty.toString ty, ">"])
119              | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)              | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
120              | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)              | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
# Line 126  Line 123 
123              | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)              | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
124              | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)              | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
125              | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)              | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)
126              | (Op.Max, args) => CL.mkApply(RN.max, castArgs (!RN.gRealTy) args)              | (Op.Max, args) => CL.mkApply(CLN.max, castArgs (!CLN.gGPURealTy) args)
127              | (Op.Min, args) => CL.mkApply(RN.min, castArgs (!RN.gRealTy) args)              | (Op.Min, args) => CL.mkApply(CLN.min, castArgs (!CLN.gGPURealTy) args)
128              | (Op.Clamp ty, [lo, hi, x]) => CL.mkApply(RN.clamp, [x, lo, hi])              | (Op.Clamp ty, [lo, hi, x]) => CL.mkApply(CLN.clamp, [x, lo, hi])
129              | (Op.Lerp ty, args) => (case ty              | (Op.Lerp ty, args) => (case ty
130                   of Ty.TensorTy[] => CL.mkApply(RN.lerp, castArgs (!RN.gRealTy) args)                   of Ty.TensorTy[] => CL.mkApply(CLN.lerp, castArgs (!CLN.gGPURealTy) args)
131                    | Ty.TensorTy[n] => CL.mkApply(RN.lerp, castArgs (CL.T_Named(RN.vecTy n)) args)                    | Ty.TensorTy[n] => CL.mkApply(CLN.lerp, castArgs (CL.T_Named(CLN.vecTy n)) args)
132                    | _ => raise Fail(concat[                    | _ => raise Fail(concat[
133                      "lerp<", Ty.toString ty, "> not supported"                      "lerp<", Ty.toString ty, "> not supported"
134                        ])                        ])
135                  (* end case *))                  (* end case *))
136              | (Op.Dot d, args) => CL.E_Apply(RN.dot, args)              | (Op.Dot d, args) => CL.E_Apply(CLN.dot, args)
137              | (Op.MulVecMat(m, n), args) =>              | (Op.MulVecMat(m, n), args) =>
138                  if (1 < m) andalso (m < 4) andalso (m = n)                  if (1 < m) andalso (m < 4) andalso (m = n)
139                    then CL.E_Apply(RN.mulVecMat(m,n), args)                    then CL.E_Apply(CLN.mulVecMat(m,n), args)
140                    else raise Fail "unsupported vector-matrix multiply"                    else raise Fail "unsupported vector-matrix multiply"
141              | (Op.MulMatVec(m, n), args) =>              | (Op.MulMatVec(m, n), args) =>
142                  if (1 < m) andalso (m < 4) andalso (m = n)                  if (1 < m) andalso (m < 4) andalso (m = n)
143                    then CL.E_Apply(RN.mulMatVec(m,n), args)                    then CL.E_Apply(CLN.mulMatVec(m,n), args)
144                    else raise Fail "unsupported matrix-vector multiply"                    else raise Fail "unsupported matrix-vector multiply"
145              | (Op.MulMatMat(m, n, p), args) =>              | (Op.MulMatMat(m, n, p), args) =>
146                  if (1 < m) andalso (m < 4) andalso (m = n) andalso (n = p)                  if (1 < m) andalso (m < 4) andalso (m = n) andalso (n = p)
147                    then CL.E_Apply(RN.mulMatMat(m,n,p), args)                    then CL.E_Apply(CLN.mulMatMat(m,n,p), args)
148                    else raise Fail "unsupported matrix-matrix multiply"                    else raise Fail "unsupported matrix-matrix multiply"
149              | (Op.Cross, args) => CL.E_Apply(RN.cross, args)              | (Op.Cross, args) => CL.E_Apply(CLN.cross, args)
150              | (Op.Norm(Ty.TensorTy[n]), args) => CL.E_Apply(RN.length, args)              | (Op.Norm(Ty.TensorTy[n]), args) => CL.E_Apply(CLN.length, args)
151              | (Op.Norm(Ty.TensorTy[m,n]), args) => CL.E_Apply(RN.norm(m,n), args)              | (Op.Norm(Ty.TensorTy[m,n]), args) => CL.E_Apply(CLN.norm(m,n), args)
152              | (Op.Normalize d, args) => CL.E_Apply(RN.normalize, args)              | (Op.Normalize d, args) => CL.E_Apply(CLN.normalize, args)
153              | (Op.Scale(Ty.TensorTy[n]), [s, v]) => CL.mkBinOp(s, CL.#*, v)              | (Op.Scale(Ty.TensorTy[n]), [s, v]) => CL.mkBinOp(s, CL.#*, v)
154              | (Op.PrincipleEvec ty, _) => raise Fail "PrincipleEvec unimplemented"              | (Op.PrincipleEvec ty, _) => raise Fail "PrincipleEvec unimplemented"
155              | (Op.Select(Ty.TupleTy tys, i), [a]) => raise Fail "Select unimplemented"              | (Op.Select(Ty.TupleTy tys, i), [a]) => raise Fail "Select unimplemented"
# Line 160  Line 157 
157              | (Op.Index(Ty.TensorTy[n], i), [a]) => vecIndex (a, i)              | (Op.Index(Ty.TensorTy[n], i), [a]) => vecIndex (a, i)
158              | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)              | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)
159              | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, ix]) => let              | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, ix]) => let
160                  val unionTy = CL.T_Named(concat["union", Int.toString n, !RN.gIntSuffix, "_t"])                  val unionTy = CL.T_Named(concat["union", Int.toString n, !CLN.gIntSuffix, "_t"])
161                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "i")                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "i")
162                  in                  in
163                    CL.mkSubscript(vecExp, ix)                    CL.mkSubscript(vecExp, ix)
# Line 168  Line 165 
165              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)
166              | (Op.Subscript(Ty.TensorTy[n]), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)              | (Op.Subscript(Ty.TensorTy[n]), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)
167              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
168                  val unionTy = CL.T_Named(concat["union", Int.toString n, !RN.gRealSuffix, "_t"])                  val unionTy = CL.T_Named(concat["union", Int.toString n, !CLN.gRealSuffix, "_t"])
169                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")
170                  in                  in
171                    CL.mkSubscript(vecExp, ix)                    CL.mkSubscript(vecExp, ix)
# Line 176  Line 173 
173              | (Op.Subscript(Ty.TensorTy[_,_]), [m, ix, CL.E_Int(jx, _)]) =>              | (Op.Subscript(Ty.TensorTy[_,_]), [m, ix, CL.E_Int(jx, _)]) =>
174                  vecIndex(CL.mkSubscript(m, ix), Int.fromLarge jx)                  vecIndex(CL.mkSubscript(m, ix), Int.fromLarge jx)
175              | (Op.Subscript(Ty.TensorTy[_,n]), [m, ix, jx]) => let              | (Op.Subscript(Ty.TensorTy[_,n]), [m, ix, jx]) => let
176                  val unionTy = CL.T_Named(concat["union", Int.toString n, !RN.gRealSuffix, "_t"])                  val unionTy = CL.T_Named(concat["union", Int.toString n, !CLN.gRealSuffix, "_t"])
177                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, CL.mkSubscript(m, ix)), "r")                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, CL.mkSubscript(m, ix)), "r")
178                  in                  in
179                    CL.mkSubscript(vecExp, jx)                    CL.mkSubscript(vecExp, jx)
# Line 187  Line 184 
184              | (Op.Floor d, args) => CL.mkApply("floor", args)              | (Op.Floor d, args) => CL.mkApply("floor", args)
185              | (Op.Round d, args) => CL.mkApply("round", args)              | (Op.Round d, args) => CL.mkApply("round", args)
186              | (Op.Trunc d, args) => CL.mkApply("trunc", args)              | (Op.Trunc d, args) => CL.mkApply("trunc", args)
187              | (Op.IntToReal, [a]) => CL.mkCast(!RN.gRealTy, a)              | (Op.IntToReal, [a]) => CL.mkCast(!CLN.gGPURealTy, a)
188              | (Op.RealToInt 1, [a]) => CL.mkCast(!RN.gIntTy, a)              | (Op.RealToInt 1, [a]) => CL.mkCast(!CLN.gGPUIntTy, a)
189              | (Op.RealToInt d, args) => CL.mkApply(RN.vecftoi d, args)              | (Op.RealToInt d, args) => CL.mkApply(CLN.vecftoi d, args)
190  (* FIXME: need type info *)  (* FIXME: need type info *)
191              | (Op.ImageAddress info, [a as CL.E_Indirect(_,field)]) => let              | (Op.ImageAddress info, [a as CL.E_Indirect(_,field)]) => let
192                  val cTy = imageDataPtrTy(ImageInfo.sampleTy info)                  val cTy = CLTyTranslate.imageDataPtrTy info
193                  in                  in
194                    CL.mkCast(cTy,                    CL.mkCast(cTy,
195                      CL.mkSelect(CL.mkVar RN.globalImageDataName, RN.imageDataName field))                      CL.mkSelect(CL.mkVar CLN.globalImageDataName, CLN.imageDataName field))
196                  end                  end
197              | (Op.LoadVoxels(info, 1), [a]) => let              | (Op.LoadVoxels(info, 1), [a]) => let
198                  val realTy as CL.T_Num rTy = !RN.gRealTy                  val realTy as CL.T_Num rTy = !CLN.gGPURealTy
199                  val a = CL.E_UnOp(CL.%*, a)                  val a = CL.E_UnOp(CL.%*, a)
200                  in                  in
201                    if (rTy = ImageInfo.sampleTy info)                    if (rTy = ImageInfo.sampleTy info)
# Line 208  Line 205 
205              | (Op.LoadVoxels _, [a]) =>              | (Op.LoadVoxels _, [a]) =>
206                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
207              | (Op.PosToImgSpace info, [img, pos]) =>              | (Op.PosToImgSpace info, [img, pos]) =>
208                  CL.mkApply(RN.toImageSpace(ImageInfo.dim info), [CL.mkUnOp(CL.%&,img), pos])                  CL.mkApply(CLN.toImageSpace(ImageInfo.dim info), [CL.mkUnOp(CL.%&,img), pos])
209              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
210                  CL.mkApply(RN.toWorldSpace ty, [CL.mkUnOp(CL.%&,v), x])                  CL.mkApply(CLN.toWorldSpace ty, [CL.mkUnOp(CL.%&,v), x])
211              | (Op.Inside(info, s), [pos, img]) =>              | (Op.Inside(info, s), [pos, img]) =>
212                  CL.mkApply(RN.inside(ImageInfo.dim info), [pos, CL.mkUnOp(CL.%&,img), intExp s])                  CL.mkApply(CLN.inside(ImageInfo.dim info), [pos, CL.mkUnOp(CL.%&,img), intExp s])
213              | (Op.Input _, []) => raise Fail("impossible " ^ Op.toString rator)              | (Op.Input _, []) => raise Fail("impossible " ^ Op.toString rator)
214              | _ => raise Fail(concat[              | _ => raise Fail(concat[
215                "unknown or incorrect operator ", Op.toString rator                "unknown or incorrect operator ", Op.toString rator
# Line 220  Line 217 
217            (* end case *))            (* end case *))
218    
219      fun trExp (env, e) = (case e      fun trExp (env, e) = (case e
220             of IL.E_State x => trStateVar x             of IL.E_State x => rvalueStateVar (env, x)
221              | IL.E_Var x => trVar (env, x)              | IL.E_Var x => rvalueVar (env, x)
222              | IL.E_Lit(Literal.Int n) => CL.mkIntTy(n, !RN.gIntTy)              | IL.E_Lit(Literal.Int n) => CL.mkIntTy(n, !CLN.gGPUIntTy)
223              | IL.E_Lit(Literal.Bool b) => CL.mkBool b              | IL.E_Lit(Literal.Bool b) => CL.mkBool b
224              | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !RN.gRealTy)              | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !CLN.gGPURealTy)
225              | IL.E_Lit(Literal.String s) => CL.mkStr s              | IL.E_Lit(Literal.String s) => CL.mkStr s
226              | IL.E_Op(rator, args) => trOp (rator, trExps(env, args))              | IL.E_Op(rator, args) => trOp (rator, trExps(env, args))
227              | IL.E_Apply(f, args) => trApply(f, trExps(env, args))              | IL.E_Apply(f, args) => trApply(f, trExps(env, args))
228              | IL.E_Cons(Ty.TensorTy[n], args) => CL.mkApply(RN.mkVec n, trExps(env, args))              | IL.E_Cons(Ty.TensorTy[n], args) => CL.mkApply(CLN.mkVec n, trExps(env, args))
229              | IL.E_Cons(ty, _) => raise Fail(concat["E_Cons(", Ty.toString ty, ", _) in expression"])              | IL.E_Cons(ty, _) => raise Fail(concat["E_Cons(", Ty.toString ty, ", _) in expression"])
230            (* end case *))            (* end case *))
231    
# Line 246  Line 243 
243                  end                  end
244            (* end case *))            (* end case *))
245    
246      fun trLHSVar (env, lhs) = (case V.kind lhs      fun trAssign (env, lhs, rhs) = (
            of IL.VK_Local => CL.mkVar(lookup(env, lhs))  
             | _ => CL.mkIndirect(CL.mkVar RN.globalsVarName, lookup(env, lhs))  
           (* end case *))  
   
     fun trLHSStateVar (IL.SV{name, ...}) = CL.mkIndirect(CL.mkVar "selfOut", name)  
   
     fun trSet (env, lhs, rhs) = (  
247          (* certain rhs forms, such as those that return a matrix,          (* certain rhs forms, such as those that return a matrix,
248           * require a function call instead of an assignment           * require a function call instead of an assignment
249           *)           *)
250            case rhs            case rhs
251             of IL.E_Op(Op.Add(Ty.TensorTy[m,n]), args) =>             of IL.E_Op(Op.Add(Ty.TensorTy[m,n]), args) =>
252                  [CL.mkCall(RN.addMat(m,n),  lhs :: trExps(env, args))]                  [CL.mkCall(CLN.addMat(m,n),  lhs :: trExps(env, args))]
253              | IL.E_Op(Op.Sub(Ty.TensorTy[m,n]), args) =>              | IL.E_Op(Op.Sub(Ty.TensorTy[m,n]), args) =>
254                  [CL.mkCall(RN.subMat(m,n),  lhs :: trExps(env, args))]                  [CL.mkCall(CLN.subMat(m,n),  lhs :: trExps(env, args))]
255              | IL.E_Op(Op.Neg(Ty.TensorTy[m,n]), args) =>              | IL.E_Op(Op.Neg(Ty.TensorTy[m,n]), args) =>
256                  [CL.mkCall(RN.scaleMat(m,n),  lhs :: intExp ~1 :: trExps(env, args))]                  [CL.mkCall(CLN.scaleMat(m,n),  lhs :: intExp ~1 :: trExps(env, args))]
257              | IL.E_Op(Op.Scale(Ty.TensorTy[m,n]), args) =>              | IL.E_Op(Op.Scale(Ty.TensorTy[m,n]), args) =>
258                  [CL.mkCall(RN.scaleMat(m,n),  lhs :: trExps(env, args))]                  [CL.mkCall(CLN.scaleMat(m,n),  lhs :: trExps(env, args))]
259              | IL.E_Op(Op.MulMatMat(m,n,p), args) =>              | IL.E_Op(Op.MulMatMat(m,n,p), args) =>
260                  [CL.mkCall(RN.mulMatMat(m,n,p), lhs :: trExps(env, args))]                  [CL.mkCall(CLN.mulMatMat(m,n,p), lhs :: trExps(env, args))]
261              | IL.E_Op(Op.Identity n, args) =>              | IL.E_Op(Op.Identity n, args) =>
262                  [CL.mkCall(RN.identityMat n, [lhs])]                  [CL.mkCall(CLN.identityMat n, [lhs])]
263              | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>              | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>
264                  [CL.mkCall(RN.zeroMat(m,n), [lhs])]                  [CL.mkCall(CLN.zeroMat(m,n), [lhs])]
265              | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy[_,_]), [img,src]) =>              | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy[_,_]), [img,src]) =>
266                  [CL.mkCall(RN.toWorldSpace ty, lhs :: [CL.mkUnOp(CL.%&,trExp(env, img)),trExp(env, src)] )]                  [CL.mkCall(CLN.toWorldSpace ty, lhs :: [CL.mkUnOp(CL.%&,trExp(env, img)),trExp(env, src)] )]
267              | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>              | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>
268                  if (n > 1)                  if (n > 1)
269                    then let                    then let
270                      val stride = ImageInfo.stride info                      val stride = ImageInfo.stride info
271                      val rTy = ImageInfo.sampleTy info                      val rTy = ImageInfo.sampleTy info
272                      val vp = freshVar "vp"                      val vp = freshVar "vp"
273                      val needsCast = (CL.T_Num rTy <> !RN.gRealTy)                      val needsCast = (CL.T_Num rTy <> !CLN.gGPURealTy)
274                      fun mkLoad i = let                      fun mkLoad i = let
275                            val e = CL.mkSubscript(CL.mkVar vp, intExp(i*stride))                            val e = CL.mkSubscript(CL.mkVar vp, intExp(i*stride))
276                            in                            in
277                              if needsCast then CL.mkCast(!RN.gRealTy, e) else e                              if needsCast then CL.mkCast(!CLN.gGPURealTy, e) else e
278                            end                            end
279                      in [                      in [
280                        CL.mkDeclInit(imageDataPtrTy rTy, vp, trExp(env, a)),                        CL.mkDeclInit(CLTyTranslate.imageDataPtrTy info, vp, trExp(env, a)),
281                        CL.mkAssign(lhs,                        CL.mkAssign(lhs,
282                        CL.mkApply(RN.mkVec n, List.tabulate (n, mkLoad)))                        CL.mkApply(CLN.mkVec n, List.tabulate (n, mkLoad)))
283                      ] end                      ] end
284                  else [CL.mkAssign(lhs, trExp(env, rhs))]                  else [CL.mkAssign(lhs, trExp(env, rhs))]
285              | IL.E_Op(Op.EigenVals2x2, [m]) => let              | IL.E_Op(Op.EigenVals2x2, [m]) => let
286                  val (m, stms) = expToVar (env, CL.T_Named(RN.matTy(2,2)), "m", m)                  val (m, stms) = expToVar (env, CL.T_Named(CLN.matTy(2,2)), "m", m)
287                  in                  in
288                    stms @ [CL.mkCall(RN.evals2x2, [                    stms @ [CL.mkCall(CLN.evals2x2, [
289                        CL.mkUnOp(CL.%&,lhs),                        CL.mkUnOp(CL.%&,lhs),
290                        matIndex (m, CL.mkInt 0,  "0"),                        matIndex (m, CL.mkInt 0,  "0"),
291                        matIndex (m, CL.mkInt 0, "1"),                        matIndex (m, CL.mkInt 0, "1"),
# Line 303  Line 293 
293                      ])]                      ])]
294                  end                  end
295              | IL.E_Op(Op.EigenVals3x3, [m]) => let              | IL.E_Op(Op.EigenVals3x3, [m]) => let
296                  val (m, stms) = expToVar (env, CL.T_Named(RN.matTy(3,3)), "m", m)                  val (m, stms) = expToVar (env, CL.T_Named(CLN.matTy(3,3)), "m", m)
297                  in                  in
298                    stms @ [CL.mkCall(RN.evals3x3, [                    stms @ [CL.mkCall(CLN.evals3x3, [
299                        CL.mkUnOp(CL.%&,lhs),                        CL.mkUnOp(CL.%&,lhs),
300                        matIndex (m, CL.mkInt 0, "0"),                        matIndex (m, CL.mkInt 0, "0"),
301                        matIndex (m, CL.mkInt 0, "1"),                        matIndex (m, CL.mkInt 0, "1"),
# Line 326  Line 316 
316                    doRows (0, trExps(env, args))                    doRows (0, trExps(env, args))
317                  end                  end
318              | IL.E_Var x => (case IL.Var.ty x              | IL.E_Var x => (case IL.Var.ty x
319                   of Ty.TensorTy[n,m] => [CL.mkCall(RN.copyMat(n,m), [lhs, trVar(env, x)])]                   of Ty.TensorTy[n,m] => [CL.mkCall(CLN.copyMat(n,m), [lhs, rvalueVar(env, x)])]
320                    | _ => [CL.mkAssign(lhs, trVar(env, x))]                    | _ => [CL.mkAssign(lhs, rvalueVar(env, x))]
321                  (* end case *))                  (* end case *))
322              | _ => [CL.mkAssign(lhs, trExp(env, rhs))]              | _ => [CL.mkAssign(lhs, trExp(env, rhs))]
323            (* end case *))            (* end case *))
324    
     fun trAssign (env, lhs, rhs) = trSet (env, trLHSVar (env, lhs), rhs)  
   
325      fun trMultiAssign (env, lhs, IL.E_Op(rator, args)) = (case (lhs, rator, args)      fun trMultiAssign (env, lhs, IL.E_Op(rator, args)) = (case (lhs, rator, args)
326             of ([vals, vecs], Op.EigenVecs2x2, [m]) => let             of ([vals, vecs], Op.EigenVecs2x2, [m]) => let
327                  val (m, stms) = expToVar (env, CL.T_Named(RN.matTy(2,2)), "m", m)                  val (m, stms) = expToVar (env, CL.T_Named(CLN.matTy(2,2)), "m", m)
328                  in                  in
329                    stms @ [CL.mkCall(RN.evecs2x2, [                    stms @ [CL.mkCall(CLN.evecs2x2, [
330                        CL.mkUnOp(CL.%&,vals), vecs,                        CL.mkUnOp(CL.%&,vals), vecs,
331                        matIndex (m, CL.mkInt 0, "0"),                        matIndex (m, CL.mkInt 0, "0"),
332                        matIndex (m, CL.mkInt 0, "1"),                        matIndex (m, CL.mkInt 0, "1"),
# Line 346  Line 334 
334                      ])]                      ])]
335                  end                  end
336              | ([vals, vecs], Op.EigenVecs3x3, [m]) => let              | ([vals, vecs], Op.EigenVecs3x3, [m]) => let
337                  val (m, stms) = expToVar (env, CL.T_Named(RN.matTy(3,3)), "m", m)                  val (m, stms) = expToVar (env, CL.T_Named(CLN.matTy(3,3)), "m", m)
338                  in                  in
339                    stms @ [CL.mkCall(RN.evecs3x3, [                    stms @ [CL.mkCall(CLN.evecs3x3, [
340                        CL.mkUnOp(CL.%&,vals), vecs,                        CL.mkUnOp(CL.%&,vals), vecs,
341                        matIndex (m, CL.mkInt 0, "0"),                        matIndex (m, CL.mkInt 0, "0"),
342                        matIndex (m, CL.mkInt 0, "1"),                        matIndex (m, CL.mkInt 0, "1"),
# Line 364  Line 352 
352    
353      fun trLocals (env : env, locals) =      fun trLocals (env : env, locals) =
354            List.foldl            List.foldl
355              (fn (x, env) => V.Map.insert(env, x, V(trType(V.ty x), V.name x)))              (fn (x, env) => V.Map.insert(env, x, V(CLTyTranslate.toGPUType(V.ty x), V.name x)))
356                env locals                env locals
357    
358    (* generate code to check the status of runtime-system calls *)    (* generate code to check the status of runtime-system calls *)
# Line 380  Line 368 
368      fun trStms (env, stms) = let      fun trStms (env, stms) = let
369            fun trStmt (env, stm) = (case stm            fun trStmt (env, stm) = (case stm
370               of IL.S_Comment text => [CL.mkComment text]               of IL.S_Comment text => [CL.mkComment text]
371                | IL.S_Assign([x], exp) => trAssign (env, x, exp)                    | IL.S_Assign([x], exp) => trAssign (env, lvalueVar (env, x), exp)
372                | IL.S_Assign(xs, exp) =>                | IL.S_Assign(xs, exp) =>
373                        trMultiAssign (env, List.map (fn x => trVar (env, x)) xs, exp)                            trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp)
374                | IL.S_IfThen(cond, thenBlk) =>                | IL.S_IfThen(cond, thenBlk) =>
375                    [CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk))]                    [CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk))]
376                | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>                | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
# Line 390  Line 378 
378                      trBlk(env, thenBlk),                      trBlk(env, thenBlk),
379                      trBlk(env, elseBlk))]                      trBlk(env, elseBlk))]
380                | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)                | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)
381                | IL.S_Save([x], exp) => trSet (env, trLHSStateVar x, exp)                    | IL.S_Save([x], exp) => trAssign (env, lvalueStateVar(env, x), exp)
382                      | IL.S_Save(xs, exp) =>
383                          trMultiAssign (env, List.map (fn x => lvalueStateVar(env, x)) xs, exp)
384                      | IL.S_LoadNrrd _ => raise Fail "impossible S_LoadNrrd in OpenCL"
385                | IL.S_Input _ => raise Fail "impossible S_Input in OpenCL"                | IL.S_Input _ => raise Fail "impossible S_Input in OpenCL"
386                      | IL.S_InputNrrd _ => raise Fail "impossible S_InputNrrd in OpenCL"
387                | IL.S_Exit args => [CL.mkReturn NONE]                | IL.S_Exit args => [CL.mkReturn NONE]
388                | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar RN.kActive))]                    | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar CLN.kActive))]
389                | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar RN.kStabilize))]                    | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar CLN.kStabilize))]
390                | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar RN.kDie))]                    | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar CLN.kDie))]
391              (* end case *))              (* end case *))
392            in            in
393              List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms              List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms

Legend:
Removed from v.2404  
changed lines
  Added in v.2405

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