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

Parent Directory | Revision Log | Patch

	revision 524, Sat Feb 12 21:11:01 2011 UTC	revision 525, Sat Feb 12 22:59:18 2011 UTC
#	Line 11	Line 11
11
12	structure CL = CLang	structure CL = CLang
13
14	type program	datatype ty
15	type strand	= T_Bool
16	type var	| T_Int                   (* default float type *)
17	type exp	| T_Real                  (* default real type *)
18	type stm	| T_Vec of int
19	type method	| T_IVec of int
20	type ty	| T_Image of int          (* n-dimensional image data *)
21		| T_Data                  (* pointer to image data *)
22
23		type program = CL.decl list
24
25		type strand = unit (* FIXME *)
26
27		type var = (ty * string) (* FIXME *)
28
29		type exp = CLang.exp * ty
30
31		type stm = CL.stm
32
33		type method = unit (* FIXME *)
34
35		(* globals that specify the target characteristics.  These should be initialized
36		* when the program object is created.
37		*)
38		val gVectorWid = ref 4
39		val gIntTy = ref CL.int32
40		val gRealTy = ref CL.float
41
42		(* initialize globals based on target precision *)
43		fun initGlobals () = if !Controls.doublePrecision
44		then (
45		gVectorWid := 2;
46		gIntTy := CL.int64;
47		gRealTy := CL.double)
48		else (
49		gVectorWid := 4;
50		gIntTy := CL.int32;
51		gRealTy := CL.float)
52
53	(* for SSE, we have 128-bit vectors *)	(* for SSE, we have 128-bit vectors *)
54	fun vectorWidth () = if !Controls.singlePrecision	fun vectorWidth () = !gVectorWid
	then 4
	else 2
55
56	(* target types *)	(* target types *)
57	val boolTy : ty	val boolTy = T_Bool
58	val intTy : ty	val intTy = T_Int
59	val realTy : ty	val realTy = T_Real
60	val vecTy : int -> ty	fun vecTy 1 = T_Real
61	val ivecTy : int -> ty	| vecTy n = if (n < 1) orelse (!gVectorWid < n)
62		then raise Size
63	val defineStrand : program * string -> strand	else T_Vec n
64		fun ivecTy 1 = T_Int
65	structure Var : sig	| ivecTy n = if (n < 1) orelse (!gVectorWid < n)
66	val global : program * ty * string -> var	then raise Size
67	val state : strand * ty * string -> var	else T_IVec n
68	val tmp : ty -> var	fun imageTy dim = T_Image dim
69
70		(* helper functions for checking the types of arguments *)
71		fun scalarTy T_Int = true
72		| scalarTy T_Real = true
73		| scalarTy _ = false
74		fun numTy T_Bool = false
75		| numTy (T_Image _) = false
76		| numTy T_Data = false
77		| numTy _ = true
78
79		fun defineStrand (p, strandId) = raise Fail "FIXME: unimplemented"
80
81		structure Var =
82		struct
83		fun global (p, ty, name) = raise Fail "FIXME: Var.global"
84		fun state (strand, ty, name) = raise Fail "FIXME: Var.state"
85		fun tmp ty = raise Fail "FIXME: Var.tmp"
86	end	end
87
88	(* expression construction *)	(* expression construction *)
89	structure Expr : sig	structure Expr =
90		struct
91	(* variable references *)	(* variable references *)
92	val global : var -> exp	fun global (ty, x) = (CL.mkVar x, ty)
93	val getState : var -> exp	fun getState (ty, x) = (CL.mkIndirect(CL.mkVar "self", x), ty)
94	val param : var -> exp	fun param (ty, x) = (CL.mkVar x, ty)
95	val var : var -> exp	fun var (ty, x) = (CL.mkVar x, ty)
96
97	(* literals *)	(* literals *)
98	val intLit : IntegerLit.integer -> exp	fun intLit n = (CL.mkInt(n, !gIntTy), intTy)
99	val floatLit : FloatLit.float -> exp	fun floatLit f = (CL.mkFlt(f, !gRealTy), realTy)
100	val stringLit : string -> exp	fun stringLit s = raise Fail "FIXME: Expr.stringLit"
101	val boolLit : bool -> exp	fun boolLit b = (CL.mkBool b, boolTy)
102
103	(* vector construction *)	(* vector construction *)
104	val vector : exp list -> exp	fun vector _ = raise Fail "FIXME: Expr.vector"
105
106	(* select from a vector *)	(* select from a vector *)
107	val select : int * exp -> exp	fun select (i, (e, T_Vec n)) =
108		if (i < 0) orelse (n <= i)
109		then raise Subscript
110		else (CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i, CL.int32)), T_Real)
111		| select (i, (e, T_IVec n)) =
112		if (i < 0) orelse (n <= i)
113		then raise Subscript
114		else (CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i, CL.int32)), T_Int)
115		| select _ = raise Fail "invalid argument to select"
116
117	(* vector (and scalar) arithmetic *)	(* vector (and scalar) arithmetic *)
118	val add : exp * exp -> exp	local
119	val mul : exp * exp -> exp	fun checkTys (ty1, ty2) = (ty1 = ty2) andalso numTy ty1
120	val sub : exp * exp -> exp	fun binop rator ((e1, ty1), (e2, ty2)) =
121	val divide : exp * exp -> exp	if checkTys (ty1, ty2)
122	val neg : exp -> exp	then (CL.mkBinOp(e1, rator, e2), ty1)
123	val abs : exp -> exp	else raise Fail "invalid arguments to binary operator"
124	val dot : exp * exp -> exp              (* dot product *)	in
125	val cross : exp * exp -> exp            (* cross product *)	val add = binop CL.#+
126	val length : exp -> exp                 (* vector length *)	val sub = binop CL.#-
127	val normalize : exp -> exp              (* normalize vector *)	val mul = binop CL.#*
128		val divide = binop CL.#/
129		end (* local *)
130		fun neg (e, T_Bool) = raise Fail "invalid argument to neg"
131		| neg (e, ty) = (CL.mkUnOp(CL.%-, e), ty)
132
133		fun abs (e, T_Int) = (CL.mkApply("abs", [e]), T_Int)    (* FIXME: not the right type for 64-bit ints *)
134		| abs (e, T_Real) =
135		if !Controls.doublePrecision
136		then (CL.mkApply("fabs", [e]), T_Real)
137		else (CL.mkApply("fabsf", [e]), T_Real)
138		| abs (e, T_Vec n) = raise Fail "FIXME: Expr.abs"
139		| abs (e, T_IVec n) = raise Fail "FIXME: Expr.abs"
140		| abs _ = raise Fail "invalid argument to abs"
141
142		fun dot ((e1, T_Vec n1), (e2, T_Vec n2)) = raise Fail "FIXME: Expr.dot"
143		| dot _ = raise Fail "invalid argument to dot"
144
145		fun cross ((e1, T_Vec 3), (e2, T_Vec 3)) = raise Fail "FIXME: Expr.cross"
146		| cross _ = raise Fail "invalid argument to cross"
147
148		fun length (e, T_Vec n) = raise Fail "FIXME: Expr.length"
149		| length _ = raise Fail "invalid argument to length"
150
151		fun normalize (e, T_Vec n) = raise Fail "FIXME: Expr.normalize"
152		| normalize _ = raise Fail "invalid argument to length"
153
154	(* comparisons *)	(* comparisons *)
155	val lt : exp * exp -> exp	local
156	val lte : exp * exp -> exp	fun checkTys (ty1, ty2) =
157	val equ : exp * exp -> exp	(ty1 = ty2) andalso scalarTy ty1
158	val neq : exp * exp -> exp	fun cmpop rator ((e1, ty1), (e2, ty2)) =
159	val gte : exp * exp -> exp	if checkTys (ty1, ty2)
160	val gt : exp * exp -> exp	then (CL.mkBinOp(e1, rator, e2), T_Bool)
161		else raise Fail "invalid arguments to compare operator"
162		in
163		val lt = cmpop CL.#<
164		val lte = cmpop CL.#<=
165		val equ = cmpop CL.#==
166		val neq = cmpop CL.#!=
167		val gte = cmpop CL.#>=
168		val gt = cmpop CL.#>
169		end (* local *)
170
171	(* logical connectives *)	(* logical connectives *)
172	val not : exp -> exp	fun not (e, T_Bool) = (CL.mkUnOp(CL.%!, e), T_Bool)
173	val && : exp * exp -> exp	| not _ = raise Fail "invalid argument to not"
174	val || : exp * exp -> exp	fun && ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#&&, e2), T_Bool)
175		| && _ = raise Fail "invalid arguments to &&"
176		fun || ((e1, T_Bool), (e2, T_Bool)) = (CL.mkBinOp(e1, CL.#||, e2), T_Bool)
177		| || _ = raise Fail "invalid arguments to ||"
178
179		local
180		fun checkTys (ty1, ty2) = (ty1 = ty2) andalso scalarTy ty1
181		fun binFn f ((e1, ty1), (e2, ty2)) =
182		if checkTys (ty1, ty2)
183		then (CL.mkApply(f, [e1, e2]), ty1)
184		else raise Fail "invalid arguments to binary function"
185		in
186	(* misc functions *)	(* misc functions *)
187	val min : exp * exp -> exp	val min = binFn "Diderot_min"
188	val max : exp * exp -> exp	val max = binFn "Diderot_max"
189		end (* local *)
190
191	(* math functions *)	(* math functions *)
192	val pow : exp * exp -> exp	fun pow ((e1, T_Real), (e2, T_Real)) =
193	val sin : exp -> exp	if !Controls.doublePrecision
194	val cos : exp -> exp	then (CL.mkApply("pow", [e1, e2]), T_Real)
195	val sqrt : exp -> exp	else (CL.mkApply("powf", [e1, e2]), T_Real)
196		| pow _ = raise Fail "invalid arguments to pow"
197
198		local
199		fun r2r (ff, fd) (e, T_Real) = if !Controls.doublePrecision
200		then (CL.mkApply(fd, [e]), T_Real)
201		else (CL.mkApply(ff, [e]), T_Real)
202		| r2r (_, fd) _ = raise Fail("invalid argument for "^fd)
203		in
204		val sin = r2r ("sinf", "sin")
205		val cos = r2r ("cosf", "cos")
206		val sqrt = r2r ("sqrtf", "sqrt")
207	(* rounding *)	(* rounding *)
208	val round : exp -> exp                  (* round real to integral real *)	val trunc = r2r ("truncf", "trunc")
209	val floor : exp -> exp                  (* round real to integral real *)	val round = r2r ("roundf", "round")
210	val ceil : exp -> exp                   (* round real to integral real *)	val floor = r2r ("floorf", "floor")
211		val ceil  = r2r ("ceilf", "ceil")
212		end (* local *)
213
214	(* conversions *)	(* conversions *)
215	val toReal : exp -> exp                 (* integer to real *)	fun toReal (e, T_Int) = (CL.mkCast(!gRealTy, e), T_Real)
216	val roundToInt : exp -> exp             (* round real to int *)	| toReal _ = raise Fail "invalid argument for toReal"
217	val truncToInt : exp -> exp             (* truncate real to inte *)
218	val ceilToInt : exp -> exp              (* ceiling of real to int *)	fun truncToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(trunc e)), T_Int)
219	val floorToInt : exp -> exp             (* floor of real to int *)	| truncToInt _ = raise Fail "invalid argument for truncToInt"
220		fun roundToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(round e)), T_Int)
221		| roundToInt _ = raise Fail "invalid argument for roundToInt"
222		fun ceilToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(floor e)), T_Int)
223		| ceilToInt _ = raise Fail "invalid argument for ceilToInt"
224		fun floorToInt (e as (_, T_Real)) = (CL.mkCast(!gIntTy, #1(ceil e)), T_Int)
225		| floorToInt _ = raise Fail "invalid argument for floorToInt"
226
227	(* runtime system hooks *)	(* runtime system hooks *)
228	val imageAddr : exp -> exp              (* based address of image data *)	fun imageAddr (e, T_Image d) =
229		(CL.mkCast(CL.T_Ptr(!gRealTy), CL.mkIndirect(e, "data")), T_Data)
230		| imageAddr _ = raise Fail "invalid argument to imageAddr"
231	end	end
232
233	(* statement construction *)	(* statement construction *)
234	structure Stmt : sig	structure Stmt =
235	val comment : string list -> stm	struct
236	val assignState : var * exp -> stm	val comment = CL.S_Comment
237	val assign : var * exp -> stm	fun assignState (x, (e, _)) = CL.mkAssign(#1(Expr.getState x), e)
238	val assignb : var * exp -> stm	fun assign ((_, x), (e, _)) = CL.mkAssign(CL.mkVar x, e)
239	val block : stm list -> stm	val block = CL.mkBlock
240	val ifthenelse : exp * stm * stm -> stm	fun ifthenelse ((e, T_Bool), s1, s2) = CL.mkIfThenElse(e, s1, s2)
241	val die : unit -> stm	fun die () = raise Fail "FIXME: Stmt.die"
242	val stabilize : unit -> stm	fun stabilize () = raise Fail "FIXME: Stmt.die"
243	end	end
244
245	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.524   changed lines   Added in v.525

---

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