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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/target-cpu/gen-global-update.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/target-cpu/gen-global-update.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4519 - (view) (download)

1 : jhr 4364 (* gen-global-update.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2016 The University of Chicago
6 :     * All rights reserved.
7 :     *)
8 :    
9 :     structure GenGlobalUpdate : sig
10 :    
11 : jhr 4500 (* generate the global start/update function *)
12 : jhr 4386 val gen : CodeGenEnv.t * string * TreeIR.block -> CLang.decl
13 : jhr 4364
14 :     end = struct
15 :    
16 : jhr 4386 structure IR = TreeIR
17 : jhr 4380 structure R = Reductions
18 : jhr 4364 structure Env = CodeGenEnv
19 :     structure CL = CLang
20 : jhr 4386 structure RN = CxxNames
21 : jhr 4364
22 : jhr 4380 (* make the C++ expression for a reduction *)
23 :     fun mkReduce (red, e1, e2) = (case red
24 :     of R.ALL => CL.mkBinOp(e1, CL.#&&, e2)
25 :     | R.EXISTS => CL.mkBinOp(e1, CL.#||, e2)
26 :     | R.MAX => CL.mkApply("std::max", [e1, e2])
27 :     | R.MIN => CL.mkApply("std::min", [e1, e2])
28 :     | R.PRODUCT => CL.mkBinOp(e1, CL.#*, e2)
29 :     | R.SUM => CL.mkBinOp(e1, CL.#+, e2)
30 :     (* end case *))
31 :    
32 :     (* code generation for sequential map-reduce *)
33 :     (*
34 :     accum = /* reduction identity */;
35 : jhr 4519 for (auto ix = this->_strands.begin_XXX()
36 :     ix != this->_strands.end_XXX();
37 :     ix = this->_strands.next_XXX(ix))
38 :     {
39 :     S_strand *s = this->_strands.strand(ix);
40 :     diderot::strand_status sts = this->_strands.status(ix);
41 : jhr 4380 if (/* s in strand set */) {
42 :     value = /* map code */
43 :     accum = REDUCE(value, accm);
44 :     }
45 :     }
46 :     *)
47 :    
48 : jhr 4475 fun genMapReduceSeq (env, mrs, src, stms) = let
49 : jhr 4386 val worldV = CL.mkVar(Env.world env)
50 :     val strandTy = let
51 :     val TreeTypes.StrandPtrTy s = TreeVar.ty src
52 :     in
53 :     RN.strandTy(Atom.toString s)
54 :     end
55 :     (* compute the least-upper bound of the sources *)
56 :     val srcSet = let
57 :     val IR.MapReduce(_, _, _, _, srcSet)::rest = mrs
58 :     in
59 :     List.foldl
60 :     (fn (IR.MapReduce(_, _, _, _, set), set') => StrandSets.join(set, set'))
61 :     srcSet rest
62 :     end
63 : jhr 4380 (* define accumulators for lhs results *)
64 :     val (accs, accDcls) = let
65 : jhr 4386 fun mkAcc (IR.MapReduce(x, r, _, _, set), (accs, stms)) = let
66 :     val acc = TreeVar.name x
67 :     val stm = CL.mkAssign(CL.mkVar acc, TreeToCxx.trLit(env, R.identity r))
68 : jhr 4380 in
69 :     (acc::accs, stm::stms)
70 :     end
71 :     in
72 :     List.foldr mkAcc ([], []) mrs
73 :     end
74 : jhr 4519 (* _strands array access *)
75 :     val strands = RN.strandArray env
76 :     (* strand index *)
77 :     val ix = CodeGenUtil.freshVar "ix"
78 : jhr 4386 (* pointer to strand state *)
79 :     val strand = CodeGenUtil.freshVar "strand"
80 : jhr 4519 val strandDcl =
81 :     CL.mkDeclInit(CL.constPtrTy strandTy, strand,
82 :     CL.mkDispatch(strands, "strand", [CL.mkVar ix]))
83 : jhr 4386 val env = Env.insert(env, src, strand)
84 :     (* strand status *)
85 :     val status = CodeGenUtil.freshVar "sts"
86 :     val statusDcl = let
87 :     val stsTy = CL.T_Named "diderot::strand_status"
88 :     in
89 :     CL.mkDeclInit(stsTy, status,
90 : jhr 4519 CL.mkDispatch(strands, "status", [CL.mkVar ix]))
91 : jhr 4386 end
92 :     (* build the body of the loop *)
93 :     fun doMR (acc, IR.MapReduce(x, r, f, args, set)) = let
94 :     val mapExp = TreeToCxx.trApply (env, f, args)
95 :     val reduceStm = CL.mkAssign(CL.mkVar acc, mkReduce(r, CL.mkVar acc, mapExp))
96 :     in
97 :     if StrandSets.same(srcSet, set)
98 :     then reduceStm
99 :     else let
100 :     val kSts = (case set
101 :     of StrandSets.ACTIVE => "diderot::kActive"
102 :     | StrandSets.STABLE => "diderot::kStable"
103 :     | StrandSets.ALL => raise Fail "impossible"
104 :     (* end case *))
105 :     in
106 :     CL.mkIfThen(CL.mkBinOp(CL.mkVar kSts, CL.#==, CL.mkVar status), reduceStm)
107 :     end
108 :     end
109 :     val loopBody = strandDcl :: statusDcl :: ListPair.map doMR (accs, mrs)
110 : jhr 4519 val {begin, stop, next} = let
111 :     val suffix = (case srcSet
112 :     of StrandSets.ACTIVE => "active"
113 :     | StrandSets.STABLE => "stable"
114 :     | StrandSets.ALL => "alive"
115 :     (* end case *))
116 :     in {
117 :     begin = CL.mkDispatch(strands, "begin_"^suffix, []),
118 :     stop = CL.mkDispatch(strands, "end_"^suffix, []),
119 :     next = CL.mkDispatch(strands, "next_"^suffix, [CL.mkVar ix])
120 :     } end
121 : jhr 4386 val loopStm = CL.mkFor(
122 : jhr 4519 CL.autoTy, [(ix, begin)],
123 :     CL.mkBinOp(CL.mkVar ix, CL.#!=, stop),
124 :     [CL.mkAssignOp(CL.mkVar ix, CL.$=, next)],
125 : jhr 4386 CL.mkBlock loopBody)
126 : jhr 4380 in
127 : jhr 4475 (env, loopStm :: List.revAppend(accDcls, stms))
128 : jhr 4380 end
129 :    
130 : jhr 4500 (* generate the global start/update function *)
131 : jhr 4386 fun gen (env, name, body) = let
132 : jhr 4364 val env = Env.insert(env, PseudoVars.world, "this")
133 : jhr 4386 val _ = Env.setMapReduceCB (env, genMapReduceSeq)
134 : jhr 4364 in
135 : jhr 4386 CL.D_Func([], CL.voidTy, [], "world::global_" ^ name,
136 : jhr 4364 [],
137 :     GenUtil.genBodyWithGlobPtr (env, body))
138 :     end
139 :    
140 :     end

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