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 2269 - (download) (annotate)
Thu Mar 7 13:56:24 2013 UTC (6 years, 5 months ago) by lamonts
File size: 31260 byte(s)
Fixed bug: strand pool not correctly reallocating
(* 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 target_desc = TargetUtil.target_desc

    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 {
	tgt : target_desc,		(* info about target *)
	hasDie : bool,			(* true for programs that have "die" *)
	hasNew : bool,			(* true for programs that have "new" *)
	hasCom : bool,			(* true for programs that have strand communication *)
    hasReduce: bool ref,    (* true for programs that have global reductions *) 
	hasGlobalBlk : bool ref,		(* true for programs that have global block definition *)
    gridIs2D  : bool,       (* true for programs that are using a 2D spatial grid *) 
        inputs : GenInputs.input_desc list ref,
        globals : (CL.ty * string) list ref,
        globalBlock: CL.decl option ref, 
        globalReduce: CL.decl 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
(* NOTE: we may be able to simplify the interface to ToC.trBlock! *)
        fun block (ENV{vMap, ...}, 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
              }
      (* define the current translation context *)
        fun setScope scope (ENV{info, vMap, ...}) = ENV{info=info, vMap=vMap, scope=scope}
        val scopeGlobal = setScope GlobalScope
        val scopeInitially = setScope InitiallyScope
        fun scopeStrand env = setScope StrandScope env
        fun scopeMethod (env, name) = setScope (MethodScope name) env
      (* 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
              }
      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{tgt, ...}, name, tyName, code, ...}, params, init) = let
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
              val fName = N.strandInit name
              val params =
                    CL.PARAM([], globTy, "glob") ::
                    CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut") ::
                      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{tgt, ...}, name, tyName, code, ...}, methName, body,hasCom) = let
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
              val fName = concat[name, "_", StrandUtil.nameToString methName]
              val params = [
                      CL.PARAM([], globTy, "glob"),
                      CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfIn"),
                      CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut")
                    ]

              val updateParams = params @ [CL.PARAM([], CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)),N.strandsName)
                                          ]
              (* Extra update params for spatial communication *) 
              val updateParams = params @ [CL.PARAM([], CL.T_Ptr(CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName))),"selfInStrands"), 
                                  CL.PARAM([], CL.T_Ptr(CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName))),"selfOutStrands"), 
                                  CL.PARAM([], CL.T_Ptr(CL.T_Ptr(CL.uint8)),"status"), 
                                  CL.PARAM([], CL.T_Ptr(CL.T_Named N.strandPoolTy),"poolInfo")] @ (if hasCom     
                                 then   [CL.PARAM([], CL.T_Ptr(CL.T_Named(N.gridContextTy)),N.gridCxtName), 
                                         CL.PARAM([],CL.T_Ptr(CL.T_Named(N.queryPoolTy)),N.queryPoolName)]
                                 else [])  
    

              val (resTy,params') = (case methName
                     of StrandUtil.Update => (CL.T_Named "StrandStatus_t",updateParams)
                      | StrandUtil.Stabilize => (CL.voidTy,params))

              val methFn = CL.D_Func(["static"], resTy, fName, params', body)
              in
                code := methFn :: !code
              end

      end

  (* programs *)
    structure Program =
      struct
        fun new (tgt : target_desc, props : StrandUtil.program_prop list) =  (
	      N.initTargetSpec {double = #double tgt, long = false};
	      Prog{
		  tgt = tgt,
		  hasDie = SU.hasProp SU.StrandsMayDie props,
		  hasNew = SU.hasProp SU.NewStrands props,
		  hasCom = SU.hasProp SU.StrandCommunication props,
          hasReduce = ref (false), 
          gridIs2D = SU.hasProp SU.GridIs2D props,
		  hasGlobalBlk = ref false,
          inputs = ref [],
		  globals = ref [],
          globalBlock = ref(NONE), 
          globalReduce = ref(CL.D_Comment["no global reduce"]), 
		  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

        (* Returns true if spatial communication is defined, otherwise false *) 
        fun hasSpatialCom(Prog{hasCom,...}) = hasCom 

     (*register the global block code *) 
      fun genGlobalFun(_,_,CL.S_Block([])) = () 
        | genGlobalFun(Prog{tgt, globalBlock,hasGlobalBlk, ...},Strand{tyName,...},globlFunBlk) =  let 
         val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
         val fName = N.globalFunName  
         val params = [CL.PARAM([], globTy, "glob"),
                       CL.PARAM([], CL.uint32, "numberOfStrands"), 
                       CL.PARAM([], CL.T_Ptr(CL.uint8), "status"), 
                       CL.PARAM([], CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)), "selfIn"), 
                       CL.PARAM([], CL.T_Ptr(CL.T_Named N.queryPoolTy),N.queryPoolName)]
         val globalFn = CL.D_Func(["static"], CL.voidTy, fName, params, globlFunBlk)
         in 
              globalBlock := SOME(globalFn); 
              hasGlobalBlk := true 
         end 


     (*register the global reduction block code *) 
       fun genGlobalReduceFun(Prog{hasReduce,...},_,CL.S_Block([])) = hasReduce:= false 
         | genGlobalReduceFun(Prog{tgt,globalReduce,hasReduce,...},Strand{tyName,...},globlReduceBlk) =  let 
         val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
         val fName = N.globalReduceName tyName;   
         val params = [CL.PARAM([], globTy, "glob"),
                       CL.PARAM([], CL.uint8, "selfInStatus"), 
                       CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfIn")]
         val globalRFn = CL.D_Func(["static"], CL.voidTy, fName, params, globlReduceBlk)
         in 
              globalReduce := globalRFn; 
              hasReduce := true 
         end 

      (* register the global initialization part of a program *)
        fun init (Prog{tgt, topDecls, ...}, init) = let
              val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
	      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 tgt)
		    then CL.mkIfThen(
		      CL.mkApply(N.checkDefined tgt, [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{tgt, topDecls, ...}, free) = let
              val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
              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{tgt, 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 tgt))
              val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
              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 [] = CL.mkBlock(createPrefix @ [
                      CL.mkCall(N.strandInit name, CL.mkVar "glob" :: statePtr "inState" :: args),
		      CL.mkCall("memcpy", [
			  statePtr "outState", statePtr "inState",
			  CL.mkSizeof(CL.T_Named(N.strandTy name))
			]),
                      CL.mkAssign(CL.mkIndirect(statePtr "inState","strandId"),CL.mkVar indexVar),
                      CL.mkAssign(CL.mkIndirect(statePtr "outState","strandId"),CL.mkVar indexVar),
                      CL.S_Exp(CL.mkPostOp(CL.mkVar indexVar, CL.^++))
                    ])
                | 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 tgt, [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 (tgt : target_desc, hasCom, hasGlobalBlk, hasReduce, gridIs2D,Strand{name, tyName, ...}) = let 
        val d =  if gridIs2D then 2 else 3
        val buildGrid =  concat["\n",N.gridBuildFun d, "(wrld->inState,wrld->gridCtx);\n"] 
        val queryInit = concat["\nwrld->", N.queryPoolName,"  = ", N.queryAllocFun, "();"] 
        val gridInit = concat["wrld->", N.gridCxtName,"= ", N.gridAllocFun d, "(&glob->qGridDim,",
                              "wrld->numStrands,",
                              "&glob->qCellDim,",
                              "&glob->qWinDim);\n"]  
        val globalBlock = concat["Diderot_QueryClearPool(wrld->queryPool);\n",
                                  N.globalFunName,
                                 "(glob,wrld->numStrands,wrld->status,wrld->inState,",
                                  "wrld->queryPool);"]  

        val globalReduce = "Diderot_GlobalReduceSeq(wrld,glob);"
        in 
         [
		("CFILE",	OS.Path.joinBaseExt{base= #outBase tgt, ext= SOME "c"}),
		("HDRFILE",	OS.Path.joinBaseExt{base= #outBase tgt, ext= SOME "h"}),
		("PREFIX",	#namespace tgt),
		("SRCFILE",	#srcFile tgt),
		("STRAND",	name),
        ("DEFINE_GRID_DIMENSION", if hasCom then (if gridIs2D then "#define DIDEROT_GRID_2D" 
                                                              else "#define DIDEROT_GRID_3D")
                                  else ""),
        ("QUERY_POOL_ALLOCATION", queryInit ), 
        ("GLOBAL_BLOCK", if !hasGlobalBlk then globalBlock   else ""),     
        ("GLOBAL_REDUCE", if !hasReduce then globalReduce   else ""),   
        ("GRID_D", if gridIs2D then "2" else "3"),
        ("BUILD_GRID", if hasCom then buildGrid else ""), 
        ("GRID_INIT", if hasCom then gridInit else ""), 
        ("PASS_GRID",  if hasCom then ",wrld->gridCtx,wrld->queryPool" else ""), 
		("STRANDTY",	tyName)
	      ]
        end 

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

	fun verbFrag (tgt : target_desc, parFrag, seqFrag, subs) =
	      CL.verbatim [if (#parallel tgt) then parFrag else seqFrag] subs

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

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

        fun genStrand (Strand{prog=Prog{tgt, ...}, name, tyName, state, output, code}) = let
            (* the type declaration for the strand's state struct *)
              val selfTyDef = CL.D_StructDef(
		      SOME(concat[#namespace tgt, "struct_", name]),
                      (List.rev (List.map (fn CL.V(ty, x) => (ty, x)) state))@[(ToC.trType(Ty.IntTy),"strandId")],
                      NONE)
            (* define the allocation of a strand function *) 
            val allocPrototype = CL.D_Verbatim([concat[" uint32_t  Diderot_AllocNewStrand(",
                                                  "StrandPoolInfo_t   * poolInfo,", 
                                                  tyName," **** selfIn,",  
                                                  tyName," **** selfOut,", 
                                                  "uint8_t *** status);\n"]])  
            
            (* 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 (tgt : target_desc, globals) =
              CL.D_StructDef(NONE, globals, SOME(#namespace tgt ^ "Globals_t"))

      (* generate the struct declaration for the world representation *)
	fun genWorldStruct (tgt, hasCom, Strand{tyName, ...}) = let
              val extras = [
		    (* target-specific world components *)
                      (CL.T_Ptr(CL.T_Named(N.globalsTy tgt)),	"globals"),
		      (CL.T_Ptr CL.uint8,			"status"),
		      (CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)),	"inState"),
              (CL.T_Named N.strandPoolTy, "poolInfo"), 
		      (CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)),	"outState"), 
              (CL.T_Ptr(CL.T_Named(N.queryPoolTy)),N.queryPoolName)
		    ]
	      val extras = if #exec tgt
		    then extras
		    else (CL.T_Named(N.definedInpTy tgt), "definedInp") :: extras
	      val extras = if #parallel tgt
		    then (CL.T_Ptr(CL.T_Named "Diderot_Sched_t"), "sched") :: extras
		    else (CL.T_Named "uint32_t", "numActive") :: extras
           val extras = if hasCom  
            then (CL.T_Ptr(CL.T_Named(N.gridContextTy)),N.gridCxtName):: extras 
            else extras  
              
	      in
		World.genStruct (tgt, 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{
                tgt, hasDie, hasNew, hasCom, hasReduce, gridIs2D, hasGlobalBlk,globalBlock,globalReduce,
		inputs, globals, topDecls, strands, nAxes, initially, ...
              }) = let
	    (* does the program require barrier synchronization to implement BSP semantics? *)
	      val needsBarrier = #bsp tgt orelse hasCom orelse !hasGlobalBlk
              val [strand as Strand{name, tyName, state, output, ...}] = AtomTable.listItems strands
	      val outputs = GenOutput.gen (tgt, !nAxes) [output]
	      val substitutions = mkSubs (tgt,hasCom,hasGlobalBlk,hasReduce,gridIs2D,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
              fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
	      in
		ppDecl (CL.verbatim [CHeadFrag.text] substitutions);
		if (#parallel tgt)
		  then ppDecl (CL.verbatim [CHeadParExtraFrag.text] substitutions)
		  else ();

                ppDecl (CL.verbatim [CHeadGridExtraFrag.text] substitutions); 

                ppDecl (GenInputs.genDefinedInpStruct (tgt, !inputs));
                ppDecl (genGlobalStruct (tgt, List.rev(!globals)));
		        ppDecl (genWorldStruct(tgt, hasCom, strand));
                List.app ppDecl (GenInputs.genInputFuns(tgt, !inputs));
                List.app ppDecl (List.rev (!topDecls));
                List.app ppDecl (genStrand strand);
                ppDecl(CL.verbatim [SeqNewFrag.text] substitutions);
                ppDecl(CL.verbatim [QueryPoolFrag.text] substitutions); 

            if (!hasGlobalBlk) then               
            case (!globalBlock) 
               of SOME b' => ppDecl(b')
                | NONE => ()
            else (); 

   


       if(hasCom)
              then (ppDecl(CL.verbatim [GridFrag.text] substitutions); 
                    if(gridIs2D)then ppDecl (CL.verbatim [Grid2DFrag.text] substitutions)	
                                else ppDecl (CL.verbatim [Grid3DFrag.text] substitutions))        
              else (); 

    if(!hasReduce) 
            then (ppDecl(!globalReduce); 
                  ppDecl(CL.verbatim [SeqGlobalReduceFrag.text] substitutions))
            else (); 

List.app ppDecl outputs;
                ppStrandTable (ppStrm, [strand]);

		ppDecl (CL.verbatim [CBodyFrag.text] substitutions);
		ppDecl (CL.verbatim [InitFrag.text] substitutions);
		ppDecl (CL.verbatim [AllocFrag.text] substitutions);
                ppDecl (!initially);
		ppDecl (CL.verbatim [
		    if not(#parallel tgt) then SeqRunFrag.text
		    else if needsBarrier then ParRunFrag.text
		    else ParRunFragNoBar.text
		  ] substitutions);
(*
		ppDecl (verbFrag (tgt, ParRunFrag.text, SeqRunFrag.text, substitutions));
*)
		ppDecl (CL.verbatim [ShutdownFrag.text] substitutions);
                PrintAsC.close ppStrm;
                TextIO.closeOut outS
	      end

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

        fun genExecSrc (baseName, prog) = let
              val Prog{
		      tgt, hasDie, hasNew, hasCom, hasReduce, gridIs2D,hasGlobalBlk,globalBlock,globalReduce, 
		      inputs, globals, topDecls, strands, nAxes, initially, ...
		    } = prog
	    (* does the program require barrier synchronization to implement BSP semantics? *)
	      val needsBarrier = #bsp tgt orelse hasCom orelse !hasGlobalBlk
              val [strand as Strand{name, tyName, state, output, ...}] = AtomTable.listItems strands
	      val outputs = GenOutput.gen (tgt, !nAxes) [output]
	      val substitutions =
		    ("DIDEROT_FLOAT_PRECISION", TargetUtil.floatPrecisionDef tgt) ::
		    ("DIDEROT_INT_PRECISION", TargetUtil.intPrecisionDef tgt) ::
		    ("DIDEROT_TARGET", TargetUtil.targetDef tgt) ::
		    mkSubs (tgt, hasCom,hasGlobalBlk,hasReduce,gridIs2D,strand)
              val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
              val outS = TextIO.openOut fileName
              val ppStrm = PrintAsC.new outS
              fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
              in
		ppDecl (CL.verbatim [ExecHdr.text] substitutions);
		if (#parallel tgt)
		  then ppDecl (CL.verbatim [CHeadParExtraFrag.text] substitutions)
		  else ();

             ppDecl (CL.verbatim [CHeadGridExtraFrag.text] substitutions); 
     
                ppDecl (genGlobalStruct (tgt, List.rev(!globals)));
		ppDecl (genWorldStruct(tgt, hasCom, strand));
              ppDecl (GenInputs.genInputsStruct (tgt, !inputs));
                List.app ppDecl (List.rev (!topDecls));
		List.app ppDecl (GenInputs.genExecInputFuns (tgt, !inputs));
                List.app ppDecl (genStrand strand); 
      ppDecl(CL.verbatim [SeqNewFrag.text] substitutions);          	
      ppDecl(CL.verbatim [QueryPoolFrag.text] substitutions); 

            if (!hasGlobalBlk) then               
            case (!globalBlock) 
               of SOME b' => ppDecl(b')
                | NONE => ()
            else (); 
            


       if(hasCom)
              then (ppDecl(CL.verbatim [GridFrag.text] substitutions); 
                    if(gridIs2D)then ppDecl (CL.verbatim [Grid2DFrag.text] substitutions)	
                                else ppDecl (CL.verbatim [Grid3DFrag.text] substitutions))        
              else (); 


       if(!hasReduce) 
            then (ppDecl(!globalReduce); 
                  ppDecl(CL.verbatim [SeqGlobalReduceFrag.text] substitutions))
            else (); 
		List.app ppDecl outputs;
                ppStrandTable (ppStrm, [strand]);
   	
		ppDecl (CL.verbatim [InitFrag.text] substitutions);
		ppDecl (CL.verbatim [AllocFrag.text] substitutions);
                ppDecl (!initially);
		ppDecl (CL.verbatim [
		    if not(#parallel tgt) then SeqRunFrag.text
		    else if needsBarrier then ParRunFrag.text
		    else ParRunFragNoBar.text
		  ] substitutions);
(*
		ppDecl (verbFrag (tgt, ParRunFrag.text, SeqRunFrag.text, substitutions));
*)
		ppDecl (CL.verbatim [ShutdownFrag.text] substitutions);
		ppDecl (verbFrag (tgt, 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{tgt, ...}) = let
	      val {outDir, outBase, exec, double, parallel, debug, ...} = tgt
	      val basename = OS.Path.joinDirFile{dir=outDir, file=outBase}
              in
                 genExecSrc (basename, prog); 
                compile (tgt, basename);
                RunCC.linkExec (basename, ldFlags tgt)
              end

	fun generate (prog as Prog{tgt, ...}) = if #exec tgt
	      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