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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/target-cpu/gen.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/target-cpu/gen.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5536 - (view) (download)

1 : jhr 3902 (* gen.sml
2 :     *
3 :     * Code generation for the sequential and parallel targets.
4 :     *
5 :     * COPYRIGHT (c) 2016 The Diderot Project (http://diderot-language.cs.uchicago.edu)
6 :     * All rights reserved.
7 :     *)
8 :    
9 :     structure Gen : sig
10 :    
11 : jhr 5097 val exec : TargetSpec.t * CmdLineConstants.t * TreeIR.program -> unit
12 : jhr 3902
13 : jhr 5097 val library : TargetSpec.t * CmdLineConstants.t * TreeIR.program -> unit
14 : jhr 3902
15 :     end = struct
16 :    
17 :     structure IR = TreeIR
18 : jhr 3924 structure GV = TreeGlobalVar
19 : jhr 3902 structure CL = CLang
20 : jhr 3905 structure Env = CodeGenEnv
21 :     structure Out = CodeOutput
22 : jhr 3906 structure RN = CxxNames
23 : jhr 4407 structure Frags = CPUFragments
24 : jhr 4933 structure TSpec = TargetSpec
25 : jhr 3902
26 : jhr 3905 val openCxxOut = Out.openOut {ext = "cxx", ppDecl = PrintAsCxx.output}
27 :    
28 : jhr 4933 fun mkEnv spec = if TSpec.dualState spec
29 : jhr 4317 then Env.new {
30 :     world = RN.worldVar,
31 :     global = RN.globalsVar,
32 : jhr 4500 selfLocal = RN.selfLocalVar,
33 : jhr 4317 selfIn = RN.selfInVar,
34 :     selfOut = RN.selfOutVar,
35 :     spec = spec
36 :     }
37 :     else Env.new {
38 :     world = RN.worldVar,
39 :     global = RN.globalsVar,
40 : jhr 4500 selfLocal = RN.selfVar,
41 : jhr 4317 selfIn = RN.selfVar,
42 :     selfOut = RN.selfVar,
43 :     spec = spec
44 :     }
45 : jhr 3908
46 : jhr 4988 type method_props = {present : bool, needsW : bool, hasG : bool}
47 :    
48 : jhr 3905 (* create the target-specific substitution list *)
49 : jhr 4045 fun mkSubs (spec, strand, create) = let
50 : jhr 4500 val IR.Strand{name, stateInit, startM, updateM, stabilizeM, ...} = strand
51 : jhr 4937 (* make the parameter-type string for a strand method. This code should be kept in
52 :     * sync with the genMethodDef function in gen-strand.sml
53 :     *)
54 : jhr 4988 fun mkMethodParams (_, name, {present=false, ...} : method_props) = (name, "")
55 :     | mkMethodParams (needWorker, name, {needsW, hasG, ...}) = let
56 : jhr 5070 val params = GenStrand.methodParams {
57 :     world = fn _ => "world *wrld, ",
58 :     wcache = fn _ => "worker_cache *strands, ",
59 :     globals = fn _ => "globals *glob, "
60 :     } spec {
61 :     cxt = (), needWorker = needWorker, needsW = needsW, hasG = hasG
62 :     }
63 :     in
64 :     (name, String.concat params)
65 :     end
66 : jhr 4937 (* make the argument string for a strand method. This code should be kept in
67 :     * sync with the code above and the genMethodDef function in gen-strand.sml
68 :     *)
69 : jhr 4988 fun mkMethodArgs (_, _, name, {present=false, ...} : method_props) = (name, "")
70 :     | mkMethodArgs (needWorker, inWrld, name, {needsW, hasG, ...}) = let
71 : jhr 5070 val args = GenStrand.methodParams {
72 :     world = fn true => "this, " | false => "wrld, ",
73 :     wcache = fn _ => "strands, ",
74 :     globals = fn _ => "glob, "
75 :     } spec {
76 :     cxt = inWrld, needWorker = needWorker, needsW = needsW, hasG = hasG
77 :     }
78 :     in
79 :     (name, String.concat args)
80 :     end
81 : jhr 5012 (* get method properties *)
82 :     fun methodProps NONE = {present=false, needsW=false, hasG=false}
83 :     | methodProps (SOME(IR.Method{needsW, hasG, ...})) =
84 :     {present=true, needsW=needsW, hasG=hasG}
85 :     (* add properties from the second method to the first *)
86 :     fun combineProps ({present, needsW, hasG}, props : method_props) = {
87 :     present = present,
88 :     needsW = present andalso (needsW orelse #needsW props),
89 :     hasG = present andalso (hasG orelse #hasG props)
90 :     }
91 :     (* extra parameters/arguments for various functions that are defined in the code
92 :     * fragments. There are some inclusion requirements on these:
93 :     *
94 :     * START_PARAMS ⊆ STABILIZE_PARAMS (because run_start_methods)
95 :     *
96 :     * There are two argument forms, which depend on whether the calling function
97 :     * is a world method or not.
98 :     *)
99 :     val updateMProps = methodProps (SOME updateM)
100 :     val stabilizeMProps = methodProps stabilizeM
101 :     val startMProps = combineProps (methodProps startM, stabilizeMProps)
102 : jhr 4317 in [
103 :     ("CFILE", OS.Path.joinBaseExt{base= #outBase spec, ext= SOME "c"}),
104 :     ("CXXFILE", OS.Path.joinBaseExt{base= #outBase spec, ext= SOME "cxx"}),
105 :     ("H_FILE", OS.Path.joinBaseExt{base= #outBase spec, ext= SOME "h"}),
106 : jhr 4842 ("LOG_FILE", OS.Path.joinBaseExt{base= #outBase spec, ext= SOME "evtlog"}),
107 : jhr 4317 ("PREFIX", #namespace spec),
108 :     ("SRCFILE", #srcFile spec),
109 :     ("PROG_NAME", #outBase spec),
110 :     ("STRAND", Atom.toString name),
111 :     ("STRANDTY", Atom.toString name ^ "_strand"),
112 :     ("IS_GRID", Bool.toString(#isGrid spec)),
113 : jhr 4500 ("NUM_AXES", Int.toString(Option.getOpt(Create.arrayDim create, 1))),
114 : jhr 4369 ("SPATIAL_DIM", Int.toString(Option.getOpt(#spatialDim spec, 0))),
115 : jhr 4317 ("DIDEROTC_CMD", #diderotc spec),
116 :     ("DIDEROTC_ARGV", String.concatWith " " (#argv spec)),
117 :     ("DIDEROTC_VERSION", #version spec),
118 : jhr 4933 ("DIDEROT_FLOAT_PRECISION", TSpec.floatPrecisionDef spec),
119 :     ("DIDEROT_INT_PRECISION", TSpec.intPrecisionDef spec),
120 :     ("DIDEROT_TARGET", TSpec.targetDef spec),
121 : jhr 4317 ("REALTY", if #double spec then "double" else "float"),
122 :     ("INTTY", if #longint spec then "int64_t" else "int32_t"),
123 : jhr 4965 ("DIDEROT_REAL_SIZE", if #double spec then "64" else "32"),
124 :     ("DIDEROT_INT_SIZE", if #longint spec then "64" else "32"),
125 : jhr 4317 ("BOOLTY", SizeOf.c_bool),
126 : jhr 5012 (* START_{PARAMS,ARGS,ARGS_IN_WRLD} used for
127 :     * worker_cache::run_start_methods (@START_PARAMS@ ...)
128 :     * worker_cache::strand_start (@START_PARAMS@ ...)
129 :     * strand_status @STRAND@_start (@START_PARAMS@ ...)
130 :     *)
131 : jhr 4988 mkMethodParams (true, "START_PARAMS", startMProps),
132 :     mkMethodArgs (true, true, "START_ARGS_IN_WRLD", startMProps),
133 :     mkMethodArgs (true, false, "START_ARGS", startMProps),
134 : jhr 5012 (* UPDATE_{PARAMS,ARGS,ARGS_IN_WRLD} used for
135 :     * worker_cache::run_start_methods (@START_PARAMS@ ...)
136 :     * worker_cache::strand_start (@START_PARAMS@ ...)
137 :     * strand_status @STRAND@_start (@START_PARAMS@ ...)
138 :     *)
139 : jhr 4988 mkMethodParams (true, "UPDATE_PARAMS", updateMProps),
140 :     mkMethodArgs (true, true, "UPDATE_ARGS_IN_WRLD", updateMProps),
141 :     mkMethodArgs (true, false, "UPDATE_ARGS", updateMProps),
142 : jhr 5012 (* used for
143 :     * worker_cache::strand_stabilize (sched_block *bp, @STABILIZE_PARAMS@ ...)
144 :     * strand_stabilize (@STABILIZE_PARAMS@ ...)
145 :     * strand_array::strand_stabilize (@STABILIZE_PARAMS@ ...)
146 :     *)
147 : jhr 4988 mkMethodParams (false, "STABILIZE_PARAMS", stabilizeMProps),
148 :     mkMethodArgs (false, true, "STABILIZE_ARGS_IN_WRLD", stabilizeMProps),
149 :     mkMethodArgs (false, false, "STABILIZE_ARGS", stabilizeMProps)
150 : jhr 4317 ] end
151 : jhr 3905
152 :     fun condCons (true, x, xs) = x::xs
153 :     | condCons (false, _, xs) = xs
154 :    
155 : jhr 3906 fun verbFrag (spec, parFrag, seqFrag, subs) =
156 : jhr 4933 CL.verbatimDcl [if (TSpec.isParallel spec) then parFrag else seqFrag] subs
157 : jhr 3905
158 : jhr 4547 (* translate function parameters and initialize the environment *)
159 :     fun trParams (spec, params) = List.foldr
160 : jhr 4628 (fn (x, (env, ps)) => let
161 :     val (env, p) = TreeToCxx.trParam(env, x)
162 :     in
163 :     (env, p::ps)
164 :     end)
165 :     (Env.empty spec, []) params
166 : jhr 4547
167 : jhr 4174 (* generate code for a user-defined function *)
168 :     fun genFunc spec (IR.Func{name, params, body}) = let
169 : jhr 4317 val (resTy, _) = TreeFunc.ty name
170 : jhr 4547 val (env, params) = trParams (spec, params)
171 : jhr 4317 val (env, params) = if TreeFunc.hasGlobals name
172 :     then (
173 :     Env.insert(env, PseudoVars.global, RN.globalsVar),
174 :     CL.PARAM([], RN.globalPtrTy, RN.globalsVar) :: params
175 :     )
176 :     else (env, params)
177 :     val (env, params) = if TreeFunc.needsWorld name
178 :     then (
179 :     Env.insert(env, PseudoVars.world, RN.worldVar),
180 :     CL.PARAM([], RN.worldPtrTy, RN.worldVar) :: params
181 :     )
182 :     else (env, params)
183 :     in
184 :     CL.D_Func([], TreeToCxx.trType(env, resTy), [], TreeFunc.qname name, params,
185 :     TreeToCxx.trBlock (env, body))
186 :     end
187 : jhr 4174
188 : jhr 5269 (* QUESTION: should be move the init_consts code into a constructor for the
189 :     * globals struct and make init_globals a member of the world struct?
190 :     *)
191 : jhr 3931
192 : jhr 5257 fun genInitConsts (env, IR.Block{locals, body}) = let
193 : jhr 5269 val body = IR.Block{locals=locals, body=body}
194 : jhr 5257 in
195 : jhr 5269 CL.D_Func(["static"], CL.voidTy, [], "init_consts",
196 : jhr 5257 [RN.worldParam],
197 :     GenUtil.genBodyWithGlobPtr (env, body))
198 :     end
199 :    
200 :     fun genInitGlobals (env, inputs, globals, IR.Block{locals, body}) = let
201 :     val body = GenUtil.genBodyWithGlobPtr (env, IR.Block{locals=locals, body=body})
202 :     (* register global references to image data *)
203 :     val regStms = let
204 :     fun isImg gv = (case GV.ty gv
205 :     of TreeTypes.ImageTy _ => true
206 :     | _ => false
207 :     (* end case *))
208 :     val imgs = List.filter isImg globals
209 :     val imgs = List.foldr
210 :     (fn (inp, gvs) => let val gv = Inputs.varOf inp
211 :     in
212 :     if isImg gv then gv :: gvs else gvs
213 :     end) imgs inputs
214 :     fun mkStm gv = CL.mkExpStm(
215 :     CL.mkDispatch(CL.mkIndirect(CL.mkVar "glob", GV.qname gv),
216 :     "register_global", []))
217 :     in
218 :     (* the init_globals function returns false on success *)
219 :     List.map mkStm imgs @ [CL.mkReturn(SOME(CL.mkVar "false"))]
220 :     end
221 :     val body = CL.mkBlock(CL.unBlock body @ regStms)
222 :     in
223 :     CL.D_Func(["static"], CL.boolTy, [], "init_globals", [RN.worldParam], body)
224 :     end
225 :    
226 : jhr 4500 (* specialize the fragments that implement the run and run_start_methods world methods *)
227 : jhr 4407 fun runFrag (spec, subs) = let
228 : jhr 5012 val frags = (case (TSpec.isParallel spec, TSpec.noBSP spec)
229 :     of (false, false) => [Frags.seqRun]
230 :     | (false, true) => [Frags.seqRunNoBSP]
231 :     | (true, false) => [Frags.parWorker, Frags.parRun]
232 :     | (true, true) => [Frags.parWorkerNoBSP, Frags.parRun]
233 :     (* end case *))
234 : jhr 4985 val frags = (case (TSpec.isParallel spec, #hasStartMeth spec)
235 : jhr 5012 of (false, true) => Frags.seqRunStartMethods :: frags
236 :     | (true, true) => Frags.parRunStartMethods :: frags
237 :     | _ => frags
238 :     (* end case *))
239 :     in
240 :     [CL.verbatimDcl frags subs]
241 :     end
242 : jhr 3917
243 : jhr 4933 fun compile (spec : TSpec.t, basename) = let
244 : jhr 4317 (* generate the C compiler flags *)
245 :     val cflags = ["-I" ^ Paths.diderotInclude(), "-I" ^ Paths.teemInclude()]
246 : jhr 5012 val cflags = #simd Paths.cxxFlags :: cflags
247 : jhr 4933 val cflags = condCons (TSpec.isParallel spec, #parallel Paths.cxxFlags, cflags)
248 : jhr 4317 val cflags = if #debug spec
249 : jhr 4417 then #debug Paths.cxxFlags :: cflags
250 :     else #ndebug Paths.cxxFlags :: cflags
251 :     val cflags = #base Paths.cxxFlags :: cflags
252 : jhr 4317 in
253 :     RunCC.compile (basename, cflags)
254 :     end
255 : jhr 3905
256 : jhr 4933 fun ldFlags (spec : TSpec.t) = if #exec spec
257 : jhr 4317 then let
258 : jhr 4933 val extraLibs = condCons (TSpec.isParallel spec, #parallel Paths.extraLibs, [])
259 : jhr 4317 val extraLibs = Paths.teemLinkFlags() @ #base Paths.extraLibs :: extraLibs
260 : jhr 4933 val rtLib = TSpec.runtimeLibName spec
261 : jhr 4317 in
262 : jhr 4933 condCons (TSpec.isParallel spec, #parallel Paths.cxxFlags, rtLib :: extraLibs)
263 : jhr 4317 end
264 : jhr 5536 else TSpec.runtimeLibName spec :: Paths.teemLinkFlags()
265 : jhr 3905
266 : jhr 4367 (* generate defines that control specialization of the code for various features (e.g.,
267 :     * parallelism, global updates, ...
268 :     *)
269 : jhr 5097 fun outputDefines (outS, spec, defs, substitutions) = let
270 : jhr 4369 val ppDecl = Out.decl outS
271 : jhr 4387 fun pp (true, dcl) = ppDecl (CL.D_Verbatim ["#define " ^ dcl])
272 : jhr 4369 | pp _ = ()
273 : jhr 5113 fun cmdLineDef (symb, value) =
274 :     ppDecl (CL.D_Verbatim [concat["#define ", symb, " ", value]])
275 : jhr 4369 in
276 : jhr 5012 pp (#exec spec andalso #snapshot spec, "DIDEROT_EXEC_SNAPSHOT");
277 : jhr 4933 pp (not(TSpec.noBSP spec), "DIDEROT_BSP");
278 : jhr 4628 pp (#hasStartMeth spec, "DIDEROT_HAS_START_METHOD");
279 : jhr 4500 pp (#hasStabilizeMeth spec, "DIDEROT_HAS_STABILIZE_METHOD");
280 : jhr 4933 pp (TSpec.dualState spec, "DIDEROT_DUAL_STATE");
281 :     pp (TSpec.indirectState spec, "DIDEROT_INDIRECT_STATE");
282 : jhr 4943 pp (#strandConstr spec, "DIDEROT_STRAND_HAS_CONSTR");
283 : jhr 5108 pp (#hasConsts spec, "DIDEROT_HAS_CONSTS");
284 : jhr 5113 pp (not(#hasConsts spec orelse #hasGlobals spec), "DIDEROT_NO_GLOBALS");
285 : jhr 4387 pp (not(#hasInputs spec), "DIDEROT_NO_INPUTS");
286 : jhr 4628 pp (#hasDie spec orelse #hasKillAll spec, "DIDEROT_HAS_STRAND_DIE");
287 : jhr 4500 pp (#hasNew spec, "DIDEROT_HAS_STRAND_NEW");
288 : jhr 5012 pp (#isGrid spec, "DIDEROT_STRAND_ARRAY");
289 : jhr 4387 pp (#hasCom spec, "DIDEROT_HAS_STRAND_COMMUNICATION");
290 : jhr 4589 pp (not(#useKDTree spec), "DIDEROT_NO_SPACE_PARTITION");
291 : jhr 4500 pp (#hasGlobalStart spec, "DIDEROT_HAS_GLOBAL_START");
292 : jhr 4387 pp (#hasGlobalUpdate spec, "DIDEROT_HAS_GLOBAL_UPDATE");
293 : jhr 4933 pp (TSpec.killAll spec, "DIDEROT_HAS_KILL_ALL");
294 : jhr 4500 pp (#hasStabilizeAll spec, "DIDEROT_HAS_STABILIZE_ALL");
295 : jhr 4842 pp (#hasReduce spec, "DIDEROT_HAS_MAPREDUCE");
296 : jhr 5097 pp (#runtimeLog spec, "DIDEROT_ENABLE_LOGGING");
297 : jhr 5113 List.app cmdLineDef (CmdLineConstants.defines defs)
298 : jhr 4369 end
299 : jhr 4367
300 : jhr 4500 (* include the appropriate definition of the strand_array type based on the target *)
301 :     fun strandArrayDcl spec = (
302 : jhr 4933 case (TSpec.isParallel spec, TSpec.dualState spec, TSpec.indirectState spec)
303 : jhr 4766 of (true, false, false) => CPUFragments.parSArrayDir
304 : jhr 4906 | (true, true, false) => CPUFragments.parSArrayDualDir
305 : jhr 5012 | (true, false, true) => CPUFragments.parSArrayInd
306 :     | (true, true, true) => CPUFragments.parSArrayDualInd
307 : jhr 4500 | (_, false, false) => CPUFragments.seqSArrayDir
308 :     | (_, true, false) => CPUFragments.seqSArrayDualDir
309 :     | (_, false, true) => CPUFragments.seqSArrayInd
310 :     | (_, true, true) => CPUFragments.seqSArrayDualInd
311 :     (* end case *))
312 :    
313 : jhr 3912 (* generate source code that is common to both libraries and standalone executables *)
314 : jhr 4500 fun outputSrc (outS, env, spec, prog, strand, outputs, substitutions, genInputCode) = let
315 : jhr 5108 val IR.Program{
316 :     consts, inputs, globals, funcs, constInit, globInit,
317 :     create, start, update, ...
318 :     } = prog
319 : jhr 4317 val IR.Strand{name=strandName, ...} = strand
320 : jhr 4500 val dim = Create.arrayDim create
321 : jhr 4317 val ppDecl = Out.decl outS
322 : jhr 4500 val {structDefs, methods} = GenStrand.gen (env, strand)
323 : jhr 4317 in
324 : jhr 4899 List.app ppDecl
325 :     (GenGlobals.gen{env=env, consts=consts, inputs=inputs, globals=globals});
326 : jhr 4500 List.app ppDecl structDefs;
327 :     ppDecl (CL.verbatimDcl [strandArrayDcl spec] substitutions);
328 : jhr 4349 ppDecl (GenWorld.genStruct(env, strandName, Option.getOpt(dim, 1)));
329 : jhr 4317 List.app ppDecl (genInputCode());
330 :     List.app (ppDecl o genFunc spec) funcs;
331 : jhr 5108 if #hasConsts spec
332 :     then ppDecl (genInitConsts (env, constInit))
333 :     else ();
334 : jhr 4317 if #hasGlobalInit spec
335 : jhr 5257 then ppDecl (genInitGlobals (env, inputs, globals, globInit))
336 : jhr 4317 else ();
337 :     List.app ppDecl methods;
338 :     List.app ppDecl (GenOutputs.gen (env, dim, outputs));
339 : jhr 4407 ppDecl (CL.verbatimDcl [Frags.worldMethods] substitutions);
340 :     ppDecl (GenWorld.genCreateFun (env, globInit, strand, create));
341 :     List.app ppDecl (runFrag (spec, substitutions));
342 : jhr 4500 Option.app (fn blk => ppDecl (GenGlobalUpdate.gen (env, "start", blk))) start;
343 : jhr 4386 Option.app (fn blk => ppDecl (GenGlobalUpdate.gen (env, "update", blk))) update
344 : jhr 4317 end
345 : jhr 3931
346 : jhr 5097 fun exec (spec : TSpec.t, defs, prog) = let
347 : jhr 4317 val IR.Program{inputs, strand, create, ...} = prog
348 :     val env = mkEnv spec
349 :     val baseName = OS.Path.joinDirFile{dir = #outDir spec, file = #outBase spec}
350 :     val substitutions = mkSubs (spec, strand, create)
351 :     (* output to C++ file *)
352 :     val outS = openCxxOut baseName
353 :     val ppDecl = Out.decl outS
354 :     val fragment = Out.fragment substitutions outS
355 : jhr 4369 val {preWorld, postWorld} = GenTysAndOps.gen (env, CollectInfo.collect prog)
356 : jhr 4500 val outputs = OutputUtil.gatherOutputs (spec, prog)
357 : jhr 4317 in
358 : jhr 5012 ppDecl (CL.verbatimDcl [CxxFragments.cxxHead] substitutions);
359 : jhr 5097 outputDefines (outS, spec, defs, substitutions);
360 : jhr 4367 ppDecl (CL.verbatimDcl [CxxFragments.execIncl] substitutions);
361 : jhr 4351 List.app ppDecl preWorld;
362 : jhr 4317 ppDecl (CL.verbatimDcl [CxxFragments.namespaceOpen] substitutions);
363 :     ppDecl (CL.verbatimDcl [CxxFragments.nrrdSaveHelper] substitutions);
364 : jhr 4500 outputSrc (outS, env, spec, prog, strand, outputs, substitutions,
365 : jhr 4317 fn () => (
366 : jhr 4369 postWorld @
367 : jhr 4317 GenInputs.genInputsStruct (env, inputs) @
368 :     GenInputs.genExecInputFuns (env, prog) @
369 : jhr 4500 GenOutputsUtil.genRegisterOutputOpts (env, outputs)));
370 : jhr 4317 ppDecl (CL.verbatimDcl [CxxFragments.namespaceClose] substitutions);
371 :     (* generate main function after closing off the namespace *)
372 : jhr 5267 ppDecl (CL.verbatimDcl [Frags.exitWithError] substitutions);
373 : jhr 4407 ppDecl (verbFrag (spec, Frags.parMain, Frags.seqMain, substitutions));
374 : jhr 4317 Out.closeOut outS;
375 :     compile (spec, baseName);
376 :     RunCC.linkExec (baseName, ldFlags spec)
377 :     end
378 : jhr 3990
379 : jhr 5097 fun library (spec : TSpec.t, defs, prog) = let
380 : jhr 4317 val IR.Program{inputs, strand, create, ...} = prog
381 :     val env = mkEnv spec
382 :     val baseName = OS.Path.joinDirFile{dir = #outDir spec, file = #outBase spec}
383 :     val substitutions = mkSubs (spec, strand, create)
384 :     (* output to C++ file *)
385 :     val outS = openCxxOut baseName
386 :     val ppDecl = Out.decl outS
387 :     val fragment = Out.fragment substitutions outS
388 :     (* gather the outputs *)
389 : jhr 4500 val outputs = OutputUtil.gatherOutputs (spec, prog)
390 : jhr 4369 val {preWorld, postWorld} = GenTysAndOps.gen (env, CollectInfo.collect prog)
391 : jhr 4317 in
392 : jhr 5012 if not (TSpec.isDebugger spec)
393 :     then (* generate the library .h file *)
394 :     GenLibraryInterface.gen {
395 :     subs = substitutions,
396 :     env = env,
397 :     rt = NONE, (* ?? *)
398 :     inputs = inputs,
399 :     outputs = outputs
400 :     }
401 :     else ();
402 :     (* generate the optional JSON description of the library API *)
403 : jhr 4965 if (#jsonAPI spec)
404 :     then GenLibraryJSON.gen {
405 : jhr 5012 subs = substitutions,
406 :     env = env,
407 :     rt = NONE, (* ?? *)
408 : jhr 5070 strand = strand,
409 : jhr 5012 inputs = inputs,
410 :     outputs = outputs
411 :     }
412 : jhr 4965 else ();
413 : jhr 5012 ppDecl (CL.verbatimDcl [CxxFragments.cxxHead] substitutions);
414 : jhr 5097 outputDefines (outS, spec, defs, substitutions);
415 : jhr 5012 if (TSpec.isDebugger spec)
416 :     then ppDecl (CL.verbatimDcl [CxxFragments.debugIncl] substitutions)
417 :     else ppDecl (CL.verbatimDcl [CxxFragments.libCXXIncl] substitutions);
418 : jhr 4351 List.app ppDecl preWorld;
419 : jhr 4317 ppDecl (CL.verbatimDcl [CxxFragments.namespaceOpen] substitutions);
420 :     ppDecl (CL.verbatimDcl [CxxFragments.nrrdSaveHelper] substitutions);
421 :     List.app ppDecl (GenInputs.genDefinedInpStruct inputs);
422 : jhr 4500 outputSrc (outS, env, spec, prog, strand, outputs, substitutions,
423 : jhr 4351 fn () => (postWorld @ GenInputs.genLibraryInputFuns (env, prog)));
424 : jhr 5012 if (TSpec.isDebugger spec)
425 :     then List.app ppDecl (GenDebuggerHooks.gen (env, prog))
426 :     else ();
427 : jhr 5068 ppDecl (CL.verbatimDcl [CxxFragments.namespaceClose] substitutions);
428 : jhr 4407 ppDecl (CL.verbatimDcl [Frags.cWrappers] substitutions);
429 : jhr 4317 Out.closeOut outS;
430 :     (* compile and link *)
431 :     compile (spec, baseName);
432 : jhr 5513 RunCC.linkLib (#staticLib spec, baseName, ldFlags spec)
433 : jhr 4317 end
434 : jhr 3908
435 : jhr 3902 end

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