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 4549 - (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 : jhr 4547 val TreeTypes.StrandIdTy s = TreeVar.ty src
52 : jhr 4386 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 : jhr 4549 val (accs, accDcls, env) = let
65 :     fun mkAcc (IR.MapReduce(x, r, _, _, set), (accs, stms, env)) = let
66 : jhr 4386 val acc = TreeVar.name x
67 : jhr 4549 val stm = CL.mkDeclInit(
68 :     TypeToCxx.trType (env, TreeVar.ty x), acc,
69 :     TreeToCxx.trLit(env, R.identity r))
70 :     val env = Env.insert(env, x, acc)
71 : jhr 4380 in
72 : jhr 4549 (acc::accs, stm::stms, env)
73 : jhr 4380 end
74 :     in
75 : jhr 4549 List.foldr mkAcc ([], [], env) mrs
76 : jhr 4380 end
77 : jhr 4519 (* _strands array access *)
78 :     val strands = RN.strandArray env
79 :     (* strand index *)
80 :     val ix = CodeGenUtil.freshVar "ix"
81 : jhr 4547 val env = Env.insert(env, src, ix)
82 :     (* strand status (if needed in doMR) *)
83 : jhr 4386 val status = CodeGenUtil.freshVar "sts"
84 : jhr 4547 fun needsStatus (IR.MapReduce(_, _, _, _, set)) = not (StrandSets.same(srcSet, set))
85 :     val statusDcl = if List.exists needsStatus mrs
86 :     then let
87 :     val stsTy = CL.T_Named "diderot::strand_status"
88 :     in [
89 :     CL.mkDeclInit(stsTy, status,
90 :     CL.mkDispatch(strands, "status", [CL.mkVar ix]))
91 :     ] end
92 :     else []
93 : jhr 4386 (* build the body of the loop *)
94 :     fun doMR (acc, IR.MapReduce(x, r, f, args, set)) = let
95 :     val mapExp = TreeToCxx.trApply (env, f, args)
96 :     val reduceStm = CL.mkAssign(CL.mkVar acc, mkReduce(r, CL.mkVar acc, mapExp))
97 :     in
98 :     if StrandSets.same(srcSet, set)
99 :     then reduceStm
100 :     else let
101 :     val kSts = (case set
102 :     of StrandSets.ACTIVE => "diderot::kActive"
103 :     | StrandSets.STABLE => "diderot::kStable"
104 :     | StrandSets.ALL => raise Fail "impossible"
105 :     (* end case *))
106 :     in
107 :     CL.mkIfThen(CL.mkBinOp(CL.mkVar kSts, CL.#==, CL.mkVar status), reduceStm)
108 :     end
109 :     end
110 : jhr 4547 val loopBody = statusDcl @ ListPair.map doMR (accs, mrs)
111 : jhr 4519 val {begin, stop, next} = let
112 :     val suffix = (case srcSet
113 :     of StrandSets.ACTIVE => "active"
114 :     | StrandSets.STABLE => "stable"
115 :     | StrandSets.ALL => "alive"
116 :     (* end case *))
117 :     in {
118 :     begin = CL.mkDispatch(strands, "begin_"^suffix, []),
119 :     stop = CL.mkDispatch(strands, "end_"^suffix, []),
120 :     next = CL.mkDispatch(strands, "next_"^suffix, [CL.mkVar ix])
121 :     } end
122 : jhr 4386 val loopStm = CL.mkFor(
123 : jhr 4519 CL.autoTy, [(ix, begin)],
124 :     CL.mkBinOp(CL.mkVar ix, CL.#!=, stop),
125 :     [CL.mkAssignOp(CL.mkVar ix, CL.$=, next)],
126 : jhr 4386 CL.mkBlock loopBody)
127 : jhr 4380 in
128 : jhr 4475 (env, loopStm :: List.revAppend(accDcls, stms))
129 : jhr 4380 end
130 :    
131 : jhr 4500 (* generate the global start/update function *)
132 : jhr 4386 fun gen (env, name, body) = let
133 : jhr 4364 val env = Env.insert(env, PseudoVars.world, "this")
134 : jhr 4386 val _ = Env.setMapReduceCB (env, genMapReduceSeq)
135 : jhr 4364 in
136 : jhr 4386 CL.D_Func([], CL.voidTy, [], "world::global_" ^ name,
137 : jhr 4364 [],
138 :     GenUtil.genBodyWithGlobPtr (env, body))
139 :     end
140 :    
141 :     end

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