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

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/cl-target/cl-target.sml
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/cl-target/cl-target.sml

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

revision 1307, Sat Jun 11 13:58:02 2011 UTC revision 1460, Sun Aug 7 20:31:00 2011 UTC
# Line 1  Line 1 
1  (* c-target.sml  (* cl-target.sml
2   *   *
3   * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)   * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
# Line 15  Line 15 
15      structure ToCL = TreeToCL      structure ToCL = TreeToCL
16      structure N = CNames      structure N = CNames
17    
18    (* variable translation *)    (* translate TreeIL types to shadow types *)
19      structure TrVar =      fun shadowTy ty = (case ty
20        struct             of Ty.BoolTy => CL.T_Named "cl_bool"
21          type env = CL.typed_var TreeIL.Var.Map.map              | Ty.StringTy => raise Fail "unexpected string type"
22          fun lookup (env, x) = (case V.Map.find (env, x)              | Ty.IVecTy 1 => CL.T_Named(RN.shadowIntTy ())
23                 of SOME(CL.V(_, x')) => x'              | Ty.IVecTy n => raise Fail "unexpected int vector type"
24                  | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])              | Ty.TensorTy[] => CL.T_Named(RN.shadowRealTy ())
25                | Ty.TensorTy[n] => CL.T_Named(RN.shadowVecTy n)
26                | Ty.TensorTy[n, m] => CL.T_Named(RN.shadowMatTy(n,m))
27                | Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}) => CL.T_Named(RN.shadowImageTy dim)
28                | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])
29                (* end case *))                (* end case *))
30        (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)  
31          fun lvalueVar (env, x) = (case V.kind x     (* translate TreeIL types to shadow types *)
32                 of IL.VK_Global => CL.mkVar(lookup(env, x))      fun convertToShadow (ty, name) = (case ty
33                  | IL.VK_State strand => CL.mkIndirect(CL.mkVar "selfOut", lookup(env, x))             of Ty.IVecTy 1 => CL.mkAssign(
34                  | IL.VK_Local => CL.mkVar(lookup(env, x))                  CL.mkSelect(CL.mkVar(RN.shadowGlaobalsName),name),
35                (* end case *))                  CL.mkIndirect(CL.mkVar(RN.globalsVarName), name))
36        (* translate a variable that occurs in an r-value context *)              | Ty.TensorTy[n]=> CL.mkCall(RN.convertToShadowVec n, [
37          fun rvalueVar (env, x) = (case V.kind x                    CL.mkSelect(CL.mkVar(RN.shadowGlaobalsName),name),
38                 of IL.VK_Global => CL.mkVar(lookup(env, x))                    CL.mkIndirect(CL.mkVar(RN.globalsVarName), name)
39                  | IL.VK_State strand => CL.mkIndirect(CL.mkVar "selfIn", lookup(env, x))                  ])
40                  | IL.VK_Local => CL.mkVar(lookup(env, x))              | Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}) => CL.mkCall(RN.shadowImageFunc dim, [
41                      CL.mkVar "context",
42                      CL.mkUnOp(CL.%&,CL.mkSelect(CL.mkVar(RN.shadowGlaobalsName),name)),
43                      CL.mkIndirect(CL.mkVar(RN.globalsVarName),name)
44                    ])
45                | Ty.TensorTy[n, m] => CL.mkCall(RN.convertToShadowMat(m,n), [
46                      CL.mkSelect(CL.mkVar(RN.shadowGlaobalsName),name),
47                      CL.mkIndirect(CL.mkVar(RN.globalsVarName), name)
48                    ])
49                | _ => CL.mkAssign(
50                    CL.mkSelect(CL.mkVar(RN.shadowGlaobalsName),name),
51                    CL.mkIndirect(CL.mkVar(RN.globalsVarName), name))
52                (* end case *))                (* end case *))
       end  
53    
54          structure ToC = TreeToCFn (TrVar)    (* helper functions for specifying parameters in various address spaces *)
55        fun clParam (spc, ty, x) = CL.PARAM([spc], ty, x)
56        fun globalParam (ty, x) = CL.PARAM(["__global"], ty, x)
57        fun constantParam (ty, x) = CL.PARAM(["__constant"], ty, x)
58        fun localParam (ty, x) = CL.PARAM(["__local"], ty, x)
59        fun privateParam (ty, x) = CL.PARAM(["__private"], ty, x)
60    
61      (* OpenCL global pointer type *)
62        fun globalPtr ty = CL.T_Qual("__global", CL.T_Ptr ty)
63    
64    (* C variable translation *)    (* C variable translation *)
65      structure TrCVar =      structure TrCVar =
# Line 50  Line 72 
72        (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)        (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
73          fun lvalueVar (env, x) = (case V.kind x          fun lvalueVar (env, x) = (case V.kind x
74                 of IL.VK_Global => CL.mkIndirect(CL.mkVar RN.globalsVarName, lookup(env, x))                 of IL.VK_Global => CL.mkIndirect(CL.mkVar RN.globalsVarName, lookup(env, x))
75                  | IL.VK_State strand => raise Fail "unexpected strand context"                  | IL.VK_State strand => CL.mkIndirect(CL.mkVar "selfOut", lookup(env, x))
76                  | IL.VK_Local => CL.mkVar(lookup(env, x))                  | IL.VK_Local => CL.mkVar(lookup(env, x))
77                (* end case *))                (* end case *))
78        (* translate a variable that occurs in an r-value context *)        (* translate a variable that occurs in an r-value context *)
79          val rvalueVar = lvalueVar          fun rvalueVar (env, x) = (case V.kind x
80                   of IL.VK_Global => CL.mkIndirect(CL.mkVar RN.globalsVarName, lookup(env, x))
81                    | IL.VK_State strand => CL.mkIndirect(CL.mkVar "selfIn", lookup(env, x))
82                    | IL.VK_Local => CL.mkVar(lookup(env, x))
83                  (* end case *))
84        end        end
85    
86      structure ToC = TreeToCFn (TrCVar)      structure ToC = TreeToCFn (TrCVar)
# Line 64  Line 90 
90      type stm = CL.stm      type stm = CL.stm
91    
92    (* OpenCL specific types *)    (* OpenCL specific types *)
93        val clIntTy = CL.T_Named "cl_int"
94      val clProgramTy = CL.T_Named "cl_program"      val clProgramTy = CL.T_Named "cl_program"
95      val clKernelTy  = CL.T_Named "cl_kernel"      val clKernelTy  = CL.T_Named "cl_kernel"
96      val clCmdQueueTy = CL.T_Named "cl_command_queue"      val clCmdQueueTy = CL.T_Named "cl_command_queue"
# Line 71  Line 98 
98      val clDeviceIdTy = CL.T_Named "cl_device_id"      val clDeviceIdTy = CL.T_Named "cl_device_id"
99      val clPlatformIdTy = CL.T_Named "cl_platform_id"      val clPlatformIdTy = CL.T_Named "cl_platform_id"
100      val clMemoryTy = CL.T_Named "cl_mem"      val clMemoryTy = CL.T_Named "cl_mem"
101        val globPtrTy = CL.T_Ptr(CL.T_Named RN.globalsTy)
102    
103    (* variable or field that is mirrored between host and GPU *)    (* variable or field that is mirrored between host and GPU *)
104      type mirror_var = {      type mirror_var = {
105    (* FIXME: perhaps it would be cleaner to just track the TreeIL type of the variable? *)
106              hostTy : CL.ty,             (* variable type on Host (i.e., C type) *)              hostTy : CL.ty,             (* variable type on Host (i.e., C type) *)
107                shadowTy : CL.ty,           (* host-side shadow type of GPU type *)
108              gpuTy : CL.ty,              (* variable's type on GPU (i.e., OpenCL type) *)              gpuTy : CL.ty,              (* variable's type on GPU (i.e., OpenCL type) *)
109                hToS: stm,                  (* the statement that converts the variable to its *)
110                                            (* shadow representation *)
111              var : CL.var                (* variable name *)              var : CL.var                (* variable name *)
112            }            }
113    
# Line 97  Line 129 
129          topDecls : CL.decl list ref,          topDecls : CL.decl list ref,
130          strands : strand AtomTable.hash_table,          strands : strand AtomTable.hash_table,
131          initially :  CL.decl ref,          initially :  CL.decl ref,
132          numDims: int ref,          numDims: int ref,               (* number of dimensions in initially iteration *)
133          imgGlobals: (string * int) list ref,          imgGlobals: (string * int) list ref,
134          prFn: CL.decl ref          prFn: CL.decl ref
135        }        }
# Line 117  Line 149 
149        | GlobalScope        | GlobalScope
150        | InitiallyScope        | InitiallyScope
151        | StrandScope of TreeIL.var list  (* strand initialization *)        | StrandScope of TreeIL.var list  (* strand initialization *)
152        | MethodScope of TreeIL.var list  (* method body; vars are state variables *)        | MethodScope of MethodName.name * TreeIL.var list  (* method body; vars are state variables *)
153    
154    (* the supprted widths of vectors of reals on the target. *)    (* the supprted widths of vectors of reals on the target. *)
155  (* FIXME: for OpenCL 1.1, 3 is also valid *)  (* FIXME: for OpenCL 1.1, 3 is also valid *)
# Line 130  Line 162 
162    (* TreeIL to target translations *)    (* TreeIL to target translations *)
163      structure Tr =      structure Tr =
164        struct        struct
       (* this function is used for the initially clause, so it generates OpenCL *)  
165          fun fragment (ENV{info, vMap, scope}, blk) = let          fun fragment (ENV{info, vMap, scope}, blk) = let
166                val (vMap, stms) = ToCL.trFragment (vMap, blk)                val (vMap, stms) = (case scope
167                         of GlobalScope => ToC.trFragment (vMap, blk)
168    (* NOTE: if we move strand initialization to the GPU, then we'll have to change the following code! *)
169                          | InitiallyScope => ToC.trFragment (vMap, blk)
170                          | _ => ToCL.trFragment (vMap, blk)
171                        (* end case *))
172                in                in
173                  (ENV{info=info, vMap=vMap, scope=scope}, stms)                  (ENV{info=info, vMap=vMap, scope=scope}, stms)
174                end                end
175          fun saveState cxt stateVars (env, args, stm) = (          fun block (ENV{vMap, scope, ...}, blk) = let
176                  fun saveState cxt stateVars trAssign (env, args, stm) = (
177                ListPair.foldrEq                ListPair.foldrEq
178                  (fn (x, e, stms) => ToCL.trAssign(env, x, e)@stms)                        (fn (x, e, stms) => trAssign(env, x, e)@stms)
179                    [stm]                    [stm]
180                      (stateVars, args)                      (stateVars, args)
181                ) handle ListPair.UnequalLengths => (                ) handle ListPair.UnequalLengths => (
182                  print(concat["saveState ", cxt, ": length mismatch; ", Int.toString(List.length args), " args\n"]);                  print(concat["saveState ", cxt, ": length mismatch; ", Int.toString(List.length args), " args\n"]);
183                  raise Fail(concat["saveState ", cxt, ": length mismatch"]))                  raise Fail(concat["saveState ", cxt, ": length mismatch"]))
184          fun block (ENV{vMap, scope, ...}, blk) = (case scope                in
185                 of StrandScope stateVars => ToCL.trBlock (vMap, saveState "StrandScope" stateVars, blk)                  case scope
186                  | MethodScope stateVars => ToCL.trBlock (vMap, saveState "MethodScope" stateVars, blk)  (* NOTE: if we move strand initialization to the GPU, then we'll have to change the following code! *)
187                     of StrandScope stateVars =>
188                          ToC.trBlock (vMap, saveState "StrandScope" stateVars ToC.trAssign, blk)
189                      | MethodScope(name, stateVars) =>
190                          ToCL.trBlock (vMap, saveState "MethodScope" stateVars ToCL.trAssign, blk)
191                  | InitiallyScope => ToCL.trBlock (vMap, fn (_, _, stm) => [stm], blk)                  | InitiallyScope => ToCL.trBlock (vMap, fn (_, _, stm) => [stm], blk)
192                  | _ => ToC.trBlock (vMap, fn (_, _, stm) => [stm], blk)                  | _ => ToC.trBlock (vMap, fn (_, _, stm) => [stm], blk)
193                (* end case *))                  (* end case *)
194                  end
195          fun exp (ENV{vMap, ...}, e) = ToCL.trExp(vMap, e)          fun exp (ENV{vMap, ...}, e) = ToCL.trExp(vMap, e)
196        end        end
197    
198    (* variables *)    (* variables *)
199      structure Var =      structure Var =
200        struct        struct
201            fun mirror (ty, name) = {
202                    hostTy = ToC.trType ty,
203                    shadowTy = shadowTy ty,
204                    gpuTy = ToCL.trType ty,
205                    hToS = convertToShadow(ty,name),
206                    var = name
207                  }
208          fun name (ToCL.V(_, name)) = name          fun name (ToCL.V(_, name)) = name
209          fun global (Prog{globals, imgGlobals, ...}, name, ty) = let          fun global (Prog{globals, imgGlobals, ...}, name, ty) = let
210                val x = {hostTy = ToC.trType ty, gpuTy = ToCL.trType ty, var = name}                val x = mirror (ty, name)
211                fun isImgGlobal (Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}), name) =                fun isImgGlobal (Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}), name) =
212                      imgGlobals  := (name,dim) :: !imgGlobals                      imgGlobals  := (name,dim) :: !imgGlobals
213                  | isImgGlobal _ =  ()                  | isImgGlobal _ =  ()
# Line 170  Line 219 
219          fun param x = ToCL.V(ToCL.trType(V.ty x), V.name x)          fun param x = ToCL.V(ToCL.trType(V.ty x), V.name x)
220          fun state (Strand{state, ...}, x) = let          fun state (Strand{state, ...}, x) = let
221                val ty = V.ty x                val ty = V.ty x
222                val x' = {hostTy = ToC.trType ty, gpuTy = ToCL.trType ty, var = V.name x}                val x' = mirror (ty, V.name x)
223                in                in
224                  state := x' :: !state;                  state := x' :: !state;
225                  ToCL.V(#gpuTy x', #var x')                  ToCL.V(#gpuTy x', #var x')
# Line 191  Line 240 
240          val scopeGlobal = setScope GlobalScope          val scopeGlobal = setScope GlobalScope
241          val scopeInitially = setScope InitiallyScope          val scopeInitially = setScope InitiallyScope
242          fun scopeStrand (env, svars) = setScope (StrandScope svars) env          fun scopeStrand (env, svars) = setScope (StrandScope svars) env
243          fun scopeMethod (env, svars) = setScope (MethodScope svars) env          fun scopeMethod (env, name, svars) = setScope (MethodScope(name, svars)) env
244        (* bind a TreeIL varaiable to a target variable *)        (* bind a TreeIL varaiable to a target variable *)
245          fun bind (ENV{info, vMap, scope}, x, x') = ENV{          fun bind (ENV{info, vMap, scope}, x, x') = ENV{
246                  info = info,                  info = info,
# Line 213  Line 262 
262                    topDecls = ref [],                    topDecls = ref [],
263                    strands = AtomTable.mkTable (16, Fail "strand table"),                    strands = AtomTable.mkTable (16, Fail "strand table"),
264                    initially = ref(CL.D_Comment["missing initially"]),                    initially = ref(CL.D_Comment["missing initially"]),
265                    numDims = ref(0),                    numDims = ref 0,
266                    imgGlobals = ref[],                    imgGlobals = ref[],
267                    prFn = ref(CL.D_Comment(["No Print Function"]))                    prFn = ref(CL.D_Comment(["No Print Function"]))
268                  })                  })
       (* register the global initialization part of a program *)  
           fun globalIndirects (globals,stms) = let  
                 fun getGlobals ({name,target as TargetUtil.TARGET_CL}::rest) =  
                       CL.mkAssign(CL.mkIndirect(CL.mkVar RN.globalsVarName,name),CL.mkVar name)  
                         ::getGlobals rest  
                   | getGlobals [] = []  
                   | getGlobals (_::rest) = getGlobals rest  
                 in  
                   stms @ getGlobals globals  
                 end  
269    
270        (* register the code that is used to register command-line options for input variables *)        (* register the code that is used to register command-line options for input variables *)
271          fun inputs (Prog{topDecls, ...}, stm) = let          fun inputs (Prog{topDecls, ...}, stm) = let
# Line 240  Line 279 
279    
280        (* register the global initialization part of a program *)        (* register the global initialization part of a program *)
281          fun init (Prog{topDecls, ...}, init) = let          fun init (Prog{topDecls, ...}, init) = let
282                val globPtrTy = CL.T_Ptr(CL.T_Named RN.globalsTy)                val globalsDecl = CL.mkAssign(CL.E_Var RN.globalsVarName,
283                        CL.mkApply("malloc", [CL.mkSizeof(CL.T_Named RN.globalsTy)]))
284                val initFn = CL.D_Func(                val initFn = CL.D_Func(
285                      [], CL.voidTy, RN.initGlobals, [CL.PARAM([], globPtrTy, RN.globalsVarName)],                      [], CL.voidTy, RN.initGlobals, [],
286                        CL.mkBlock[
287                            globalsDecl,
288                            CL.mkCall(RN.initGlobalsHelper, [CL.mkVar RN.globalsVarName])
289                          ])
290                  val initHelperFn = CL.D_Func(
291                        [], CL.voidTy, RN.initGlobalsHelper,
292                        [CL.PARAM([], globPtrTy, RN.globalsVarName)],
293                      init)                      init)
294                val shutdownFn = CL.D_Func(                val shutdownFn = CL.D_Func(
295                      [], CL.voidTy, RN.shutdown,                      [], CL.voidTy, RN.shutdown,
296                      [CL.PARAM([], CL.T_Ptr(CL.T_Named RN.worldTy), "wrld")],                      [CL.PARAM([], CL.T_Ptr(CL.T_Named RN.worldTy), "wrld")],
297                      CL.S_Block[])                      CL.S_Block[])
298                in                in
299                  topDecls := shutdownFn :: initFn :: !topDecls                  topDecls := shutdownFn :: initFn :: initHelperFn :: !topDecls
300                end                end
301    
302           (* create and register the initially function for a program *)           (* create and register the initially function for a program *)
303          fun initially {          fun initially {
304                prog = Prog{name=progName, strands, initially, ...},                prog = Prog{name=progName, strands, initially,numDims, ...},
305                isArray : bool,                isArray : bool,
306                iterPrefix : stm list,                iterPrefix : stm list,
307                iters : (var * exp * exp) list,                iters : (var * exp * exp) list,
# Line 298  Line 346 
346                        CL.mkDecl(strandTy, "sp",                        CL.mkDecl(strandTy, "sp",
347                          SOME(CL.I_Exp(                          SOME(CL.I_Exp(
348                            CL.E_Cast(strandTy,                            CL.E_Cast(strandTy,
349                            CL.E_Apply(N.inState, [CL.E_Var "wrld", CL.E_Var indexVar]))))),                            CL.E_Apply(N.inState, [CL.E_Var "wrld", CL.mkBinOp(CL.mkVar indexVar, CL.#*, CL.mkSizeof(CL.T_Named (N.strandDesc name)))]))))),
350                        CL.mkCall(N.strandInit name, CL.E_Var "sp" :: args),                        CL.mkCall(N.strandInit name, CL.E_Var "sp" :: args),
351                        CL.mkAssign(CL.E_Var indexVar, CL.mkBinOp(CL.E_Var indexVar, CL.#+, CL.E_Int(1, CL.uint32)))                        CL.mkAssign(CL.E_Var indexVar, CL.mkBinOp(CL.E_Var indexVar, CL.#+, CL.E_Int(1, CL.uint32)))
352                      ])                      ])
# Line 323  Line 371 
371                      [CL.mkReturn(SOME(CL.E_Var "wrld"))])                      [CL.mkReturn(SOME(CL.E_Var "wrld"))])
372                val initFn = CL.D_Func([], worldTy, N.initially, [], body)                val initFn = CL.D_Func([], worldTy, N.initially, [], body)
373                in                in
374                    numDims := nDims;
375                  initially := initFn                  initially := initFn
376                end                end
377    
378    
379        (***** OUTPUT *****)        (***** OUTPUT *****)
380    (* FIXME: I think that the iteration and test for stable strands can be moved into the runtime, which
381     * will make the print function compatible with the C target version.
382     *)
383          fun genStrandPrint (Strand{name, tyName, state, output, code,...}) = let          fun genStrandPrint (Strand{name, tyName, state, output, code,...}) = let
384                  (* the print function *)                  (* the print function *)
385                val prFnName = concat[name, "_print"]                val prFnName = concat[name, "_print"]
# Line 366  Line 419 
419                                   prFn                                   prFn
420                end                end
421    
422          fun genStrandTyDef (targetTy, Strand{tyName, state,...}) =          fun genStrandTyDef (targetTy, Strand{state,...},tyName) =
423              (* the type declaration for the strand's state struct *)              (* the type declaration for the strand's state struct *)
424                CL.D_StructDef(                CL.D_StructDef(
425                  List.rev (List.map (fn x => (targetTy x, #var x)) (!state)),                  List.rev (List.map (fn x => (targetTy x, #var x)) (!state)),
426                  tyName)                  tyName)
427    
428    
429          (* generates the load kernel function *)           fun genStrandCopy(Strand{tyName,name,state,...}) = let
430                  val params = [
431                          CL.PARAM([""], CL.T_Ptr(CL.T_Named tyName), "selfIn"),
432                          CL.PARAM([""], CL.T_Ptr(CL.T_Named tyName), "selfOut")
433                      ]
434                    val assignStms = List.rev(List.map(fn x => CL.mkAssign(CL.mkIndirect(CL.E_Var "selfOut", #var x),
435                                                                                                           CL.mkIndirect(CL.E_Var "selfIn", #var x))) (!state))
436                     in
437                            CL.D_Func([""], CL.voidTy, RN.strandCopy name, params,CL.mkBlock(assignStms))
438                     end
439    
440        (* generates the opencl buffers for the image data *)        (* generates the opencl buffers for the image data *)
441          fun getGlobalDataBuffers(globals,contextVar,errVar) = let          fun getGlobalDataBuffers (globals, imgGlobals, contextVar, errVar) = let
442                  val globalBuffErr = "error creating OpenCL global buffer\n"
443                  fun errorFn msg = CL.mkIfThen(CL.mkBinOp(CL.E_Var errVar, CL.#!=, CL.E_Var "CL_SUCCESS"),
444                        CL.mkBlock([CL.mkCall("fprintf",[CL.E_Var "stderr", CL.E_Str msg]),
445                        CL.mkCall("exit",[CL.mkInt 1])]))
446                  val shadowTypeDecl =
447                        CL.mkDecl(CL.T_Named(RN.shadowGlobalsTy), RN.shadowGlaobalsName, NONE)
448                  val globalToShadowStms = List.map (fn (x:mirror_var) => #hToS x ) globals
449                val globalBufferDecl =  CL.mkDecl(clMemoryTy,concat[RN.globalsVarName,"_cl"],NONE)                val globalBufferDecl =  CL.mkDecl(clMemoryTy,concat[RN.globalsVarName,"_cl"],NONE)
450                val globalBuffer = CL.mkAssign(CL.mkVar(concat[RN.globalsVarName,"_cl"]),                val globalBuffer = CL.mkAssign(CL.mkVar(concat[RN.globalsVarName,"_cl"]),
451                      CL.mkApply("clCreateBuffer", [                      CL.mkApply("clCreateBuffer", [
452                          CL.mkVar contextVar,                          CL.mkVar contextVar,
453                          CL.mkVar "CL_MEM_COPY_HOST_PTR",                          CL.mkBinOp(CL.mkVar "CL_MEM_READ_ONLY", CL.#|, CL.mkVar "CL_MEM_COPY_HOST_PTR"),
454                          CL.mkApply("sizeof",[CL.mkVar RN.globalsTy]),                          CL.mkSizeof(CL.T_Named RN.shadowGlobalsTy),
455                          CL.mkVar RN.globalsVarName,                          CL.mkUnOp(CL.%&,CL.mkVar RN.shadowGlaobalsName),
456                          CL.mkUnOp(CL.%&,CL.mkVar errVar)                          CL.mkUnOp(CL.%&,CL.mkVar errVar)
457                        ]))                        ]))
458                  fun genDataBuffers ([],_,_,_) = []
459          fun genDataBuffers([],_,_) = []                  | genDataBuffers ((var,nDims)::globals, contextVar, errVar,errFn) = let
460            | genDataBuffers((var,nDims)::globals,contextVar,errVar) = let                      val hostVar = CL.mkIndirect(CL.mkVar RN.globalsVarName, var)
461  (* FIXME: use CL constructors to  build expressions (not strings) *)                      val size = CL.mkIndirect(hostVar, "dataSzb")
               val size = if nDims = 1  
                     then CL.mkBinOp(CL.mkApply("sizeof",[CL.mkVar "float"]), CL.#*,  
                                          CL.mkIndirect(CL.mkVar var, "size[0]"))  
                                         else if nDims = 2 then  
                                         CL.mkBinOp(CL.mkApply("sizeof",[CL.mkVar "float"]), CL.#*,  
                                           CL.mkIndirect(CL.mkVar var, concat["size[0]", " * ", var, "->size[1]"]))  
                                         else  
                                          CL.mkBinOp(CL.mkApply("sizeof",[CL.mkVar "float"]), CL.#*,  
                                           CL.mkIndirect(CL.mkVar var,concat["size[0]", " * ", var, "->size[1] * ", var, "->size[2]"]))  
   
462                   in                   in
                    CL.mkDecl(clMemoryTy, RN.addBufferSuffix var ,NONE)::  
463                     CL.mkDecl(clMemoryTy, RN.addBufferSuffixData var ,NONE)::                     CL.mkDecl(clMemoryTy, RN.addBufferSuffixData var ,NONE)::
464                     CL.mkAssign(CL.mkVar(RN.addBufferSuffix var), CL.mkApply("clCreateBuffer",                        CL.mkAssign(CL.mkVar(RN.addBufferSuffixData var),
465                                                                  [CL.mkVar contextVar,                          CL.mkApply("clCreateBuffer", [
466                                                                  CL.mkVar "CL_MEM_COPY_HOST_PTR",                              CL.mkVar contextVar,
467                                                                  CL.mkApply("sizeof",[CL.mkVar (RN.imageTy nDims)]),                              CL.mkVar "CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR",
                                                                 CL.mkVar var,  
                                                                 CL.mkUnOp(CL.%&,CL.mkVar errVar)])) ::  
                         CL.mkAssign(CL.mkVar(RN.addBufferSuffixData var), CL.mkApply("clCreateBuffer",  
                                                                 [CL.mkVar contextVar,  
                                                                  CL.mkVar "CL_MEM_COPY_HOST_PTR",  
468                                                                  size,                                                                  size,
469                                                                  CL.mkIndirect(CL.mkVar var,"data"),                              CL.mkIndirect(hostVar, "data"),
470                                                                  CL.mkUnOp(CL.%&,CL.mkVar errVar)])):: genDataBuffers(globals,contextVar,errVar)                              CL.mkUnOp(CL.%&,CL.mkVar errVar)
471                              ])) ::
472                            errFn(concat["error in creating ",RN.addBufferSuffixData var, " global buffer\n"]) ::
473                            genDataBuffers(globals,contextVar,errVar,errFn)
474                  end                  end
475                in                in
476                  [globalBufferDecl] @ [globalBuffer] @ genDataBuffers(globals,contextVar,errVar)                  [shadowTypeDecl] @ globalToShadowStms
477                    @ [globalBufferDecl, globalBuffer,errorFn(globalBuffErr)]
478                    @ genDataBuffers(imgGlobals,contextVar,errVar,errorFn)
479                end                end
480    
   
481  (* generates the kernel arguments for the image data *)  (* generates the kernel arguments for the image data *)
482          fun genGlobalArguments(globals,count,kernelVar,errVar) = let          fun genGlobalArguments(globals,count,kernelVar,errVar) = let
483          val globalArgument = CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.|=,CL.mkApply("clSetKernelArg",                val globalArgErr = "error creating OpenCL global argument\n"
484                  fun errorFn msg = CL.mkIfThen(CL.mkBinOp(CL.E_Var errVar, CL.#!=, CL.E_Var "CL_SUCCESS"),
485                        CL.mkBlock([CL.mkCall("fprintf",[CL.E_Var "stderr", CL.E_Str msg]),
486                        CL.mkCall("exit",[CL.mkInt 1])]))
487                  val globalArgument = CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.&=,
488                        CL.mkApply("clSetKernelArg",
489                                                                  [CL.mkVar kernelVar,                                                                  [CL.mkVar kernelVar,
490                                                                   CL.mkPostOp(CL.E_Var count, CL.^++),                                                                   CL.mkPostOp(CL.E_Var count, CL.^++),
491                                                                   CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),                                                                   CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),
492                                                                   CL.mkUnOp(CL.%&,CL.mkVar(concat[RN.globalsVarName,"_cl"]))])))                                                                   CL.mkUnOp(CL.%&,CL.mkVar(concat[RN.globalsVarName,"_cl"]))])))
493                  fun genDataArguments ([],_,_,_,_) = []
494          fun genDataArguments([],_,_,_) = []                  | genDataArguments ((var,nDims)::globals,count,kernelVar,errVar,errFn) =
495            | genDataArguments((var,nDims)::globals,count,kernelVar,errVar) =                      CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.$=,
496                          CL.mkApply("clSetKernelArg",
                 CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.|=, CL.mkApply("clSetKernelArg",  
497                                  [CL.mkVar kernelVar,                                  [CL.mkVar kernelVar,
498                                   CL.mkPostOp(CL.E_Var count, CL.^++),                                   CL.mkPostOp(CL.E_Var count, CL.^++),
499                                   CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),                                   CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),
500                                   CL.mkUnOp(CL.%&,CL.mkVar(RN.addBufferSuffix var))])))::                           CL.mkUnOp(CL.%&,CL.mkVar(RN.addBufferSuffixData var))]))) ::
501                             errFn(concat["error in creating ",RN.addBufferSuffixData var, " argument\n"]) ::
502                          CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.|=,CL.mkApply("clSetKernelArg",                      genDataArguments (globals,count,kernelVar,errVar,errFn)
                                 [CL.mkVar kernelVar,  
                                  CL.mkPostOp(CL.E_Var count, CL.^++),  
                                  CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),  
                                  CL.mkUnOp(CL.%&,CL.mkVar(RN.addBufferSuffixData var))]))):: genDataArguments (globals,count,kernelVar,errVar)  
   
503          in          in
504                    globalArgument :: errorFn globalArgErr ::
505                  [globalArgument] @ genDataArguments(globals,count,kernelVar,errVar)                    genDataArguments(globals, count, kernelVar, errVar,errorFn)
   
506          end          end
507    
508        (* generates the globals buffers and arguments function *)        (* generates the globals buffers and arguments function *)
509          fun genGlobalBuffersArgs (imgGlobals) = let          fun genGlobalBuffersArgs (globals,imgGlobals) = let
510              (* Delcare opencl setup objects *)              (* Delcare opencl setup objects *)
511                val errVar = "err"                val errVar = "err"
512                val imgDataSizeVar = "image_dataSize"                val imgDataSizeVar = "image_dataSize"
513                val params = [                val params = [
514                        CL.PARAM([],CL.T_Named("cl_context"), "context"),                        CL.PARAM([],CL.T_Named("cl_context"), "context"),
515                        CL.PARAM([],CL.T_Named("cl_kernel"), "kernel"),                        CL.PARAM([],CL.T_Named("cl_kernel"), "kernel"),
516                          CL.PARAM([],CL.T_Named("cl_command_queue"), "cmdQ"),
517                        CL.PARAM([],CL.T_Named("int"), "argStart")                        CL.PARAM([],CL.T_Named("int"), "argStart")
518                      ]                      ]
519                val clGlobalBuffers = getGlobalDataBuffers(!imgGlobals, "context", "err")                val clGlobalBuffers = getGlobalDataBuffers(globals,!imgGlobals, "context", errVar)
520                val clGlobalArguments = genGlobalArguments(!imgGlobals, "argStart", "kernel", "err")                val clGlobalArguments = genGlobalArguments(!imgGlobals, "argStart", "kernel", errVar)
521              (* Body put all the statments together *)              (* Body put all the statments together *)
522                val body =  clGlobalBuffers @ clGlobalArguments                val body = CL.mkDecl(clIntTy, errVar, SOME(CL.I_Exp(CL.mkInt 0)))
523                        :: clGlobalBuffers @ clGlobalArguments
524                in                in
525                  CL.D_Func([],CL.voidTy,RN.globalsSetupName,params,CL.mkBlock(body))                  CL.D_Func([],CL.voidTy,RN.globalsSetupName,params,CL.mkBlock(body))
526                end                end
527    
528        (* generate the data and global parameters *)        (* generate the data and global parameters *)
529          fun genKeneralGlobalParams ((name,tyname)::rest) =          fun genKeneralGlobalParams ((name,tyname)::rest) =
530                CL.PARAM([], CL.T_Ptr(CL.T_Named RN.globalsTy), concat[RN.globalsVarName]) ::                globalParam (CL.T_Ptr(CL.voidTy), RN.addBufferSuffixData name) ::
               CL.PARAM([], CL.T_Ptr(CL.T_Named (RN.imageTy tyname)),RN.addBufferSuffix name) ::  
               CL.PARAM([], CL.T_Ptr(CL.voidTy),RN.addBufferSuffixData name) ::  
531                genKeneralGlobalParams rest                genKeneralGlobalParams rest
532            | genKeneralGlobalParams [] = []            | genKeneralGlobalParams [] = []
533    
       (*generate code for intilizing kernel global data *)  
         fun initKernelGlobals (globals, imgGlobals) = let  
 (* FIXME: should use List.map here *)  
               fun initGlobalStruct ({hostTy, gpuTy, var}::rest) =  
                     CL.mkAssign(CL.mkVar var, CL.mkIndirect(CL.mkVar RN.globalsVarName, var)) ::  
                     initGlobalStruct rest  
                 | initGlobalStruct [] = []  
               fun initGlobalImages ((name, tyname)::rest) =  
                     CL.mkAssign(CL.mkVar name, CL.mkVar (RN.addBufferSuffix name)) ::  
                     CL.mkAssign(CL.mkIndirect(CL.mkVar name,"data"),CL.mkVar (RN.addBufferSuffixData name)) ::  
                     initGlobalImages rest  
                   | initGlobalImages [] = []  
               in  
                 initGlobalStruct globals @ initGlobalImages(imgGlobals)  
               end  
   
534          (* generate the main kernel function for the .cl file *)          (* generate the main kernel function for the .cl file *)
535          fun genKernelFun (strand, nDims, globals, imgGlobals) = let          fun genKernelFun (strand, nDims, globals, imgGlobals) = let
536                val Strand{name, tyName, state, output, code,...} = strand                val Strand{name, tyName, state, output, code,...} = strand
537                val fName = RN.kernelFuncName;                val fName = RN.kernelFuncName;
538                val inState = "strand_in"                val inState = "selfIn"
539                val outState = "strand_out"                val outState = "selfOut"
540                  val tempVar = "tmp"
541    
542                  val (workerOffset,localOffset) = if nDims = 1 then
543                            ( CL.mkApply(RN.getGroupId,[CL.mkInt 0]), CL.mkApply(RN.getLocalThreadId,[CL.mkInt 0]) )
544                           else if nDims = 2 then
545                         (CL.mkBinOp(CL.mkBinOp(CL.mkApply(RN.getGroupId,[CL.mkInt 0]),CL.#*, CL.mkApply(RN.getNumGroups,[CL.mkInt 1])),CL.#+,CL.mkApply(RN.getGroupId,[CL.mkInt 1])),
546                                CL.mkBinOp(CL.mkBinOp(CL.mkApply(RN.getLocalThreadId,[CL.mkInt 0]),CL.#*, CL.mkApply(RN.getLocalSize,[CL.mkInt 1])),CL.#+,CL.mkApply(RN.getLocalThreadId,[CL.mkInt 1])))
547                    else
548                              ( CL.mkBinOp(CL.mkBinOp(CL.mkBinOp(
549                                CL.mkBinOp(CL.mkApply(RN.getGroupId,[CL.mkInt 0]), CL.#*, CL.mkApply(RN.getNumGroups,[CL.mkInt 1])),CL.#*, CL.mkApply(RN.getLocalSize,[CL.mkInt 2])), CL.#+,
550                                CL.mkBinOp(CL.mkApply(RN.getGroupId,[CL.mkInt 1]),CL.#*,CL.mkApply(RN.getLocalSize,[CL.mkInt 1]))),CL.#+,CL.mkApply(RN.getGroupId,[CL.mkInt 2])),
551                               CL.mkBinOp(CL.mkBinOp(CL.mkBinOp(
552                                CL.mkBinOp(CL.mkApply(RN.getLocalThreadId,[CL.mkInt 0]), CL.#*, CL.mkApply(RN.getLocalSize,[CL.mkInt 1])),CL.#*, CL.mkApply(RN.getLocalSize,[CL.mkInt 2])), CL.#+,
553                                CL.mkBinOp(CL.mkApply(RN.getLocalThreadId,[CL.mkInt 1]),CL.#*,CL.mkApply(RN.getLocalSize,[CL.mkInt 1]))),CL.#+,CL.mkApply(RN.getLocalThreadId,[CL.mkInt 2])) )
554    
555                val params = [                val params = [
556                        CL.PARAM(["__global"], CL.T_Ptr(CL.T_Named tyName), "selfIn"),                        globalParam(CL.T_Ptr(CL.T_Named tyName), "strands"),
557                        CL.PARAM(["__global"], CL.T_Ptr(CL.T_Named tyName), "selfOut"),                        globalParam(CL.T_Ptr(CL.intTy), "strandStatus"),
558                        CL.PARAM(["__global"], CL.intTy, "width")                        globalParam(CL.T_Ptr(CL.intTy), "workerQueue"),
559                      ] @ genKeneralGlobalParams(!imgGlobals)                        globalParam(CL.T_Ptr(CL.intTy),"numAvail"),
560                val thread_ids = if nDims = 1                        clParam("",CL.intTy,"numStrands"),
561                      then [                        clParam("",CL.intTy,"limit")] @
562                          CL.mkDecl(CL.intTy, "x", SOME(CL.I_Exp(CL.mkInt(0, CL.intTy)))),                        [globalParam(globPtrTy, RN.globalsVarName)] @
563                          CL.mkAssign(CL.mkVar "x",CL.mkApply(RN.getGlobalThreadId,[CL.mkInt(0,CL.intTy)]))                        genKeneralGlobalParams(!imgGlobals)
564                        ]  
565                      else [              val index_ids = [
566                          CL.mkDecl(CL.intTy, "x", SOME(CL.I_Exp(CL.mkInt(0, CL.intTy)))),                            CL.mkDecl(CL.intTy, "workerIndex",
567                          CL.mkDecl(CL.intTy, "y", SOME(CL.I_Exp(CL.mkInt(0, CL.intTy)))),                              SOME(CL.I_Exp(workerOffset))),
568                          CL.mkAssign(CL.mkVar "x",  CL.mkApply(RN.getGlobalThreadId,[CL.mkInt(0,CL.intTy)])),                            CL.mkDecl(CL.intTy, "strandIndex",
569                          CL.mkAssign(CL.mkVar "y",CL.mkApply(RN.getGlobalThreadId,[CL.mkInt(1,CL.intTy)]))                              SOME(CL.I_Exp(CL.mkBinOp(CL.mkSubscript(CL.mkVar "workQueue",CL.mkVar "workerIndex"),CL.#+,CL.mkBinOp(localOffset,CL.#*,CL.mkVar "limit")))))
570                        ]                        ]
571    
572                val strandDecl = [                val strandDecl = [
573                      CL.mkDecl(CL.T_Named tyName, inState, NONE),                        CL.mkDecl(CL.T_Named tyName, "selfIn", NONE),
574                      CL.mkDecl(CL.T_Named tyName, outState,NONE)]                        CL.mkDecl(CL.T_Named tyName, "selfOut", NONE)
               val strandObjects  = if nDims = 1  
                         then [  
                             CL.mkAssign( CL.mkVar inState, CL.mkSubscript(CL.mkVar "selfIn", CL.mkStr "x")),  
                             CL.mkAssign(CL.mkVar outState,CL.mkSubscript(CL.mkVar "selfOut", CL.mkStr "x"))  
575                            ]                            ]
576                          else let                val imageDataDecl = CL.mkDecl(CL.T_Named(RN.imageDataType),RN.globalImageDataName,NONE)
577                                  val index = CL.mkBinOp(CL.mkBinOp(CL.mkVar "x",CL.#*,CL.mkVar "width"),CL.#+,CL.mkVar "y")                val imageDataStms = List.map (fn (x,_) =>
578                                  in                    CL.mkAssign(CL.mkSelect(CL.mkVar(RN.globalImageDataName),RN.imageDataName x),
579                                          [CL.mkAssign(CL.mkVar inState, CL.mkSubscript(CL.mkVar "selfIn",index)),                                CL.mkVar(RN.addBufferSuffixData x))) (!imgGlobals)
580                                           CL.mkAssign(CL.mkVar outState,CL.mkSubscript(CL.mkVar "selfOut",index))]  
581                                  end              val status = [CL.mkDecl(CL.intTy, "status", NONE)]
582                val status = CL.mkDecl(CL.intTy, "status", SOME(CL.I_Exp(CL.mkInt(0, CL.intTy))))  
583                val local_vars =  thread_ids @ initKernelGlobals(!globals,!imgGlobals)  @ strandDecl @ strandObjects @ [status]  
584                val while_exp = CL.mkBinOp(CL.mkBinOp(CL.mkVar "status",CL.#!=, CL.mkVar RN.kStabilize),CL.#||,CL.mkBinOp(CL.mkVar "status", CL.#!=, CL.mkVar RN.kDie))         fun strandCopy(inStrand, outStrand) = CL.mkCall(RN.strandCopy name,[inStrand,outStrand])
585                val whileBody = CL.mkBlock [         val updateStm =  CL.mkAssign(CL.mkVar "status",
                       CL.mkAssign(CL.mkVar "status",  
586                          CL.mkApply(RN.strandUpdate name,                          CL.mkApply(RN.strandUpdate name,
587                            [CL.mkUnOp(CL.%&,CL.mkVar inState), CL.mkUnOp(CL.%&,CL.mkVar outState)])),                            [CL.mkUnOp(CL.%&,CL.mkVar inState),
588                        CL.mkCall(RN.strandStabilize name,                             CL.mkUnOp(CL.%&,CL.mkVar outState),
589                          [CL.mkUnOp(CL.%&,CL.mkVar inState), CL.mkUnOp(CL.%&,CL.mkVar outState)])                             CL.mkVar RN.globalsVarName,
590                      ]                             CL.mkVar RN.globalImageDataName]))
591                val whileBlock = [CL.mkWhile(while_exp, whileBody)]  
592                val body = CL.mkBlock(local_vars  @ whileBlock)                (*      CL.mkBlock([CL.mkAssign(CL.mkSubscript(CL.mkVar "strandStatus",CL.mkVar "strandIndex"),CL.mkVar RN.kStable),
593                                    strandCopy(CL.mkUnOp(CL.%&,CL.mkVar "selfOut"),CL.mkBinOp(CL.mkVar "strands", CL.#+, CL.mkVar "strandIndex")),
594                                    CL.mkCall(RN.atom_dec,[CL.mkUnOp(CL.%&,CL.mkSubcript(CL.mkVar "numAvail",CL.mkInt 0))])]),
595                        CL.mkBlock([CL.mkIfThen(CL.mkBinOp(CL.E_Var "status", CL.#==, CL.E_Var RN.kDie),
596                                    CL.mkBlock([CL.mkAssign(CL.mkSubscript(CL.mkVar "strandStatus",CL.mkVar "strandIndex"),CL.mkVar RN.kDie),
597                                    strandCopy(CL.mkUnOp(CL.%&,CL.mkVar "selfOut"),CL.mkBinOp(CL.mkVar "strands", CL.#+, CL.mkVar "strandIndex")),
598                                    CL.mkCall(RN.atom_dec,[CL.mkUnOp(CL.%&,CL.mkSubscript(CL.mkVar "numAvail",CL.mkInt 0))])])) *)
599    
600           val statusIf = CL.mkIfThenElse(CL.mkBinOp(CL.E_Var "status", CL.#==, CL.E_Var RN.kStabilize),
601                        CL.mkBlock([CL.mkAssign(CL.mkSubscript(CL.mkVar "strandStatus",CL.mkVar "strandIndex"),CL.mkVar RN.kStable),
602                                    strandCopy(CL.mkUnOp(CL.%&,CL.mkVar "selfOut"),CL.mkBinOp(CL.mkVar "strands", CL.#+, CL.mkVar "strandIndex")),
603                                    CL.mkCall(RN.atom_dec,[CL.mkUnOp(CL.%&,CL.mkSubscript(CL.mkVar "numAvail",CL.mkInt 0))])]),
604                        CL.mkBlock([CL.mkIfThen(CL.mkBinOp(CL.E_Var "status", CL.#==, CL.E_Var RN.kDie),
605                                    CL.mkBlock([CL.mkAssign(CL.mkSubscript(CL.mkVar "strandStatus",CL.mkVar "strandIndex"),CL.mkVar RN.kDie),
606                                    strandCopy(CL.mkUnOp(CL.%&,CL.mkVar "selfOut"),CL.mkBinOp(CL.mkVar "strands", CL.#+, CL.mkVar "strandIndex")),
607                                    CL.mkCall(RN.atom_dec,[CL.mkUnOp(CL.%&,CL.mkSubscript(CL.mkVar "numAvail",CL.mkInt 0))])]))]))
608    
609           val incStrand = CL.mkExpStm(CL.mkPostOp(CL.mkVar "strandIndex",CL.^++))
610    
611            val forStablize = CL.mkFor( [(CL.intTy,"idx",CL.mkInt 0)], CL.mkBinOp(CL.mkBinOp(CL.mkVar "idx", CL.#<, CL.mkVar "limit"),CL.#&&,
612                                                                         CL.mkBinOp(CL.mkVar "strandIndex", CL.#<, CL.mkVar "numStrands")),
613                                           [CL.mkPostOp(CL.mkVar "idx", CL.^++)], CL.mkBlock(
614                                           [
615                                             strandCopy(CL.mkBinOp(CL.mkVar "strands", CL.#+, CL.mkVar "strandIndex"),CL.mkUnOp(CL.%&,CL.mkVar "selfIn")),
616                                             updateStm,
617                                             statusIf,
618                                             incStrand
619                                           ]))
620    
621                  val local_vars = index_ids
622                        @ [imageDataDecl]
623                        @ imageDataStms
624                        @ strandDecl
625                        @ status
626    
627                  val body = CL.mkBlock(local_vars @ [forStablize])
628                in                in
629                  CL.D_Func(["__kernel"], CL.voidTy, fName, params, body)                  CL.D_Func(["__kernel"], CL.voidTy, fName, params, body)
630                end                end
631        (* generate a global structure from the globals *)  
632          fun genGlobalStruct (targetTy, globals) = let        (* generate a global structure type definition from the list of globals *)
633            fun genGlobalStruct (targetTy, globals, tyName) = let
634                val globs = List.map (fn (x : mirror_var) => (targetTy x, #var x)) globals                val globs = List.map (fn (x : mirror_var) => (targetTy x, #var x)) globals
635                in                in
636                  CL.D_StructDef(globs, RN.globalsTy)                  CL.D_StructDef(globs, tyName)
637                  end
638    
639          (* generate a global structure type definition from the image data of the image globals *)
640            fun genImageDataStruct (imgGlobals, tyName) = let
641                  val globs = List.map
642                        (fn (x, _) => (globalPtr CL.voidTy, RN.imageDataName x))
643                          imgGlobals
644                  in
645                    CL.D_StructDef(globs, tyName)
646                end                end
647    
648          fun genGlobals (declFn, targetTy, globals) = let          fun genGlobals (declFn, targetTy, globals) = let
649                fun doVar (x : mirror_var) = declFn (CL.D_Var([], targetTy x, #var x, NONE))                fun doVar (x : mirror_var) = declFn (CL.D_Var([], targetTy x, #var x, NONE))
650                in                in
651                  List.app doVar globals                  List.app doVar globals
652                end                end
653    
654          fun genSrc (baseName, Prog{double,globals, topDecls, strands, initially,imgGlobals,numDims,...}) = let          fun genStrandDesc (Strand{name, output, ...}) = let
655                (* the strand's descriptor object *)
656                  val descI = let
657                        fun fnPtr (ty, f) = CL.I_Exp(CL.mkCast(CL.T_Named ty, CL.mkVar f))
658                        val SOME(outTy, _) = !output
659                        in
660                          CL.I_Struct[
661                              ("name", CL.I_Exp(CL.mkStr name)),
662                              ("stateSzb", CL.I_Exp(CL.mkSizeof(CL.T_Named(RN.strandTy name)))),
663    (*
664                              ("outputSzb", CL.I_Exp(CL.mkSizeof(ToC.trTy outTy))),
665    *)
666                              ("update", fnPtr("update_method_t", "0")),
667                              ("print", fnPtr("print_method_t", name ^ "_print"))
668                            ]
669                        end
670                  val desc = CL.D_Var([], CL.T_Named N.strandDescTy, N.strandDesc name, SOME descI)
671                  in
672                    desc
673                  end
674    
675          (* generate the table of strand descriptors *)
676            fun genStrandTable (declFn, strands) = let
677                  val nStrands = length strands
678                  fun genInit (Strand{name, ...}) = CL.I_Exp(CL.mkUnOp(CL.%&, CL.E_Var(N.strandDesc name)))
679                  fun genInits (_, []) = []
680                    | genInits (i, s::ss) = (i, genInit s) :: genInits(i+1, ss)
681                  in
682                    declFn (CL.D_Var([], CL.int32, N.numStrands,
683                      SOME(CL.I_Exp(CL.E_Int(IntInf.fromInt nStrands, CL.int32)))));
684                    declFn (CL.D_Var([],
685                      CL.T_Array(CL.T_Ptr(CL.T_Named N.strandDescTy), SOME nStrands),
686                      N.strands,
687                      SOME(CL.I_Array(genInits (0, strands)))))
688                  end
689    
690            fun genSrc (baseName, prog) = let
691                  val Prog{name,double, globals, topDecls, strands, initially, imgGlobals, numDims, ...} = prog
692                val clFileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "cl"}                val clFileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "cl"}
693                val cFileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}                val cFileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
694                val clOutS = TextIO.openOut clFileName                val clOutS = TextIO.openOut clFileName
695                val cOutS = TextIO.openOut cFileName                val cOutS = TextIO.openOut cFileName
 (* FIXME: need to use PrintAsC and PrintAsCL *)  
696                val clppStrm = PrintAsCL.new clOutS                val clppStrm = PrintAsCL.new clOutS
697                val cppStrm = PrintAsC.new cOutS                val cppStrm = PrintAsC.new cOutS
698                  val progName = name
699                fun cppDecl dcl = PrintAsC.output(cppStrm, dcl)                fun cppDecl dcl = PrintAsC.output(cppStrm, dcl)
700                fun clppDecl dcl = PrintAsCL.output(clppStrm, dcl)                fun clppDecl dcl = PrintAsCL.output(clppStrm, dcl)
701                val strands = AtomTable.listItems strands                val strands = AtomTable.listItems strands
# Line 576  Line 709 
709                      "#define DIDEROT_TARGET_CL",                      "#define DIDEROT_TARGET_CL",
710                      "#include \"Diderot/cl-diderot.h\""                      "#include \"Diderot/cl-diderot.h\""
711                    ]));                    ]));
712                  genGlobals (clppDecl, #gpuTy, !globals);                  clppDecl (genGlobalStruct (#gpuTy, !globals, RN.globalsTy));
713                  clppDecl (genGlobalStruct (#gpuTy, !globals));                  clppDecl (genImageDataStruct(!imgGlobals,RN.imageDataType));
714                  clppDecl (genStrandTyDef(#gpuTy, strand));                  clppDecl (genStrandTyDef(#gpuTy, strand,tyName));
715                    clppDecl (genStrandCopy(strand));
716                  List.app clppDecl (!code);                  List.app clppDecl (!code);
717                  clppDecl (genKernelFun (strand, !numDims, globals, imgGlobals));                  clppDecl (genKernelFun (strand, !numDims, globals, imgGlobals));
   
718                (* Generate the Host C file *)                (* Generate the Host C file *)
719                  cppDecl (CL.D_Verbatim([                  cppDecl (CL.D_Verbatim([
720                      if double                      if double
# Line 590  Line 723 
723                      "#define DIDEROT_TARGET_CL",                      "#define DIDEROT_TARGET_CL",
724                      "#include \"Diderot/diderot.h\""                      "#include \"Diderot/diderot.h\""
725                    ]));                    ]));
726                  genGlobals (cppDecl, #hostTy, !globals);                  cppDecl (CL.D_Var(["static"], CL.charPtr, "ProgramName",
727                  cppDecl (genGlobalStruct (#hostTy, !globals));                    SOME(CL.I_Exp(CL.mkStr progName))));
728                  cppDecl (genStrandTyDef (#gpuTy, strand));                  cppDecl (genGlobalStruct (#hostTy, !globals, RN.globalsTy));
729                    cppDecl (genGlobalStruct (#shadowTy, !globals, RN.shadowGlobalsTy));
730    (* FIXME: does this really need to be a global? *)
731                    cppDecl (CL.D_Var(["static"], globPtrTy, RN.globalsVarName, NONE));
732                    cppDecl (genStrandTyDef (#hostTy, strand, tyName));
733                  cppDecl  (!init_code);                  cppDecl  (!init_code);
734                  cppDecl (genStrandPrint strand);                  cppDecl (genStrandPrint strand);
735                  List.app cppDecl (List.rev (!topDecls));                  List.app cppDecl (List.rev (!topDecls));
736                  cppDecl (genGlobalBuffersArgs (imgGlobals));                  cppDecl (genGlobalBuffersArgs (!globals,imgGlobals));
737                    List.app (fn strand => cppDecl (genStrandDesc strand)) strands;
738                    genStrandTable (cppDecl, strands);
739                  cppDecl (!initially);                  cppDecl (!initially);
740                  PrintAsC.close cppStrm;                  PrintAsC.close cppStrm;
741                  PrintAsCL.close clppStrm;                  PrintAsCL.close clppStrm;
# Line 604  Line 743 
743                  TextIO.closeOut clOutS                  TextIO.closeOut clOutS
744                end                end
745    
746        (* output the code to a file.  The string is the basename of the file, the extension        (* output the code to the filesystem.  The string is the basename of the source file *)
        * is provided by the target.  
        *)  
747          fun generate (basename, prog as Prog{double, parallel, debug, ...}) = let          fun generate (basename, prog as Prog{double, parallel, debug, ...}) = let
748                fun condCons (true, x, xs) = x::xs                fun condCons (true, x, xs) = x::xs
749                  | condCons (false, _, xs) = xs                  | condCons (false, _, xs) = xs
# Line 632  Line 769 
769                  RunCC.link (basename, ldOpts)                  RunCC.link (basename, ldOpts)
770                end                end
771    
772        end        end (* Program *)
773    
774    (* strands *)    (* strands *)
775      structure Strand =      structure Strand =
# Line 661  Line 798 
798          fun init (Strand{name, tyName, code,init_code, ...}, params, init) = let          fun init (Strand{name, tyName, code,init_code, ...}, params, init) = let
799                val fName = RN.strandInit name                val fName = RN.strandInit name
800                val params =                val params =
801                      CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut") ::                      clParam ("",CL.T_Ptr(CL.T_Named tyName), "selfOut") ::
802                        List.map (fn (ToCL.V(ty, x)) => CL.PARAM([], ty, x)) params                        List.map (fn (ToCL.V(ty, x)) => CL.PARAM([], ty, x)) params
803                val initFn = CL.D_Func([], CL.voidTy, fName, params, init)                val initFn = CL.D_Func([], CL.voidTy, fName, params, init)
804                in                in
# Line 670  Line 807 
807    
808        (* register a strand method *)        (* register a strand method *)
809          fun method (Strand{name, tyName, code,...}, methName, body) = let          fun method (Strand{name, tyName, code,...}, methName, body) = let
810                val fName = concat[name, "_", methName]                val fName = concat[name, "_", MethodName.toString methName]
811                val params = [                val params = [
812                        CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfIn"),                        clParam ("",CL.T_Ptr(CL.T_Named tyName), "selfIn"),
813                        CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut")                        clParam ("",CL.T_Ptr(CL.T_Named tyName), "selfOut"),
814                          globalParam (CL.T_Ptr(CL.T_Named (RN.globalsTy)), RN.globalsVarName),
815                          CL.PARAM([],CL.T_Named(RN.imageDataType),RN.globalImageDataName)
816                      ]                      ]
817                val methFn = CL.D_Func([], CL.int32, fName, params, body)                val resTy = (case methName
818                         of MethodName.Update => CL.T_Named "StrandStatus_t"
819                          | MethodName.Stabilize => CL.voidTy
820                        (* end case *))
821                  val methFn = CL.D_Func([], resTy, fName, params, body)
822                in                in
823                  code := methFn :: !code                  code := methFn :: !code
824                end                end

Legend:
Removed from v.1307  
changed lines
  Added in v.1460

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