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

SCM Repository

[diderot] Diff of /branches/vis12-cl/src/compiler/c-util/tree-to-c.sml
ViewVC logotype

Diff of /branches/vis12-cl/src/compiler/c-util/tree-to-c.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1690, Wed Jan 25 21:09:26 2012 UTC revision 1872, Sun May 13 10:35:15 2012 UTC
# Line 27  Line 27 
27    
28      val trBlock : env * TreeIL.block -> CLang.stm      val trBlock : env * TreeIL.block -> CLang.stm
29    
30        val trFree : env * TreeIL.block -> CLang.stm
31    
32      val trFragment : env * TreeIL.block -> env * CLang.stm list      val trFragment : env * TreeIL.block -> env * CLang.stm list
33    
34      val trExp : env * TreeIL.exp -> CLang.exp      val trExp : env * TreeIL.exp -> CLang.exp
# Line 55  Line 57 
57    (* integer literal expression *)    (* integer literal expression *)
58      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
59    
60        fun addrOf e = CL.mkUnOp(CL.%&, e)
61    
62    (* translate TreeIL types to CLang types *)    (* translate TreeIL types to CLang types *)
63      fun trType ty = (case ty      val trType = CTyTranslate.toType
            of Ty.BoolTy => CLang.T_Named "bool"  
             | Ty.StringTy => CL.charPtr  
             | Ty.IntTy => !N.gIntTy  
             | Ty.TensorTy[] => !N.gRealTy  
             | Ty.TensorTy[n] => CL.T_Named(N.vecTy n)  
             | Ty.TensorTy[n, m] => CL.T_Named(N.matTy(n,m))  
             | Ty.SeqTy(Ty.IntTy, n) => CL.T_Named(N.ivecTy n)  
             | Ty.SeqTy(ty, n) => CL.T_Array(trType ty, SOME n)  
             | Ty.DynSeqTy _ => CL.T_Named N.dynSeqTy  
             | Ty.AddrTy(ImageInfo.ImgInfo{ty=(_, rTy), ...}) => CL.T_Ptr(CL.T_Num rTy)  
             | Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}) => CL.T_Ptr(CL.T_Named(N.imageTy dim))  
             | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])  
           (* end case *))  
64    
65    (* generate new variables *)    (* generate new variables *)
66      local      local
# Line 106  Line 97 
97    
98    (* vector indexing support.  Arguments are: vector, arity, index *)    (* vector indexing support.  Arguments are: vector, arity, index *)
99      fun ivecIndex (v, n, ix) = let      fun ivecIndex (v, n, ix) = let
100            val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gIntSuffix, "_t"])            val e1 = CL.mkCast(CL.T_Named(N.iunionTy n), v)
           val e1 = CL.mkCast(unionTy, v)  
101            val e2 = CL.mkSelect(e1, "i")            val e2 = CL.mkSelect(e1, "i")
102            in            in
103              CL.mkSubscript(e2, intExp ix)              CL.mkSubscript(e2, intExp ix)
104            end            end
105    
106      fun vecIndex (v, n, ix) = let      fun vecIndex (v, n, ix) = let
107            val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gRealSuffix, "_t"])            val e1 = CL.mkCast(CL.T_Named(N.unionTy n), v)
           val e1 = CL.mkCast(unionTy, v)  
108            val e2 = CL.mkSelect(e1, "r")            val e2 = CL.mkSelect(e1, "r")
109            in            in
110              CL.mkSubscript(e2, intExp ix)              CL.mkSubscript(e2, intExp ix)
# Line 176  Line 165 
165              | (Op.Index(Ty.SeqTy(Ty.IntTy, n), i), [a]) => ivecIndex (a, n, i)              | (Op.Index(Ty.SeqTy(Ty.IntTy, n), i), [a]) => ivecIndex (a, n, i)
166              | (Op.Index(Ty.TensorTy[n], i), [a]) => vecIndex (a, n, i)              | (Op.Index(Ty.TensorTy[n], i), [a]) => vecIndex (a, n, i)
167              | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, ix]) => let              | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, ix]) => let
168                  val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gIntSuffix, "_t"])                  val unionTy = CL.T_Named(N.iunionTy n)
169                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "i")                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "i")
170                  in                  in
171                    CL.mkSubscript(vecExp, ix)                    CL.mkSubscript(vecExp, ix)
172                  end                  end
173              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)
174              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
175                  val unionTy = CL.T_Named(concat["union", Int.toString n, !N.gRealSuffix, "_t"])                  val unionTy = CL.T_Named(N.unionTy n)
176                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")
177                  in                  in
178                    CL.mkSubscript(vecExp, ix)                    CL.mkSubscript(vecExp, ix)
# Line 191  Line 180 
180              | (Op.Subscript(Ty.TensorTy[_,_]), [m, ix, jx]) => matIndex (m, ix, jx)              | (Op.Subscript(Ty.TensorTy[_,_]), [m, ix, jx]) => matIndex (m, ix, jx)
181              | (Op.Subscript ty, t::(ixs as _::_)) =>              | (Op.Subscript ty, t::(ixs as _::_)) =>
182                  raise Fail(concat["Subscript<", Ty.toString ty, "> unsupported"])                  raise Fail(concat["Subscript<", Ty.toString ty, "> unsupported"])
183              | (Op.MkDynamic(ty, n), [seq]) => CL.mkApply("DYNSEQ_MK(", [              | (Op.MkDynamic(ty, n), [seq]) => CL.mkApply("Diderot_DynSeqMk", [
184                    CL.mkSizeof(trType ty), CL.mkInt(IntInf.fromInt n), seq                    CL.mkSizeof(trType ty), CL.mkInt(IntInf.fromInt n),
185                      addrOf (CL.mkSubscript(seq, intExp 0))
186                  ])                  ])
187              | (Op.Append ty, [seq, x]) => CL.mkApply("DYNSEQ_APPEND(", [              | (Op.Append ty, [seq, x]) => CL.mkApply("Diderot_DynSeqAppend", [
188                    CL.mkSizeof(trType ty), seq, x                    CL.mkSizeof(trType ty), seq, addrOf x
189                  ])                  ])
190              | (Op.Prepend ty, [x, seq]) => CL.mkApply("DYNSEQ_PREPEND(", [              | (Op.Prepend ty, [x, seq]) => CL.mkApply("Diderot_DynSeqPrepend", [
191                    CL.mkSizeof(trType ty), x, seq                    CL.mkSizeof(trType ty), addrOf x, seq
192                  ])                  ])
193              | (Op.Concat ty, [seq1, seq2]) => CL.mkApply("DYNSEQ_CONCAT(", [              | (Op.Concat ty, [seq1, seq2]) => CL.mkApply("Diderot_DynSeqConcat", [
194                    CL.mkSizeof(trType ty), seq1, seq2                    CL.mkSizeof(trType ty), seq1, seq2
195                  ])                  ])
196              | (Op.Ceiling d, args) => CL.mkApply(N.addTySuffix("ceil", d), args)              | (Op.Ceiling d, args) => CL.mkApply(N.addTySuffix("ceil", d), args)
# Line 210  Line 200 
200              | (Op.IntToReal, [a]) => CL.mkCast(!N.gRealTy, a)              | (Op.IntToReal, [a]) => CL.mkCast(!N.gRealTy, a)
201              | (Op.RealToInt 1, [a]) => CL.mkCast(!N.gIntTy, a)              | (Op.RealToInt 1, [a]) => CL.mkCast(!N.gIntTy, a)
202              | (Op.RealToInt d, args) => CL.mkApply(N.vecftoi d, args)              | (Op.RealToInt d, args) => CL.mkApply(N.vecftoi d, args)
203  (* FIXME: need type info *)              | (Op.ImageAddress info, [a]) => let
204              | (Op.ImageAddress(ImageInfo.ImgInfo{ty=(_,rTy), ...}), [a]) => let                  val cTy = CL.T_Ptr(CL.T_Num(ImageInfo.sampleTy info))
                 val cTy = CL.T_Ptr(CL.T_Num rTy)  
205                  in                  in
206                    CL.mkCast(cTy, CL.mkIndirect(a, "data"))                    CL.mkCast(cTy, CL.mkIndirect(a, "data"))
207                  end                  end
# Line 226  Line 215 
215                  end                  end
216              | (Op.LoadVoxels _, [a]) =>              | (Op.LoadVoxels _, [a]) =>
217                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
218              | (Op.PosToImgSpace(ImageInfo.ImgInfo{dim, ...}), [img, pos]) =>              | (Op.PosToImgSpace info, [img, pos]) =>
219                  CL.mkApply(N.toImageSpace dim, [img, pos])                  CL.mkApply(N.toImageSpace(ImageInfo.dim info), [img, pos])
220              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
221                  CL.mkApply(N.toWorldSpace ty, [v, x])                  CL.mkApply(N.toWorldSpace ty, [v, x])
222              | (Op.LoadImage info, [a]) =>              | (Op.LoadImage info, [a]) =>
223                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
224              | (Op.Inside(ImageInfo.ImgInfo{dim, ...}, s), [pos, img]) =>              | (Op.Inside(info, s), [pos, img]) =>
225                  CL.mkApply(N.inside dim, [pos, img, intExp s])                  CL.mkApply(N.inside(ImageInfo.dim info), [pos, img, intExp s])
226              | (Op.Input(ty, desc, name), []) =>              | (Op.Input(ty, desc, name), []) =>
227                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
228              | (Op.InputWithDefault(ty, desc, name), [a]) =>              | (Op.InputWithDefault(ty, desc, name), [a]) =>
# Line 253  Line 242 
242              | IL.E_Op(rator, args) => trOp (rator, trExps(env, args))              | IL.E_Op(rator, args) => trOp (rator, trExps(env, args))
243              | IL.E_Apply(f, args) => trApply(f, trExps(env, args))              | IL.E_Apply(f, args) => trApply(f, trExps(env, args))
244              | IL.E_Cons(Ty.TensorTy[n], args) => CL.mkApply(N.mkVec n, trExps(env, args))              | IL.E_Cons(Ty.TensorTy[n], args) => CL.mkApply(N.mkVec n, trExps(env, args))
             | IL.E_Cons(Ty.SeqTy(ty, n), args) => CL.mkApply("Diderot_MkSeq",  
                 CL.mkSizeof(trType ty) :: CL.mkInt(IntInf.fromInt n) :: trExps(env, args))  
245              | IL.E_Cons(ty, _) => raise Fail(concat["E_Cons(", Ty.toString ty, ", _) in expression"])              | IL.E_Cons(ty, _) => raise Fail(concat["E_Cons(", Ty.toString ty, ", _) in expression"])
246            (* end case *))            (* end case *))
247    
# Line 414  Line 401 
401                  in                  in
402                    doRows (0, trExps(env, args))                    doRows (0, trExps(env, args))
403                  end                  end
404                | IL.E_Cons(Ty.TensorTy[n,m,l], args) => let
405                  (* 3rd-order tensors are represented as 2D arrays of union<d><ty>_t vectors *)
406                    fun lp1 (i, [], code) = code
407                      | lp1 (i, e::es, code) = let
408                          val lhs_i = CL.mkSubscript(lhs, intExp i)
409                          fun lp2 j = if (j < m)
410                                then CL.mkAssign(
411                                    CL.mkSelect(CL.mkSubscript(lhs_i, intExp j), "v"),
412                                    CL.mkSelect(CL.mkSubscript (e, intExp j), "v")
413                                  ) :: lp2(j+1)
414                                else code
415                          in
416                            lp1 (i+1, es, lp2 0)
417                          end
418                    in
419                      lp1 (0, trExps(env, args), [])
420                    end
421                | IL.E_Cons(Ty.SeqTy(ty, n), args) => let
422                    fun doAssign (_, []) = []
423                      | doAssign (i, arg::args) =
424                          CL.mkAssign(CL.mkSubscript(lhs, intExp i), arg) :: doAssign(i+1, args)
425                    in
426                      doAssign (0, trExps(env, args))
427                    end
428                | IL.E_State x => (case IL.StateVar.ty x
429                     of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueStateVar x])]
430                      | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen(n,m,l), [lhs, VarToC.rvalueStateVar x])]
431                      | _ => [CL.mkAssign(lhs, VarToC.rvalueStateVar x)]
432                    (* end case *))
433              | IL.E_Var x => (case IL.Var.ty x              | IL.E_Var x => (case IL.Var.ty x
434                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueVar(env, x)])]                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueVar(env, x)])]
435                      | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen(n,m,l), [lhs, VarToC.rvalueVar(env, x)])]
436                    | _ => [CL.mkAssign(lhs, VarToC.rvalueVar(env, x))]                    | _ => [CL.mkAssign(lhs, VarToC.rvalueVar(env, x))]
437                  (* end case *))                  (* end case *))
438              | _ => [CL.mkAssign(lhs, trExp(env, rhs))]              | _ => [CL.mkAssign(lhs, trExp(env, rhs))]
# Line 455  Line 472 
472              (fn (x, env) => V.Map.insert(env, x, V(trType(V.ty x), V.name x)))              (fn (x, env) => V.Map.insert(env, x, V(trType(V.ty x), V.name x)))
473                env locals                env locals
474    
475    (* generate code to check the status of runtime-system calls *)    (* generate code to check the status of runtime-system calls; this code assumes that
476       * we are in a function with a boolean return type
477       *)
478      fun checkSts mkDecl = let      fun checkSts mkDecl = let
479            val sts = freshVar "sts"            val sts = freshVar "sts"
480            in            in
481              mkDecl sts @              mkDecl sts @
482              [CL.mkIfThen(              [CL.mkIfThen(
483                CL.mkBinOp(CL.mkVar "DIDEROT_OK", CL.#!=, CL.mkVar sts),                CL.mkBinOp(CL.mkVar "DIDEROT_OK", CL.#!=, CL.mkVar sts),
484                CL.mkCall("exit", [intExp 1]))]                CL.mkReturn(SOME(CL.mkVar "true")))]
485              end
486    
487      (* given the global initialization code, generate code to free the storage that is heap
488       * allocated for globals.
489       *)
490        fun trFree (env, IL.Block{locals, body}) = let
491              val env = trLocals (env, locals)
492              fun trStmt (env, stm) = (case stm
493                     of IL.S_Comment text => [CL.mkComment text]
494                      | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let
495                          val lhs = VarToC.lvalueVar (env, lhs)
496                          val imgTy = CL.T_Named(N.imageTy dim)
497                          val freeFn = N.freeImage dim
498                          in [
499                            CL.mkDecl(
500                              CL.T_Named N.statusTy, sts,
501                              SOME(CL.I_Exp(CL.E_Apply(freeFn, [
502                                  CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),
503                                  addrOf lhs
504                                ]))))
505                          ] end)
506                      | _ => []
507                    (* end case *))
508              val stms = List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body
509              fun mkDecl (x, stms) = (case V.Map.find (env, x)
510                     of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
511                      | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
512                    (* end case *))
513              val stms = List.foldr mkDecl stms locals
514              in
515                CL.mkBlock stms
516            end            end
517    
518      fun trStms (env, stms) = let      fun trStms (env, stms) = let
# Line 489  Line 539 
539                        in [                        in [
540                          CL.mkDecl(                          CL.mkDecl(
541                            CL.T_Named N.statusTy, sts,                            CL.T_Named N.statusTy, sts,
542                            SOME(CL.I_Exp(CL.E_Apply(loadFn, [name, CL.mkUnOp(CL.%&, lhs)]))))                            SOME(CL.I_Exp(CL.E_Apply(loadFn, [
543                                  CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),
544                                  name, addrOf lhs
545                                ]))))
546                        ] end)                        ] end)
547                    | IL.S_Input(lhs, name, desc, optDflt) => let                    | IL.S_Input(_, _, _, NONE) => []
548                        val inputFn = N.input(V.ty lhs)                    | IL.S_Input(lhs, name, _, SOME dflt) => [
549                        val lhs = VarToC.lvalueVar (env, lhs)                          CL.mkAssign(VarToC.lvalueVar(env, lhs), trExp(env, dflt))
550                        val (initCode, hasDflt) = (case optDflt                        ]
551                               of SOME e => ([CL.mkAssign(lhs, trExp(env, e))], true)                    | IL.S_Exit args => []
                               | NONE => ([], false)  
                             (* end case *))  
                       val code = [CL.mkCall(inputFn, [  
                               CL.mkVar "opts",  
                               CL.mkStr name,  
                               CL.mkStr desc,  
                               CL.mkUnOp(CL.%&, lhs),  
                               CL.mkBool hasDflt])]  
                       in  
                         initCode @ code  
                       end  
                   | IL.S_Exit args => [CL.mkReturn NONE]  
552                    | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]                    | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]
553                    | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]                    | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]
554                    | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar N.kDie))]                    | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar N.kDie))]

Legend:
Removed from v.1690  
changed lines
  Added in v.1872

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