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

SCM Repository

[diderot] Diff of /branches/charisee/src/compiler/c-target/c-target.sml
ViewVC logotype

Diff of /branches/charisee/src/compiler/c-target/c-target.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1639, Wed Nov 16 01:48:07 2011 UTC revision 1640, Wed Nov 16 02:19:51 2011 UTC
# Line 12  Line 12 
12      structure Ty = IL.Ty      structure Ty = IL.Ty
13      structure CL = CLang      structure CL = CLang
14      structure N = CNames      structure N = CNames
     structure ToC = TreeToC  
15    
16      type var = ToC.var    (* variable translation *)
17        structure TrVar =
18          struct
19            type env = CL.typed_var TreeIL.Var.Map.map
20            fun lookup (env, x) = (case V.Map.find (env, x)
21                   of SOME(CL.V(_, x')) => x'
22                    | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
23                  (* end case *))
24          (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
25            fun lvalueVar (env, x) = (case V.kind x
26                   of IL.VK_Global => CL.mkVar(lookup(env, x))
27                    | IL.VK_Local => CL.mkVar(lookup(env, x))
28                  (* end case *))
29          (* translate a variable that occurs in an r-value context *)
30            fun rvalueVar (env, x) = (case V.kind x
31                   of IL.VK_Global => CL.mkVar(lookup(env, x))
32                    | IL.VK_Local => CL.mkVar(lookup(env, x))
33                  (* end case *))
34          (* translate a strand state variable that occurs in an l-value context *)
35            fun lvalueStateVar x = CL.mkIndirect(CL.mkVar "selfOut", IL.StateVar.name x)
36          (* translate a strand state variable that occurs in an r-value context *)
37            fun rvalueStateVar x = CL.mkIndirect(CL.mkVar "selfIn", IL.StateVar.name x)
38          end
39    
40        structure ToC = TreeToCFn (TrVar)
41    
42        type var = CL.typed_var
43      type exp = CL.exp      type exp = CL.exp
44      type stm = CL.stm      type stm = CL.stm
45    
46      datatype strand = Strand of {      datatype strand = Strand of {
47          name : string,          name : string,
48          tyName : string,          tyName : string,
49          state : var list ref,          state : var list,
50          output : (Ty.ty * CL.var) option ref,   (* the strand's output variable (only one for now) *)          output : (Ty.ty * CL.var),      (* the strand's output variable (only one for now) *)
51          code : CL.decl list ref          code : CL.decl list ref
52        }        }
53    
# Line 51  Line 76 
76        = NoScope        = NoScope
77        | GlobalScope        | GlobalScope
78        | InitiallyScope        | InitiallyScope
79        | StrandScope of TreeIL.var list  (* strand initialization *)        | StrandScope                     (* strand initialization *)
80        | MethodScope of TreeIL.var list  (* method body; vars are state variables *)        | MethodScope of StrandUtil.method_name  (* method body; vars are state variables *)
81    
82    (* the supprted widths of vectors of reals on the target.  For the GNU vector extensions,    (* the supprted widths of vectors of reals on the target.  For the GNU vector extensions,
83     * the supported sizes are powers of two, but float2 is broken.     * the supported sizes are powers of two, but float2 is broken.
# Line 62  Line 87 
87            then [2, 4, 8]            then [2, 4, 8]
88            else [4, 8]            else [4, 8]
89    
90      (* we support printing in the sequential C target *)
91        val supportsPrinting = true
92    
93    (* tests for whether various expression forms can appear inline *)    (* tests for whether various expression forms can appear inline *)
94      fun inlineCons n = (n < 2)          (* vectors are inline, but not matrices *)      fun inlineCons n = (n < 2)          (* vectors are inline, but not matrices *)
95      val inlineMatrixExp = false         (* can matrix-valued expressions appear inline? *)      val inlineMatrixExp = false         (* can matrix-valued expressions appear inline? *)
# Line 74  Line 102 
102                in                in
103                  (ENV{info=info, vMap=vMap, scope=scope}, stms)                  (ENV{info=info, vMap=vMap, scope=scope}, stms)
104                end                end
105          fun saveState cxt stateVars (env, args, stm) = (  (* NOTE: we may be able to simplify the interface to ToC.trBlock! *)
106                ListPair.foldrEq          fun block (ENV{vMap, ...}, blk) = ToC.trBlock (vMap, blk)
                 (fn (x, e, stms) => ToC.trAssign(env, x, e)@stms)  
                   [stm]  
                     (stateVars, args)  
               ) handle ListPair.UnequalLengths => (  
                 print(concat["saveState ", cxt, ": length mismatch; ", Int.toString(List.length args), " args\n"]);  
                 raise Fail(concat["saveState ", cxt, ": length mismatch"]))  
         fun block (ENV{vMap, scope, ...}, blk) = (case scope  
                of StrandScope stateVars => ToC.trBlock (vMap, saveState "StrandScope" stateVars, blk)  
                 | MethodScope stateVars => ToC.trBlock (vMap, saveState "MethodScope" stateVars, blk)  
                 | _ => ToC.trBlock (vMap, fn (_, _, stm) => [stm], blk)  
               (* end case *))  
107          fun exp (ENV{vMap, ...}, e) = ToC.trExp(vMap, e)          fun exp (ENV{vMap, ...}, e) = ToC.trExp(vMap, e)
108        end        end
109    
110    (* variables *)    (* variables *)
111      structure Var =      structure Var =
112        struct        struct
113          fun name (ToC.V(_, name)) = name          fun name (CL.V(_, name)) = name
114          fun global (Prog{globals, ...}, name, ty) = let          fun global (Prog{globals, ...}, name, ty) = let
115                val ty' = ToC.trType ty                val ty' = ToC.trType ty
116                in                in
117                  globals := CL.D_Var([], ty', name, NONE) :: !globals;                  globals := CL.D_Var([], ty', name, NONE) :: !globals;
118                  ToC.V(ty', name)                  CL.V(ty', name)
               end  
         fun param x = ToC.V(ToC.trType(V.ty x), V.name x)  
         fun state (Strand{state, ...}, x) = let  
               val ty' = ToC.trType(V.ty x)  
               val x' = ToC.V(ty', V.name x)  
               in  
                 state := x' :: !state;  
                 x'  
119                end                end
120            fun param x = CL.V(ToC.trType(V.ty x), V.name x)
121        end        end
122    
123    (* environments *)    (* environments *)
# Line 123  Line 133 
133          fun setScope scope (ENV{info, vMap, ...}) = ENV{info=info, vMap=vMap, scope=scope}          fun setScope scope (ENV{info, vMap, ...}) = ENV{info=info, vMap=vMap, scope=scope}
134          val scopeGlobal = setScope GlobalScope          val scopeGlobal = setScope GlobalScope
135          val scopeInitially = setScope InitiallyScope          val scopeInitially = setScope InitiallyScope
136          fun scopeStrand (env, svars) = setScope (StrandScope svars) env          fun scopeStrand env = setScope StrandScope env
137          fun scopeMethod (env, svars) = setScope (MethodScope svars) env          fun scopeMethod (env, name) = setScope (MethodScope name) env
138        (* bind a TreeIL varaiable to a target variable *)        (* bind a TreeIL varaiable to a target variable *)
139          fun bind (ENV{info, vMap, scope}, x, x') = ENV{          fun bind (ENV{info, vMap, scope}, x, x') = ENV{
140                  info = info,                  info = info,
# Line 137  Line 147 
147      structure Program =      structure Program =
148        struct        struct
149          fun new {name, double, parallel, debug} = (          fun new {name, double, parallel, debug} = (
150                N.initTargetSpec double;                N.initTargetSpec {double=double, long=false};
151                Prog{                Prog{
152                    name = name,                    name = name,
153                    double = double, parallel = parallel, debug = debug,                    double = double, parallel = parallel, debug = debug,
# Line 146  Line 156 
156                          SOME(CL.I_Exp(CL.mkStr name))),                          SOME(CL.I_Exp(CL.mkStr name))),
157                        CL.D_Verbatim[                        CL.D_Verbatim[
158                            if double                            if double
159                              then "#define DIDEROT_DOUBLE_PRECISION"                              then "#define DIDEROT_DOUBLE_PRECISION\n"
160                              else "#define DIDEROT_SINGLE_PRECISION",                              else "#define DIDEROT_SINGLE_PRECISION\n",
161                              "#define DIDEROT_INT\n",
162                            if parallel                            if parallel
163                              then "#define DIDEROT_TARGET_PARALLEL"                              then "#define DIDEROT_TARGET_PARALLEL\n"
164                              else "#define DIDEROT_TARGET_C",                              else "#define DIDEROT_TARGET_C\n",
165                            "#include \"Diderot/diderot.h\""                            "#include \"Diderot/diderot.h\"\n"
166                          ]                          ]
167                      ],                      ],
168                    topDecls = ref [],                    topDecls = ref [],
# Line 198  Line 209 
209                      end                      end
210                val baseInit = mapi (fn (i, (_, e, _)) => (i, CL.I_Exp e)) iters                val baseInit = mapi (fn (i, (_, e, _)) => (i, CL.I_Exp e)) iters
211                val sizeInit = mapi                val sizeInit = mapi
212                      (fn (i, (ToC.V(ty, _), lo, hi)) =>                      (fn (i, (CL.V(ty, _), lo, hi)) =>
213                          (i, CL.I_Exp(CL.mkBinOp(CL.mkBinOp(hi, CL.#-, lo), CL.#+, CL.E_Int(1, ty))))                          (i, CL.I_Exp(CL.mkBinOp(CL.mkBinOp(hi, CL.#-, lo), CL.#+, CL.E_Int(1, ty))))
214                      ) iters                      ) iters
215              (* code to allocate the world and initial strands *)              (* code to allocate the world and initial strands *)
# Line 228  Line 239 
239                        CL.mkCall(N.strandInit name, CL.E_Var "sp" :: args),                        CL.mkCall(N.strandInit name, CL.E_Var "sp" :: args),
240                        CL.mkAssign(CL.E_Var indexVar, CL.mkBinOp(CL.E_Var indexVar, CL.#+, CL.E_Int(1, CL.uint32)))                        CL.mkAssign(CL.E_Var indexVar, CL.mkBinOp(CL.E_Var indexVar, CL.#+, CL.E_Int(1, CL.uint32)))
241                      ])                      ])
242                  | mkLoopNest ((ToC.V(ty, param), lo, hi)::iters) = let                  | mkLoopNest ((CL.V(ty, param), lo, hi)::iters) = let
243                      val body = mkLoopNest iters                      val body = mkLoopNest iters
244                      in                      in
245                        CL.mkFor(                        CL.mkFor(
# Line 256  Line 267 
267          fun genStrand (Strand{name, tyName, state, output, code}) = let          fun genStrand (Strand{name, tyName, state, output, code}) = let
268              (* the type declaration for the strand's state struct *)              (* the type declaration for the strand's state struct *)
269                val selfTyDef = CL.D_StructDef(                val selfTyDef = CL.D_StructDef(
270                        List.rev (List.map (fn ToC.V(ty, x) => (ty, x)) (!state)),                        List.rev (List.map (fn CL.V(ty, x) => (ty, x)) state),
271                        tyName)                        tyName)
272                (* the type and access expression for the strand's output variable *)
273                  val (outTy, outState) = (#1 output, CL.mkIndirect(CL.mkVar "self", #2 output))
274              (* the print function *)              (* the print function *)
275                val prFnName = concat[name, "_print"]                val prFnName = concat[name, "_Print"]
276                val prFn = let                val prFn = let
277                      val params = [                      val params = [
278                            CL.PARAM([], CL.T_Ptr(CL.T_Named "FILE"), "outS"),                            CL.PARAM([], CL.T_Ptr(CL.T_Named "FILE"), "outS"),
279                            CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "self")                            CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "self")
280                          ]                          ]
281                      val SOME(ty, x) = !output                      val prArgs = (case outTy
282                      val outState = CL.mkIndirect(CL.mkVar "self", x)                             of Ty.IntTy => [CL.E_Str(!N.gIntFormat ^ "\n"), outState]
283                      val prArgs = (case ty                              | Ty.TensorTy[] => [CL.E_Str "%f\n", outState]
284                             of Ty.IVecTy 1 => [CL.E_Str(!N.gIntFormat ^ "\n"), outState]                              | Ty.TensorTy[d] => let
                             | Ty.IVecTy d => let  
285                                  val fmt = CL.E_Str(                                  val fmt = CL.E_Str(
286                                        String.concatWith " " (List.tabulate(d, fn _ => !N.gIntFormat))                                        String.concatWith " " (List.tabulate(d, fn _ => "%f"))
287                                        ^ "\n")                                        ^ "\n")
288                                  val args = List.tabulate (d, fn i => ToC.ivecIndex(outState, d, i))                                  val args = List.tabulate (d, fn i => ToC.vecIndex(outState, d, i))
289                                  in                                  in
290                                    fmt :: args                                    fmt :: args
291                                  end                                  end
292                              | Ty.TensorTy[] => [CL.E_Str "%f\n", outState]                              | Ty.SeqTy(Ty.IntTy, d) => let
                             | Ty.TensorTy[d] => let  
293                                  val fmt = CL.E_Str(                                  val fmt = CL.E_Str(
294                                        String.concatWith " " (List.tabulate(d, fn _ => "%f"))                                        String.concatWith " " (List.tabulate(d, fn _ => !N.gIntFormat))
295                                        ^ "\n")                                        ^ "\n")
296                                  val args = List.tabulate (d, fn i => ToC.vecIndex(outState, d, i))                                  val args = List.tabulate (d, fn i => ToC.ivecIndex(outState, d, i))
297                                  in                                  in
298                                    fmt :: args                                    fmt :: args
299                                  end                                  end
300                              | _ => raise Fail("genStrand: unsupported output type " ^ Ty.toString ty)                              | _ => raise Fail("genStrand: unsupported output type " ^ Ty.toString outTy)
301                            (* end case *))                            (* end case *))
302                      in                      in
303                        CL.D_Func(["static"], CL.voidTy, prFnName, params,                        CL.D_Func(["static"], CL.voidTy, prFnName, params,
304                          CL.mkCall("fprintf", CL.mkVar "outS" :: prArgs))                          CL.mkCall("fprintf", CL.mkVar "outS" :: prArgs))
305                      end                      end
306                (* the output function *)
307                  val outFnName = concat[name, "_Output"]
308                  val outFn = let
309                        val params = [
310                              CL.PARAM([], CL.T_Ptr CL.voidTy, "outS"),
311                              CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "self")
312                            ]
313                      (* get address of output variable *)
314                        val outState = CL.mkUnOp(CL.%&, outState)
315                        in
316                          CL.D_Func(["static"], CL.voidTy, outFnName, params,
317                            CL.mkCall("memcpy", [CL.mkVar "outS", outState, CL.mkSizeof(ToC.trType outTy)] ))
318                        end
319              (* the strand's descriptor object *)              (* the strand's descriptor object *)
320                val descI = let                val descI = let
321                      fun fnPtr (ty, f) = CL.I_Exp(CL.mkCast(CL.T_Named ty, CL.mkVar f))                      fun fnPtr (ty, f) = CL.I_Exp(CL.mkCast(CL.T_Named ty, CL.mkVar f))
322                      val SOME(outTy, _) = !output                      val nrrdTy = NrrdTypes.toNrrdType outTy
323                        val nrrdSize = NrrdTypes.toNrrdSize outTy
324                      in                      in
325                        CL.I_Struct[                        CL.I_Struct[
326                            ("name", CL.I_Exp(CL.mkStr name)),                            ("name", CL.I_Exp(CL.mkStr name)),
327                            ("stateSzb", CL.I_Exp(CL.mkSizeof(CL.T_Named(N.strandTy name)))),                            ("stateSzb", CL.I_Exp(CL.mkSizeof(CL.T_Named(N.strandTy name)))),
328  (*                            ("outputSzb", CL.I_Exp(CL.mkInt nrrdSize)),
329                            ("outputSzb", CL.I_Exp(CL.mkSizeof(ToC.trTy outTy))),                            ("nrrdSzb", CL.I_Exp(CL.mkInt nrrdSize)),
330  *)                            ("nrrdType", CL.I_Exp(CL.mkInt nrrdTy)),
331                            ("update", fnPtr("update_method_t", name ^ "_update")),  (* FIXME: should use StrandUtil.nameToString here *)
332                            ("print", fnPtr("print_method_t", prFnName))                            ("update", fnPtr("update_method_t", name ^ "_Update")),
333                              ("stabilize", fnPtr("stabilize_method_t", name ^ "_Stabilize")),
334                              ("print", fnPtr("print_method_t", prFnName)),
335                              ("output", fnPtr("output_method_t", outFnName))
336                          ]                          ]
337                      end                      end
338                val desc = CL.D_Var([], CL.T_Named N.strandDescTy, N.strandDesc name, SOME descI)                val desc = CL.D_Var([], CL.T_Named N.strandDescTy, N.strandDesc name, SOME descI)
339                in                in
340                  selfTyDef :: List.rev (desc :: prFn :: !code)                  selfTyDef :: List.rev (desc :: prFn :: outFn :: !code)
341                end                end
342    
343        (* generate the table of strand descriptors *)        (* generate the table of strand descriptors *)
# Line 377  Line 405 
405    (* strands *)    (* strands *)
406      structure Strand =      structure Strand =
407        struct        struct
408          fun define (Prog{strands, ...}, strandId) = let          fun define (Prog{strands, ...}, strandId, state) = let
409                val name = Atom.toString strandId                val name = Atom.toString strandId
410                (* the output state variable *)
411                  val outputVar = (case List.filter IL.StateVar.isOutput state
412                         of [] => raise Fail("no output specified for strand " ^ name)
413                          | [x] => (IL.StateVar.ty x, IL.StateVar.name x)
414                          | _ => raise Fail("multiple outputs in " ^ name)
415                        (* end case *))
416                (* the state variables *)
417                  val state = let
418                        fun cvt x = CL.V(ToC.trType(IL.StateVar.ty x), IL.StateVar.name x)
419                        in
420                          List.map cvt state
421                        end
422                val strand = Strand{                val strand = Strand{
423                        name = name,                        name = name,
424                        tyName = N.strandTy name,                        tyName = N.strandTy name,
425                        state = ref [],                        state = state,
426                        output = ref NONE,                        output = outputVar,
427                        code = ref []                        code = ref []
428                      }                      }
429                in                in
# Line 401  Line 441 
441                val fName = N.strandInit name                val fName = N.strandInit name
442                val params =                val params =
443                      CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut") ::                      CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut") ::
444                        List.map (fn (ToC.V(ty, x)) => CL.PARAM([], ty, x)) params                        List.map (fn (CL.V(ty, x)) => CL.PARAM([], ty, x)) params
445                val initFn = CL.D_Func([], CL.voidTy, fName, params, init)                val initFn = CL.D_Func([], CL.voidTy, fName, params, init)
446                in                in
447                  code := initFn :: !code                  code := initFn :: !code
# Line 409  Line 449 
449    
450        (* register a strand method *)        (* register a strand method *)
451          fun method (Strand{name, tyName, code, ...}, methName, body) = let          fun method (Strand{name, tyName, code, ...}, methName, body) = let
452                val fName = concat[name, "_", MethodName.toString methName]                val fName = concat[name, "_", StrandUtil.nameToString methName]
453                val params = [                val params = [
454                        CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfIn"),                        CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfIn"),
455                        CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut")                        CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "selfOut")
456                      ]                      ]
457                val resTy = (case methName                val resTy = (case methName
458                       of MethodName.Update => CL.T_Named "StrandStatus_t"                       of StrandUtil.Update => CL.T_Named "StrandStatus_t"
459                        | MethodName.Stabilize => CL.voidTy                        | StrandUtil.Stabilize => CL.voidTy
460                      (* end case *))                      (* end case *))
461                val methFn = CL.D_Func(["static"], resTy, fName, params, body)                val methFn = CL.D_Func(["static"], resTy, fName, params, body)
462                in                in
463                  code := methFn :: !code                  code := methFn :: !code
464                end                end
465    
         fun output (Strand{output, ...}, ty, ToC.V(_, x)) = output := SOME(ty, x)  
   
466        end        end
467    
468    end    end

Legend:
Removed from v.1639  
changed lines
  Added in v.1640

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