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

SCM Repository

[diderot] View of /branches/lamont/src/compiler/c-target/c-target.sml
ViewVC logotype

View of /branches/lamont/src/compiler/c-target/c-target.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2548 - (download) (annotate)
Wed Feb 26 14:22:24 2014 UTC (5 years, 7 months ago) by lamonts
File size: 39843 byte(s)
Fixed global reduction block
(* c-target.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *)

structure CTarget : TARGET =
  struct

    structure IL = TreeIL
    structure V = IL.Var
    structure Ty = IL.Ty
    structure CL = CLang
    structure N = CNames
    structure ToC = TreeToC
    structure SU = StrandUtil

    type props = Properties.props

    type var = CL.typed_var
    type exp = CL.exp
    type stm = CL.stm

    datatype strand = Strand of {
        prog : program,
        name : string,
        tyName : string,
        state : var list,
        output : (Ty.ty * CL.var),      (* the strand's output variable (only one for now) *)
        code : CL.decl list ref
      }

    and program = Prog of {
        props : props,                  (* info about target *)
        inputs : GenInputs.input_desc list ref,
        globals : (CL.ty * string) list ref,
        globalBlock: CL.decl ref,
        globalReduce: (CL.decl * CL.decl * CL.decl) ref, 
        globalReduceInit: CL.decl ref, 
        reduceGlobals: (CL.ty * string) list ref,
        topDecls : CL.decl list ref,
        strands : strand AtomTable.hash_table,
        nAxes : int option ref,         (* number of axes in initial grid (NONE means collection) *)
        initially : CL.decl ref
      }

    datatype env = ENV of {
        info : env_info,
        vMap : var V.Map.map,
        scope : scope
      }

    and env_info = INFO of {
        prog : program
      }

    and scope
      = NoScope
      | GlobalScope
      | InitiallyScope
      | StrandScope                             (* strand initialization *)
      | MethodScope of StrandUtil.method_name   (* method body; vars are state variables *)

  (* the supprted widths of vectors of reals on the target.  For the GNU vector extensions,
   * the supported sizes are powers of two, but float2 is broken.
   * NOTE: we should also consider the AVX vector hardware, which has 256-bit registers.
   *)
    fun vectorWidths () = if !N.doublePrecision
          then [2, 4, 8]
          else [4, 8]

  (* we support printing in the sequential C target *)
    val supportsPrinting = true

  (* tests for whether various expression forms can appear inline *)
    fun inlineCons n = (n < 2)          (* vectors are inline, but not matrices *)
    val inlineMatrixExp = false         (* can matrix-valued expressions appear inline? *)

  (* TreeIL to target translations *)
    structure Tr =
      struct
        fun fragment (ENV{info, vMap, scope}, blk) = let
              val (vMap, stms) = ToC.trFragment (vMap, blk)
              in
                (ENV{info=info, vMap=vMap, scope=scope}, stms)
              end
        fun reduceBlk(ENV{info, vMap, scope}, gblk,rblk) = ToC.trReduce(vMap,gblk,rblk)
(* NOTE: we may be able to simplify the interface to ToC.trBlock! *)
        fun block (ENV{vMap,info as INFO{prog},...}, blk) = ToC.trBlock (vMap, blk)
        fun free (ENV{vMap, ...}, blk) = ToC.trFree (vMap, blk)
        fun exp (ENV{vMap, ...}, e) = ToC.trExp(vMap, e)
      end

  (* variables *)
    structure Var =
      struct
        fun name (CL.V(_, name)) = name
        fun global (Prog{globals, ...}, name, ty) = let
              val ty' = ToC.trType ty
              in
                globals := (ty', name) :: !globals;
                CL.V(ty', name)
              end
        fun param x = CL.V(ToC.trType(V.ty x), V.name x)
      end

  (* environments *)
    structure Env =
      struct
      (* create a new environment *)
        fun new prog = ENV{
                info=INFO{prog = prog},
                vMap = V.Map.empty,
                scope = NoScope 
              }
      (* bind a TreeIL varaiable to a target variable *)
        fun bind (ENV{info, vMap, scope}, x, x') = ENV{
                info = info,
                vMap = V.Map.insert(vMap, x, x'),
                scope = scope
              }
      (* define the current translation context *)
        fun setScope (scope, wrld, glob, globNode,selfIn, selfOut, stateIn, stateOut) (ENV{info, vMap, ...}) = ENV{
                info = info,
                vMap = List.foldl
                    (fn ((x, x'), vm) => V.Map.insert(vm, x, x'))
                      vMap [
                          (PseudoVars.world, CL.V(CL.voidTy, wrld)),
                          (PseudoVars.global, CL.V(CL.voidTy, glob)),
                          (PseudoVars.globalNode, CL.V(CL.voidTy,globNode )),
                          (PseudoVars.selfIn, CL.V(CL.voidTy, selfIn)),
                          (PseudoVars.selfOut, CL.V(CL.voidTy, selfOut)),
			  (PseudoVars.stateIn, CL.V(CL.voidTy, stateIn)),
			  (PseudoVars.stateOut, CL.V(CL.voidTy, stateOut))
                        ],
                scope = scope
              }
      (* define the current translation context *)
        val scopeGlobal = setScope (GlobalScope, "wrld", "glob","node", "_bogus_", "_bogus_", "_bogus_", "_bogus_")
        val scopeInitially = setScope (InitiallyScope, "wrld", "glob","_bogus_","_bogus_", "_bogus_", "_bogus_", "_bogus_")
        fun scopeStrand (env as ENV{info=INFO{prog=Prog{props, ...}}, ...}) =
              if Properties.dualState props
                then setScope (StrandScope, "wrld", "glob","_bogus_","selfIn", "selfOut", "inState", "outState") env
                else setScope (StrandScope, "wrld", "glob","_bogus_", "self", "self", "state", "state") env
         fun scopeMethod (env as ENV{info=INFO{prog=Prog{props, ...}}, ...}, name) =
              if Properties.dualState props
                then setScope (MethodScope name, "wrld", "glob", "_bogus_","selfIn", "selfOut", "inState", "outState") env
                else setScope (MethodScope name, "wrld", "glob", "_bogus_","self", "self", "state", "state") env
      end

  (* strands *)
    structure Strand =
      struct
        fun define (prog as Prog{strands, ...}, strandId, state) = let
              val name = Atom.toString strandId
            (* the output state variable *)
              val outputVar = (case List.filter IL.StateVar.isOutput state
                     of [] => raise Fail("no output specified for strand " ^ name)
                      | [x] => (IL.StateVar.ty x, IL.StateVar.name x)
                      | _ => raise Fail("multiple outputs in " ^ name)
                    (* end case *))
            (* the state variables *)
              val state = let
                    fun cvt x = CL.V(ToC.trType(IL.StateVar.ty x), IL.StateVar.name x)
                    in
                      List.map cvt state
                    end
              val strand = Strand{
                      prog = prog,
                      name = name,
                      tyName = N.strandTy name,
                      state = state,
                      output = outputVar,
                      code = ref []
                    }
              in
                AtomTable.insert strands (strandId, strand);
                strand
              end

      (* return the strand with the given name *)
        fun lookup (Prog{strands, ...}, strandId) = AtomTable.lookup strands strandId

      (* register the strand-state initialization code.  The variables are the strand
       * parameters.
       *)
        fun init (Strand{prog=Prog{props, ...}, name, tyName, code, ...}, params, init) = let
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy props))
              val fName = N.strandInit name
              val selfParam = if Properties.dualState props
                    then "selfOut"
                    else "self"
              val params =
                    CL.PARAM([], globTy, "glob") ::
                    CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), selfParam) ::
                      List.map (fn (CL.V(ty, x)) => CL.PARAM([], ty, x)) params
              val initFn = CL.D_Func(["static"], CL.voidTy, fName, params, init)
              in
                code := initFn :: !code
              end

      (* register a strand method *)
        fun method (Strand{prog=Prog{props, ...}, name, tyName, code, ...}, methName, body) = let
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy props))
              val fName = concat[name, "_", StrandUtil.nameToString methName]
              val (resTy, params, body) = (case methName
                     of StrandUtil.Update => let
			  val params = if Properties.noBSP props
				then [
				    CL.PARAM([], CL.T_Ptr(CL.T_Named(N.globalTy props)), "glob"),
				    CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "self")
				  ]
			        else [
				    CL.PARAM([], CL.T_Ptr(CL.T_Named(N.worldTy props)), "wrld"),
				    CL.PARAM([], CL.uint32, "strandIdx")
				  ]
			  val body = if Properties.noBSP props
				then body
				else let
				  fun self st = CL.mkSubscript(CL.mkIndirect(CL.mkVar "wrld", st), CL.mkVar "strandIdx")
				  val dcls = if #hasCom props
					then [
					    CL.mkDeclInit(CL.T_Ptr(CL.T_Named N.kdTreeTy), N.kdTreeName, 
						CL.mkIndirect(CL.mkVar "wrld", N.kdTreeName)),
					    CL.mkDeclInit(CL.T_Ptr(CL.T_Named N.queryPoolTy), N.queryPoolName,
						CL.mkIndirect(CL.mkVar "wrld", "queryPool"))
					  ]
					else []
				  val dcls = if Properties.dualState props
					then CL.mkDeclInit(CL.T_Ptr(CL.T_Named tyName), "selfIn", self "inState")
					  :: CL.mkDeclInit(CL.T_Ptr(CL.T_Named tyName), "selfOut", self "outState")
					  :: dcls
					else CL.mkDeclInit(CL.T_Ptr(CL.T_Named tyName), "self", CL.mkUnOp(CL.%&, self "state"))
					  :: dcls
				  val dcls = CL.mkDeclInit(CL.T_Ptr(CL.T_Named(N.globalTy props)), "glob",
					CL.mkIndirect(CL.mkVar "wrld", "globals")) :: dcls
				  in
				    CL.mkBlock(dcls @ CL.unBlock body)
				  end
			  in
			    (CL.T_Named "StrandStatus_t", params, body)
			  end
		      | StrandUtil.Stabilize => let
			  val stateParams = if Properties.dualState props
				then [
				    CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfIn"),
				    CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut")
				  ]
				else [CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "self")]
			  val params = CL.PARAM([], globTy, "glob") :: stateParams
			  in
			    (CL.voidTy, params, body)
			  end
                    (* end case *))
              val methFn = CL.D_Func(["static"], resTy, fName, params, body)
              in
                code := methFn :: !code
              end

      end

  (* programs *)
    structure Program =
      struct
        fun new (tgt : TargetUtil.target_desc, props : StrandUtil.program_prop list) = (
              N.initTargetSpec {double = #double tgt, long = false};
              Prog{
                  props = Properties.mkProps (tgt, props),
                  inputs = ref [],
                  globals = ref [],
                  globalBlock =ref(CL.D_Comment["no global block"]), 
                  globalReduceInit = ref(CL.D_Comment["no global reduce init"]), 
                  globalReduce = ref(CL.D_Comment["no global reductions"],CL.D_Comment[""],CL.D_Comment[""]), 
                  reduceGlobals = ref [], 
                  topDecls = ref [],
                  strands = AtomTable.mkTable (16, Fail "strand table"),
                  nAxes = ref(SOME ~1),
                  initially = ref(CL.D_Comment["missing initially"])
                })
      (* gather the inputs *)
        fun inputs (Prog{inputs, ...}, env, blk) = inputs := GenInputs.gatherInputs blk 
      (* register the global block code *) 
        fun genGlobalFun (_, _, (CL.S_Block[],_,_,_,_,_)) = () 
          | genGlobalFun (Prog{props,globals,globalBlock,globalReduce,globalReduceInit,reduceGlobals,...}, Strand{tyName,...}, (globlFunBlk,reduceFunBlk,aBlock,fBlock,rGlobals,iStms)) = let 
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy props))
              val params = [
		      CL.PARAM([], CL.T_Ptr(CL.T_Named(N.worldTy props)), "wrld")
		    ]
	      fun wrldField f = CL.mkIndirect(CL.mkVar "wrld", f)
          val stateTy = if Properties.dualState props then CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName))
                                                      else CL.T_Ptr(CL.T_Named tyName) 
	      val state = if Properties.dualState props then "inState" else "state"
	      val rdcls = [
		      CL.mkDeclInit (globTy, "glob", wrldField "globals")
          ]  
          val dcls = [
		      CL.mkDeclInit (globTy, "glob", wrldField "globals"),
              
		      CL.mkDeclInit (CL.uint32, "numberOfStrands", wrldField "numStrands"),
		      CL.mkDeclInit (CL.T_Ptr CL.uint8, "status", wrldField "status"),
		      CL.mkDeclInit (stateTy, "state", wrldField state),
                      CL.mkDeclInit (CL.T_Ptr(CL.T_Named N.queryPoolTy), N.queryPoolName, wrldField "queryPool")
                    ]
           
          val params' =  [              
		      CL.PARAM([], CL.T_Ptr(CL.T_Named(N.worldTy props)), "wrld"),
              CL.PARAM([], CL.T_Ptr(CL.uint32), "workerId")
		    ]
          val globalFn = CL.D_Func(["static"], CL.voidTy, N.globalFunName, params',
		    CL.mkBlock( dcls @ CL.unBlock globlFunBlk))

          val parmsInit = [CL.PARAM([],CL.T_Ptr(CL.T_Named(N.globalReduceNodeTy)), "node"), 
                           CL.PARAM([], CL.uint32, "leaderId"),        
                           CL.PARAM([], CL.T_Ptr(CL.T_Named(N.worldTy props)), "wrld"),
                          CL.PARAM([],  CL.uint32, "workerId")
        ]
          val globalReduceInitFn = CL.D_Func(["static"], CL.voidTy, N.globalReduceIniitFn, parmsInit,
        CL.mkBlock(CL.unBlock iStms))
         
          val params' = CL.PARAM([], CL.T_Ptr(CL.T_Named(N.globalReduceNodeTy)), "node")::
                    CL.PARAM([], CL.uint32, "phase"):: 
                    CL.PARAM([], CL.uint32, "start")::
                    CL.PARAM([], CL.uint32, "end")::params
                                
            val globalReduceFn =  CL.D_Func(["static"], CL.voidTy, N.globalReduceFn, params', CL.mkBlock(dcls @ CL.unBlock reduceFunBlk))
            val params' = CL.PARAM([], CL.T_Ptr(CL.T_Named(N.globalReduceNodeTy)), "node")::
                          CL.PARAM([], CL.uint32, "phase")::params

            val globalParReduceAssignFn = CL.D_Func(["static"], CL.voidTy, N.globalReduceParAssignFn,params',CL.mkBlock(rdcls @ CL.unBlock aBlock))
            val params' = CL.PARAM([], CL.uint32, "phase")::params
            val globalParReduceFinalFn = CL.D_Func(["static"], CL.voidTy, N.globalReduceParFinalFn, params', CL.mkBlock(rdcls @ CL.unBlock fBlock))
              in 
                (globalBlock := globalFn;  
                globals := (CL.uint32,"phase")::(!globals); 
                reduceGlobals := rGlobals; 
                globalReduceInit := globalReduceInitFn; 
                globalReduce := (globalReduceFn,globalParReduceAssignFn,globalParReduceFinalFn))
              end 
      (* register the global initialization part of a program *)
        fun init (Prog{props, topDecls, ...}, init) = let
              val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy props))
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy props))
              val wrldV = CL.mkVar "wrld"
            (* the body of the global initializtion code *)
              val initStms = 
                    CL.mkDeclInit(globTy, "glob", CL.mkIndirect(wrldV, "globals")) ::
                    CL.unBlock init @ [CL.mkReturn(SOME(CL.mkVar "false"))]
            (* for libraries, we need to make sure that the inputs are initialized *)
              val initStms = if not(#exec props)
                    then CL.mkIfThen(
                      CL.mkApply(N.checkDefined props, [wrldV]),
                      CL.mkReturn(SOME(CL.mkBool true))) :: initStms
                    else initStms
              val initFn = CL.D_Func(
                    ["static"], CL.boolTy, N.initGlobals,
                    [CL.PARAM([], worldTy, "wrld")],
                    CL.mkBlock initStms)
              in
                topDecls := initFn :: !topDecls
              end
      (* register the global destruction part of a program *)
        fun free (Prog{props, topDecls, ...}, free) = let
              val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy props))
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy props))
              val free = CL.mkBlock(
                    CL.mkDeclInit(globTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) ::
                    CL.unBlock free @ [CL.mkReturn(SOME(CL.mkVar "false"))])
              val freeFn = CL.D_Func(
                    ["static"], CL.boolTy, N.freeGlobals,
                    [CL.PARAM([], worldTy, "wrld")],
                    free)
              in
                topDecls := freeFn :: !topDecls
              end
      (* create and register the initially function for a program *)
        fun initially {
              prog = Prog{props, strands, nAxes, initially, ...},
              isArray : bool,
              iterPrefix : stm list,
              iters : (var * exp * exp) list,
              createPrefix : stm list,
              strand : Atom.atom,
              args : exp list
            } = let
              val name = Atom.toString strand
              val nDims = List.length iters
              val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy props))
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy props))
              fun mapi f xs = let
                    fun mapf (_, []) = []
                      | mapf (i, x::xs) = f(i, x) :: mapf(i+1, xs)
                    in
                      mapf (0, xs)
                    end
              val baseInit = mapi (fn (i, (_, e, _)) => (i, CL.I_Exp e)) iters
              val sizeInit = mapi
                    (fn (i, (CL.V(ty, _), lo, hi)) =>
                        (i, CL.I_Exp(CL.mkBinOp(CL.mkBinOp(hi, CL.#-, lo), CL.#+, CL.E_Int(1, ty))))
                    ) iters
            (* code to allocate the world and initial strands *)
              val allocCode = [
                      CL.mkComment["allocate initial block of strands"],
                      CL.mkDecl(CL.T_Array(CL.uint32, SOME nDims), "base", SOME(CL.I_Array baseInit)),
                      CL.mkDecl(CL.T_Array(CL.uint32, SOME nDims), "size", SOME(CL.I_Array sizeInit)),
                      CL.mkIfThen(CL.mkApply(N.allocInitially, [
                          CL.mkVar "wrld",
                          CL.E_Bool isArray,
                          CL.E_Int(IntInf.fromInt nDims, CL.int32),
                          CL.E_Var "base",
                          CL.E_Var "size"
                        ]),
                      (* then *)
                        CL.mkBlock [
(* FIXME: anything else? *)
                            CL.mkReturn(SOME(CL.mkVar "true"))
                          ])
                      (* endif *)
                    ]
            (* create the loop nest for the initially iterations *)
              val indexVar = "ix"
              val strandTy = CL.T_Ptr(CL.T_Named(N.strandTy name))
              fun statePtr inout = CL.mkSubscript(CL.mkIndirect(CL.mkVar "wrld", inout), CL.mkVar indexVar)
              fun mkLoopNest [] = let
                    val initCode = if Properties.dualState props
                          then [
                              CL.mkCall(N.strandInit name,
                                CL.mkVar "glob" :: statePtr "inState" :: args),
			      CL.mkAssign(CL.mkIndirect(statePtr "inState", "strandId"),
				CL.mkVar indexVar),
                              CL.mkCall("memcpy", [
                                  statePtr "outState", statePtr "inState",
                                  CL.mkSizeof(CL.T_Named(N.strandTy name))
                                ])
                            ]
                          else [
                              CL.mkCall(N.strandInit name,
                                CL.mkVar "glob" :: CL.mkUnOp(CL.%&, statePtr "state") :: args),
			      CL.mkAssign(CL.mkSelect(statePtr "state", "strandId"),
				CL.mkVar indexVar)
                            ]
                    in
                      CL.mkBlock(createPrefix @ initCode @ [
                          CL.S_Exp(CL.mkPostOp(CL.mkVar indexVar, CL.^++))
                        ])
                    end
                | 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
                    ]
              val body = CL.mkBlock(
                    CL.mkIfThen (CL.mkApply (N.initGlobals, [CL.mkVar "wrld"]),
                        CL.mkReturn(SOME(CL.mkVar "true"))
                      ) ::
                    CL.mkDeclInit (globTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) ::
                    iterPrefix @
                    allocCode @
                    iterCode @
                    [CL.mkReturn(SOME(CL.mkVar "false"))])
              val initFn = CL.D_Func([], CL.boolTy, N.initially props, [CL.PARAM([], worldTy, "wrld")], body)
              in
                nAxes := (if isArray then SOME nDims else NONE);
                initially := initFn
              end

      (***** OUTPUT *****)

      (* create the target-specific substitution list *)
        fun mkSubs (props : props,Strand{name, tyName, ...}) = let 
			  val queryInit = concat["\nwrld->", N.queryPoolName,"  = ", N.queryAllocFun, "();"] 
			  val dimStr = if #hasCom props then (Int.toString(#spatialDim props)) else "" 
			  val callBuildTreeFn = concat[N.kdTreeBuildFn,"(wrld);"]
			  val callAllocTreeFn =  concat[N.kdTreeAllocFn,"(wrld);\n" ]  

              val callglobalFns = concat[N.queryClearFun,"(wrld->queryPool);\n",
			      					     N.globalFunName, "(wrld,0);"]  

			  val reallocSpatial = concat[N.kdTreeReallocFn,"(wrld);\n"] 
              in [
                ("CFILE",       OS.Path.joinBaseExt{base= #outBase props, ext= SOME "c"}),
                ("HDRFILE",     OS.Path.joinBaseExt{base= #outBase props, ext= SOME "h"}),
                ("PREFIX",      #namespace props),
                ("SRCFILE",     #srcFile props),
                ("STRAND",      name),
                ("STRANDTY",    tyName),
                ("SPATIAL_DIMENSION", dimStr),
				("QUERY_POOL_ALLOCATION", queryInit), 
                ("CALL_GLOBAL_BLOCK_FN", if #hasGlobal props then callglobalFns else ""), 
				("CALL_BUILD_TREE_FN", if #hasCom props then callBuildTreeFn else ""), 
				("CALL_ALLOC_TREE_FN",  if #hasCom props then callAllocTreeFn else ""), 
				("REALLOC_SPATIAL_COPY_ARRAY", if #hasCom props then reallocSpatial else "")
              ] end 

        fun condCons (true, x, xs) = x::xs
          | condCons (false, _, xs) = xs

        fun verbFrag (props : props, parFrag, seqFrag, subs) =
              CL.verbatimDcl [if (#parallel props) then parFrag else seqFrag] subs

		fun spatialFrag(props : props,subs) = 
			  CL.verbatimDcl [if (#parallel props) then ParKDTreeFrag.text else SeqKDTreeFrag.text] subs

        fun runFrag (false, props, subs) =
              verbFrag (props, ParRunFrag.text, SeqRunFrag.text, subs)
          | runFrag (true, props, subs) = 
              verbFrag (props, ParRunNoBSPFrag.text, SeqRunNoBSPFrag.text, subs)

        fun compile (props : props, basename) = let
            (* generate the C compiler flags *)
              val cflags = ["-I" ^ Paths.diderotInclude, "-I" ^ Paths.teemInclude]
              val cflags = condCons (#parallel props, #pthread Paths.cflags, cflags)
              val cflags = if #debug props
                    then #debug Paths.cflags :: cflags
                    else #ndebug Paths.cflags :: cflags
              val cflags = #base Paths.cflags :: cflags
              in
                RunCC.compile (basename, cflags)
              end

        fun ldFlags (props : props) = if #exec props
              then let
                val extraLibs = condCons (#parallel props, #pthread Paths.extraLibs, [])
                val extraLibs = Paths.teemLinkFlags @ #base Paths.extraLibs :: extraLibs
                val rtLib = Properties.runtimeName props
                in
                  rtLib :: extraLibs
                end
              else [Properties.runtimeName props]

        fun genStrand (Strand{prog=Prog{props, ...}, name, tyName, state, output, code}) = let
            (* the type declaration for the strand's state struct *)
              val selfTyDef = CL.D_StructDef(
                      SOME(concat[#namespace props, "struct_", name]),
(* FIXME: use revAppend *)
                      (List.rev (List.map (fn CL.V(ty, x) => (ty, x)) state))@[(ToC.trType(Ty.IntTy),"strandId")],
                      NONE)
            (* define the allocation of a strand prototype *)
              val allocPrototype = CL.D_Proto([], CL.uint32, N.allocNewStrand name, [
		      CL.PARAM([], CL.T_Ptr(CL.T_Named(N.worldTy props)), "wrld")
		    ])
            (* the type and access expression for the strand's output variable *)
              val (outTy, outState) = (#1 output, CL.mkIndirect(CL.mkVar "self", #2 output))
            (* the strand's descriptor object *)
              val descI = let
                    fun fnPtr (ty, f) = CL.I_Exp(CL.mkCast(CL.T_Named ty, CL.mkVar f))
                    in
                      CL.I_Struct[
                          ("name", CL.I_Exp(CL.mkStr name)),
                          ("stateSzb", CL.I_Exp(CL.mkSizeof(CL.T_Named(N.strandTy name)))),
                          ("update", fnPtr("update_method_t", name ^ "_Update")),
                          ("stabilize", fnPtr("stabilize_method_t", name ^ "_Stabilize"))
                        ]
                    end
              val desc = CL.D_Var([], CL.T_Named N.strandDescTy, N.strandDesc name, SOME descI)
              in
                selfTyDef :: allocPrototype :: List.rev (desc :: !code)
              end

        fun genGlobalStruct (props : props, globals) =
              CL.D_StructDef(NONE, globals, SOME(#namespace props ^ "Globals_t"))

      (* generate the struct declaration for the world representation *)
        fun genWorldStruct (props, Strand{tyName, ...}) = let
              val extras = if Properties.dualState props
                    then [
                        (CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)), "inState"),
                        (CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)), "outState")
                      ]
                    else [
                        (CL.T_Ptr(CL.T_Named tyName),           "state")
                      ]
              val extras = [
                    (* target-specific world components *)
                      (CL.T_Ptr(CL.T_Named(N.globalsTy props)), "globals"),
                      (CL.T_Ptr CL.uint8,                       "status"),
                      (CL.T_Named N.strandPoolTy,               "poolInfo"), 
                      (CL.T_Ptr(CL.T_Named(N.queryPoolTy)),     N.queryPoolName)
                    ] @ extras
              val extras = if #exec props
                    then extras
                    else (CL.T_Named(N.definedInpTy props), "definedInp") :: extras
              val extras = if #parallel props
                    then (CL.T_Ptr(CL.T_Named "Diderot_Sched_t"), "sched") :: extras
                    else (CL.uint32, "numActive")::(CL.uint32, "numStable")::extras
              val extras = if #hasReduce props 
                    then (CL.T_Named(N.globalReduceNodeTy),"gNode"):: extras 
                    else extras 
              val extras = if #parallel props andalso #hasReduce props
                    then  (CL.T_Ptr(CL.T_Named (N.globalSchedulerTy)), "globSched") :: extras 
                    else extras
              val extras = if #hasCom props  
                    then let 
                            val treeDel = (CL.T_Ptr(CL.T_Named N.kdTreeTy), N.kdTreeName)
                         in 
                            if #parallel props
                            then treeDel ::
                                 (CL.T_Ptr(CL.uint32), N.kdTreeParIndicesName) :: 
                                 (CL.T_Ptr(CL.uint32), N.kdTreeParTmpIndicesName) :: 
                                 (CL.T_Ptr(CL.T_Named N.kdTreeSchedTy), N.kdTreeParSchedName) ::extras
                            else treeDel ::
						        (CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)), N.kdStrandBlockName) ::extras 
                         end 
                    else extras  
              in
                World.genStruct (props, extras)
              end

      (* generate the table of strand descriptors *)
        fun ppStrandTable (ppStrm, strands) = let
              val nStrands = length strands
              fun genInit (Strand{name, ...}) = CL.I_Exp(CL.mkUnOp(CL.%&, CL.E_Var(N.strandDesc name)))
              fun genInits (_, []) = []
                | genInits (i, s::ss) = (i, genInit s) :: genInits(i+1, ss)
              fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
              in
                ppDecl (CL.D_Var(["static const"], CL.int32, "NumStrands",
                  SOME(CL.I_Exp(CL.E_Int(IntInf.fromInt nStrands, CL.int32)))));
                ppDecl (CL.D_Var([],
                  CL.T_Array(CL.T_Ptr(CL.T_Named N.strandDescTy), SOME nStrands),
                  N.strands,
                  SOME(CL.I_Array(genInits (0, strands)))))
              end

        fun outputLibSrc (baseName, Prog{
                props,globalBlock, globalReduce,reduceGlobals,globalReduceInit,
                inputs, globals, topDecls, strands, nAxes, initially, ...
              }) = let
            (* does the program require barrier synchronization to implement BSP semantics? *)
              val needsBarrier = Properties.noBSP props orelse #hasGlobal props
              val [strand as Strand{name, tyName, state, output, ...}] = AtomTable.listItems strands
              val outputs = GenOutput.gen (props, !nAxes) [output]
              val substitutions = mkSubs (props,strand)
            (* output to C file *)
              val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
              val outS = TextIO.openOut fileName
              val ppStrm = PrintAsC.new outS
              val (reduceFn,assignFn,finalReduceFn) = !globalReduce 
              fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
              in
                ppDecl (CL.verbatimDcl [CHeadFrag.text] substitutions);
                if (#parallel props)
                  then ppDecl (CL.verbatimDcl [CHeadParExtraFrag.text] substitutions)
                  else ();
                if Properties.dualState props
                  then ppDecl (CL.D_Verbatim ["#define DIDEROT_DUAL_STATE\n"])
                  else ();
                if #hasCom props
                  then 
                    ppDecl (CL.verbatimDcl [CHeadSpatialExtraFrag.text] substitutions)
                  else (); 
                if #hasReduce props
                then ppDecl(CL.D_StructDef(NONE, !reduceGlobals, SOME(N.globalReduceNodeTy)))
                else (); 
                if #hasReduce props andalso #parallel props 
                then ppDecl (CL.verbatimDcl [CHeadParGlobalExtraFrag.text] substitutions)  
                else (); 
                ppDecl (GenInputs.genDefinedInpStruct (props, !inputs));
                ppDecl (genGlobalStruct (props, List.rev(!globals)));
                ppDecl (genWorldStruct(props, strand));
                List.app ppDecl (GenInputs.genInputFuns(props, !inputs));
                List.app ppDecl (List.rev (!topDecls));
                List.app ppDecl (genStrand strand);
                ppDecl (CL.verbatimDcl [SeqNewFrag.text] substitutions);
                ppDecl (CL.verbatimDcl [QueryPoolFrag.text] substitutions); 
                if (#hasReduce props)
                   then( 
                       if (#parallel props)
                       then 
                           (ppDecl(!globalReduceInit); 
                            ppDecl(assignFn); 
                            ppDecl(finalReduceFn); 
                            ppDecl(reduceFn);
                            ppDecl (CL.verbatimDcl [ReduceFrag.text] substitutions))
                        else (ppDecl(!globalReduceInit); 
                              ppDecl(finalReduceFn); 
                              ppDecl(reduceFn);
                              ppDecl (CL.verbatimDcl [ReduceFrag.text] substitutions));
                          ppDecl(!globalBlock))  
                  else if (#hasGlobal props)
                        then ppDecl(!globalBlock)
                        else  (); 
                if #hasCom props
                  then(
                    ppDecl (CL.verbatimDcl [KDTreeFrag.text] substitutions);
                    ppDecl (spatialFrag(props, substitutions)))
                  else ();
                List.app ppDecl outputs;
                ppStrandTable (ppStrm, [strand]);
                ppDecl (CL.verbatimDcl [CBodyFrag.text] substitutions);
                ppDecl (CL.verbatimDcl [InitFrag.text] substitutions);
                ppDecl (CL.verbatimDcl [AllocFrag.text] substitutions);
                ppDecl (!initially);
                ppDecl (runFrag (Properties.noBSP props, props, substitutions));
                ppDecl (CL.verbatimDcl [ShutdownFrag.text] substitutions);
                PrintAsC.close ppStrm;
                TextIO.closeOut outS
              end

        fun generateLib (prog as Prog{props, inputs, strands, ...}) = let
              val {outDir, outBase, exec, double, parallel, debug, ...} = props
              val basename = OS.Path.joinDirFile{dir=outDir, file=outBase}
              val [Strand{state, output, ...}] = AtomTable.listItems strands
              in
              (* generate the library .h file *)
                GenLibraryInterface.gen {
                    props = props,
                    rt = if #parallel props
                      then SOME LibInterfaceParFrag.text
                      else NONE,
                    inputs = !inputs,
                    outputs = [output]
                  };
              (* *)
                outputLibSrc (basename, prog);
              (* compile and link *)
                compile (props, basename);
                RunCC.linkLib (basename, ldFlags props)
              end

        fun genExecSrc (baseName, prog) = let
              val Prog{
                      props,globalBlock, globalReduce,reduceGlobals,globalReduceInit,
                      inputs, globals, topDecls, strands, nAxes, initially, ...
                    } = prog
            (* does the program require barrier synchronization to implement BSP semantics? *)
              val needsBarrier = not(Properties.noBSP props) orelse (#hasGlobal props)
              val [strand as Strand{name, tyName, state, output, ...}] = AtomTable.listItems strands
              val outputs = GenOutput.gen (props, !nAxes) [output]
              val substitutions =
                    ("DIDEROT_FLOAT_PRECISION", Properties.floatPrecisionDef props) ::
                    ("DIDEROT_INT_PRECISION", Properties.intPrecisionDef props) ::
                    ("DIDEROT_TARGET", Properties.targetDef props) ::
                    mkSubs (props,strand)
              val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
              val outS = TextIO.openOut fileName
              val (reduceFn,assignFn,finalReduceFn) = !globalReduce 
              val ppStrm = PrintAsC.new outS
              fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
              in
                ppDecl (CL.verbatimDcl [ExecHdr.text] substitutions);
                if (#parallel props)
                  then ppDecl (CL.verbatimDcl [CHeadParExtraFrag.text] substitutions)
                  else ();
                if Properties.dualState props
                  then ppDecl (CL.D_Verbatim ["#define DIDEROT_DUAL_STATE\n"])
                  else ();
              if #hasCom props
                  then 
                    ppDecl (CL.verbatimDcl [CHeadSpatialExtraFrag.text] substitutions)
                  else (); 
               if(#hasReduce props)
                then ppDecl(CL.D_StructDef(NONE, !reduceGlobals, SOME(N.globalReduceNodeTy)))
                else (); 
                if #hasReduce props andalso #parallel props 
                then ppDecl (CL.verbatimDcl [CHeadParGlobalExtraFrag.text] substitutions)  
                else (); 
                ppDecl (genGlobalStruct (props, List.rev(!globals)));
                ppDecl (genWorldStruct (props, strand));
                ppDecl (GenInputs.genInputsStruct (props, !inputs));
                List.app ppDecl (List.rev (!topDecls));
                List.app ppDecl (GenInputs.genExecInputFuns (props, !inputs));
                List.app ppDecl (genStrand strand); 
                ppDecl (CL.verbatimDcl [SeqNewFrag.text] substitutions);              
                ppDecl (CL.verbatimDcl [QueryPoolFrag.text] substitutions);
                if (#hasReduce props)
                   then(
                       if (#parallel props)
                       then 
                           (ppDecl(!globalReduceInit); 
                            ppDecl(assignFn); 
                            ppDecl(finalReduceFn); 
                            ppDecl(reduceFn);
                            ppDecl (CL.verbatimDcl [ReduceFrag.text] substitutions))
                        else (ppDecl(!globalReduceInit);
                              ppDecl(finalReduceFn);
                              ppDecl(reduceFn);
                              ppDecl (CL.verbatimDcl [ReduceFrag.text] substitutions));
                          ppDecl(!globalBlock))  
                  else if (#hasGlobal props)
                        then ppDecl(!globalBlock)
                        else  (); 
                if #hasCom props
                  then(
                    ppDecl (CL.verbatimDcl [KDTreeFrag.text] substitutions);
                    ppDecl (spatialFrag(props, substitutions)))
                  else ();
                List.app ppDecl outputs;
                ppStrandTable (ppStrm, [strand]);
                ppDecl (CL.verbatimDcl [InitFrag.text] substitutions);
                ppDecl (CL.verbatimDcl [AllocFrag.text] substitutions);
                ppDecl (!initially);
                ppDecl (runFrag (Properties.noBSP props, props, substitutions));
                ppDecl (CL.verbatimDcl [ShutdownFrag.text] substitutions);
                ppDecl (verbFrag (props, ParMainFrag.text, SeqMainFrag.text, substitutions));
                PrintAsC.close ppStrm;
                TextIO.closeOut outS
              end

      (* output the code to a file.  The string is the basename of the file, the extension
       * is provided by the target.
       *)
        fun generateExec (prog as Prog{props, ...}) = let
              val {outDir, outBase, exec, double, parallel, debug, ...} = props
              val basename = OS.Path.joinDirFile{dir=outDir, file=outBase}
              in
                 genExecSrc (basename, prog);
                 compile (props, basename); 
                RunCC.linkExec (basename, ldFlags props)
              end

        fun generate (prog as Prog{props, ...}) = if #exec props
              then generateExec prog
              else generateLib prog

      end

  end

structure CBackEnd = CodeGenFn(CTarget)

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