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 1812 - (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 : jhr 1807 val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")
28 : jhr 1803
29 :     type target_desc = TargetUtil.target_desc
30 :    
31 :     (* translate TreeIL types to CLang types *)
32 :     val trType = TreeTyToC.trType
33 :    
34 : jhr 1806 (* an l-value expression for accessing a global variable *)
35 :     fun global name = CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld", "globals"), name)
36 :    
37 : jhr 1803 (* gather the input globals from the input initialization block *)
38 :     fun gatherInputs (IL.Block{body, ...}) = let
39 :     fun gather (IL.S_Input(x, name, desc, NONE)) = SOME(IL.Var.ty x, name, desc, false)
40 :     | gather (IL.S_Input(x, name, desc, SOME _)) = SOME(IL.Var.ty x, name, desc, true)
41 :     | gather _ = NONE
42 :     in
43 :     List.mapPartial gather body
44 :     end
45 :    
46 :     (* old input code from tree-to-c.sml
47 :     | IL.S_Input(lhs, name, desc, optDflt) => let
48 :     val lhs = VarToC.lvalueVar (env, lhs)
49 :     val (initCode, hasDflt) = (case optDflt
50 :     of SOME e => ([CL.mkAssign(lhs, trExp(env, e))], true)
51 :     | NONE => ([], false)
52 :     (* end case *))
53 :     val code = [CL.mkCall(N.input(V.ty lhs), [
54 :     CL.mkVar "opts",
55 :     CL.mkStr name,
56 :     CL.mkStr desc,
57 :     addrOf lhs,
58 :     CL.mkBool hasDflt])]
59 :     in
60 :     initCode
61 :     end
62 :     *)
63 :    
64 :     fun genRegisterInputs (tgt : target_desc, inputs) = let
65 : jhr 1774 val prefix = #namespace tgt
66 :     (* the world pointer type *)
67 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(prefix ^ "World_t"))
68 :     in
69 :     CL.D_Func(
70 :     [], CL.voidTy, N.registerOpts,
71 :     [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], CL.T_Ptr(CL.T_Named N.optionsTy), "opts")],
72 :     (* FIXME: fill in the code! *)
73 :     CL.mkBlock[])
74 :     end
75 :    
76 : jhr 1806 (* FIXME: we need to translate from the C representation to the Diderot representation *)
77 :     fun copy (ty, dst, src) = let
78 :     fun assign () = CL.mkAssign(dst, src)
79 :     fun addrOf (CL.E_UnOp(CL.%*, x)) = x
80 :     | addrOf x = CL.mkUnOp(CL.%&, x)
81 :     fun memcpy () = CL.mkCall("memcpy", [addrOf dst, addrOf src, CL.mkSizeof(trType ty)])
82 :     in
83 :     case ty
84 :     of Ty.BoolTy => assign()
85 :     | Ty.StringTy => CL.mkCall("strcpy", [addrOf dst, addrOf src])
86 :     | Ty.IntTy => assign()
87 :     | Ty.TensorTy[] => assign()
88 :     | Ty.TensorTy _ => memcpy()
89 :     | Ty.SeqTy _ => memcpy()
90 :     | Ty.DynSeqTy _ => raise Fail "dynamic sequence"
91 :     | Ty.ImageTy _ => raise Fail "unexpected image copy"
92 :     | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
93 :     (* end case *)
94 :     end
95 :    
96 : jhr 1803 (* for each input variable we generate two or three top-level declaraions *)
97 :     fun genInputFuns (tgt : target_desc, inputs) = let
98 :     val prefix = #namespace tgt
99 :     (* the world pointer type *)
100 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(prefix ^ "World_t"))
101 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
102 :     (* create decls for an input variable *)
103 :     fun mkInputDecls (ty, name, desc, hasDflt) = let
104 :     (* create a description declaration for the input variable *)
105 :     val descDcl = if (desc = "")
106 :     then []
107 :     else [
108 :     CL.D_Var([], CL.T_Ptr(CL.T_Named "const char"),
109 : jhr 1812 concat[prefix, name, "Desc"],
110 : jhr 1803 SOME(CL.I_Exp(CL.mkStr desc)))
111 :     ]
112 :     val getDcl = if hasDflt
113 :     then let
114 : jhr 1812 val getName = concat[prefix, name, "Get"]
115 : jhr 1803 (* convert the input type to a by-reference C type *)
116 :     val outTy = (case ty
117 :     of Ty.BoolTy => CL.T_Ptr(trType ty)
118 :     | Ty.StringTy => CL.T_Ptr(trType ty)
119 :     | Ty.IntTy => CL.T_Ptr(trType ty)
120 :     | Ty.TensorTy[] => CL.T_Ptr(trType ty)
121 : jhr 1806 | Ty.TensorTy _ => trType ty
122 : jhr 1803 | Ty.SeqTy _ => trType ty
123 :     | Ty.DynSeqTy _ => CL.T_Ptr(trType ty)
124 :     | Ty.ImageTy _ => CL.T_Ptr CL.charPtr
125 :     | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
126 :     (* end case *))
127 :     in [
128 : jhr 1806 CL.D_Func([], CL.voidTy, getName, [wrldParam, CL.PARAM([], outTy, "v")],
129 :     CL.mkBlock[copy(ty, CL.mkUnOp(CL.%*, CL.mkVar "v"), global name)])
130 : jhr 1803 ] end
131 :     else []
132 :     val setDcl = (case ty
133 : jhr 1807 of Ty.ImageTy info => let
134 :     val dim = ImageInfo.dim info
135 :     in [
136 : jhr 1803 CL.D_Func(
137 : jhr 1812 [], CL.boolTy, concat[prefix, name, "SetByName"],
138 : jhr 1803 [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
139 : jhr 1807 CL.mkBlock[
140 :     (* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
141 :     CL.mkReturn(SOME(
142 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
143 :     CL.mkApply(N.loadImage dim, [
144 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
145 :     CL.mkVar "s", CL.mkUnOp(CL.%&, global name)
146 :     ]))))
147 :     ]),
148 : jhr 1803 CL.D_Func(
149 : jhr 1812 [], CL.boolTy, concat[prefix, name, "Set"],
150 : jhr 1807 [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
151 :     CL.mkBlock[
152 :     (* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
153 :     CL.mkReturn(SOME(
154 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
155 :     CL.mkApply(N.setImage dim, [
156 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
157 :     CL.mkVar "nin", CL.mkUnOp(CL.%&, global name)
158 :     ]))))
159 :     ])
160 :     ] end
161 : jhr 1803 | Ty.DynSeqTy _ => raise Fail "dynamic input not supported yet"
162 :     | _ => [
163 :     CL.D_Func(
164 : jhr 1812 [], CL.boolTy, concat[prefix, name, "Set"],
165 : jhr 1803 [wrldParam, CL.PARAM([], trType ty, "v")],
166 : jhr 1808 CL.mkBlock[
167 :     copy(ty, global name, CL.mkVar "v"),
168 :     CL.mkReturn(SOME(CL.mkVar "false"))
169 :     ])
170 : jhr 1803 ]
171 :     (* end case *))
172 :     in
173 :     descDcl @ getDcl @ setDcl
174 :     end
175 :     in
176 :     List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) [] inputs
177 :     end
178 :    
179 : jhr 1774 end

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