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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch 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

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