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 1315, Sat Jun 11 21:10:15 2011 UTC revision 1430, Tue Jul 5 16:02:02 2011 UTC
# Line 15  Line 15 
15      structure ToCL = TreeToCL      structure ToCL = TreeToCL
16      structure N = CNames      structure N = CNames
17    
18      (* translate TreeIL types to shadow types *)
19        fun shadowTy ty = (case ty
20               of Ty.BoolTy => CL.T_Named "cl_bool"
21                | Ty.StringTy => raise Fail "unexpected string type"
22                | Ty.IVecTy 1 => CL.T_Named(RN.shadowIntTy ())
23                | Ty.IVecTy n => raise Fail "unexpected int vector type"
24                | 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 *))
30    
31       (* translate TreeIL types to shadow types *)
32        fun convertToShadow (ty, name) = (case ty
33               of Ty.IVecTy 1 => CL.mkAssign(
34                    CL.mkSelect(CL.mkVar(RN.shadowGlaobalsName),name),
35                    CL.mkIndirect(CL.mkVar(RN.globalsVarName), name))
36                | Ty.TensorTy[n]=> CL.mkCall(RN.convertToShadowVec n, [
37                      CL.mkSelect(CL.mkVar(RN.shadowGlaobalsName),name),
38                      CL.mkIndirect(CL.mkVar(RN.globalsVarName), name)
39                    ])
40                | 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 *))
53    
54      (* 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 =
66        struct        struct
# Line 56  Line 102 
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 79  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 115  Line 165 
165          fun fragment (ENV{info, vMap, scope}, blk) = let          fun fragment (ENV{info, vMap, scope}, blk) = let
166                val (vMap, stms) = (case scope                val (vMap, stms) = (case scope
167                       of GlobalScope => ToC.trFragment (vMap, blk)                       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)                        | InitiallyScope => ToC.trFragment (vMap, blk)
170                        | _ => ToCL.trFragment (vMap, blk)                        | _ => ToCL.trFragment (vMap, blk)
171                      (* end case *))                      (* end case *))
# Line 134  Line 185 
185                  case scope                  case scope
186  (* NOTE: if we move strand initialization to the GPU, then we'll have to change the following code! *)  (* NOTE: if we move strand initialization to the GPU, then we'll have to change the following code! *)
187                   of StrandScope stateVars =>                   of StrandScope stateVars =>
188                        ToC.trBlock (vMap, saveState "StrandScope" stateVars ToC.trAssign, blk)                        ToCL.trBlock (vMap, saveState "StrandScope" stateVars ToCL.trAssign, blk)
189                    | MethodScope stateVars =>                    | MethodScope stateVars =>
190                        ToCL.trBlock (vMap, saveState "MethodScope" stateVars ToCL.trAssign, blk)                        ToCL.trBlock (vMap, saveState "MethodScope" stateVars ToCL.trAssign, blk)
191                    | InitiallyScope => ToC.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                end
# Line 147  Line 198 
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 161  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 204  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                  })                  })
269        (* register the global initialization part of a program *)  
 (* FIXME: unused code; can this be removed??  
           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  
 *)  
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
272                val inputsFn = CL.D_Func(                val inputsFn = CL.D_Func(
# Line 232  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 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 273  Line 330 
330                        CL.mkDecl(CL.T_Array(CL.int32, SOME nDims), "base", SOME(CL.I_Array baseInit)),                        CL.mkDecl(CL.T_Array(CL.int32, SOME nDims), "base", SOME(CL.I_Array baseInit)),
331                        CL.mkDecl(CL.T_Array(CL.uint32, SOME nDims), "size", SOME(CL.I_Array sizeInit)),                        CL.mkDecl(CL.T_Array(CL.uint32, SOME nDims), "size", SOME(CL.I_Array sizeInit)),
332                        CL.mkDecl(worldTy, wrld,                        CL.mkDecl(worldTy, wrld,
333                          SOME(CL.I_Exp(CL.E_Apply(N.allocInitially, [                          SOME(CL.I_Exp(CL.E_Apply(RN.allocInitially, [
334                              CL.mkVar "ProgramName",                              CL.mkVar "ProgramName",
335                              CL.mkUnOp(CL.%&, CL.E_Var(N.strandDesc name)),                              CL.mkUnOp(CL.%&, CL.E_Var(N.strandDesc name)),
336                              CL.E_Bool isArray,                              CL.E_Bool isArray,
# Line 282  Line 339 
339                              CL.E_Var "size"                              CL.E_Var "size"
340                            ]))))                            ]))))
341                      ]                      ]
             (* create the loop nest for the initially iterations *)  
               val indexVar = "ix"  
               val strandTy = CL.T_Ptr(CL.T_Named(N.strandTy name))  
               fun mkLoopNest [] = CL.mkBlock(createPrefix @ [  
                       CL.mkDecl(strandTy, "sp",  
                         SOME(CL.I_Exp(  
                           CL.E_Cast(strandTy,  
                           CL.E_Apply(N.inState, [CL.E_Var "wrld", CL.E_Var indexVar]))))),  
                       CL.mkCall(N.strandInit name,  
                         CL.E_Var RN.globalsVarName :: CL.E_Var "sp" :: args),  
                       CL.mkAssign(CL.E_Var indexVar, CL.mkBinOp(CL.E_Var indexVar, CL.#+, CL.E_Int(1, CL.uint32)))  
                     ])  
                 | mkLoopNest ((CL.V(ty, param), lo, hi)::iters) = let  
                     val body = mkLoopNest iters  
                     in  
                       CL.mkFor(  
                         [(ty, param, lo)],  
                         CL.mkBinOp(CL.E_Var param, CL.#<=, hi),  
                         [CL.mkPostOp(CL.E_Var param, CL.^++)],  
                         body)  
                     end  
               val iterCode = [  
                       CL.mkComment["initially"],  
                       CL.mkDecl(CL.uint32, indexVar, SOME(CL.I_Exp(CL.E_Int(0, CL.uint32)))),  
                       mkLoopNest iters  
                     ]  
342                val body = CL.mkBlock(                val body = CL.mkBlock(
343                      iterPrefix @                      iterPrefix @
344                      allocCode @                      allocCode @
                     iterCode @  
345                      [CL.mkReturn(SOME(CL.E_Var "wrld"))])                      [CL.mkReturn(SOME(CL.E_Var "wrld"))])
346                val initFn = CL.D_Func([], worldTy, N.initially, [CL.PARAM([], globPtrTy, RN.globalsVarName)], body)                val initFn = CL.D_Func([], worldTy, N.initially, [], body)
347                in                in
348                    numDims := nDims;
349                  initially := initFn                  initially := initFn
350                end                end
351    
352        (***** OUTPUT *****)        (***** OUTPUT *****)
353    (* FIXME: I think that the iteration and test for stable strands can be moved into the runtime, which
354     * will make the print function compatible with the C target version.
355     *)
356          fun genStrandPrint (Strand{name, tyName, state, output, code,...}) = let          fun genStrandPrint (Strand{name, tyName, state, output, code,...}) = let
357              (* the print function *)              (* the print function *)
358                val prFnName = concat[name, "_print"]                val prFnName = concat[name, "Print"]
359                val prFn = let                val prFn = let
360                      val params = [                      val params = [
361                              CL.PARAM([], CL.T_Ptr(CL.T_Named "FILE"), "outS"),                              CL.PARAM([], CL.T_Ptr(CL.T_Named "FILE"), "outS"),
362                              CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "self")                              CL.PARAM([], CL.T_Ptr(CL.T_Num(RawTypes.RT_UInt8)),"status"),
363                                CL.PARAM([], CL.intTy,"numStrands"),
364                                CL.PARAM([], CL.T_Ptr(CL.T_Named (RN.strandShadowTy name)), "self")
365                            ]                            ]
366                      val SOME(ty, x) = !output                      val SOME(ty, x) = !output
367                      val outState = CL.mkIndirect(CL.mkVar "self", x)                      val unshadowFields = (case ty
368                               of Ty.IVecTy d =>  [
369                                      CL.mkDecl(ToC.trType ty,x,NONE),
370                                      CL.mkCall(RN.unshadowVec d,[CL.mkVar(x),
371                                        CL.mkSelect(CL.mkSubscript(CL.mkVar "self", CL.E_Var "i"), x)])
372                                    ]
373                                | Ty.TensorTy[d] => [
374                                      CL.mkDecl(ToC.trType ty,x,NONE),
375                                      CL.mkCall(RN.unshadowVec d,[CL.mkVar(x),
376                                        CL.mkSelect(CL.mkSubscript(CL.mkVar "self", CL.E_Var "i"), x)])
377                                    ]
378                                | _ => []
379                              (* end case *))
380                        val outState =  (case ty
381                               of Ty.IVecTy 1 =>CL.mkSelect(CL.mkSubscript(CL.mkVar "self", CL.E_Var "i"), x)
382                                | Ty.TensorTy[] => CL.mkSelect(CL.mkSubscript(CL.mkVar "self", CL.E_Var "i"), x)
383                                | Ty.IVecTy d =>CL.mkVar(x)
384                                | Ty.TensorTy[d] =>CL.mkVar(x)
385                                | _ => raise Fail("genStrand: unsupported output type " ^ Ty.toString ty)
386                              (* end case *))
387                      val prArgs = (case ty                      val prArgs = (case ty
388                             of Ty.IVecTy 1 => [CL.E_Str(!N.gIntFormat ^ "\n"), outState]                             of Ty.IVecTy 1 => [CL.E_Str(!N.gIntFormat ^ "\n"), outState]
389                              | Ty.IVecTy d => let                              | Ty.IVecTy d => let
# Line 350  Line 405 
405                                  end                                  end
406                              | _ => raise Fail("genStrand: unsupported output type " ^ Ty.toString ty)                              | _ => raise Fail("genStrand: unsupported output type " ^ Ty.toString ty)
407                            (* end case *))                            (* end case *))
408                        val forBody = CL.mkIfThen(
409                              CL.mkBinOp(CL.mkSubscript(CL.E_Var "status",CL.E_Var "i"), CL.#==, CL.E_Var "DIDEROT_STABILIZE"),
410                              CL.mkBlock(unshadowFields@[CL.mkCall("fprintf", CL.mkVar "outS" :: prArgs)]))
411                        val body =  CL.mkFor(
412                            [(CL.intTy, "i", CL.mkInt 0)],
413                            CL.mkBinOp(CL.E_Var "i", CL.#<, CL.E_Var "numStrands"),
414                            [CL.mkPostOp(CL.E_Var "i", CL.^++)],
415                            forBody)
416                      in                      in
417                        CL.D_Func(["static"], CL.voidTy, prFnName, params,                        CL.D_Func(["static"], CL.voidTy, prFnName, params, body)
                         CL.mkCall("fprintf", CL.mkVar "outS" :: prArgs))  
418                      end                      end
419                in                in
420                  prFn                  prFn
421                end                end
422    
423          fun genStrandTyDef (targetTy, Strand{tyName, state,...}) =          fun genStrandTyDef (targetTy, Strand{state,...},tyName) =
424              (* the type declaration for the strand's state struct *)              (* the type declaration for the strand's state struct *)
425                CL.D_StructDef(                CL.D_StructDef(
426                  List.rev (List.map (fn x => (targetTy x, #var x)) (!state)),                  List.rev (List.map (fn x => (targetTy x, #var x)) (!state)),
427                  tyName)                  tyName)
428    
       (* generates the load kernel function *)  
   
429        (* generates the opencl buffers for the image data *)        (* generates the opencl buffers for the image data *)
430          fun getGlobalDataBuffers (globals,contextVar,errVar) = let          fun getGlobalDataBuffers (globals, imgGlobals, contextVar, errVar) = let
431                  val globalBuffErr = "error creating OpenCL global buffer"
432                  fun errorFn msg = CL.mkIfThen(CL.mkBinOp(CL.E_Var errVar, CL.#!=, CL.E_Var "CL_SUCCESS"),
433                        CL.mkBlock([CL.mkCall("fprintf",[CL.E_Var "stderr", CL.E_Str msg]),
434                        CL.mkCall("exit",[CL.mkInt 1])]))
435                  val shadowTypeDecl =
436                        CL.mkDecl(CL.T_Named(RN.shadowGlobalsTy), RN.shadowGlaobalsName, NONE)
437                  val globalToShadowStms = List.map (fn (x:mirror_var) => #hToS x ) globals
438                val globalBufferDecl =  CL.mkDecl(clMemoryTy,concat[RN.globalsVarName,"_cl"],NONE)                val globalBufferDecl =  CL.mkDecl(clMemoryTy,concat[RN.globalsVarName,"_cl"],NONE)
439                val globalBuffer = CL.mkAssign(CL.mkVar(concat[RN.globalsVarName,"_cl"]),                val globalBuffer = CL.mkAssign(CL.mkVar(concat[RN.globalsVarName,"_cl"]),
440                      CL.mkApply("clCreateBuffer", [                      CL.mkApply("clCreateBuffer", [
441                          CL.mkVar contextVar,                          CL.mkVar contextVar,
442                          CL.mkVar "CL_MEM_COPY_HOST_PTR",                          CL.mkBinOp(CL.mkVar "CL_MEM_READ_ONLY", CL.#|, CL.mkVar "CL_MEM_COPY_HOST_PTR"),
443                          CL.mkApply("sizeof",[CL.mkVar RN.globalsTy]),                          CL.mkSizeof(CL.T_Named RN.shadowGlobalsTy),
444                          CL.mkVar RN.globalsVarName,                          CL.mkUnOp(CL.%&,CL.mkVar RN.shadowGlaobalsName),
445                          CL.mkUnOp(CL.%&,CL.mkVar errVar)                          CL.mkUnOp(CL.%&,CL.mkVar errVar)
446                        ]))                        ]))
447                fun genDataBuffers ([],_,_) = []                fun genDataBuffers ([],_,_,_) = []
448                  | genDataBuffers ((var,nDims)::globals, contextVar, errVar) = let                  | genDataBuffers ((var,nDims)::globals, contextVar, errVar,errFn) = let
449                      val hostVar = CL.mkIndirect(CL.mkVar RN.globalsVarName, var)                      val hostVar = CL.mkIndirect(CL.mkVar RN.globalsVarName, var)
450  (* FIXME: use CL constructors to build expressions (not strings) *)                      val size = CL.mkIndirect(hostVar, "dataSzb")
                     fun sizeExp i = CL.mkSubscript(CL.mkIndirect(hostVar, "size"), CL.mkInt i)  
                     val size = CL.mkBinOp(CL.mkApply("sizeof",[CL.mkVar "float"]), CL.#*, sizeExp 0)  
                     val size = if (nDims > 1)  
                           then CL.mkBinOp(size, CL.#*, sizeExp 1)  
                           else size  
                     val size = if (nDims > 2)  
                           then CL.mkBinOp(size, CL.#*, sizeExp 2)  
                           else size  
451                      in                      in
                       CL.mkDecl(clMemoryTy, RN.addBufferSuffix var ,NONE)::  
452                        CL.mkDecl(clMemoryTy, RN.addBufferSuffixData var ,NONE)::                        CL.mkDecl(clMemoryTy, RN.addBufferSuffixData var ,NONE)::
                       CL.mkAssign(CL.mkVar(RN.addBufferSuffix var),  
                         CL.mkApply("clCreateBuffer", [  
                             CL.mkVar contextVar,  
                             CL.mkVar "CL_MEM_COPY_HOST_PTR",  
                             CL.mkApply("sizeof",[CL.mkVar (RN.imageTy nDims)]),  
                             hostVar,  
                             CL.mkUnOp(CL.%&,CL.mkVar errVar)  
                           ])) ::  
453                        CL.mkAssign(CL.mkVar(RN.addBufferSuffixData var),                        CL.mkAssign(CL.mkVar(RN.addBufferSuffixData var),
454                          CL.mkApply("clCreateBuffer", [                          CL.mkApply("clCreateBuffer", [
455                              CL.mkVar contextVar,                              CL.mkVar contextVar,
456                              CL.mkVar "CL_MEM_COPY_HOST_PTR",                              CL.mkVar "CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR",
457                              size,                              size,
458                              CL.mkIndirect(hostVar, "data"),                              CL.mkIndirect(hostVar, "data"),
459                              CL.mkUnOp(CL.%&,CL.mkVar errVar)                              CL.mkUnOp(CL.%&,CL.mkVar errVar)
460                            ])) :: genDataBuffers(globals,contextVar,errVar)                            ])) ::
461                            errFn(concat["error in creating ",RN.addBufferSuffixData var, " global buffer"]) ::
462                            genDataBuffers(globals,contextVar,errVar,errFn)
463                      end                      end
464                in                in
465                  globalBufferDecl :: globalBuffer :: genDataBuffers(globals,contextVar,errVar)                  [shadowTypeDecl] @ globalToShadowStms
466                    @ [globalBufferDecl, globalBuffer,errorFn(globalBuffErr)]
467                    @ genDataBuffers(imgGlobals,contextVar,errVar,errorFn)
468                end                end
469    
470        (* generates the kernel arguments for the image data *)        (* generates the kernel arguments for the image data *)
471          fun genGlobalArguments (globals, count, kernelVar, errVar) = let          fun genGlobalArguments (globals, count, kernelVar, errVar) = let
472                val globalArgument = CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.|=,                val globalArgErr = "error creating OpenCL global argument"
473                  fun errorFn msg = CL.mkIfThen(CL.mkBinOp(CL.E_Var errVar, CL.#!=, CL.E_Var "CL_SUCCESS"),
474                        CL.mkBlock([CL.mkCall("fprintf",[CL.E_Var "stderr", CL.E_Str msg]),
475                        CL.mkCall("exit",[CL.mkInt 1])]))
476                  val globalArgument = CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.&=,
477                      CL.mkApply("clSetKernelArg",                      CL.mkApply("clSetKernelArg",
478                        [CL.mkVar kernelVar,                        [CL.mkVar kernelVar,
479                         CL.mkPostOp(CL.E_Var count, CL.^++),                         CL.mkPostOp(CL.E_Var count, CL.^++),
480                         CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),                         CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),
481                         CL.mkUnOp(CL.%&,CL.mkVar(concat[RN.globalsVarName,"_cl"]))])))                         CL.mkUnOp(CL.%&,CL.mkVar(concat[RN.globalsVarName,"_cl"]))])))
482                fun genDataArguments ([],_,_,_) = []                fun genDataArguments ([],_,_,_,_) = []
483                  | genDataArguments ((var,nDims)::globals,count,kernelVar,errVar) =                  | genDataArguments ((var,nDims)::globals,count,kernelVar,errVar,errFn) =
484                      CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.|=,                      CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.$=,
                       CL.mkApply("clSetKernelArg",  
                         [CL.mkVar kernelVar,  
                          CL.mkPostOp(CL.E_Var count, CL.^++),  
                          CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),  
                          CL.mkUnOp(CL.%&,CL.mkVar(RN.addBufferSuffix var))]))) ::  
                     CL.mkExpStm(CL.mkAssignOp(CL.mkVar errVar,CL.|=,  
485                        CL.mkApply("clSetKernelArg",                        CL.mkApply("clSetKernelArg",
486                          [CL.mkVar kernelVar,                          [CL.mkVar kernelVar,
487                           CL.mkPostOp(CL.E_Var count, CL.^++),                           CL.mkPostOp(CL.E_Var count, CL.^++),
488                           CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),                           CL.mkApply("sizeof",[CL.mkVar "cl_mem"]),
489                           CL.mkUnOp(CL.%&,CL.mkVar(RN.addBufferSuffixData var))]))) ::                           CL.mkUnOp(CL.%&,CL.mkVar(RN.addBufferSuffixData var))]))) ::
490                      genDataArguments (globals,count,kernelVar,errVar)                           errFn(concat["error in creating ",RN.addBufferSuffixData var, " argument"]) ::
491                        genDataArguments (globals,count,kernelVar,errVar,errFn)
492                in                in
493                  globalArgument :: genDataArguments(globals, count, kernelVar, errVar)                 [globalArgument,errorFn(globalArgErr)] @ genDataArguments(globals, count, kernelVar, errVar,errorFn)
494                end                end
495    
496        (* generates the globals buffers and arguments function *)        (* generates the globals buffers and arguments function *)
497          fun genGlobalBuffersArgs (imgGlobals) = let          fun genGlobalBuffersArgs (globals,imgGlobals) = let
498              (* Delcare opencl setup objects *)              (* Delcare opencl setup objects *)
499                val errVar = "err"                val errVar = "err"
500                val imgDataSizeVar = "image_dataSize"                val imgDataSizeVar = "image_dataSize"
501                val params = [                val params = [
                       CL.PARAM([], globPtrTy, RN.globalsVarName),  
502                        CL.PARAM([],CL.T_Named("cl_context"), "context"),                        CL.PARAM([],CL.T_Named("cl_context"), "context"),
503                        CL.PARAM([],CL.T_Named("cl_kernel"), "kernel"),                        CL.PARAM([],CL.T_Named("cl_kernel"), "kernel"),
504                          CL.PARAM([],CL.T_Named("cl_command_queue"), "cmdQ"),
505                        CL.PARAM([],CL.T_Named("int"), "argStart")                        CL.PARAM([],CL.T_Named("int"), "argStart")
506                      ]                      ]
507                val clGlobalBuffers = getGlobalDataBuffers(!imgGlobals, "context", errVar)                val clGlobalBuffers = getGlobalDataBuffers(globals,!imgGlobals, "context", errVar)
508                val clGlobalArguments = genGlobalArguments(!imgGlobals, "argStart", "kernel", errVar)                val clGlobalArguments = genGlobalArguments(!imgGlobals, "argStart", "kernel", errVar)
509              (* Body put all the statments together *)              (* Body put all the statments together *)
510                val body = CL.mkDecl(clIntTy, errVar, SOME(CL.I_Exp(CL.mkInt 0)))                val body = CL.mkDecl(clIntTy, errVar, SOME(CL.I_Exp(CL.mkInt 0)))
511                      :: clGlobalBuffers @ clGlobalArguments                      :: clGlobalBuffers @ clGlobalArguments
512                in                in
 (* FIXME: we ought to check the error condition! *)  
513                  CL.D_Func([],CL.voidTy,RN.globalsSetupName,params,CL.mkBlock(body))                  CL.D_Func([],CL.voidTy,RN.globalsSetupName,params,CL.mkBlock(body))
514                end                end
515    
516        (* generate the data and global parameters *)        (* generate the data and global parameters *)
517          fun genKeneralGlobalParams ((name,tyname)::rest) =          fun genKeneralGlobalParams ((name,tyname)::rest) =
518                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) ::  
519                genKeneralGlobalParams rest                genKeneralGlobalParams rest
520            | genKeneralGlobalParams [] = []            | genKeneralGlobalParams [] = []
521    
       (*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  
   
522          (* generate the main kernel function for the .cl file *)          (* generate the main kernel function for the .cl file *)
523          fun genKernelFun (strand, nDims, globals, imgGlobals) = let          fun genKernelFun (strand, nDims, globals, imgGlobals) = let
524                val Strand{name, tyName, state, output, code,...} = strand                val Strand{name, tyName, state, output, code,...} = strand
525                val fName = RN.kernelFuncName;                val fName = RN.kernelFuncName;
526                val inState = "strand_in"                val inState = "strand_in"
527                val outState = "strand_out"                val outState = "strand_out"
528                  val tempVar = "tmp"
529                  val sizeParams = if nDims = 1 then
530                            []
531                        else if nDims = 2 then
532                            [CL.PARAM([], CL.intTy, "width")]
533                        else
534                            [CL.PARAM([], CL.intTy, "width"),CL.PARAM([], CL.intTy, "height")]
535                val params = [                val params = [
536                        CL.PARAM(["__global"], CL.T_Ptr(CL.T_Named tyName), "selfIn"),                        globalParam(CL.T_Ptr(CL.T_Named tyName), "selfIn"),
537                        CL.PARAM(["__global"], CL.T_Ptr(CL.T_Named tyName), "selfOut"),                        globalParam(CL.T_Ptr(CL.T_Named tyName), "selfOut"),
538                        CL.PARAM(["__global"], CL.intTy, "width")                        globalParam(CL.T_Ptr(CL.T_Num(RawTypes.RT_UInt8)), "strandStatus")] @
539                      ] @ genKeneralGlobalParams(!imgGlobals)                        sizeParams @
540                          [globalParam(globPtrTy, RN.globalsVarName)] @
541                          genKeneralGlobalParams(!imgGlobals)
542                val thread_ids = if nDims = 1                val thread_ids = if nDims = 1
543                      then [                      then [
544                          CL.mkDecl(CL.intTy, "x", SOME(CL.I_Exp(CL.mkInt 0))),                            CL.mkDecl(CL.intTy, "x",
545                          CL.mkAssign(CL.mkVar "x",CL.mkApply(RN.getGlobalThreadId,[CL.mkInt 0]))                              SOME(CL.I_Exp(CL.mkApply(RN.getGlobalThreadId,[CL.mkInt 0]))))
546                            ]
547                        else if nDims = 2
548                          then [
549                              CL.mkDecl(CL.intTy, "x",
550                                SOME(CL.I_Exp(CL.mkApply(RN.getGlobalThreadId,[CL.mkInt 1])))),
551                              CL.mkDecl(CL.intTy, "y",
552                                SOME(CL.I_Exp(CL.mkApply(RN.getGlobalThreadId,[CL.mkInt 0]))))
553                        ]                        ]
554                      else [                      else [
555                          CL.mkDecl(CL.intTy, "x", SOME(CL.I_Exp(CL.mkInt 0))),                            CL.mkDecl(CL.intTy, "x",
556                          CL.mkDecl(CL.intTy, "y", SOME(CL.I_Exp(CL.mkInt 0))),                              SOME(CL.I_Exp(CL.mkApply(RN.getGlobalThreadId,[CL.mkInt 1])))),
557                          CL.mkAssign(CL.mkVar "x",  CL.mkApply(RN.getGlobalThreadId,[CL.mkInt 0])),                            CL.mkDecl(CL.intTy, "y",
558                          CL.mkAssign(CL.mkVar "y",CL.mkApply(RN.getGlobalThreadId,[CL.mkInt 1]))                              SOME(CL.I_Exp(CL.mkApply(RN.getGlobalThreadId,[CL.mkInt 0])))),
559                              CL.mkDecl(CL.intTy, "z",
560                                SOME(CL.I_Exp(CL.mkApply(RN.getGlobalThreadId,[CL.mkInt 2]))))
561                        ]                        ]
562                val strandDecl = [                val strandDecl = [
563                      CL.mkDecl(CL.T_Named tyName, inState, NONE),                        CL.mkAttrDecl(["__global"], CL.T_Ptr(CL.T_Named tyName), inState, NONE),
564                      CL.mkDecl(CL.T_Named tyName, outState,NONE)]                        CL.mkAttrDecl(["__global"], CL.T_Ptr(CL.T_Named tyName), outState, NONE),
565                val strandObjects = if nDims = 1                        CL.mkAttrDecl(["__global"], CL.T_Ptr(CL.T_Named tyName), tempVar, NONE)
566                      then [                      ]
567                          CL.mkAssign( CL.mkVar inState, CL.mkSubscript(CL.mkVar "selfIn", CL.mkStr "x")),                val imageDataDecl = CL.mkDecl(CL.T_Named(RN.imageDataType),RN.globalImageDataName,NONE)
568                          CL.mkAssign(CL.mkVar outState,CL.mkSubscript(CL.mkVar "selfOut", CL.mkStr "x"))                val imageDataStms = List.map (fn (x,_) =>
569                      CL.mkAssign(CL.mkSelect(CL.mkVar(RN.globalImageDataName),RN.imageDataName x),
570                                  CL.mkVar(RN.addBufferSuffixData x))) (!imgGlobals)
571                  val barrierCode = CL.mkIfThen(CL.mkBinOp(CL.E_Var "status",CL.#==,CL.E_Var "DIDEROT_ACTIVE"),
572                                     CL.mkBlock ([CL.mkAssign(CL.E_Var tempVar, CL.E_Var inState),
573                                     CL.mkAssign(CL.E_Var inState, CL.E_Var outState),
574                                     CL.mkAssign(CL.E_Var outState, CL.E_Var tempVar)]))
575                  val barrierStm = CL.mkCall("barrier",[CL.E_Var "CLK_LOCAL_MEM_FENCE"])
576                  val index = if nDims = 1 then
577                            CL.mkVar "x"
578                        else if nDims = 2 then
579                            CL.mkBinOp(
580                                CL.mkBinOp(CL.mkVar "y", CL.#*, CL.mkVar "width"), CL.#+, CL.mkVar "x")
581                        else
582                           CL.mkBinOp(CL.mkBinOp(CL.mkBinOp(
583                                CL.mkBinOp(CL.mkVar "z", CL.#*, CL.mkVar "width"),CL.#*, CL.mkVar "height"), CL.#+,
584                                CL.mkBinOp(CL.mkVar "y",CL.#*,CL.mkVar "height")),CL.#+,CL.mkVar "x")
585    
586                  val args = (case nDims
587                         of 1 => [CL.mkVar "x"]
588                          | 2 => [CL.mkVar "x", CL.mkVar "y"]
589                          | 3 => [CL.mkVar "x", CL.mkVar "y", CL.mkVar "z"]
590                        (* end case *))
591                  val strandObjects = [
592                          CL.mkAssign(CL.mkVar inState,  CL.mkBinOp(CL.mkVar "selfIn",CL.#+,index)),
593                          CL.mkAssign(CL.mkVar outState, CL.mkBinOp(CL.mkVar "selfOut",CL.#+,index))
594                        ]                        ]
595                      else let                val stabalizeStm = CL.mkAssign(
596                        val index = CL.mkBinOp(CL.mkBinOp(CL.mkVar "x",CL.#*,CL.mkVar "width"),CL.#+,CL.mkVar "y")                      CL.mkSubscript(CL.mkVar "strandStatus",index),
597                        in [                      CL.E_Var "status")
598                          CL.mkAssign(CL.mkVar inState, CL.mkSubscript(CL.mkVar "selfIn",index)),                val status = CL.mkDecl(CL.intTy, "status", SOME(CL.I_Exp(CL.mkSubscript(CL.mkVar "strandStatus",index))))
599                          CL.mkAssign(CL.mkVar outState,CL.mkSubscript(CL.mkVar "selfOut",index))                val strandInitStm = CL.mkCall(RN.strandInit name,
600                        ] end                        CL.mkVar RN.globalsVarName :: CL.mkVar inState :: args)
601                val status = CL.mkDecl(CL.intTy, "status", SOME(CL.I_Exp(CL.mkInt 0)))                val local_vars = thread_ids
602                val local_vars = thread_ids @ initKernelGlobals(!globals,!imgGlobals)  @ strandDecl @ strandObjects @ [status]                      @ [imageDataDecl]
603                val while_exp = CL.mkBinOp(                      @ imageDataStms
604                      CL.mkBinOp(CL.mkVar "status",CL.#!=, CL.mkVar RN.kStabilize),                      @ strandDecl
605                      CL.#||,                      @ strandObjects
606                      CL.mkBinOp(CL.mkVar "status", CL.#!=, CL.mkVar RN.kDie))                      @ [strandInitStm,status]
607                val whileBody = CL.mkBlock [                val while_exp = CL.mkBinOp(CL.mkVar "status",CL.#==, CL.mkVar RN.kActive)
608                  val whileBody = CL.mkBlock ([
609                        CL.mkAssign(CL.mkVar "status",                        CL.mkAssign(CL.mkVar "status",
610                          CL.mkApply(RN.strandUpdate name,                          CL.mkApply(RN.strandUpdate name,
611                            [CL.mkUnOp(CL.%&,CL.mkVar inState), CL.mkUnOp(CL.%&,CL.mkVar outState)])),                            [CL.mkVar inState,
612                        CL.mkCall(RN.strandStabilize name,                             CL.mkVar outState,
613                          [CL.mkUnOp(CL.%&,CL.mkVar inState), CL.mkUnOp(CL.%&,CL.mkVar outState)])                             CL.mkVar RN.globalsVarName,
614                      ]                             CL.mkVar RN.globalImageDataName]))] @ [barrierCode,barrierStm] )
615                val whileBlock = [CL.mkWhile(while_exp, whileBody)]                val whileBlock = [CL.mkWhile(while_exp, whileBody)]
616                val body = CL.mkBlock(local_vars  @ whileBlock)                val body = CL.mkBlock(local_vars @ whileBlock @ [stabalizeStm])
617                in                in
618                  CL.D_Func(["__kernel"], CL.voidTy, fName, params, body)                  CL.D_Func(["__kernel"], CL.voidTy, fName, params, body)
619                end                end
620        (* generate a global structure from the globals *)  
621          fun genGlobalStruct (targetTy, globals) = let        (* generate a global structure type definition from the list of globals *)
622            fun genGlobalStruct (targetTy, globals, tyName) = let
623                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
624                in                in
625                  CL.D_StructDef(globs, RN.globalsTy)                  CL.D_StructDef(globs, tyName)
626                end                end
627    
628          (* generate a global structure type definition from the image data of the image globals *)
629            fun genImageDataStruct (imgGlobals, tyName) = let
630                  val globs = List.map
631                        (fn (x, _) => (globalPtr CL.voidTy, RN.imageDataName x))
632                          imgGlobals
633                  in
634                    CL.D_StructDef(globs, tyName)
635                  end
636    
637          fun genGlobals (declFn, targetTy, globals) = let          fun genGlobals (declFn, targetTy, globals) = let
638                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))
639                in                in
# Line 559  Line 648 
648                      in                      in
649                        CL.I_Struct[                        CL.I_Struct[
650                            ("name", CL.I_Exp(CL.mkStr name)),                            ("name", CL.I_Exp(CL.mkStr name)),
651                            ("stateSzb", CL.I_Exp(CL.mkSizeof(CL.T_Named(N.strandTy name)))),                            ("stateSzb", CL.I_Exp(CL.mkSizeof(CL.T_Named(RN.strandShadowTy name)))),
652  (*  (*
653                            ("outputSzb", CL.I_Exp(CL.mkSizeof(ToC.trTy outTy))),                            ("outputSzb", CL.I_Exp(CL.mkSizeof(ToC.trTy outTy))),
654  *)  *)
655                            ("update", fnPtr("update_method_t", "0")),                            ("update", fnPtr("update_method_t", "0")),
656                            ("print", fnPtr("print_method_t", name ^ "_print"))                            ("print", fnPtr("print_method_t", name ^ "Print"))
657                          ]                          ]
658                      end                      end
659                val desc = CL.D_Var([], CL.T_Named N.strandDescTy, N.strandDesc name, SOME descI)                val desc = CL.D_Var([], CL.T_Named N.strandDescTy, N.strandDesc name, SOME descI)
# Line 588  Line 677 
677                end                end
678    
679          fun genSrc (baseName, prog) = let          fun genSrc (baseName, prog) = let
680                val Prog{double, globals, topDecls, strands, initially, imgGlobals, numDims, ...} = prog                val Prog{name,double, globals, topDecls, strands, initially, imgGlobals, numDims, ...} = prog
681                val clFileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "cl"}                val clFileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "cl"}
682                val cFileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}                val cFileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
683                val clOutS = TextIO.openOut clFileName                val clOutS = TextIO.openOut clFileName
684                val cOutS = TextIO.openOut cFileName                val cOutS = TextIO.openOut cFileName
685                val clppStrm = PrintAsCL.new clOutS                val clppStrm = PrintAsCL.new clOutS
686                val cppStrm = PrintAsC.new cOutS                val cppStrm = PrintAsC.new cOutS
687                  val progName = name
688                fun cppDecl dcl = PrintAsC.output(cppStrm, dcl)                fun cppDecl dcl = PrintAsC.output(cppStrm, dcl)
689                fun clppDecl dcl = PrintAsCL.output(clppStrm, dcl)                fun clppDecl dcl = PrintAsCL.output(clppStrm, dcl)
690                val strands = AtomTable.listItems strands                val strands = AtomTable.listItems strands
# Line 608  Line 698 
698                      "#define DIDEROT_TARGET_CL",                      "#define DIDEROT_TARGET_CL",
699                      "#include \"Diderot/cl-diderot.h\""                      "#include \"Diderot/cl-diderot.h\""
700                    ]));                    ]));
701                  genGlobals (clppDecl, #gpuTy, !globals);                  clppDecl (genGlobalStruct (#gpuTy, !globals, RN.globalsTy));
702                  clppDecl (genGlobalStruct (#gpuTy, !globals));                  clppDecl (genImageDataStruct(!imgGlobals,RN.imageDataType));
703                  clppDecl (genStrandTyDef(#gpuTy, strand));                  clppDecl (genStrandTyDef(#gpuTy, strand,tyName));
704                    clppDecl  (!init_code);
705                  List.app clppDecl (!code);                  List.app clppDecl (!code);
706                  clppDecl (genKernelFun (strand, !numDims, globals, imgGlobals));                  clppDecl (genKernelFun (strand, !numDims, globals, imgGlobals));
707                (* Generate the Host C file *)                (* Generate the Host C file *)
# Line 622  Line 713 
713                      "#include \"Diderot/diderot.h\""                      "#include \"Diderot/diderot.h\""
714                    ]));                    ]));
715                  cppDecl (CL.D_Var(["static"], CL.charPtr, "ProgramName",                  cppDecl (CL.D_Var(["static"], CL.charPtr, "ProgramName",
716                    SOME(CL.I_Exp(CL.mkStr name))));                    SOME(CL.I_Exp(CL.mkStr progName))));
717  (* FIXME: I don't think that the following is necessary, since we have the global struct. [jhr]                  cppDecl (genGlobalStruct (#hostTy, !globals, RN.globalsTy));
718                  genGlobals (cppDecl, #hostTy, !globals);                  cppDecl (genGlobalStruct (#shadowTy, !globals, RN.shadowGlobalsTy));
719  *)  (* FIXME: does this really need to be a global? *)
720                  cppDecl (genGlobalStruct (#hostTy, !globals));                  cppDecl (CL.D_Var(["static"], globPtrTy, RN.globalsVarName, NONE));
721                  cppDecl (genStrandTyDef (#hostTy, strand));                  cppDecl (genStrandTyDef (#shadowTy, strand,RN.strandShadowTy name));
                 cppDecl  (!init_code);  
722                  cppDecl (genStrandPrint strand);                  cppDecl (genStrandPrint strand);
723                  List.app cppDecl (List.rev (!topDecls));                  List.app cppDecl (List.rev (!topDecls));
724                  cppDecl (genGlobalBuffersArgs imgGlobals);                  cppDecl (genGlobalBuffersArgs (!globals,imgGlobals));
725                  List.app (fn strand => cppDecl (genStrandDesc strand)) strands;                  List.app (fn strand => cppDecl (genStrandDesc strand)) strands;
726                  genStrandTable (cppDecl, strands);                  genStrandTable (cppDecl, strands);
727                  cppDecl (!initially);                  cppDecl (!initially);
# Line 641  Line 731 
731                  TextIO.closeOut clOutS                  TextIO.closeOut clOutS
732                end                end
733    
734        (* 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.  
        *)  
735          fun generate (basename, prog as Prog{double, parallel, debug, ...}) = let          fun generate (basename, prog as Prog{double, parallel, debug, ...}) = let
736                fun condCons (true, x, xs) = x::xs                fun condCons (true, x, xs) = x::xs
737                  | condCons (false, _, xs) = xs                  | condCons (false, _, xs) = xs
# Line 669  Line 757 
757                  RunCC.link (basename, ldOpts)                  RunCC.link (basename, ldOpts)
758                end                end
759    
760        end        end (* Program *)
761    
762    (* strands *)    (* strands *)
763      structure Strand =      structure Strand =
# Line 698  Line 786 
786          fun init (Strand{name, tyName, code, init_code, ...}, params, init) = let          fun init (Strand{name, tyName, code, init_code, ...}, params, init) = let
787                val fName = RN.strandInit name                val fName = RN.strandInit name
788                val params =                val params =
789                      CL.PARAM([], globPtrTy, RN.globalsVarName) ::                      globalParam (globPtrTy, RN.globalsVarName) ::
790                      CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut") ::                      globalParam (CL.T_Ptr(CL.T_Named tyName), "selfOut") ::
791                        List.map (fn (ToCL.V(ty, x)) => CL.PARAM([], ty, x)) params                        List.map (fn (ToCL.V(ty, x)) => CL.PARAM([], ty, x)) params
792                val initFn = CL.D_Func([], CL.voidTy, fName, params, init)                val initFn = CL.D_Func([], CL.voidTy, fName, params, init)
793                in                in
# Line 710  Line 798 
798          fun method (Strand{name, tyName, code,...}, methName, body) = let          fun method (Strand{name, tyName, code,...}, methName, body) = let
799                val fName = concat[name, "_", methName]                val fName = concat[name, "_", methName]
800                val params = [                val params = [
801                        CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfIn"),                        globalParam (CL.T_Ptr(CL.T_Named tyName), "selfIn"),
802                        CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut")                        globalParam (CL.T_Ptr(CL.T_Named tyName), "selfOut"),
803                          globalParam (CL.T_Ptr(CL.T_Named (RN.globalsTy)), RN.globalsVarName),
804                          CL.PARAM([],CL.T_Named(RN.imageDataType),RN.globalImageDataName)
805                      ]                      ]
806                val methFn = CL.D_Func([], CL.int32, fName, params, body)                val methFn = CL.D_Func([], CL.int32, fName, params, body)
807                in                in

Legend:
Removed from v.1315  
changed lines
  Added in v.1430

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