(* cl-target.sml * * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu) * All rights reserved. *) structure CLTarget : TARGET = struct structure IL = TreeIL structure V = IL.Var structure Ty = IL.Ty structure CL = CLang structure CLN = CLNames structure N = CNames structure ToC = TreeToC structure ToCL = TreeToCL structure SU = StrandUtil type props = Properties.props type var = CL.typed_var type exp = CL.exp type stm = CL.stm (* variable or field that is mirrored between host and GPU *) datatype mirror_var = MV of { var : CL.var, (* variable name *) ty : IL.Ty.ty, (* tree IL type *) hToS : stm (* the statement that converts the variable to its *) (* shadow representation *) } datatype strand = Strand of { prog : program, name : string, tyName : string, state : mirror_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 : Properties.props, globals : mirror_var 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. *) (* FIXME: for OpenCL 1.1, 3 is also valid *) fun vectorWidths () = [2, 4, 8, 16] (* we do not support printing on the OpenCL target *) val supportsPrinting = false (* 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? *) (* helper functions for specifying parameters in various address spaces *) local fun param spc (ty, x) = CL.PARAM([spc], ty, x) in val globalParam = param "__global" val constantParam = param "__constant" val localParam = param "__local" val privateParam = param "__private" fun clParam (ty, x) = CL.PARAM([], ty, x) end (* local *) (* OpenCL global pointer type *) fun globalPtr ty = CL.T_Qual("__global", CL.T_Ptr ty) (* lvalue/rvalue state variable *) fun lvalueSV name = CL.mkIndirect(CL.mkVar "selfOut", name) fun rvalueSV name = CL.mkIndirect(CL.mkVar "selfIn", name) (* TreeIL to target translations *) structure Tr = struct fun fragment (ENV{info, vMap, scope}, blk) = let val (vMap, stms) = (case scope of GlobalScope => ToC.trFragment (vMap, blk) | InitiallyScope => ToC.trFragment (vMap, blk) | _ => ToCL.trFragment (vMap, blk) (* end case *)) in (ENV{info=info, vMap=vMap, scope=scope}, stms) end fun block (ENV{vMap, scope, ...}, blk) = (case scope of StrandScope => ToC.trBlock (vMap, blk) | MethodScope name => ToCL.trBlock (vMap, blk) | InitiallyScope => ToCL.trBlock (vMap, blk) | _ => ToC.trBlock (vMap, blk) (* end case *)) fun free (ENV{vMap, ...}, blk) = ToC.trFree (vMap, blk) fun exp (ENV{vMap, ...}, e) = ToCL.trExp(vMap, e) end (* variables *) structure Var = struct fun mirror (ty, name, shadowEnv) = MV{ var = name, ty = ty, hToS = (case shadowEnv of GLOBAL_SHADOW => convertToShadow (ty, name) | STRAND_SHADOW => convertStrandToShadow(ty, name, "selfIn", "selfOut") (* end case *)) } fun name (ToCL.V(_, name)) = name fun global (Prog{globals, imgGlobals, ...}, name, ty) = let val x = mirror (ty, name, GLOBAL_SHADOW) fun isImgGlobal (Ty.ImageTy info, name) = imgGlobals := (name, ImageInfo.dim info) :: !imgGlobals | isImgGlobal _ = () in globals := x :: !globals; isImgGlobal (ty, name); ToCL.V(#gpuTy x, name) end fun param x = ToCL.V(CLTyTranslate.toGPUType(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, glob, selfIn, selfOut) (ENV{info, vMap, ...}) = ENV{ info = info, vMap = List.foldl (fn ((x, x'), vm) => V.Map.insert(vm, x, x')) vMap [ (PseudoVars.global, CL.V(CL.voidTy, glob)), (PseudoVars.selfIn, CL.V(CL.voidTy, selfIn)), (PseudoVars.selfOut, CL.V(CL.voidTy, selfOut)) ], scope = scope } (* define the current translation context *) val scopeGlobal = setScope (GlobalScope, CLN.globalsVarName, "_bogus_", "_bogus_") val scopeInitially = setScope (InitiallyScope, CLN.globalsVarName, "_bogus_", "_bogus_") val scopeStrand = setScope (StrandScope, CLN.globalsVarName, "selfIn", "selfOut") fun scopeMethod (env, name) = setScope (MethodScope name, CLN.globalsVarName, "selfIn", "selfOut") 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 = Var.mirror (IL.StateVar.ty x, IL.StateVar.name x, STRAND_SHADOW) 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([], 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 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 = globalParam (globTy, "glob") :: clParam (CL.T_Named(CLN.imageDataType), CLN.globalImageDataName) :: stateParams val resTy = (case methName of StrandUtil.Update => CL.T_Named "StrandStatus_t" | StrandUtil.Stabilize => CL.voidTy (* end case *)) val methFn = CL.D_Func([], resTy, fName, params, body) in code := methFn :: !code end end (* programs *) structure Program = struct fun new (tgt : TargetUtil.target_desc, props) = ( N.initTargetSpec {double= #double tgt, long=false}; Prog{ props = Properties.mkProps (tgt, props), inputs = ref [], globals = ref [], topDecls = ref [], strands = AtomTable.mkTable (16, Fail "strand table"), nAxes = ref(SOME ~1), initially = ref(CL.D_Comment["missing initially"]) }) (* FIXME: for standalone exes, the defaults should be set in the inputs struct; * not sure how to handle library inputs yet. *) (* DEPRECATED (* register the code that is used to set defaults for input variables *) fun inputs (Prog{props, inputs, topDecls, ...}, env, blk) = let val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy props)) val globTy = CL.T_Ptr(CL.T_Named(N.globalTy props)) 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 *) (* gather the inputs *) fun inputs (Prog{inputs, ...}, env, blk) = inputs := GenInputs.gatherInputs blk (* 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, initially, numDims, ...}, 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 [] = 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 "wrld"))]) val initFn = CL.D_Func([], worldTy, N.initially props, [], 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, ...}) = [ ("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) ] 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 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]), 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 (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 = [ (* target-specific world components *) (CL.T_Ptr(CL.T_Named(N.globalsTy props)), "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 #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.T_Named "uint32_t", "numActive") :: 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 (* generate the OpenCL source code. *) fun outputCLSrc (baseName, prog as Prog{props, ...}) = let val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "cl"} val outS = TextIO.openOut fileName val ppStrm = PrintAsCL.new outS fun ppDecl dcl = PrintAsCL.output(ppStrm, dcl) in (* Retrieve the header information *) ppDecl (CL.verbatimDcl [CLHeadFrag.text] [ ("OUTFILE", fileName), ("SRCFILE", #srcFile props), ("DIDEROT_FLOAT_PRECISION", Properties.floatPrecisionDef props), ("DIDEROT_INT_PRECISION", Properties.intPrecisionDef props) ]); (* FIXME: check to see if we really need the DUAL_STATE define for OpenCL *) if Properties.dualState props then ppDecl (CL.D_Verbatim ["#define DIDEROT_DUAL_STATE\n"]) else (); (* if there are no globals, then define a dummy type *) if List.null(!globals) then ppDecl (CL.D_Verbatim["typedef void ", CLN.globalsTy, ";\n"]) else (); (* if there are no images, then define a dummy type *) if List.null(!imgGlobals) then ppDecl (CL.D_Verbatim["typedef void * ", CLN.imageDataType, ";\n"]) else (); (* Retrieve the scheduler kernels and functions *) ppDecl (CL.D_Verbatim[CLSchedFrag.text]); (* FIXME: should only include eigen code fragments if they are being used! *) ppDecl (CL.D_Verbatim[CLEigen2x2Frag.text]); (* FIXME: should only include eigen code fragments if they are being used! *) ppDecl (CL.D_Verbatim[CLEigen3x3Frag.text]); ppDecl (genGlobalStruct (#gpuTy, !globals, CLN.globalsTy)); ppDecl (genImageDataStruct(!imgGlobals, CLN.imageDataType)); ppDecl (genStrandTyDef(#gpuTy, strand, tyName)); List.app clppDppDeclecl (!code); ppDecl (genStrandCopy strand); ppDecl (genUpdateMethod(strand, globals, imgGlobals)) end fun outputLibSrc (baseName, Prog{ props, inputs, globals, topDecls, strands, nAxes, initially, ... }) = let 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 fun ppDecl dcl = PrintAsC.output(ppStrm, dcl) in ppDecl (CL.verbatimDcl [CHeadFrag.text] substitutions); if Properties.dualState props then ppDecl (CL.D_Verbatim ["#define DIDEROT_DUAL_STATE\n"]) 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); 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 (CL.verbatimDcl [RunFrag.text] 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 = SOME LibInterfaceCLFrag.text, inputs = !inputs, outputs = [output] }; (* *) outputLibSrc (basename, prog); outputCLSrc (basename, prog); (* compile and link *) compile (props, basename); RunCC.linkLib (basename, ldFlags props) end fun outputExecSrc (baseName, prog) = let val Prog{props, inputs, globals, topDecls, strands, nAxes, initially, ...} = prog 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 ppStrm = PrintAsC.new outS fun ppDecl dcl = PrintAsC.output(ppStrm, dcl) in ppDecl (CL.verbatimDcl [ExecHdrFrag.text] substitutions); if Properties.dualState props then ppDecl (CL.D_Verbatim ["#define DIDEROT_DUAL_STATE\n"]) 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); List.app ppDecl outputs; ppStrandTable (ppStrm, [strand]); ppDecl (CL.verbatimDcl [InitFrag.text] substitutions); ppDecl (CL.verbatimDcl [AllocFrag.text] substitutions); ppDecl (!initially); ppDecl (CL.verbatimDcl [RunFrag.text] substitutions); ppDecl (CL.verbatimDcl [ShutdownFrag.text] substitutions); ppDecl (CL.verbatimDcl [MainFrag.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 outputExecSrc (basename, prog); outputCLSrc (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 CLBackEnd = CodeGenFn(CLTarget)