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

SCM Repository

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

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

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

revision 2635, Mon May 26 14:06:39 2014 UTC revision 2636, Tue May 27 16:18:36 2014 UTC
# Line 60  Line 60 
60              | Ty.SeqTy(Ty.IntTy, n) => CL.T_Named(RN.ivecTy n)              | Ty.SeqTy(Ty.IntTy, n) => CL.T_Named(RN.ivecTy n)
61              | Ty.SeqTy(Ty.TensorTy[] , n) => CL.T_Named(RN.vecTy n)              | Ty.SeqTy(Ty.TensorTy[] , n) => CL.T_Named(RN.vecTy n)
62              | Ty.SeqTy(ty, n) => CL.T_Array(trType ty, SOME n)              | Ty.SeqTy(ty, n) => CL.T_Array(trType ty, SOME n)
63              | Ty.AddrTy(ImageInfo.ImgInfo{ty=(_, rTy), ...}) => imageDataPtrTy rTy              | Ty.AddrTy info => imageDataPtrTy(ImageInfo.sampleTy info)
64              | Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}) => CL.T_Named(RN.imageTy dim)              | Ty.ImageTy info => CL.T_Named(RN.imageTy(ImageInfo.dim info))
65              | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])              | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])
66            (* end case *))            (* end case *))
67    
# Line 96  Line 96 
96    
97    (* translate a variable use *)    (* translate a variable use *)
98      fun trVar (env, x) = (case V.kind x      fun trVar (env, x) = (case V.kind x
99             of IL.VK_Global => CL.mkIndirect(CL.E_Var RN.globalsVarName, lookup(env, x))             of IL.VK_Local => CL.mkVar(lookup(env, x))
100              | IL.VK_Local => CL.mkVar(lookup(env, x))              | _ => CL.mkIndirect(CL.E_Var RN.globalsVarName, lookup(env, x))
101            (* end case *))            (* end case *))
102    
103    (* matrix indexing *)    (* matrix indexing *)
# Line 165  Line 165 
165                  in                  in
166                    CL.mkSubscript(vecExp, ix)                    CL.mkSubscript(vecExp, ix)
167                  end                  end
             | (Op.Subscript(Ty.SeqTy(Ty.TensorTy[], n)), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)  
168              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)
169              | (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)
170              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
# Line 192  Line 191 
191              | (Op.RealToInt 1, [a]) => CL.mkCast(!RN.gIntTy, a)              | (Op.RealToInt 1, [a]) => CL.mkCast(!RN.gIntTy, a)
192              | (Op.RealToInt d, args) => CL.mkApply(RN.vecftoi d, args)              | (Op.RealToInt d, args) => CL.mkApply(RN.vecftoi d, args)
193  (* FIXME: need type info *)  (* FIXME: need type info *)
194              | (Op.ImageAddress(ImageInfo.ImgInfo{ty=(_,rTy), ...}), [a as CL.E_Indirect(_,field)]) => let              | (Op.ImageAddress info, [a as CL.E_Indirect(_,field)]) => let
195                  val cTy = imageDataPtrTy rTy                  val cTy = imageDataPtrTy(ImageInfo.sampleTy info)
196                  in                  in
197                    CL.mkCast(cTy,                    CL.mkCast(cTy,
198                      CL.mkSelect(CL.mkVar RN.globalImageDataName, RN.imageDataName field))                      CL.mkSelect(CL.mkVar RN.globalImageDataName, RN.imageDataName field))
# Line 208  Line 207 
207                  end                  end
208              | (Op.LoadVoxels _, [a]) =>              | (Op.LoadVoxels _, [a]) =>
209                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
210              | (Op.PosToImgSpace(ImageInfo.ImgInfo{dim, ...}), [img, pos]) =>              | (Op.PosToImgSpace info, [img, pos]) =>
211                  CL.mkApply(RN.toImageSpace dim, [CL.mkUnOp(CL.%&,img), pos])                  CL.mkApply(RN.toImageSpace(ImageInfo.dim info), [CL.mkUnOp(CL.%&,img), pos])
212              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
213                  CL.mkApply(RN.toWorldSpace ty, [CL.mkUnOp(CL.%&,v), x])                  CL.mkApply(RN.toWorldSpace ty, [CL.mkUnOp(CL.%&,v), x])
214              | (Op.LoadImage info, [a]) =>              | (Op.Inside(info, s), [pos, img]) =>
215                  raise Fail("impossible " ^ Op.toString rator)                  CL.mkApply(RN.inside(ImageInfo.dim info), [pos, CL.mkUnOp(CL.%&,img), intExp s])
216              | (Op.Inside(ImageInfo.ImgInfo{dim, ...}, s), [pos, img]) =>              | (Op.Input _, []) => raise Fail("impossible " ^ Op.toString rator)
                 CL.mkApply(RN.inside dim, [pos, CL.mkUnOp(CL.%&,img), intExp s])  
             | (Op.Input(ty, name, desc), []) =>  
                 raise Fail("impossible " ^ Op.toString rator)  
             | (Op.InputWithDefault(ty, name, desc), [a]) =>  
                 raise Fail("impossible " ^ Op.toString rator)  
217              | _ => raise Fail(concat[              | _ => raise Fail(concat[
218                "unknown or incorrect operator ", Op.toString rator                "unknown or incorrect operator ", Op.toString rator
219              ])              ])
# Line 248  Line 242 
242              | exp => let              | exp => let
243                  val x = freshVar name                  val x = freshVar name
244                  in                  in
245                    (CL.mkVar x, [CL.mkDecl(ty, x, SOME(CL.I_Exp exp))])                    (CL.mkVar x, [CL.mkDeclInit(ty, x, exp)])
246                  end                  end
247            (* end case *))            (* end case *))
248    
249      fun trLHSVar (env, lhs) = (case V.kind lhs      fun trLHSVar (env, lhs) = (case V.kind lhs
250             of IL.VK_Global => CL.mkIndirect(CL.mkVar RN.globalsVarName, lookup(env, lhs))             of IL.VK_Local => CL.mkVar(lookup(env, lhs))
251              | IL.VK_Local => CL.mkVar(lookup(env, lhs))              | _ => CL.mkIndirect(CL.mkVar RN.globalsVarName, lookup(env, lhs))
252            (* end case *))            (* end case *))
253    
254      fun trLHSStateVar (IL.SV{name, ...}) = CL.mkIndirect(CL.mkVar "selfOut", name)      fun trLHSStateVar (IL.SV{name, ...}) = CL.mkIndirect(CL.mkVar "selfOut", name)
# Line 293  Line 287 
287                              if needsCast then CL.mkCast(!RN.gRealTy, e) else e                              if needsCast then CL.mkCast(!RN.gRealTy, e) else e
288                            end                            end
289                      in [                      in [
290                        CL.mkDecl(imageDataPtrTy rTy, vp, SOME(CL.I_Exp(trExp(env, a)))),                        CL.mkDeclInit(imageDataPtrTy rTy, vp, trExp(env, a)),
291                        CL.mkAssign(lhs,                        CL.mkAssign(lhs,
292                        CL.mkApply(RN.mkVec n, List.tabulate (n, mkLoad)))                        CL.mkApply(RN.mkVec n, List.tabulate (n, mkLoad)))
293                      ] end                      ] end
# Line 397  Line 391 
391                      trBlk(env, elseBlk))]                      trBlk(env, elseBlk))]
392                | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)                | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)
393                | IL.S_Save([x], exp) => trSet (env, trLHSStateVar x, exp)                | IL.S_Save([x], exp) => trSet (env, trLHSStateVar x, exp)
394  (* FIXME: I think that S_LoadImage should never happen in OpenCL code [jhr] *)                | IL.S_Input _ => raise Fail "impossible S_Input in OpenCL"
               | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let  
                   val lhs = lookup(env, lhs)  
                   val name = trExp(env, name)  
                   val imgTy = CL.T_Named(RN.imageTy dim)  
                   val loadFn = RN.loadImage dim  
                   in [  
                     CL.mkDecl(  
                       CL.T_Named RN.statusTy, sts,  
                       SOME(CL.I_Exp(CL.E_Apply(loadFn, [name, CL.mkUnOp(CL.%&, CL.E_Var lhs)]))))  
                   ] end)  
 (* FIXME: I think that S_Input should never happen in OpenCL code [jhr] *)  
            | IL.S_Input(lhs, name, desc, optDflt) => checkSts (fn sts => let  
                   val inputFn = RN.input(V.ty lhs)  
                   val lhs = lookup(env, lhs)  
                   val (initCode, hasDflt) = (case optDflt  
                      of SOME e => ([CL.mkAssign(CL.E_Var lhs, trExp(env, e))], true)  
                       | NONE => ([], false)  
                     (* end case *))  
                   val code = [  
                       CL.mkDecl(  
                         CL.T_Named RN.statusTy, sts,  
                         SOME(CL.I_Exp(CL.E_Apply(inputFn, [  
                             CL.mkStr name,  
                             CL.mkUnOp(CL.%&, CL.mkIndirect(CL.mkVar RN.globalsVarName, lhs)),  
                             CL.mkBool hasDflt  
                           ]))))  
                     ]  
                   in  
                     initCode @ code  
                   end)  
395                | IL.S_Exit args => [CL.mkReturn NONE]                | IL.S_Exit args => [CL.mkReturn NONE]
396                | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar RN.kActive))]                | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar RN.kActive))]
397                | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar RN.kStabilize))]                | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar RN.kStabilize))]

Legend:
Removed from v.2635  
changed lines
  Added in v.2636

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