Annotation of /branches/vis12/src/compiler/c-target/c-target.sml

Parent Directory | Revision Log

---

Revision 2076 - (view) (download)

1 :	jhr	1115	(* c-target.sml
2 :			*
3 :			* COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :			* All rights reserved.
5 :			*)
6 :
7 :			structure CTarget : TARGET =
8 :			struct
9 :
10 :			structure IL = TreeIL
11 :			structure V = IL.Var
12 :			structure Ty = IL.Ty
13 :			structure CL = CLang
14 :	jhr	1376	structure N = CNames
15 :	jhr	2048	structure ToC = TreeToC
16 :	jhr	2076	structure SU = StrandUtil
17 :	jhr	1115
18 :	jhr	1716	type target_desc = TargetUtil.target_desc
19 :
20 :	jhr	1640	type var = CL.typed_var
21 :	jhr	1115	type exp = CL.exp
22 :			type stm = CL.stm
23 :
24 :			datatype strand = Strand of {
25 :	jhr	1806	prog : program,
26 :	jhr	1375	name : string,
27 :			tyName : string,
28 :	jhr	1640	state : var list,
29 :			output : (Ty.ty * CL.var), (* the strand's output variable (only one for now) *)
30 :	jhr	1375	code : CL.decl list ref
31 :	jhr	1115	}
32 :
33 :	jhr	1806	and program = Prog of {
34 :	jhr	1716	tgt : target_desc, (* info about target *)
35 :	jhr	2076	hasDie : bool, (* true for programs that have "die" *)
36 :			hasNew : bool, (* true for programs that have "new" *)
37 :			hasCom : bool, (* true for programs that have strand communication *)
38 :			hasReduce : bool, (* true for programs that have global reduce *)
39 :	jhr	1803	inputs : GenInputs.input_desc list ref,
40 :	jhr	1806	globals : (CL.ty * string) list ref,
41 :	jhr	1375	topDecls : CL.decl list ref,
42 :			strands : strand AtomTable.hash_table,
43 :	jhr	1713	nAxes : int option ref, (* number of axes in initial grid (NONE means collection) *)
44 :	jhr	1375	initially : CL.decl ref
45 :	jhr	1115	}
46 :
47 :			datatype env = ENV of {
48 :	jhr	1375	info : env_info,
49 :			vMap : var V.Map.map,
50 :			scope : scope
51 :	jhr	1115	}
52 :
53 :			and env_info = INFO of {
54 :	jhr	1375	prog : program
55 :	jhr	1115	}
56 :
57 :			and scope
58 :			= NoScope
59 :			| GlobalScope
60 :			| InitiallyScope
61 :	jhr	1640	| StrandScope (* strand initialization *)
62 :			| MethodScope of StrandUtil.method_name (* method body; vars are state variables *)
63 :	jhr	1115
64 :			(* the supprted widths of vectors of reals on the target. For the GNU vector extensions,
65 :			* the supported sizes are powers of two, but float2 is broken.
66 :			* NOTE: we should also consider the AVX vector hardware, which has 256-bit registers.
67 :			*)
68 :	jhr	1376	fun vectorWidths () = if !N.doublePrecision
69 :	jhr	1375	then [2, 4, 8]
70 :			else [4, 8]
71 :	jhr	1115
72 :	jhr	1640	(* we support printing in the sequential C target *)
73 :			val supportsPrinting = true
74 :
75 :	jhr	1115	(* tests for whether various expression forms can appear inline *)
76 :	jhr	1375	fun inlineCons n = (n < 2) (* vectors are inline, but not matrices *)
77 :			val inlineMatrixExp = false (* can matrix-valued expressions appear inline? *)
78 :	jhr	1115
79 :			(* TreeIL to target translations *)
80 :			structure Tr =
81 :			struct
82 :	jhr	1375	fun fragment (ENV{info, vMap, scope}, blk) = let
83 :			val (vMap, stms) = ToC.trFragment (vMap, blk)
84 :			in
85 :			(ENV{info=info, vMap=vMap, scope=scope}, stms)
86 :			end
87 :	jhr	1640	(* NOTE: we may be able to simplify the interface to ToC.trBlock! *)
88 :			fun block (ENV{vMap, ...}, blk) = ToC.trBlock (vMap, blk)
89 :	nseltzer	1870	fun free (ENV{vMap, ...}, blk) = ToC.trFree (vMap, blk)
90 :	jhr	1375	fun exp (ENV{vMap, ...}, e) = ToC.trExp(vMap, e)
91 :	jhr	1115	end
92 :
93 :			(* variables *)
94 :			structure Var =
95 :			struct
96 :	jhr	1640	fun name (CL.V(_, name)) = name
97 :	jhr	1375	fun global (Prog{globals, ...}, name, ty) = let
98 :			val ty' = ToC.trType ty
99 :			in
100 :	jhr	1806	globals := (ty', name) :: !globals;
101 :	jhr	1640	CL.V(ty', name)
102 :	jhr	1375	end
103 :	jhr	1640	fun param x = CL.V(ToC.trType(V.ty x), V.name x)
104 :	jhr	1115	end
105 :
106 :			(* environments *)
107 :			structure Env =
108 :			struct
109 :			(* create a new environment *)
110 :	jhr	1375	fun new prog = ENV{
111 :			info=INFO{prog = prog},
112 :			vMap = V.Map.empty,
113 :			scope = NoScope
114 :			}
115 :	jhr	1115	(* define the current translation context *)
116 :	jhr	1375	fun setScope scope (ENV{info, vMap, ...}) = ENV{info=info, vMap=vMap, scope=scope}
117 :			val scopeGlobal = setScope GlobalScope
118 :			val scopeInitially = setScope InitiallyScope
119 :	jhr	1640	fun scopeStrand env = setScope StrandScope env
120 :			fun scopeMethod (env, name) = setScope (MethodScope name) env
121 :	jhr	1115	(* bind a TreeIL varaiable to a target variable *)
122 :	jhr	1375	fun bind (ENV{info, vMap, scope}, x, x') = ENV{
123 :			info = info,
124 :			vMap = V.Map.insert(vMap, x, x'),
125 :			scope = scope
126 :			}
127 :	jhr	1115	end
128 :
129 :	jhr	1727	(* strands *)
130 :			structure Strand =
131 :			struct
132 :	jhr	1806	fun define (prog as Prog{strands, ...}, strandId, state) = let
133 :	jhr	1727	val name = Atom.toString strandId
134 :			(* the output state variable *)
135 :			val outputVar = (case List.filter IL.StateVar.isOutput state
136 :			of [] => raise Fail("no output specified for strand " ^ name)
137 :			| [x] => (IL.StateVar.ty x, IL.StateVar.name x)
138 :			| _ => raise Fail("multiple outputs in " ^ name)
139 :			(* end case *))
140 :			(* the state variables *)
141 :			val state = let
142 :			fun cvt x = CL.V(ToC.trType(IL.StateVar.ty x), IL.StateVar.name x)
143 :			in
144 :			List.map cvt state
145 :			end
146 :			val strand = Strand{
147 :	jhr	1806	prog = prog,
148 :	jhr	1727	name = name,
149 :			tyName = N.strandTy name,
150 :			state = state,
151 :			output = outputVar,
152 :			code = ref []
153 :			}
154 :			in
155 :			AtomTable.insert strands (strandId, strand);
156 :			strand
157 :			end
158 :
159 :			(* return the strand with the given name *)
160 :			fun lookup (Prog{strands, ...}, strandId) = AtomTable.lookup strands strandId
161 :
162 :			(* register the strand-state initialization code. The variables are the strand
163 :			* parameters.
164 :			*)
165 :	jhr	1806	fun init (Strand{prog=Prog{tgt, ...}, name, tyName, code, ...}, params, init) = let
166 :			val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
167 :	jhr	1727	val fName = N.strandInit name
168 :			val params =
169 :	jhr	1806	CL.PARAM([], globTy, "glob") ::
170 :	jhr	1727	CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut") ::
171 :			List.map (fn (CL.V(ty, x)) => CL.PARAM([], ty, x)) params
172 :	jhr	1917	val initFn = CL.D_Func(["static"], CL.voidTy, fName, params, init)
173 :	jhr	1727	in
174 :			code := initFn :: !code
175 :			end
176 :
177 :			(* register a strand method *)
178 :	jhr	1806	fun method (Strand{prog=Prog{tgt, ...}, name, tyName, code, ...}, methName, body) = let
179 :			val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
180 :	jhr	1727	val fName = concat[name, "_", StrandUtil.nameToString methName]
181 :			val params = [
182 :	jhr	1806	CL.PARAM([], globTy, "glob"),
183 :	jhr	1727	CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfIn"),
184 :			CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut")
185 :			]
186 :			val resTy = (case methName
187 :			of StrandUtil.Update => CL.T_Named "StrandStatus_t"
188 :			| StrandUtil.Stabilize => CL.voidTy
189 :			(* end case *))
190 :			val methFn = CL.D_Func(["static"], resTy, fName, params, body)
191 :			in
192 :			code := methFn :: !code
193 :			end
194 :
195 :			end
196 :
197 :	jhr	1115	(* programs *)
198 :			structure Program =
199 :			struct
200 :	jhr	2076	fun new (tgt : target_desc, props : StrandUtil.program_prop list) = (
201 :			N.initTargetSpec {double = #double tgt, long = false};
202 :	jhr	1774	Prog{
203 :			tgt = tgt,
204 :	jhr	2076	hasDie = SU.hasProp SU.StrandsMayDie props,
205 :			hasNew = SU.hasProp SU.NewStrands props,
206 :			hasCom = SU.hasProp SU.StrandCommunication props,
207 :			hasReduce = SU.hasProp SU.GlobalReduce props,
208 :	jhr	1803	inputs = ref [],
209 :	jhr	1774	globals = ref [],
210 :			topDecls = ref [],
211 :			strands = AtomTable.mkTable (16, Fail "strand table"),
212 :			nAxes = ref(SOME ~1),
213 :			initially = ref(CL.D_Comment["missing initially"])
214 :			})
215 :	jhr	2041	(* FIXME: for standalone exes, the defaults should be set in the inputs struct;
216 :			* not sure how to handle library inputs yet.
217 :			*)
218 :	jhr	2043	(* DEPRECATED
219 :	jhr	1727	(* register the code that is used to set defaults for input variables *)
220 :	jhr	1803	fun inputs (Prog{tgt, inputs, topDecls, ...}, env, blk) = let
221 :	jhr	1727	val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
222 :	jhr	1806	val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
223 :			val body = CL.mkBlock(
224 :			CL.mkDeclInit(globTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) ::
225 :			CL.unBlock (Tr.block (env, blk)))
226 :	jhr	1375	val inputsFn = CL.D_Func(
227 :	jhr	1727	["static"], CL.voidTy, N.initDefaults,
228 :			[CL.PARAM([], worldTy, "wrld")],
229 :	jhr	1806	body)
230 :	jhr	1375	in
231 :	jhr	1803	inputs := GenInputs.gatherInputs blk;
232 :	jhr	1375	topDecls := inputsFn :: !topDecls
233 :			end
234 :	jhr	2043	*)
235 :			(* gather the inputs *)
236 :			fun inputs (Prog{inputs, ...}, env, blk) = inputs := GenInputs.gatherInputs blk
237 :	jhr	1115	(* register the global initialization part of a program *)
238 :	jhr	1727	fun init (Prog{tgt, topDecls, ...}, init) = let
239 :			val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
240 :	jhr	1806	val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
241 :	jhr	2066	val wrldV = CL.mkVar "wrld"
242 :			(* the body of the global initializtion code *)
243 :			val initStms =
244 :			CL.mkDeclInit(globTy, "glob", CL.mkIndirect(wrldV, "globals")) ::
245 :			CL.unBlock init @ [CL.mkReturn(SOME(CL.mkVar "false"))]
246 :			(* for libraries, we need to make sure that the inputs are initialized *)
247 :			val initStms = if not(#exec tgt)
248 :			then CL.mkIfThen(
249 :			CL.mkApply(N.checkDefined tgt, [wrldV]),
250 :			CL.mkReturn(SOME(CL.mkBool true))) :: initStms
251 :			else initStms
252 :	jhr	1727	val initFn = CL.D_Func(
253 :	jhr	1807	["static"], CL.boolTy, N.initGlobals,
254 :	jhr	1727	[CL.PARAM([], worldTy, "wrld")],
255 :	jhr	2066	CL.mkBlock initStms)
256 :	jhr	1375	in
257 :	jhr	1718	topDecls := initFn :: !topDecls
258 :	jhr	1375	end
259 :	nseltzer	1870	(* register the global destruction part of a program *)
260 :			fun free (Prog{tgt, topDecls, ...}, free) = let
261 :			val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
262 :			val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
263 :			val free = CL.mkBlock(
264 :			CL.mkDeclInit(globTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) ::
265 :			CL.unBlock free @ [CL.mkReturn(SOME(CL.mkVar "false"))])
266 :			val freeFn = CL.D_Func(
267 :			["static"], CL.boolTy, N.freeGlobals,
268 :			[CL.PARAM([], worldTy, "wrld")],
269 :			free)
270 :			in
271 :			topDecls := freeFn :: !topDecls
272 :			end
273 :	jhr	1115	(* create and register the initially function for a program *)
274 :	jhr	1375	fun initially {
275 :	jhr	1718	prog = Prog{tgt, strands, nAxes, initially, ...},
276 :	jhr	1375	isArray : bool,
277 :			iterPrefix : stm list,
278 :			iters : (var * exp * exp) list,
279 :			createPrefix : stm list,
280 :			strand : Atom.atom,
281 :			args : exp list
282 :			} = let
283 :			val name = Atom.toString strand
284 :			val nDims = List.length iters
285 :	jhr	1718	val worldTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
286 :	jhr	1806	val globTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
287 :	jhr	1375	fun mapi f xs = let
288 :			fun mapf (_, []) = []
289 :			| mapf (i, x::xs) = f(i, x) :: mapf(i+1, xs)
290 :			in
291 :			mapf (0, xs)
292 :			end
293 :			val baseInit = mapi (fn (i, (_, e, _)) => (i, CL.I_Exp e)) iters
294 :			val sizeInit = mapi
295 :	jhr	1640	(fn (i, (CL.V(ty, _), lo, hi)) =>
296 :	jhr	1375	(i, CL.I_Exp(CL.mkBinOp(CL.mkBinOp(hi, CL.#-, lo), CL.#+, CL.E_Int(1, ty))))
297 :			) iters
298 :			(* code to allocate the world and initial strands *)
299 :			val allocCode = [
300 :			CL.mkComment["allocate initial block of strands"],
301 :	jhr	1718	CL.mkDecl(CL.T_Array(CL.uint32, SOME nDims), "base", SOME(CL.I_Array baseInit)),
302 :	jhr	1375	CL.mkDecl(CL.T_Array(CL.uint32, SOME nDims), "size", SOME(CL.I_Array sizeInit)),
303 :	jhr	1718	CL.mkIfThen(CL.mkApply(N.allocInitially, [
304 :			CL.mkVar "wrld",
305 :			CL.E_Bool isArray,
306 :			CL.E_Int(IntInf.fromInt nDims, CL.int32),
307 :			CL.E_Var "base",
308 :			CL.E_Var "size"
309 :			]),
310 :			(* then *)
311 :			CL.mkBlock [
312 :			(* FIXME: anything else? *)
313 :			CL.mkReturn(SOME(CL.mkVar "true"))
314 :			])
315 :			(* endif *)
316 :	jhr	1375	]
317 :			(* create the loop nest for the initially iterations *)
318 :			val indexVar = "ix"
319 :	jhr	1376	val strandTy = CL.T_Ptr(CL.T_Named(N.strandTy name))
320 :	jhr	1759	fun statePtr inout = CL.mkSubscript(CL.mkIndirect(CL.mkVar "wrld", inout), CL.mkVar indexVar)
321 :	jhr	1375	fun mkLoopNest [] = CL.mkBlock(createPrefix @ [
322 :	jhr	1806	CL.mkCall(N.strandInit name, CL.mkVar "glob" :: statePtr "inState" :: args),
323 :	jhr	1759	CL.mkCall("memcpy", [
324 :			statePtr "outState", statePtr "inState",
325 :			CL.mkSizeof(CL.T_Named(N.strandTy name))
326 :			]),
327 :	jhr	1718	CL.S_Exp(CL.mkPostOp(CL.mkVar indexVar, CL.^++))
328 :	jhr	1375	])
329 :	jhr	1640	| mkLoopNest ((CL.V(ty, param), lo, hi)::iters) = let
330 :	jhr	1375	val body = mkLoopNest iters
331 :			in
332 :			CL.mkFor(
333 :			[(ty, param, lo)],
334 :			CL.mkBinOp(CL.E_Var param, CL.#<=, hi),
335 :			[CL.mkPostOp(CL.E_Var param, CL.^++)],
336 :			body)
337 :			end
338 :			val iterCode = [
339 :			CL.mkComment["initially"],
340 :			CL.mkDecl(CL.uint32, indexVar, SOME(CL.I_Exp(CL.E_Int(0, CL.uint32)))),
341 :			mkLoopNest iters
342 :			]
343 :			val body = CL.mkBlock(
344 :	jhr	1807	CL.mkIfThen (CL.mkApply (N.initGlobals, [CL.mkVar "wrld"]),
345 :			CL.mkReturn(SOME(CL.mkVar "true"))
346 :			) ::
347 :	jhr	1806	CL.mkDeclInit (globTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) ::
348 :	jhr	1301	iterPrefix @
349 :			allocCode @
350 :			iterCode @
351 :	jhr	1718	[CL.mkReturn(SOME(CL.mkVar "false"))])
352 :			val initFn = CL.D_Func([], CL.boolTy, N.initially tgt, [CL.PARAM([], worldTy, "wrld")], body)
353 :	jhr	1375	in
354 :	jhr	1713	nAxes := (if isArray then SOME nDims else NONE);
355 :	jhr	1375	initially := initFn
356 :			end
357 :	jhr	1115
358 :			(***** OUTPUT *****)
359 :	jhr	1716
360 :	jhr	1773	(* create the target-specific substitution list *)
361 :			fun mkSubs (tgt : target_desc, Strand{name, tyName, ...}) = [
362 :			("CFILE", OS.Path.joinBaseExt{base= #outBase tgt, ext= SOME "c"}),
363 :			("HDRFILE", OS.Path.joinBaseExt{base= #outBase tgt, ext= SOME "h"}),
364 :			("PREFIX", #namespace tgt),
365 :			("SRCFILE", #srcFile tgt),
366 :			("STRAND", name),
367 :			("STRANDTY", tyName)
368 :			]
369 :
370 :			fun condCons (true, x, xs) = x::xs
371 :			| condCons (false, _, xs) = xs
372 :
373 :	jhr	1828	fun verbFrag (tgt : target_desc, parFrag, seqFrag, subs) =
374 :			CL.verbatim [if (#parallel tgt) then parFrag else seqFrag] subs
375 :
376 :	jhr	1773	fun compile (tgt : target_desc, basename) = let
377 :			(* generate the C compiler flags *)
378 :			val cflags = ["-I" ^ Paths.diderotInclude, "-I" ^ Paths.teemInclude]
379 :			val cflags = condCons (#parallel tgt, #pthread Paths.cflags, cflags)
380 :			val cflags = if #debug tgt
381 :			then #debug Paths.cflags :: cflags
382 :			else #ndebug Paths.cflags :: cflags
383 :			val cflags = #base Paths.cflags :: cflags
384 :			in
385 :			RunCC.compile (basename, cflags)
386 :			end
387 :
388 :			fun ldFlags (tgt : target_desc) = if #exec tgt
389 :			then let
390 :			val extraLibs = condCons (#parallel tgt, #pthread Paths.extraLibs, [])
391 :			val extraLibs = Paths.teemLinkFlags @ #base Paths.extraLibs :: extraLibs
392 :			val rtLib = TargetUtil.runtimeName tgt
393 :			in
394 :			rtLib :: extraLibs
395 :			end
396 :			else [TargetUtil.runtimeName tgt]
397 :
398 :	jhr	1806	fun genStrand (Strand{prog=Prog{tgt, ...}, name, tyName, state, output, code}) = let
399 :	jhr	1375	(* the type declaration for the strand's state struct *)
400 :			val selfTyDef = CL.D_StructDef(
401 :	jhr	1716	SOME(concat[#namespace tgt, "struct_", name]),
402 :	jhr	1640	List.rev (List.map (fn CL.V(ty, x) => (ty, x)) state),
403 :	jhr	1716	NONE)
404 :	jhr	1640	(* the type and access expression for the strand's output variable *)
405 :			val (outTy, outState) = (#1 output, CL.mkIndirect(CL.mkVar "self", #2 output))
406 :	jhr	1375	(* the strand's descriptor object *)
407 :			val descI = let
408 :			fun fnPtr (ty, f) = CL.I_Exp(CL.mkCast(CL.T_Named ty, CL.mkVar f))
409 :	jhr	1640	in
410 :			CL.I_Struct[
411 :			("name", CL.I_Exp(CL.mkStr name)),
412 :			("stateSzb", CL.I_Exp(CL.mkSizeof(CL.T_Named(N.strandTy name)))),
413 :			("update", fnPtr("update_method_t", name ^ "_Update")),
414 :	jhr	1716	("stabilize", fnPtr("stabilize_method_t", name ^ "_Stabilize"))
415 :	jhr	1640	]
416 :			end
417 :	jhr	1376	val desc = CL.D_Var([], CL.T_Named N.strandDescTy, N.strandDesc name, SOME descI)
418 :	jhr	1375	in
419 :	jhr	1716	selfTyDef :: List.rev (desc :: !code)
420 :	jhr	1375	end
421 :	jhr	1115
422 :	jhr	1806	fun genGlobalStruct (tgt : target_desc, globals) =
423 :			CL.D_StructDef(NONE, globals, SOME(#namespace tgt ^ "Globals_t"))
424 :
425 :	jhr	1716	(* generate the struct declaration for the world representation *)
426 :	jhr	1850	fun genWorldStruct (tgt, Strand{tyName, ...}) = let
427 :			val extras = [
428 :	jhr	1773	(* target-specific world components *)
429 :	jhr	2048	(CL.T_Ptr(CL.T_Named(N.globalsTy tgt)), "globals"),
430 :	jhr	1773	(CL.T_Ptr CL.uint8, "status"),
431 :			(CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)), "inState"),
432 :			(CL.T_Ptr(CL.T_Ptr(CL.T_Named tyName)), "outState")
433 :			]
434 :	jhr	2048	val extras = if #exec tgt
435 :			then extras
436 :			else (CL.T_Named(N.definedInpTy tgt), "definedInp") :: extras
437 :	jhr	1850	val extras = if #parallel tgt
438 :			then (CL.T_Ptr(CL.T_Named "Diderot_Sched_t"), "sched") :: extras
439 :			else (CL.T_Named "uint32_t", "numActive") :: extras
440 :	jhr	1773	in
441 :	jhr	1850	World.genStruct (tgt, extras)
442 :	jhr	1773	end
443 :	jhr	1716
444 :	jhr	1115	(* generate the table of strand descriptors *)
445 :	jhr	1716	fun ppStrandTable (ppStrm, strands) = let
446 :	jhr	1375	val nStrands = length strands
447 :	jhr	1376	fun genInit (Strand{name, ...}) = CL.I_Exp(CL.mkUnOp(CL.%&, CL.E_Var(N.strandDesc name)))
448 :	jhr	1375	fun genInits (_, []) = []
449 :			| genInits (i, s::ss) = (i, genInit s) :: genInits(i+1, ss)
450 :			fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
451 :			in
452 :	jhr	1718	ppDecl (CL.D_Var(["static const"], CL.int32, "NumStrands",
453 :	jhr	1375	SOME(CL.I_Exp(CL.E_Int(IntInf.fromInt nStrands, CL.int32)))));
454 :			ppDecl (CL.D_Var([],
455 :	jhr	1376	CL.T_Array(CL.T_Ptr(CL.T_Named N.strandDescTy), SOME nStrands),
456 :			N.strands,
457 :	jhr	1375	SOME(CL.I_Array(genInits (0, strands)))))
458 :			end
459 :	jhr	1115
460 :	jhr	1727	fun outputLibSrc (baseName, Prog{
461 :	jhr	1803	tgt, inputs, globals, topDecls, strands, nAxes, initially, ...
462 :	jhr	1727	}) = let
463 :	jhr	1716	val [strand as Strand{name, tyName, state, output, ...}] = AtomTable.listItems strands
464 :	jhr	1735	val outputs = GenOutput.gen (tgt, !nAxes) [output]
465 :	jhr	1717	val substitutions = mkSubs (tgt, strand)
466 :	jhr	1713	(* output to C file *)
467 :			val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
468 :			val outS = TextIO.openOut fileName
469 :			val ppStrm = PrintAsC.new outS
470 :			fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
471 :			in
472 :	jhr	1831	ppDecl (CL.verbatim [CHeadFrag.text] substitutions);
473 :			if (#parallel tgt)
474 :			then ppDecl (CL.verbatim [CHeadParExtraFrag.text] substitutions)
475 :			else ();
476 :	jhr	2048	ppDecl (GenInputs.genDefinedInpStruct (tgt, !inputs));
477 :	jhr	1806	ppDecl (genGlobalStruct (tgt, List.rev(!globals)));
478 :	jhr	1831	ppDecl (genWorldStruct(tgt, strand));
479 :	jhr	2066	List.app ppDecl (GenInputs.genInputFuns(tgt, !inputs));
480 :	jhr	1727	List.app ppDecl (List.rev (!topDecls));
481 :	jhr	1806	List.app ppDecl (genStrand strand);
482 :	jhr	1714	List.app ppDecl outputs;
483 :	jhr	1718	ppStrandTable (ppStrm, [strand]);
484 :	jhr	1717	ppDecl (CL.verbatim [CBodyFrag.text] substitutions);
485 :	jhr	1718	ppDecl (CL.verbatim [InitFrag.text] substitutions);
486 :			ppDecl (CL.verbatim [AllocFrag.text] substitutions);
487 :			ppDecl (!initially);
488 :	jhr	1828	ppDecl (verbFrag (tgt, ParRunFrag.text, SeqRunFrag.text, substitutions));
489 :	jhr	1718	ppDecl (CL.verbatim [ShutdownFrag.text] substitutions);
490 :	jhr	1714	PrintAsC.close ppStrm;
491 :			TextIO.closeOut outS
492 :	jhr	1713	end
493 :
494 :	jhr	1803	fun generateLib (prog as Prog{tgt, inputs, strands, ...}) = let
495 :	jhr	1706	val {outDir, outBase, exec, double, parallel, debug, ...} = tgt
496 :			val basename = OS.Path.joinDirFile{dir=outDir, file=outBase}
497 :			val [Strand{state, output, ...}] = AtomTable.listItems strands
498 :			in
499 :	jhr	1713	(* generate the library .h file *)
500 :	jhr	1706	GenLibraryInterface.gen {
501 :			tgt = tgt,
502 :	jhr	1844	rt = if #parallel tgt
503 :			then SOME LibInterfaceParFrag.text
504 :			else NONE,
505 :	jhr	1803	inputs = !inputs,
506 :	jhr	1706	outputs = [output]
507 :	jhr	1713	};
508 :			(* *)
509 :	jhr	1716	outputLibSrc (basename, prog);
510 :	jhr	1714	(* compile and link *)
511 :			compile (tgt, basename);
512 :			RunCC.linkLib (basename, ldFlags tgt)
513 :	jhr	1706	end
514 :
515 :	jhr	1773	fun genExecSrc (baseName, prog) = let
516 :	jhr	1803	val Prog{tgt, inputs, globals, topDecls, strands, nAxes, initially, ...} = prog
517 :	jhr	1773	val [strand as Strand{name, tyName, state, output, ...}] = AtomTable.listItems strands
518 :	jhr	1774	val outputs = GenOutput.gen (tgt, !nAxes) [output]
519 :	jhr	1773	val substitutions =
520 :			("DIDEROT_FLOAT_PRECISION", TargetUtil.floatPrecisionDef tgt) ::
521 :			("DIDEROT_INT_PRECISION", TargetUtil.intPrecisionDef tgt) ::
522 :			("DIDEROT_TARGET", TargetUtil.targetDef tgt) ::
523 :			mkSubs (tgt, strand)
524 :			val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
525 :			val outS = TextIO.openOut fileName
526 :			val ppStrm = PrintAsC.new outS
527 :			fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
528 :			in
529 :			ppDecl (CL.verbatim [ExecHdr.text] substitutions);
530 :	jhr	1831	if (#parallel tgt)
531 :			then ppDecl (CL.verbatim [CHeadParExtraFrag.text] substitutions)
532 :			else ();
533 :	jhr	1806	ppDecl (genGlobalStruct (tgt, List.rev(!globals)));
534 :	jhr	1831	ppDecl (genWorldStruct(tgt, strand));
535 :	jhr	2041	ppDecl (GenInputs.genInputsStruct (tgt, !inputs));
536 :	jhr	1773	List.app ppDecl (List.rev (!topDecls));
537 :	jhr	2048	List.app ppDecl (GenInputs.genExecInputFuns (tgt, !inputs));
538 :	jhr	1806	List.app ppDecl (genStrand strand);
539 :	jhr	1774	List.app ppDecl outputs;
540 :	jhr	1773	ppStrandTable (ppStrm, [strand]);
541 :			ppDecl (CL.verbatim [InitFrag.text] substitutions);
542 :			ppDecl (CL.verbatim [AllocFrag.text] substitutions);
543 :			ppDecl (!initially);
544 :	jhr	1828	ppDecl (verbFrag (tgt, ParRunFrag.text, SeqRunFrag.text, substitutions));
545 :	jhr	1773	ppDecl (CL.verbatim [ShutdownFrag.text] substitutions);
546 :	jhr	1828	ppDecl (verbFrag (tgt, ParMainFrag.text, SeqMainFrag.text, substitutions));
547 :	jhr	1773	PrintAsC.close ppStrm;
548 :			TextIO.closeOut outS
549 :			end
550 :
551 :			(* output the code to a file. The string is the basename of the file, the extension
552 :			* is provided by the target.
553 :			*)
554 :			fun generateExec (prog as Prog{tgt, ...}) = let
555 :			val {outDir, outBase, exec, double, parallel, debug, ...} = tgt
556 :			val basename = OS.Path.joinDirFile{dir=outDir, file=outBase}
557 :			in
558 :			genExecSrc (basename, prog);
559 :			compile (tgt, basename);
560 :			RunCC.linkExec (basename, ldFlags tgt)
561 :			end
562 :
563 :	jhr	1706	fun generate (prog as Prog{tgt, ...}) = if #exec tgt
564 :			then generateExec prog
565 :			else generateLib prog
566 :
567 :	jhr	1115	end
568 :
569 :			end
570 :
571 :			structure CBackEnd = CodeGenFn(CTarget)

---

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