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 537, Tue Feb 15 18:02:25 2011 UTC revision 544, Wed Feb 16 23:14:14 2011 UTC
# Line 33  Line 33 
33              | T_Data ty => "T_Data"              | T_Data ty => "T_Data"
34            (* end case *))            (* end case *))
35    
36      type strand = unit (* FIXME *)      datatype strand = Strand of {
37            name : string,
38            tyName : string,
39            state : (ty * string) list ref,
40            code : CL.decl list ref
41          }
42    
43      type var = (ty * string) (* FIXME *)      type var = (ty * string) (* FIXME *)
44    
# Line 55  Line 60 
60      val gVectorWid = ref 4      val gVectorWid = ref 4
61      val gIntTy = ref CL.int32      val gIntTy = ref CL.int32
62      val gRealTy = ref CL.float      val gRealTy = ref CL.float
63        val gRealSuffix = ref "f"
64    
65    (* initialize globals based on target precision *)    (* initialize globals based on target precision *)
66      fun initTargetSpec () = if !Controls.doublePrecision      fun initTargetSpec () = if !Controls.doublePrecision
67            then (            then (
68              gVectorWid := 2;              gVectorWid := 2;
69              gIntTy := CL.int64;              gIntTy := CL.int64;
70              gRealTy := CL.double)              gRealTy := CL.double;
71                gRealSuffix := "d")
72            else (            else (
73              gVectorWid := 4;              gVectorWid := 4;
74              gIntTy := CL.int32;              gIntTy := CL.int32;
75              gRealTy := CL.float)              gRealTy := CL.float;
76                gRealSuffix := "f")
77    
78    (* for SSE, we have 128-bit vectors *)    (* for SSE, we have 128-bit vectors *)
79      fun vectorWidth () = !gVectorWid      fun vectorWidth () = !gVectorWid
80    
81        fun vectorSuffix n = Int.toString n ^ !gRealSuffix
82    
83    (* target types *)    (* target types *)
84      val boolTy = T_Bool      val boolTy = T_Bool
85      val intTy = T_Int      val intTy = T_Int
# Line 120  Line 130 
130              topDecls := initFn :: !topDecls              topDecls := initFn :: !topDecls
131            end            end
132    
     fun defineStrand (p, strandId) = raise Fail "FIXME: unimplemented"  
   
133      structure Var =      structure Var =
134        struct        struct
135          fun global (Prog{globals, ...}, ty, name) = (          fun global (Prog{globals, ...}, ty, name) = (
136                globals := CL.D_Var([], cvtTy ty, name) :: !globals;                globals := CL.D_Var([], cvtTy ty, name) :: !globals;
137                (ty, name))                (ty, name))
138          fun state (strand, ty, name) = raise Fail "FIXME: Var.state"          fun param (ty, name) = (ty, name)
139            fun state (Strand{state, ...}, ty, name) = (
140                  state := (ty, name) :: !state;
141                  (ty, name))
142            fun var (ty, name) = (ty, name)
143          fun tmp ty = raise Fail "FIXME: Var.tmp"          fun tmp ty = raise Fail "FIXME: Var.tmp"
144        end        end
145    
# Line 166  Line 178 
178            fun binop rator ((e1, ty1), (e2, ty2)) =            fun binop rator ((e1, ty1), (e2, ty2)) =
179                  if checkTys (ty1, ty2)                  if checkTys (ty1, ty2)
180                    then (CL.mkBinOp(e1, rator, e2), ty1)                    then (CL.mkBinOp(e1, rator, e2), ty1)
181                    else raise Fail "invalid arguments to binary operator"                    else raise Fail(concat[
182                          "invalid arguments to binary operator \"",
183                          CL.binopToString rator, "\""
184                        ])
185          in          in
186          val add = binop CL.#+          val add = binop CL.#+
187          val sub = binop CL.#-          val sub = binop CL.#-
188          val mul = binop CL.#*        (* NOTE: multiplication and division are also used for scaling *)
189          val divide = binop CL.#/          fun mul ((e1, T_Real), (e2, T_Vec n)) =
190                  (CL.E_Apply("Diderot_scale"^vectorSuffix n, [e1, e2]), T_Vec n)
191              | mul args = binop CL.#* args
192            fun divide ((e1, T_Vec n), (e2, T_Real)) =
193                  (CL.E_Apply("Diderot_scale"^vectorSuffix n,
194                    [CL.mkBinOp(CL.mkFlt(FloatLit.one, !gRealTy), CL.#/, e2), e1]), T_Vec n)
195              | divide args = binop CL.#/ args
196          end (* local *)          end (* local *)
197          fun neg (e, T_Bool) = raise Fail "invalid argument to neg"          fun neg (e, T_Bool) = raise Fail "invalid argument to neg"
198            | neg (e, ty) = (CL.mkUnOp(CL.%-, e), ty)            | neg (e, ty) = (CL.mkUnOp(CL.%-, e), ty)
199    
200          fun abs (e, T_Int) = (CL.mkApply("abs", [e]), T_Int)    (* FIXME: not the right type for 64-bit ints *)          fun abs (e, T_Int) = (CL.mkApply("abs", [e]), T_Int)    (* FIXME: not the right type for 64-bit ints *)
201            | abs (e, T_Real) =            | abs (e, T_Real) = (CL.mkApply("fabs" ^ !gRealSuffix, [e]), T_Real)
               if !Controls.doublePrecision  
                 then (CL.mkApply("fabs", [e]), T_Real)  
                 else (CL.mkApply("fabsf", [e]), T_Real)  
202            | abs (e, T_Vec n) = raise Fail "FIXME: Expr.abs"            | abs (e, T_Vec n) = raise Fail "FIXME: Expr.abs"
203            | abs (e, T_IVec n) = raise Fail "FIXME: Expr.abs"            | abs (e, T_IVec n) = raise Fail "FIXME: Expr.abs"
204            | abs _ = raise Fail "invalid argument to abs"            | abs _ = raise Fail "invalid argument to abs"
205    
206          fun dot ((e1, T_Vec n1), (e2, T_Vec n2)) = raise Fail "FIXME: Expr.dot"          fun dot ((e1, T_Vec n1), (e2, T_Vec n2)) =
207                  (CL.E_Apply("Diderot_dot"^vectorSuffix n1, [e1, e2]), T_Real)
208            | dot _ = raise Fail "invalid argument to dot"            | dot _ = raise Fail "invalid argument to dot"
209    
210          fun cross ((e1, T_Vec 3), (e2, T_Vec 3)) = raise Fail "FIXME: Expr.cross"          fun cross ((e1, T_Vec 3), (e2, T_Vec 3)) = raise Fail "FIXME: Expr.cross"
211            | cross _ = raise Fail "invalid argument to cross"            | cross _ = raise Fail "invalid argument to cross"
212    
213          fun length (e, T_Vec n) = raise Fail "FIXME: Expr.length"          fun length (e, T_Vec n) =
214                  (CL.E_Apply("Diderot_length"^vectorSuffix n, [e]), T_Real)
215            | length _ = raise Fail "invalid argument to length"            | length _ = raise Fail "invalid argument to length"
216    
217          fun normalize (e, T_Vec n) = raise Fail "FIXME: Expr.normalize"          fun normalize (e, T_Vec n) =
218                  (CL.E_Apply("Diderot_normalize"^vectorSuffix n, [e]), T_Vec n)
219            | normalize _ = raise Fail "invalid argument to length"            | normalize _ = raise Fail "invalid argument to length"
220    
221        (* comparisons *)        (* comparisons *)
# Line 328  Line 349 
349          fun stabilize () = comment ["**** stabilize ****"] (* FIXME *)          fun stabilize () = comment ["**** stabilize ****"] (* FIXME *)
350        end        end
351    
352        structure Strand =
353          struct
354            fun define (Prog{strands, ...}, strandId) = let
355                  val strand = Strand{
356                          name = strandId,
357                          tyName = strandId ^ "_t",
358                          state = ref [],
359                          code = ref []
360                        }
361                  in
362                    strands := strand :: !strands;
363                    strand
364                  end
365    
366          (* register the strand-state initialization code.  The variables are the strand
367           * parameters.
368           *)
369            fun init (Strand{name, tyName, code, ...}, params, init) = let
370                  val fName = name ^ "_InitState"
371                  val params =
372                        CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "self") ::
373                          List.map (fn (ty, x) => CL.PARAM([], cvtTy ty, x)) params
374                  val initFn = CL.D_Func([], CL.voidTy, fName, params, init)
375                  in
376                    code := initFn :: !code
377                  end
378          end (* Strand *)
379    
380        fun genStrand (Strand{name, tyName, state, code}) = let
381              val selfTyDef = CL.D_StructDef(
382                      List.rev (List.map (fn (ty, x) => (cvtTy ty, x)) (!state)),
383                      tyName)
384              in
385                selfTyDef :: List.rev (!code)
386              end
387    
388      fun generate (baseName, Prog{globals, topDecls, strands}) = let      fun generate (baseName, Prog{globals, topDecls, strands}) = let
389            val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}            val fileName = OS.Path.joinBaseExt{base=baseName, ext=SOME "c"}
390            val outS = TextIO.openOut fileName            val outS = TextIO.openOut fileName
# Line 337  Line 394 
394              List.app ppDecl (List.rev (!globals));              List.app ppDecl (List.rev (!globals));
395              List.app ppDecl (List.rev (!topDecls));              List.app ppDecl (List.rev (!topDecls));
396  (* what about the strands, etc? *)  (* what about the strands, etc? *)
397                List.app (fn strand => List.app ppDecl (genStrand strand)) (!strands);
398              PrintAsC.close ppStrm;              PrintAsC.close ppStrm;
399              TextIO.closeOut outS              TextIO.closeOut outS
400            end            end

Legend:
Removed from v.537  
changed lines
  Added in v.544

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