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

SCM Repository

[diderot] Annotation of /branches/vis12/src/compiler/c-util/gen-inputs.sml
ViewVC logotype

Annotation of /branches/vis12/src/compiler/c-util/gen-inputs.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1806 - (view) (download)

1 : jhr 1774 (* gen-inputs.sml
2 :     *
3 :     * COPYRIGHT (c) 2012 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *)
6 :    
7 :     structure GenInputs : sig
8 :    
9 : jhr 1803 type input_desc = (TreeIL.Ty.ty * string * string * bool)
10 : jhr 1774
11 : jhr 1803 val gatherInputs : TreeIL.block -> input_desc list
12 :    
13 :     val genRegisterInputs : TargetUtil.target_desc * input_desc list -> CLang.decl
14 :    
15 :     val genInputFuns : TargetUtil.target_desc * input_desc list -> CLang.decl list
16 :    
17 : jhr 1774 end = struct
18 :    
19 : jhr 1803 structure IL = TreeIL
20 :     structure Ty = TreeIL.Ty
21 : jhr 1774 structure CL = CLang
22 :     structure N = CNames
23 :    
24 : jhr 1803 type input_desc = (Ty.ty * string * string * bool)
25 :    
26 :     val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
27 :    
28 :     type target_desc = TargetUtil.target_desc
29 :    
30 :     (* translate TreeIL types to CLang types *)
31 :     val trType = TreeTyToC.trType
32 :    
33 : jhr 1806 (* an l-value expression for accessing a global variable *)
34 :     fun global name = CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld", "globals"), name)
35 :    
36 : jhr 1803 (* gather the input globals from the input initialization block *)
37 :     fun gatherInputs (IL.Block{body, ...}) = let
38 :     fun gather (IL.S_Input(x, name, desc, NONE)) = SOME(IL.Var.ty x, name, desc, false)
39 :     | gather (IL.S_Input(x, name, desc, SOME _)) = SOME(IL.Var.ty x, name, desc, true)
40 :     | gather _ = NONE
41 :     in
42 :     List.mapPartial gather body
43 :     end
44 :    
45 :     (* old input code from tree-to-c.sml
46 :     | IL.S_Input(lhs, name, desc, optDflt) => let
47 :     val lhs = VarToC.lvalueVar (env, lhs)
48 :     val (initCode, hasDflt) = (case optDflt
49 :     of SOME e => ([CL.mkAssign(lhs, trExp(env, e))], true)
50 :     | NONE => ([], false)
51 :     (* end case *))
52 :     val code = [CL.mkCall(N.input(V.ty lhs), [
53 :     CL.mkVar "opts",
54 :     CL.mkStr name,
55 :     CL.mkStr desc,
56 :     addrOf lhs,
57 :     CL.mkBool hasDflt])]
58 :     in
59 :     initCode
60 :     end
61 :     *)
62 :    
63 :     fun genRegisterInputs (tgt : target_desc, inputs) = let
64 : jhr 1774 val prefix = #namespace tgt
65 :     (* the world pointer type *)
66 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(prefix ^ "World_t"))
67 :     in
68 :     CL.D_Func(
69 :     [], CL.voidTy, N.registerOpts,
70 :     [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], CL.T_Ptr(CL.T_Named N.optionsTy), "opts")],
71 :     (* FIXME: fill in the code! *)
72 :     CL.mkBlock[])
73 :     end
74 :    
75 : jhr 1806 (* FIXME: we need to translate from the C representation to the Diderot representation *)
76 :     fun copy (ty, dst, src) = let
77 :     fun assign () = CL.mkAssign(dst, src)
78 :     fun addrOf (CL.E_UnOp(CL.%*, x)) = x
79 :     | addrOf x = CL.mkUnOp(CL.%&, x)
80 :     fun memcpy () = CL.mkCall("memcpy", [addrOf dst, addrOf src, CL.mkSizeof(trType ty)])
81 :     in
82 :     case ty
83 :     of Ty.BoolTy => assign()
84 :     | Ty.StringTy => CL.mkCall("strcpy", [addrOf dst, addrOf src])
85 :     | Ty.IntTy => assign()
86 :     | Ty.TensorTy[] => assign()
87 :     | Ty.TensorTy _ => memcpy()
88 :     | Ty.SeqTy _ => memcpy()
89 :     | Ty.DynSeqTy _ => raise Fail "dynamic sequence"
90 :     | Ty.ImageTy _ => raise Fail "unexpected image copy"
91 :     | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
92 :     (* end case *)
93 :     end
94 :    
95 : jhr 1803 (* for each input variable we generate two or three top-level declaraions *)
96 :     fun genInputFuns (tgt : target_desc, inputs) = let
97 :     val prefix = #namespace tgt
98 :     (* the world pointer type *)
99 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(prefix ^ "World_t"))
100 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
101 :     (* create decls for an input variable *)
102 :     fun mkInputDecls (ty, name, desc, hasDflt) = let
103 :     (* create a description declaration for the input variable *)
104 :     val descDcl = if (desc = "")
105 :     then []
106 :     else [
107 :     CL.D_Var([], CL.T_Ptr(CL.T_Named "const char"),
108 :     concat[prefix, "Desc_", name],
109 :     SOME(CL.I_Exp(CL.mkStr desc)))
110 :     ]
111 :     val getDcl = if hasDflt
112 :     then let
113 : jhr 1806 val getName = concat[prefix, name]
114 : jhr 1803 (* convert the input type to a by-reference C type *)
115 :     val outTy = (case ty
116 :     of Ty.BoolTy => CL.T_Ptr(trType ty)
117 :     | Ty.StringTy => CL.T_Ptr(trType ty)
118 :     | Ty.IntTy => CL.T_Ptr(trType ty)
119 :     | Ty.TensorTy[] => CL.T_Ptr(trType ty)
120 : jhr 1806 | Ty.TensorTy _ => trType ty
121 : jhr 1803 | Ty.SeqTy _ => trType ty
122 :     | Ty.DynSeqTy _ => CL.T_Ptr(trType ty)
123 :     | Ty.ImageTy _ => CL.T_Ptr CL.charPtr
124 :     | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
125 :     (* end case *))
126 :     in [
127 : jhr 1806 CL.D_Func([], CL.voidTy, getName, [wrldParam, CL.PARAM([], outTy, "v")],
128 :     CL.mkBlock[copy(ty, CL.mkUnOp(CL.%*, CL.mkVar "v"), global name)])
129 : jhr 1803 ] end
130 :     else []
131 :     val setDcl = (case ty
132 :     of Ty.ImageTy _ => [
133 :     CL.D_Func(
134 :     [], CL.voidTy, concat[prefix, "Set_", name, "_ByName"],
135 :     [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
136 :     CL.mkBlock[] (* FIXME *)),
137 :     CL.D_Func(
138 :     [], CL.voidTy, concat[prefix, "Set_", name],
139 :     [wrldParam, CL.PARAM([], nrrdPtrTy, "data")],
140 :     CL.mkBlock[] (* FIXME *))
141 :     ]
142 :     | Ty.DynSeqTy _ => raise Fail "dynamic input not supported yet"
143 :     | _ => [
144 :     CL.D_Func(
145 :     [], CL.voidTy, concat[prefix, "Set_", name],
146 :     [wrldParam, CL.PARAM([], trType ty, "v")],
147 : jhr 1806 CL.mkBlock[copy(ty, global name, CL.mkVar "v")])
148 : jhr 1803 ]
149 :     (* end case *))
150 :     in
151 :     descDcl @ getDcl @ setDcl
152 :     end
153 :     in
154 :     List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) [] inputs
155 :     end
156 :    
157 : jhr 1774 end

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