SCM Repository
View of /branches/vis12/src/compiler/c-target/c-target.sml
Parent Directory
|
Revision Log
Revision 1917 -
(download)
(annotate)
Thu Jun 7 12:34:40 2012 UTC (8 years, 7 months ago) by jhr
File size: 23911 byte(s)
Thu Jun 7 12:34:40 2012 UTC (8 years, 7 months ago) by jhr
File size: 23911 byte(s)
Fixes to tracking of number of active strands
(* 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 type target_desc = TargetUtil.target_desc (* variable translation *) structure TrVar = struct type env = CL.typed_var TreeIL.Var.Map.map fun lookup (env, x) = (case V.Map.find (env, x) of SOME(CL.V(_, x')) => x' | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"]) (* end case *)) (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *) fun lvalueVar (env, x) = CL.mkVar(lookup(env, x)) (* translate a variable that occurs in an r-value context *) fun rvalueVar (env, x) = CL.mkVar(lookup(env, x)) (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *) fun lvalueVar (env, x) = (case V.kind x of IL.VK_Local => CL.mkVar(lookup(env, x)) | _ => CL.mkIndirect(CL.mkVar "glob", lookup(env, x)) (* end case *)) (* translate a variable that occurs in an r-value context *) fun rvalueVar (env, x) = (case V.kind x of IL.VK_Local => CL.mkVar(lookup(env, x)) | _ => CL.mkIndirect(CL.mkVar "glob", lookup(env, x)) (* end case *)) (* translate a strand state variable that occurs in an l-value context *) fun lvalueStateVar x = CL.mkIndirect(CL.mkVar "selfOut", IL.StateVar.name x) (* translate a strand state variable that occurs in an r-value context *) fun rvalueStateVar x = CL.mkIndirect(CL.mkVar "selfIn", IL.StateVar.name x) end structure ToC = TreeToCFn (TrVar) 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 *) inputs : GenInputs.input_desc list ref, globals : (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 (* 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) = 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 resTy = (case methName of StrandUtil.Update => CL.T_Named "StrandStatus_t" | StrandUtil.Stabilize => CL.voidTy (* 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 : target_desc) = ( N.initTargetSpec {double= #double tgt, long=false}; Prog{ tgt = tgt, inputs = ref [], globals = ref [], topDecls = ref [], strands = AtomTable.mkTable (16, Fail "strand table"), nAxes = ref(SOME ~1), initially = ref(CL.D_Comment["missing initially"]) }) (* register the code that is used to set defaults for input variables *) fun inputs (Prog{tgt, inputs, topDecls, ...}, env, blk) = let val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt)) val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt)) val body = CL.mkBlock( CL.mkDeclInit(globTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) :: CL.unBlock (Tr.block (env, blk))) val inputsFn = CL.D_Func( ["static"], CL.voidTy, N.initDefaults, [CL.PARAM([], worldTy, "wrld")], body) in inputs := GenInputs.gatherInputs blk; topDecls := inputsFn :: !topDecls 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 init = CL.mkBlock( CL.mkDeclInit(globTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) :: CL.unBlock init @ [CL.mkReturn(SOME(CL.mkVar "false"))]) val initFn = CL.D_Func( ["static"], CL.boolTy, N.initGlobals, [CL.PARAM([], worldTy, "wrld")], init) 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.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, Strand{name, tyName, ...}) = [ ("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), ("STRANDTY", tyName) ] 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), NONE) (* 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 :: 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, Strand{tyName, ...}) = let val ns = #namespace tgt val extras = [ (* target-specific world components *) (CL.T_Ptr(CL.T_Named(ns ^ "Globals_t")), "globals"), (CL.T_Ptr CL.uint8, "status"), (CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)), "inState"), (CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)), "outState") ] 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 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, inputs, globals, topDecls, strands, nAxes, initially, ... }) = let val [strand as Strand{name, tyName, state, output, ...}] = AtomTable.listItems strands val outputs = GenOutput.gen (tgt, !nAxes) [output] val substitutions = mkSubs (tgt, 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 (genGlobalStruct (tgt, List.rev(!globals))); ppDecl (genWorldStruct(tgt, strand)); List.app ppDecl (List.rev (!topDecls)); List.app ppDecl (GenInputs.genInputFuns(tgt, !inputs)); List.app ppDecl (genStrand strand); 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 (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, inputs, globals, topDecls, strands, nAxes, initially, ...} = prog 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, 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 (genGlobalStruct (tgt, List.rev(!globals))); ppDecl (genWorldStruct(tgt, strand)); List.app ppDecl (List.rev (!topDecls)); ppDecl (GenInputs.genRegisterInputs (tgt, !inputs)); List.app ppDecl (genStrand strand); List.app ppDecl outputs; ppStrandTable (ppStrm, [strand]); ppDecl (CL.verbatim [InitFrag.text] substitutions); ppDecl (CL.verbatim [AllocFrag.text] substitutions); ppDecl (!initially); 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 |