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

SCM Repository

[diderot] Annotation of /branches/pure-cfg/src/compiler/c-target/c-target.sml
ViewVC logotype

Annotation of /branches/pure-cfg/src/compiler/c-target/c-target.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 573 - (view) (download)

1 : jhr 519 (* c-target.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * Generate C code with SSE 4.2 intrinsics.
7 :     *)
8 :    
9 :     structure CTarget : TARGET =
10 :     struct
11 :    
12 : jhr 522 structure CL = CLang
13 : jhr 551 structure RN = RuntimeNames
14 : jhr 522
15 : jhr 551 datatype ty = datatype TargetTy.ty
16 : jhr 519
17 : jhr 544 datatype strand = Strand of {
18 :     name : string,
19 :     tyName : string,
20 :     state : (ty * string) list ref,
21 :     code : CL.decl list ref
22 :     }
23 : jhr 525
24 :     type var = (ty * string) (* FIXME *)
25 :    
26 :     type exp = CLang.exp * ty
27 :    
28 :     type stm = CL.stm
29 :    
30 :     type method = unit (* FIXME *)
31 :    
32 : jhr 527 datatype program = Prog of {
33 :     globals : CL.decl list ref,
34 : jhr 533 topDecls : CL.decl list ref,
35 : jhr 527 strands : strand list ref
36 :     }
37 :    
38 : jhr 519 (* for SSE, we have 128-bit vectors *)
39 : jhr 551 fun vectorWidth () = !RN.gVectorWid
40 : jhr 519
41 :     (* target types *)
42 : jhr 525 val boolTy = T_Bool
43 :     val intTy = T_Int
44 :     val realTy = T_Real
45 :     fun vecTy 1 = T_Real
46 : jhr 551 | vecTy n = if (n < 1) orelse (!RN.gVectorWid < n)
47 : jhr 525 then raise Size
48 :     else T_Vec n
49 :     fun ivecTy 1 = T_Int
50 : jhr 551 | ivecTy n = if (n < 1) orelse (!RN.gVectorWid < n)
51 : jhr 525 then raise Size
52 :     else T_IVec n
53 : jhr 548 fun imageTy (ImageInfo.ImgInfo{ty=([], rTy), dim, ...}) = T_Image(dim, rTy)
54 :     fun imageDataTy (ImageInfo.ImgInfo{ty=([], rTy), ...}) = T_Ptr rTy
55 : jhr 534 val stringTy = T_String
56 : jhr 519
57 : jhr 552 val statusTy = CL.T_Named RN.statusTy
58 : jhr 534
59 : jhr 528 (* convert target types to CLang types *)
60 :     fun cvtTy T_Bool = CLang.T_Named "bool"
61 : jhr 534 | cvtTy T_String = CL.charPtr
62 : jhr 551 | cvtTy T_Int = !RN.gIntTy
63 :     | cvtTy T_Real = !RN.gRealTy
64 : jhr 561 | cvtTy (T_Vec n) = CL.T_Named(RN.vecTy n)
65 :     | cvtTy (T_IVec n) = CL.T_Named(RN.ivecTy n)
66 :     | cvtTy (T_Image(n, _)) = CL.T_Ptr(CL.T_Named(RN.imageTy n))
67 : jhr 548 | cvtTy (T_Ptr ty) = CL.T_Ptr(CL.T_Num ty)
68 : jhr 528
69 : jhr 548 (* report invalid arguments *)
70 :     fun invalid (name, []) = raise Fail("invaild "^name)
71 :     | invalid (name, args) = let
72 : jhr 551 fun arg2s (e, ty) = concat["(", CL.expToString e, " : ", TargetTy.toString ty, ")"]
73 : jhr 548 val args = String.concatWith ", " (List.map arg2s args)
74 :     in
75 :     raise Fail(concat["invalid arguments to ", name, ": ", args])
76 :     end
77 :    
78 : jhr 525 (* helper functions for checking the types of arguments *)
79 :     fun scalarTy T_Int = true
80 :     | scalarTy T_Real = true
81 :     | scalarTy _ = false
82 : jhr 548 fun numTy T_Int = true
83 :     | numTy T_Real = true
84 :     | numTy (T_Vec _) = true
85 :     | numTy (T_IVec _) = true
86 :     | numTy _ = false
87 : jhr 519
88 : jhr 528 fun newProgram () = (
89 : jhr 551 RN.initTargetSpec();
90 : jhr 528 Prog{
91 : jhr 554 globals = ref [
92 :     CL.D_Verbatim[
93 :     if !Controls.doublePrecision
94 :     then "#define DIDEROT_DOUBLE_PRECISION"
95 :     else "#define DIDEROT_SINGLE_PRECISION",
96 :     "#include \"Diderot/diderot.h\""
97 :     ]],
98 : jhr 533 topDecls = ref [],
99 : jhr 528 strands = ref []
100 :     })
101 :    
102 : jhr 533 fun globalInit (Prog{topDecls, ...}, init) = let
103 : jhr 551 val initFn = CL.D_Func([], CL.voidTy, RN.initGlobals, [], init)
104 : jhr 533 in
105 :     topDecls := initFn :: !topDecls
106 :     end
107 :    
108 : jhr 525 structure Var =
109 :     struct
110 : jhr 528 fun global (Prog{globals, ...}, ty, name) = (
111 : jhr 573 globals := CL.D_Var([], cvtTy ty, name, NONE) :: !globals;
112 : jhr 528 (ty, name))
113 : jhr 544 fun param (ty, name) = (ty, name)
114 :     fun state (Strand{state, ...}, ty, name) = (
115 :     state := (ty, name) :: !state;
116 :     (ty, name))
117 :     fun var (ty, name) = (ty, name)
118 : jhr 554 local
119 :     val count = ref 0
120 :     fun freshName prefix = let
121 :     val n = !count
122 :     in
123 :     count := n+1;
124 :     concat[prefix, "_", Int.toString n]
125 :     end
126 :     in
127 :     fun tmp ty = (ty, freshName "tmp")
128 :     fun fresh prefix = freshName prefix
129 :     end (* local *)
130 : jhr 519 end
131 :    
132 :     (* expression construction *)
133 : jhr 525 structure Expr =
134 :     struct
135 : jhr 549 (* return true if the given expression from is allowed as a subexpression *)
136 :     fun allowedInline _ = true (* FIXME *)
137 :    
138 : jhr 519 (* variable references *)
139 : jhr 525 fun global (ty, x) = (CL.mkVar x, ty)
140 : jhr 547 fun getState (ty, x) = (CL.mkIndirect(CL.mkVar "selfIn", x), ty)
141 : jhr 525 fun param (ty, x) = (CL.mkVar x, ty)
142 :     fun var (ty, x) = (CL.mkVar x, ty)
143 :    
144 : jhr 519 (* literals *)
145 : jhr 551 fun intLit n = (CL.mkInt(n, !RN.gIntTy), intTy)
146 :     fun floatLit f = (CL.mkFlt(f, !RN.gRealTy), realTy)
147 : jhr 533 fun stringLit s = (CL.mkStr s, stringTy)
148 : jhr 525 fun boolLit b = (CL.mkBool b, boolTy)
149 :    
150 : jhr 561 (* select from a vector. We have to cast to the corresponding union type and then
151 :     * select from the array field.
152 :     *)
153 :     local
154 :     fun sel (tyCode, field, ty) (i, e, n) =
155 :     if (i < 0) orelse (n <= i)
156 :     then raise Subscript
157 :     else let
158 :     val unionTy = CL.T_Named(concat["union", Int.toString n, !tyCode, "_t"])
159 :     val e1 = CL.mkCast(unionTy, e)
160 :     val e2 = CL.mkSelect(e1, field)
161 :     in
162 :     (CL.mkSubscript(e2, CL.mkInt(IntInf.fromInt i, CL.int32)), ty)
163 :     end
164 :     val selF = sel (RN.gRealSuffix, "r", T_Real)
165 :     val selI = sel (RN.gIntSuffix, "i", T_Int)
166 :     in
167 :     fun select (i, (e, T_Vec n)) = selF (i, e, n)
168 :     | select (i, (e, T_IVec n)) = selI (i, e, n)
169 : jhr 548 | select (_, x) = invalid("select", [x])
170 : jhr 561 end (* local *)
171 : jhr 525
172 : jhr 519 (* vector (and scalar) arithmetic *)
173 : jhr 525 local
174 :     fun checkTys (ty1, ty2) = (ty1 = ty2) andalso numTy ty1
175 :     fun binop rator ((e1, ty1), (e2, ty2)) =
176 :     if checkTys (ty1, ty2)
177 :     then (CL.mkBinOp(e1, rator, e2), ty1)
178 : jhr 548 else invalid (
179 :     concat["binary operator \"", CL.binopToString rator, "\""],
180 :     [(e1, ty1), (e2, ty2)])
181 : jhr 525 in
182 : jhr 548 fun add ((e1, ty as T_Ptr _), (e2, T_Int)) = (CL.mkBinOp(e1, CL.#+, e2), ty)
183 :     | add args = binop CL.#+ args
184 :     fun sub ((e1, ty as T_Ptr _), (e2, T_Int)) = (CL.mkBinOp(e1, CL.#-, e2), ty)
185 :     | sub args = binop CL.#- args
186 : jhr 544 (* NOTE: multiplication and division are also used for scaling *)
187 :     fun mul ((e1, T_Real), (e2, T_Vec n)) =
188 : jhr 551 (CL.E_Apply(RN.scale n, [e1, e2]), T_Vec n)
189 : jhr 544 | mul args = binop CL.#* args
190 :     fun divide ((e1, T_Vec n), (e2, T_Real)) =
191 : jhr 551 (CL.E_Apply(RN.scale n,
192 :     [CL.mkBinOp(#1(floatLit FloatLit.one), CL.#/, e2), e1]), T_Vec n)
193 : jhr 544 | divide args = binop CL.#/ args
194 : jhr 525 end (* local *)
195 :     fun neg (e, T_Bool) = raise Fail "invalid argument to neg"
196 :     | neg (e, ty) = (CL.mkUnOp(CL.%-, e), ty)
197 :    
198 :     fun abs (e, T_Int) = (CL.mkApply("abs", [e]), T_Int) (* FIXME: not the right type for 64-bit ints *)
199 : jhr 551 | abs (e, T_Real) = (CL.mkApply("fabs" ^ !RN.gRealSuffix, [e]), T_Real)
200 : jhr 525 | abs (e, T_Vec n) = raise Fail "FIXME: Expr.abs"
201 :     | abs (e, T_IVec n) = raise Fail "FIXME: Expr.abs"
202 :     | abs _ = raise Fail "invalid argument to abs"
203 :    
204 : jhr 551 fun dot ((e1, T_Vec n1), (e2, T_Vec n2)) = (CL.E_Apply(RN.dot n1, [e1, e2]), T_Real)
205 : jhr 525 | dot _ = raise Fail "invalid argument to dot"
206 :    
207 : jhr 551 fun cross ((e1, T_Vec 3), (e2, T_Vec 3)) = (CL.E_Apply(RN.cross(), [e1, e2]), T_Vec 3)
208 : jhr 525 | cross _ = raise Fail "invalid argument to cross"
209 :    
210 : jhr 551 fun length (e, T_Vec n) = (CL.E_Apply(RN.length n, [e]), T_Real)
211 : jhr 525 | length _ = raise Fail "invalid argument to length"
212 :    
213 : jhr 551 fun normalize (e, T_Vec n) = (CL.E_Apply(RN.normalize n, [e]), T_Vec n)
214 : jhr 525 | normalize _ = raise Fail "invalid argument to length"
215 :    
216 : jhr 519 (* comparisons *)
217 : jhr 525 local
218 :     fun checkTys (ty1, ty2) =
219 :     (ty1 = ty2) andalso scalarTy ty1
220 :     fun cmpop rator ((e1, ty1), (e2, ty2)) =
221 :     if checkTys (ty1, ty2)
222 :     then (CL.mkBinOp(e1, rator, e2), T_Bool)
223 : jhr 548 else invalid (
224 :     concat["compare operator \"", CL.binopToString rator, "\""],
225 :     [(e1, ty1), (e2, ty2)])
226 : jhr 525 in
227 :     val lt = cmpop CL.#<
228 :     val lte = cmpop CL.#<=
229 :     val equ = cmpop CL.#==
230 :     val neq = cmpop CL.#!=
231 :     val gte = cmpop CL.#>=
232 :     val gt = cmpop CL.#>
233 :     end (* local *)
234 :    
235 : jhr 519 (* logical connectives *)
236 : jhr 525 fun not (e, T_Bool) = (CL.mkUnOp(CL.%!, e), T_Bool)
237 :     | not _ = raise Fail "invalid argument to not"
238 :     fun && ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#&&, e2), T_Bool)
239 :     | && _ = raise Fail "invalid arguments to &&"
240 :     fun || ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#||, e2), T_Bool)
241 :     | || _ = raise Fail "invalid arguments to ||"
242 :    
243 :     local
244 :     fun checkTys (ty1, ty2) = (ty1 = ty2) andalso scalarTy ty1
245 :     fun binFn f ((e1, ty1), (e2, ty2)) =
246 :     if checkTys (ty1, ty2)
247 : jhr 561 then (CL.mkApply(f ty1, [e1, e2]), ty1)
248 : jhr 525 else raise Fail "invalid arguments to binary function"
249 :     in
250 : jhr 519 (* misc functions *)
251 : jhr 561 val min = binFn RN.min
252 :     val max = binFn RN.max
253 : jhr 525 end (* local *)
254 :    
255 : jhr 519 (* math functions *)
256 : jhr 525 fun pow ((e1, T_Real), (e2, T_Real)) =
257 :     if !Controls.doublePrecision
258 :     then (CL.mkApply("pow", [e1, e2]), T_Real)
259 :     else (CL.mkApply("powf", [e1, e2]), T_Real)
260 :     | pow _ = raise Fail "invalid arguments to pow"
261 :    
262 :     local
263 :     fun r2r (ff, fd) (e, T_Real) = if !Controls.doublePrecision
264 :     then (CL.mkApply(fd, [e]), T_Real)
265 :     else (CL.mkApply(ff, [e]), T_Real)
266 : jhr 551 | r2r (_, fd) e = invalid (fd, [e])
267 : jhr 525 in
268 :     val sin = r2r ("sinf", "sin")
269 :     val cos = r2r ("cosf", "cos")
270 :     val sqrt = r2r ("sqrtf", "sqrt")
271 :     end (* local *)
272 :    
273 : jhr 551 (* rounding *)
274 :     fun trunc (e, ty) = (CL.mkApply(RN.addTySuffix("trunc", ty), [e]), ty)
275 :     fun round (e, ty) = (CL.mkApply(RN.addTySuffix("round", ty), [e]), ty)
276 :     fun floor (e, ty) = (CL.mkApply(RN.addTySuffix("floor", ty), [e]), ty)
277 :     fun ceil (e, ty) = (CL.mkApply(RN.addTySuffix("ceil", ty), [e]), ty)
278 :    
279 : jhr 519 (* conversions *)
280 : jhr 565 fun toInt (e, T_Real) = (CL.mkCast(!RN.gIntTy, e), T_Int)
281 :     | toInt (e, T_Vec n) = (CL.mkCast(CL.T_Named(RN.ivecTy n), e), ivecTy n)
282 :     | toInt e = invalid ("toInt", [e])
283 : jhr 551 fun toReal (e, T_Int) = (CL.mkCast(!RN.gRealTy, e), T_Real)
284 : jhr 548 | toReal e = invalid ("toReal", [e])
285 : jhr 525
286 : jhr 519 (* runtime system hooks *)
287 : jhr 548 fun imageAddr (e, T_Image(_, rTy)) = let
288 : jhr 561 val cTy = CL.T_Ptr(CL.T_Num rTy)
289 : jhr 528 in
290 : jhr 548 (CL.mkCast(cTy, CL.mkIndirect(e, "data")), T_Ptr rTy)
291 : jhr 528 end
292 : jhr 548 | imageAddr a = invalid("imageAddr", [a])
293 :     fun getImgData (e, T_Ptr rTy) = let
294 : jhr 551 val realTy as CL.T_Num rTy' = !RN.gRealTy
295 : jhr 548 val e = CL.E_UnOp(CL.%*, e)
296 :     in
297 :     if (rTy' = rTy)
298 :     then (e, T_Real)
299 :     else (CL.E_Cast(realTy, e), T_Real)
300 :     end
301 :     | getImgData a = invalid("getImgData", [a])
302 :     fun posToImgSpace ((img, T_Image(d, _)), (pos, T_Vec n)) = let
303 : jhr 551 val e = CL.mkApply(RN.toImageSpace d, [img, pos])
304 : jhr 548 in
305 :     (e, T_Vec n)
306 :     end
307 :     | posToImgSpace (a, b) = invalid("posToImgSpace", [a, b])
308 :     fun inside ((pos, T_Vec n), (img, T_Image(d, _)), s) = let
309 : jhr 551 val e = CL.mkApply(RN.inside d,
310 : jhr 547 [pos, img, CL.mkInt(IntInf.fromInt n, CL.int32)])
311 :     in
312 :     (e, T_Bool)
313 :     end
314 : jhr 548 | inside (a, b, _) = invalid("inside", [a, b])
315 : jhr 519
316 : jhr 547 end (* Expr *)
317 :    
318 : jhr 519 (* statement construction *)
319 : jhr 525 structure Stmt =
320 :     struct
321 :     val comment = CL.S_Comment
322 : jhr 547 fun assignState ((_, x), (e, _)) =
323 :     CL.mkAssign(CL.mkIndirect(CL.mkVar "selfOut", x), e)
324 : jhr 525 fun assign ((_, x), (e, _)) = CL.mkAssign(CL.mkVar x, e)
325 : jhr 528 fun decl ((ty, x), SOME(e, _)) = CL.mkDecl(cvtTy ty, x, SOME e)
326 :     | decl ((ty, x), NONE) = CL.mkDecl(cvtTy ty, x, NONE)
327 : jhr 525 val block = CL.mkBlock
328 : jhr 532 fun ifthen ((e, T_Bool), s1) = CL.mkIfThen(e, s1)
329 : jhr 525 fun ifthenelse ((e, T_Bool), s1, s2) = CL.mkIfThenElse(e, s1, s2)
330 : jhr 534 (* special Diderot forms *)
331 : jhr 553 fun cons ((T_Vec n, x), args : exp list) =
332 :     CL.mkAssign(CL.mkVar x, CL.mkApply(RN.mkVec n, List.map #1 args))
333 :     | cons _ = raise Fail "bogus cons"
334 : jhr 554 fun getImgData ((T_Vec n, x), (e, T_Ptr rTy)) = let
335 :     val addr = Var.fresh "vp"
336 : jhr 561 val needsCast = (CL.T_Num rTy <> !RN.gRealTy)
337 :     fun mkLoad i = let
338 :     val e = CL.mkSubscript(CL.mkVar addr, CL.mkInt(IntInf.fromInt i, CL.int32))
339 :     in
340 :     if needsCast then CL.mkCast(!RN.gRealTy, e) else e
341 :     end
342 : jhr 554 in [
343 : jhr 561 CL.mkDecl(CL.T_Ptr(CL.T_Num rTy), addr, SOME e),
344 :     CL.mkAssign(CL.mkVar x,
345 :     CL.mkApply(RN.mkVec n, List.tabulate (n, mkLoad)))
346 : jhr 554 ] end
347 :     | getImgData _ = raise Fail "bogus getImgData"
348 :     local
349 :     fun checkSts mkDecl = let
350 :     val sts = Var.fresh "sts"
351 :     in
352 :     mkDecl sts @
353 :     [CL.mkIfThen(
354 :     CL.mkBinOp(CL.mkVar "DIDEROT_OK", CL.#!=, CL.mkVar sts),
355 :     CL.mkCall("exit", [CL.mkInt(1, CL.int32)]))]
356 :     end
357 :     in
358 :     fun loadImage (lhs : var, dim, name : exp) = checkSts (fn sts => let
359 : jhr 551 val imgTy = CL.T_Named(RN.imageTy dim)
360 :     val loadFn = RN.loadImage dim
361 : jhr 534 in [
362 :     CL.S_Decl(
363 :     statusTy, sts,
364 :     SOME(CL.E_Apply(loadFn, [#1 name, CL.mkUnOp(CL.%&, CL.E_Var(#2 lhs))])))
365 : jhr 554 ] end)
366 :     fun input (lhs : var, name, optDflt) = checkSts (fn sts => let
367 : jhr 551 val inputFn = RN.input(#1 lhs)
368 : jhr 534 val lhs = CL.E_Var(#2 lhs)
369 :     val (initCode, hasDflt) = (case optDflt
370 :     of SOME(e, _) => ([CL.S_Assign(lhs, e)], true)
371 :     | NONE => ([], false)
372 :     (* end case *))
373 :     val code = [
374 :     CL.S_Decl(
375 :     statusTy, sts,
376 :     SOME(CL.E_Apply(inputFn, [
377 :     CL.E_Str name, CL.mkUnOp(CL.%&, lhs), CL.mkBool hasDflt
378 :     ])))
379 :     ]
380 :     in
381 :     initCode @ code
382 : jhr 554 end)
383 :     end (* local *)
384 : jhr 564 fun exit () = CL.mkReturn NONE
385 :     fun active () = CL.mkReturn(SOME(CL.mkVar RN.kActive))
386 :     fun stabilize () = CL.mkReturn(SOME(CL.mkVar RN.kStabilize))
387 : jhr 562 fun die () = CL.mkReturn(SOME(CL.mkVar RN.kDie))
388 : jhr 519 end
389 :    
390 : jhr 544 structure Strand =
391 :     struct
392 :     fun define (Prog{strands, ...}, strandId) = let
393 :     val strand = Strand{
394 :     name = strandId,
395 : jhr 552 tyName = RN.strandTy strandId,
396 : jhr 544 state = ref [],
397 :     code = ref []
398 :     }
399 :     in
400 :     strands := strand :: !strands;
401 :     strand
402 :     end
403 :    
404 :     (* register the strand-state initialization code. The variables are the strand
405 :     * parameters.
406 :     *)
407 :     fun init (Strand{name, tyName, code, ...}, params, init) = let
408 : jhr 551 val fName = RN.strandInit name
409 : jhr 544 val params =
410 : jhr 547 CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut") ::
411 : jhr 544 List.map (fn (ty, x) => CL.PARAM([], cvtTy ty, x)) params
412 :     val initFn = CL.D_Func([], CL.voidTy, fName, params, init)
413 :     in
414 :     code := initFn :: !code
415 :     end
416 : jhr 547
417 :     (* register a strand method *)
418 :     fun method (Strand{name, tyName, code, ...}, methName, body) = let
419 :     val fName = concat[name, "_", methName]
420 :     val params = [
421 :     CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfIn"),
422 :     CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut")
423 :     ]
424 :     val methFn = CL.D_Func([], CL.int32, fName, params, body)
425 :     in
426 :     code := methFn :: !code
427 :     end
428 : jhr 544 end (* Strand *)
429 :    
430 :     fun genStrand (Strand{name, tyName, state, code}) = let
431 :     val selfTyDef = CL.D_StructDef(
432 :     List.rev (List.map (fn (ty, x) => (cvtTy ty, x)) (!state)),
433 :     tyName)
434 :     in
435 :     selfTyDef :: List.rev (!code)
436 :     end
437 :    
438 : jhr 573 (* generate the table of strand descriptors *)
439 :     fun genStrandTable (ppStrm, strands) = let
440 :     val nStrands = length strands
441 :     fun genInit (Strand{name, tyName, code, ...}) = let
442 :     fun fnPtr (ty, f) = CL.I_Exp(CL.mkCast(CL.T_Named ty, CL.mkVar f))
443 :     in
444 :     CL.I_Struct[
445 :     ("name", CL.I_Exp(CL.E_Str name)),
446 :     ("stateSzb", CL.I_Exp(CL.mkSizeof(CL.T_Named(RN.strandTy name)))),
447 :     ("init", fnPtr("strand_init_t", RN.strandInit name)),
448 :     ("update", fnPtr("strand_init_t", name ^ "_update"))
449 :     ]
450 :     end
451 :     fun genInits (_, []) = []
452 :     | genInits (i, s::ss) = (i, genInit s) :: genInits(i+1, ss)
453 :     fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
454 :     in
455 :     ppDecl (CL.D_Var([], CL.int32, RN.numStrands,
456 :     SOME(CL.I_Exp(CL.E_Int(IntInf.fromInt nStrands, CL.int32)))));
457 :     ppDecl (CL.D_Var([], CL.T_Array(CL.T_Named RN.strandDescTy, SOME nStrands), RN.strands,
458 :     SOME(CL.I_Array(genInits (0, strands)))))
459 :     end
460 :    
461 : jhr 533 fun generate (baseName, Prog{globals, topDecls, strands}) = let
462 : jhr 527 val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
463 :     val outS = TextIO.openOut fileName
464 :     val ppStrm = PrintAsC.new outS
465 : jhr 533 fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
466 : jhr 527 in
467 : jhr 533 List.app ppDecl (List.rev (!globals));
468 :     List.app ppDecl (List.rev (!topDecls));
469 : jhr 527 (* what about the strands, etc? *)
470 : jhr 544 List.app (fn strand => List.app ppDecl (genStrand strand)) (!strands);
471 : jhr 573 genStrandTable (ppStrm, !strands);
472 : jhr 527 PrintAsC.close ppStrm;
473 :     TextIO.closeOut outS
474 :     end
475 :    
476 : jhr 519 end
477 :    
478 :     structure CBackEnd = CodeGenFn(CTarget)

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