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 839, Mon Apr 18 16:50:47 2011 UTC revision 840, Mon Apr 18 17:12:43 2011 UTC
# Line 4  Line 4 
4   * All rights reserved.   * All rights reserved.
5   *)   *)
6    
7  structure CTarget (*: TARGET*) =  structure CTarget : TARGET =
8    struct    struct
9    
10      structure IL = TreeIL      structure IL = TreeIL
11      structure Var = IL.Var      structure V = IL.Var
12      structure CL = CLang      structure CL = CLang
13      structure RN = RuntimeNames      structure RN = RuntimeNames
14      structure ToC = TreeToC      structure ToC = TreeToC
15    
16      type program      type var = ToC.var
     type strand  
     type var  
17      type exp = CL.exp      type exp = CL.exp
18      type stm = CL.stm      type stm = CL.stm
19    
     datatype var = V of (ty * string)  
   
20      datatype strand = Strand of {      datatype strand = Strand of {
21          name : string,          name : string,
22          tyName : string,          tyName : string,
23          state : var list ref,          state : var list ref,
24          output : var option ref,        (* the strand's output variable (only one for now) *)          output : CL.var option ref,     (* the strand's output variable (only one for now) *)
25          code : CL.decl list ref          code : CL.decl list ref
26        }        }
27    
# Line 38  Line 34 
34    
35      datatype Env = ENV of {      datatype Env = ENV of {
36          info : env_info,          info : env_info,
37          vMap : var Var.Map.map,          vMap : var V.Map.map,
38          scope : scope          scope : scope
39        }        }
40    
# Line 57  Line 53 
53     * the supported sizes are powers of two, but float2 is broken.     * the supported sizes are powers of two, but float2 is broken.
54     * NOTE: we should also consider the AVX vector hardware, which has 256-bit registers.     * NOTE: we should also consider the AVX vector hardware, which has 256-bit registers.
55     *)     *)
56      val vectorWidths () = if !Controls.doublePrecision      fun vectorWidths () = if !Controls.doublePrecision
57            then [2, 4, 8]            then [2, 4, 8]
58            else [4, 8]            else [4, 8]
59    
# Line 80  Line 76 
76                      end                      end
77                  | _ => ToC.trBlock (vMap, fn _ => raise Fail "unexpected state save", blk)                  | _ => ToC.trBlock (vMap, fn _ => raise Fail "unexpected state save", blk)
78                (* end case *))                (* end case *))
79          val exp : env * TreeIL.exp -> exp          fun exp (ENV{vMap, ...}, e) = ToC.trExp(vMap, e)
80        end        end
81    
82    (* variables *)    (* variables *)
83      structure Var =      structure Var =
84        struct        struct
85          fun global (Prog{globals, ...}, x) = let          fun global (Prog{globals, ...}, x) = let
86                val x' = CL.mkVar (Var.name x)                val x' = V.name x
87                  val ty' = ToC.trType(V.ty x)
88                in                in
89                  globals := CL.D_Var([], ToC.trType(Var.ty x), x', NONE) :: !globals;                  globals := CL.D_Var([], ty', x', NONE) :: !globals;
90                  x'                  ToC.V(ty', x')
91                end                end
92          fun param x = CL.mkVar (Var.name x)          fun param x = V.name x
93          fun state (Strand{state, ...}, ty, name), x) = let          fun state (Strand{state, ...}, x) = let
94                val x' = CL.mkVar (Var.name x)                val ty' = ToC.trType(V.ty x)
95                  val x' = ToC.V(ty', V.name x)
96                in                in
97                  state := x' :: !state;                  state := x' :: !state;
98                  x'                  x'
# Line 106  Line 104 
104        struct        struct
105        (* create a new environment *)        (* create a new environment *)
106          fun new prog = ENV{          fun new prog = ENV{
107                  info={prog = prog},                  info=INFO{prog = prog},
108                  vMap = Var.Map.empty,                  vMap = V.Map.empty,
109                  scope = NoScope                  scope = NoScope
110                }                }
111        (* define the current translation context *)        (* define the current translation context *)
# Line 119  Line 117 
117        (* bind a TreeIL varaiable to a target variable *)        (* bind a TreeIL varaiable to a target variable *)
118          fun bind (ENV{info, vMap, scope}, x, x') = ENV{          fun bind (ENV{info, vMap, scope}, x, x') = ENV{
119                  info = info,                  info = info,
120                  vMap = Var.Map.insert(vMap, x, x'),                  vMap = V.Map.insert(vMap, x, x'),
121                  scope = scope                  scope = scope
122                }                }
123        end        end
124    
125    (* programs *)    (* programs *)
126      structure Program : sig      structure Program =
127          struct
128          fun new () = (          fun new () = (
129                RN.initTargetSpec();                RN.initTargetSpec();
130                Prog{                Prog{
# Line 175  Line 174 
174                      end                      end
175                val baseInit = mapi (fn (i, (_, e, _)) => (i, CL.I_Exp e)) iters                val baseInit = mapi (fn (i, (_, e, _)) => (i, CL.I_Exp e)) iters
176                val sizeInit = mapi                val sizeInit = mapi
177                      (fn (i, (V(ty, _), lo, hi)) =>                      (fn (i, (ToC.V(ty, _), lo, hi)) =>
178                          (i, CL.I_Exp(CL.mkBinOp(CL.mkBinOp(hi, CL.#-, lo), CL.#+, CL.E_Int(1, cvtTy ty))))                          (i, CL.I_Exp(CL.mkBinOp(CL.mkBinOp(hi, CL.#-, lo), CL.#+, CL.E_Int(1, ty))))
179                      ) iters                      ) iters
180                val allocCode = [                val allocCode = [
181                        CL.mkComment["allocate initial block of strands"],                        CL.mkComment["allocate initial block of strands"],
# Line 199  Line 198 
198                          SOME(CL.I_Exp(                          SOME(CL.I_Exp(
199                            CL.E_Cast(strandTy,                            CL.E_Cast(strandTy,
200                            CL.E_Apply(RN.inState, [CL.E_Var "wrld", CL.E_Var indexVar]))))),                            CL.E_Apply(RN.inState, [CL.E_Var "wrld", CL.E_Var indexVar]))))),
201                        CL.mkCall(RN.strandInit name, CL.E_Var "sp" :: List.map (fn (E(e, _)) => e) args),                        CL.mkCall(RN.strandInit name, CL.E_Var "sp" :: args),
202                        CL.mkAssign(CL.E_Var indexVar, CL.mkBinOp(CL.E_Var indexVar, CL.#+, CL.E_Int(1, CL.uint32)))                        CL.mkAssign(CL.E_Var indexVar, CL.mkBinOp(CL.E_Var indexVar, CL.#+, CL.E_Int(1, CL.uint32)))
203                      ])                      ])
204                  | mkLoopNest ((V(ty, param), E(lo,_), E(hi, _))::iters) = let                  | mkLoopNest ((ToC.V(ty, param), lo, hi)::iters) = let
205                      val body = mkLoopNest iters                      val body = mkLoopNest iters
206                      in                      in
207                        CL.mkFor(                        CL.mkFor(
208                          [(cvtTy ty, param, lo)],                          [(ty, param, lo)],
209                          CL.mkBinOp(CL.E_Var param, CL.#<=, hi),                          CL.mkBinOp(CL.E_Var param, CL.#<=, hi),
210                          [CL.mkPostOp(CL.E_Var param, CL.^++)],                          [CL.mkPostOp(CL.E_Var param, CL.^++)],
211                          body)                          body)
# Line 226  Line 225 
225          fun genStrand (Strand{name, tyName, state, output, code}) = let          fun genStrand (Strand{name, tyName, state, output, code}) = let
226              (* the type declaration for the strand's state struct *)              (* the type declaration for the strand's state struct *)
227                val selfTyDef = CL.D_StructDef(                val selfTyDef = CL.D_StructDef(
228                        List.rev (List.map (fn V(ty, x) => (cvtTy ty, x)) (!state)),                        List.rev (List.map (fn ToC.V(ty, x) => (ty, x)) (!state)),
229                        tyName)                        tyName)
230              (* the print function *)              (* the print function *)
231                val prFnName = concat[name, "_print"]                val prFnName = concat[name, "_print"]
# Line 235  Line 234 
234                            CL.PARAM([], CL.T_Ptr(CL.T_Named "FILE"), "outS"),                            CL.PARAM([], CL.T_Ptr(CL.T_Named "FILE"), "outS"),
235                            CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "self")                            CL.PARAM([], CL.T_Ptr(CL.T_Named tyName), "self")
236                          ]                          ]
237                      val SOME(V(ty, x)) = !output                      val SOME x = !output
238                      val outState = CL.mkIndirect(CL.mkVar "self", x)                      val outState = CL.mkIndirect(CL.mkVar "self", x)
239                      val prArgs = (case ty                      val prArgs = (case ty
240                             of TargetTy.T_Int => [CL.E_Str(!RN.gIntFormat ^ "\n"), outState]                             of TargetTy.T_Int => [CL.E_Str(!RN.gIntFormat ^ "\n"), outState]

Legend:
Removed from v.839  
changed lines
  Added in v.840

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