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 534 - (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 :    
14 : jhr 525 datatype ty
15 :     = T_Bool
16 : jhr 534 | T_String
17 : jhr 525 | T_Int (* default float type *)
18 :     | T_Real (* default real type *)
19 :     | T_Vec of int
20 :     | T_IVec of int
21 :     | T_Image of int (* n-dimensional image data *)
22 : jhr 528 | T_Data of CL.ty (* pointer to image data *)
23 : jhr 519
24 : jhr 525 type strand = unit (* FIXME *)
25 :    
26 :     type var = (ty * string) (* FIXME *)
27 :    
28 :     type exp = CLang.exp * ty
29 :    
30 :     type stm = CL.stm
31 :    
32 :     type method = unit (* FIXME *)
33 :    
34 : jhr 527 datatype program = Prog of {
35 :     globals : CL.decl list ref,
36 : jhr 533 topDecls : CL.decl list ref,
37 : jhr 527 strands : strand list ref
38 :     }
39 :    
40 : jhr 525 (* globals that specify the target characteristics. These should be initialized
41 :     * when the program object is created.
42 :     *)
43 :     val gVectorWid = ref 4
44 :     val gIntTy = ref CL.int32
45 :     val gRealTy = ref CL.float
46 :    
47 :     (* initialize globals based on target precision *)
48 : jhr 533 fun initTargetSpec () = if !Controls.doublePrecision
49 : jhr 525 then (
50 :     gVectorWid := 2;
51 :     gIntTy := CL.int64;
52 :     gRealTy := CL.double)
53 :     else (
54 :     gVectorWid := 4;
55 :     gIntTy := CL.int32;
56 :     gRealTy := CL.float)
57 :    
58 : jhr 519 (* for SSE, we have 128-bit vectors *)
59 : jhr 525 fun vectorWidth () = !gVectorWid
60 : jhr 519
61 :     (* target types *)
62 : jhr 525 val boolTy = T_Bool
63 :     val intTy = T_Int
64 :     val realTy = T_Real
65 :     fun vecTy 1 = T_Real
66 :     | vecTy n = if (n < 1) orelse (!gVectorWid < n)
67 :     then raise Size
68 :     else T_Vec n
69 :     fun ivecTy 1 = T_Int
70 :     | ivecTy n = if (n < 1) orelse (!gVectorWid < n)
71 :     then raise Size
72 :     else T_IVec n
73 :     fun imageTy dim = T_Image dim
74 : jhr 534 val stringTy = T_String
75 : jhr 519
76 : jhr 534 val statusTy = CL.T_Named "Status_t"
77 :    
78 : jhr 528 (* convert target types to CLang types *)
79 :     fun cvtTy T_Bool = CLang.T_Named "bool"
80 : jhr 534 | cvtTy T_String = CL.charPtr
81 : jhr 528 | cvtTy T_Int = !gIntTy
82 :     | cvtTy T_Real = !gRealTy
83 :     | cvtTy (T_Vec n) = CLang.T_Named(concat["Diderot_vec", Int.toString n, "D_t"])
84 :     | cvtTy (T_IVec n) = raise Fail "FIXME: T_IVec"
85 :     | cvtTy (T_Image n) = CLang.T_Named(concat["Diderot_image", Int.toString n, "D_t"])
86 :     | cvtTy (T_Data ty) = ty
87 :    
88 : jhr 525 (* helper functions for checking the types of arguments *)
89 :     fun scalarTy T_Int = true
90 :     | scalarTy T_Real = true
91 :     | scalarTy _ = false
92 :     fun numTy T_Bool = false
93 :     | numTy (T_Image _) = false
94 : jhr 528 | numTy (T_Data _) = false
95 : jhr 525 | numTy _ = true
96 : jhr 519
97 : jhr 528 fun newProgram () = (
98 : jhr 533 initTargetSpec();
99 : jhr 528 Prog{
100 :     globals = ref [],
101 : jhr 533 topDecls = ref [],
102 : jhr 528 strands = ref []
103 :     })
104 :    
105 : jhr 533 fun globalInit (Prog{topDecls, ...}, init) = let
106 :     val initFn = CL.D_Func([], CL.voidTy, "Diderot_InitGlobals", [], init)
107 :     in
108 :     topDecls := initFn :: !topDecls
109 :     end
110 :    
111 : jhr 525 fun defineStrand (p, strandId) = raise Fail "FIXME: unimplemented"
112 :    
113 :     structure Var =
114 :     struct
115 : jhr 528 fun global (Prog{globals, ...}, ty, name) = (
116 :     globals := CL.D_Var([], cvtTy ty, name) :: !globals;
117 :     (ty, name))
118 : jhr 525 fun state (strand, ty, name) = raise Fail "FIXME: Var.state"
119 :     fun tmp ty = raise Fail "FIXME: Var.tmp"
120 : jhr 519 end
121 :    
122 :     (* expression construction *)
123 : jhr 525 structure Expr =
124 :     struct
125 : jhr 519 (* variable references *)
126 : jhr 525 fun global (ty, x) = (CL.mkVar x, ty)
127 :     fun getState (ty, x) = (CL.mkIndirect(CL.mkVar "self", x), ty)
128 :     fun param (ty, x) = (CL.mkVar x, ty)
129 :     fun var (ty, x) = (CL.mkVar x, ty)
130 :    
131 : jhr 519 (* literals *)
132 : jhr 525 fun intLit n = (CL.mkInt(n, !gIntTy), intTy)
133 :     fun floatLit f = (CL.mkFlt(f, !gRealTy), realTy)
134 : jhr 533 fun stringLit s = (CL.mkStr s, stringTy)
135 : jhr 525 fun boolLit b = (CL.mkBool b, boolTy)
136 :    
137 : jhr 519 (* vector construction *)
138 : jhr 525 fun vector _ = raise Fail "FIXME: Expr.vector"
139 :    
140 : jhr 519 (* select from a vector *)
141 : jhr 525 fun select (i, (e, T_Vec n)) =
142 :     if (i < 0) orelse (n <= i)
143 :     then raise Subscript
144 :     else (CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i, CL.int32)), T_Real)
145 :     | select (i, (e, T_IVec n)) =
146 :     if (i < 0) orelse (n <= i)
147 :     then raise Subscript
148 :     else (CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i, CL.int32)), T_Int)
149 :     | select _ = raise Fail "invalid argument to select"
150 :    
151 : jhr 519 (* vector (and scalar) arithmetic *)
152 : jhr 525 local
153 :     fun checkTys (ty1, ty2) = (ty1 = ty2) andalso numTy ty1
154 :     fun binop rator ((e1, ty1), (e2, ty2)) =
155 :     if checkTys (ty1, ty2)
156 :     then (CL.mkBinOp(e1, rator, e2), ty1)
157 :     else raise Fail "invalid arguments to binary operator"
158 :     in
159 :     val add = binop CL.#+
160 :     val sub = binop CL.#-
161 :     val mul = binop CL.#*
162 :     val divide = binop CL.#/
163 :     end (* local *)
164 :     fun neg (e, T_Bool) = raise Fail "invalid argument to neg"
165 :     | neg (e, ty) = (CL.mkUnOp(CL.%-, e), ty)
166 :    
167 :     fun abs (e, T_Int) = (CL.mkApply("abs", [e]), T_Int) (* FIXME: not the right type for 64-bit ints *)
168 :     | abs (e, T_Real) =
169 :     if !Controls.doublePrecision
170 :     then (CL.mkApply("fabs", [e]), T_Real)
171 :     else (CL.mkApply("fabsf", [e]), T_Real)
172 :     | abs (e, T_Vec n) = raise Fail "FIXME: Expr.abs"
173 :     | abs (e, T_IVec n) = raise Fail "FIXME: Expr.abs"
174 :     | abs _ = raise Fail "invalid argument to abs"
175 :    
176 :     fun dot ((e1, T_Vec n1), (e2, T_Vec n2)) = raise Fail "FIXME: Expr.dot"
177 :     | dot _ = raise Fail "invalid argument to dot"
178 :    
179 :     fun cross ((e1, T_Vec 3), (e2, T_Vec 3)) = raise Fail "FIXME: Expr.cross"
180 :     | cross _ = raise Fail "invalid argument to cross"
181 :    
182 :     fun length (e, T_Vec n) = raise Fail "FIXME: Expr.length"
183 :     | length _ = raise Fail "invalid argument to length"
184 :    
185 :     fun normalize (e, T_Vec n) = raise Fail "FIXME: Expr.normalize"
186 :     | normalize _ = raise Fail "invalid argument to length"
187 :    
188 : jhr 519 (* comparisons *)
189 : jhr 525 local
190 :     fun checkTys (ty1, ty2) =
191 :     (ty1 = ty2) andalso scalarTy ty1
192 :     fun cmpop rator ((e1, ty1), (e2, ty2)) =
193 :     if checkTys (ty1, ty2)
194 :     then (CL.mkBinOp(e1, rator, e2), T_Bool)
195 :     else raise Fail "invalid arguments to compare operator"
196 :     in
197 :     val lt = cmpop CL.#<
198 :     val lte = cmpop CL.#<=
199 :     val equ = cmpop CL.#==
200 :     val neq = cmpop CL.#!=
201 :     val gte = cmpop CL.#>=
202 :     val gt = cmpop CL.#>
203 :     end (* local *)
204 :    
205 : jhr 519 (* logical connectives *)
206 : jhr 525 fun not (e, T_Bool) = (CL.mkUnOp(CL.%!, e), T_Bool)
207 :     | not _ = raise Fail "invalid argument to not"
208 :     fun && ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#&&, e2), T_Bool)
209 :     | && _ = raise Fail "invalid arguments to &&"
210 :     fun || ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#||, e2), T_Bool)
211 :     | || _ = raise Fail "invalid arguments to ||"
212 :    
213 :     local
214 :     fun checkTys (ty1, ty2) = (ty1 = ty2) andalso scalarTy ty1
215 :     fun binFn f ((e1, ty1), (e2, ty2)) =
216 :     if checkTys (ty1, ty2)
217 :     then (CL.mkApply(f, [e1, e2]), ty1)
218 :     else raise Fail "invalid arguments to binary function"
219 :     in
220 : jhr 519 (* misc functions *)
221 : jhr 525 val min = binFn "Diderot_min"
222 :     val max = binFn "Diderot_max"
223 :     end (* local *)
224 :    
225 : jhr 519 (* math functions *)
226 : jhr 525 fun pow ((e1, T_Real), (e2, T_Real)) =
227 :     if !Controls.doublePrecision
228 :     then (CL.mkApply("pow", [e1, e2]), T_Real)
229 :     else (CL.mkApply("powf", [e1, e2]), T_Real)
230 :     | pow _ = raise Fail "invalid arguments to pow"
231 :    
232 :     local
233 :     fun r2r (ff, fd) (e, T_Real) = if !Controls.doublePrecision
234 :     then (CL.mkApply(fd, [e]), T_Real)
235 :     else (CL.mkApply(ff, [e]), T_Real)
236 :     | r2r (_, fd) _ = raise Fail("invalid argument for "^fd)
237 :     in
238 :     val sin = r2r ("sinf", "sin")
239 :     val cos = r2r ("cosf", "cos")
240 :     val sqrt = r2r ("sqrtf", "sqrt")
241 : jhr 519 (* rounding *)
242 : jhr 525 val trunc = r2r ("truncf", "trunc")
243 :     val round = r2r ("roundf", "round")
244 :     val floor = r2r ("floorf", "floor")
245 :     val ceil = r2r ("ceilf", "ceil")
246 :     end (* local *)
247 :    
248 : jhr 519 (* conversions *)
249 : jhr 525 fun toReal (e, T_Int) = (CL.mkCast(!gRealTy, e), T_Real)
250 :     | toReal _ = raise Fail "invalid argument for toReal"
251 :    
252 :     fun truncToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(trunc e)), T_Int)
253 :     | truncToInt _ = raise Fail "invalid argument for truncToInt"
254 :     fun roundToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(round e)), T_Int)
255 :     | roundToInt _ = raise Fail "invalid argument for roundToInt"
256 :     fun ceilToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(floor e)), T_Int)
257 :     | ceilToInt _ = raise Fail "invalid argument for ceilToInt"
258 :     fun floorToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(ceil e)), T_Int)
259 :     | floorToInt _ = raise Fail "invalid argument for floorToInt"
260 :    
261 : jhr 519 (* runtime system hooks *)
262 : jhr 528 fun imageAddr (e, T_Image d) = let
263 :     val cTy = CL.T_Ptr(!gRealTy)
264 :     in
265 :     (CL.mkCast(cTy, CL.mkIndirect(e, "data")), T_Data cTy)
266 :     end
267 : jhr 525 | imageAddr _ = raise Fail "invalid argument to imageAddr"
268 : jhr 519 end
269 :    
270 :     (* statement construction *)
271 : jhr 525 structure Stmt =
272 :     struct
273 :     val comment = CL.S_Comment
274 :     fun assignState (x, (e, _)) = CL.mkAssign(#1(Expr.getState x), e)
275 :     fun assign ((_, x), (e, _)) = CL.mkAssign(CL.mkVar x, e)
276 : jhr 528 fun decl ((ty, x), SOME(e, _)) = CL.mkDecl(cvtTy ty, x, SOME e)
277 :     | decl ((ty, x), NONE) = CL.mkDecl(cvtTy ty, x, NONE)
278 : jhr 525 val block = CL.mkBlock
279 : jhr 532 fun ifthen ((e, T_Bool), s1) = CL.mkIfThen(e, s1)
280 : jhr 525 fun ifthenelse ((e, T_Bool), s1, s2) = CL.mkIfThenElse(e, s1, s2)
281 : jhr 534 (* special Diderot forms *)
282 :     fun cons (lhs, args) = comment ["**** cons ****"] (* FIXME *)
283 :     fun loadImage (lhs : var, dim, name : exp) = let
284 :     val sts = "sts"
285 :     val imgTy = CL.T_Named(concat["Diderot_image", Int.toString dim, "D_t"])
286 :     val loadFn = concat["Diderot_LoadImage", Int.toString dim, "D"]
287 :     in [
288 :     CL.S_Decl(
289 :     statusTy, sts,
290 :     SOME(CL.E_Apply(loadFn, [#1 name, CL.mkUnOp(CL.%&, CL.E_Var(#2 lhs))])))
291 :     ] end
292 :     fun input (lhs : var, name, optDflt) = let
293 :     val sts = "sts"
294 :     val inputFn = (case #1 lhs
295 :     of T_String => "Diderot_InputString"
296 :     | T_Vec 1 => "Diderot_InputReal"
297 :     | T_Vec 3 => "Diderot_InputVec3"
298 :     | _ => raise Fail "unsupported input type"
299 :     (* end case *))
300 :     val lhs = CL.E_Var(#2 lhs)
301 :     val (initCode, hasDflt) = (case optDflt
302 :     of SOME(e, _) => ([CL.S_Assign(lhs, e)], true)
303 :     | NONE => ([], false)
304 :     (* end case *))
305 :     val code = [
306 :     CL.S_Decl(
307 :     statusTy, sts,
308 :     SOME(CL.E_Apply(inputFn, [
309 :     CL.E_Str name, CL.mkUnOp(CL.%&, lhs), CL.mkBool hasDflt
310 :     ])))
311 :     ]
312 :     in
313 :     initCode @ code
314 :     end
315 : jhr 528 fun die () = comment ["**** die ****"] (* FIXME *)
316 :     fun stabilize () = comment ["**** stabilize ****"] (* FIXME *)
317 : jhr 519 end
318 :    
319 : jhr 533 fun generate (baseName, Prog{globals, topDecls, strands}) = let
320 : jhr 527 val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
321 :     val outS = TextIO.openOut fileName
322 :     val ppStrm = PrintAsC.new outS
323 : jhr 533 fun ppDecl dcl = PrintAsC.output(ppStrm, dcl)
324 : jhr 527 in
325 : jhr 533 List.app ppDecl (List.rev (!globals));
326 :     List.app ppDecl (List.rev (!topDecls));
327 : jhr 527 (* what about the strands, etc? *)
328 :     PrintAsC.close ppStrm;
329 :     TextIO.closeOut outS
330 :     end
331 :    
332 : jhr 519 end
333 :    
334 :     structure CBackEnd = CodeGenFn(CTarget)

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