Formatting wibble
[ghc.git] / rts / Sparks.c
1 /* ---------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 2000-2008
4 *
5 * Sparking support for PARALLEL_HASKELL and THREADED_RTS versions of the RTS.
6 *
7 -------------------------------------------------------------------------*/
8
9 #include "PosixSource.h"
10 #include "Rts.h"
11
12 #include "Schedule.h"
13 #include "RtsUtils.h"
14 #include "Trace.h"
15 #include "Prelude.h"
16 #include "Sparks.h"
17
18 #if defined(THREADED_RTS)
19
20 SparkPool *
21 allocSparkPool( void )
22 {
23 return newWSDeque(RtsFlags.ParFlags.maxLocalSparks);
24 }
25
26 void
27 freeSparkPool (SparkPool *pool)
28 {
29 freeWSDeque(pool);
30 }
31
32 /* -----------------------------------------------------------------------------
33 *
34 * Turn a spark into a real thread
35 *
36 * -------------------------------------------------------------------------- */
37
38 void
39 createSparkThread (Capability *cap)
40 {
41 StgTSO *tso;
42
43 tso = createIOThread (cap, RtsFlags.GcFlags.initialStkSize,
44 (StgClosure *)runSparks_closure);
45
46 traceEventCreateSparkThread(cap, tso->id);
47
48 appendToRunQueue(cap,tso);
49 }
50
51 /* --------------------------------------------------------------------------
52 * newSpark: create a new spark, as a result of calling "par"
53 * Called directly from STG.
54 * -------------------------------------------------------------------------- */
55
56 StgInt
57 newSpark (StgRegTable *reg, StgClosure *p)
58 {
59 Capability *cap = regTableToCapability(reg);
60 SparkPool *pool = cap->sparks;
61
62 if (!fizzledSpark(p)) {
63 if (pushWSDeque(pool,p)) {
64 cap->spark_stats.created++;
65 traceEventSparkCreate(cap);
66 } else {
67 /* overflowing the spark pool */
68 cap->spark_stats.overflowed++;
69 traceEventSparkOverflow(cap);
70 }
71 } else {
72 cap->spark_stats.dud++;
73 traceEventSparkDud(cap);
74 }
75
76 return 1;
77 }
78
79 /* --------------------------------------------------------------------------
80 * Remove all sparks from the spark queues which should not spark any
81 * more. Called after GC. We assume exclusive access to the structure
82 * and replace all sparks in the queue, see explanation below. At exit,
83 * the spark pool only contains sparkable closures.
84 * -------------------------------------------------------------------------- */
85
86 void
87 pruneSparkQueue (Capability *cap)
88 {
89 SparkPool *pool;
90 StgClosurePtr spark, tmp, *elements;
91 nat n, pruned_sparks; // stats only
92 StgWord botInd,oldBotInd,currInd; // indices in array (always < size)
93 const StgInfoTable *info;
94
95 n = 0;
96 pruned_sparks = 0;
97
98 pool = cap->sparks;
99
100 // it is possible that top > bottom, indicating an empty pool. We
101 // fix that here; this is only necessary because the loop below
102 // assumes it.
103 if (pool->top > pool->bottom)
104 pool->top = pool->bottom;
105
106 // Take this opportunity to reset top/bottom modulo the size of
107 // the array, to avoid overflow. This is only possible because no
108 // stealing is happening during GC.
109 pool->bottom -= pool->top & ~pool->moduloSize;
110 pool->top &= pool->moduloSize;
111 pool->topBound = pool->top;
112
113 debugTrace(DEBUG_sparks,
114 "markSparkQueue: current spark queue len=%ld; (hd=%ld; tl=%ld)",
115 sparkPoolSize(pool), pool->bottom, pool->top);
116
117 ASSERT_WSDEQUE_INVARIANTS(pool);
118
119 elements = (StgClosurePtr *)pool->elements;
120
121 /* We have exclusive access to the structure here, so we can reset
122 bottom and top counters, and prune invalid sparks. Contents are
123 copied in-place if they are valuable, otherwise discarded. The
124 routine uses "real" indices t and b, starts by computing them
125 as the modulus size of top and bottom,
126
127 Copying:
128
129 At the beginning, the pool structure can look like this:
130 ( bottom % size >= top % size , no wrap-around)
131 t b
132 ___________***********_________________
133
134 or like this ( bottom % size < top % size, wrap-around )
135 b t
136 ***********__________******************
137 As we need to remove useless sparks anyway, we make one pass
138 between t and b, moving valuable content to b and subsequent
139 cells (wrapping around when the size is reached).
140
141 b t
142 ***********OOO_______XX_X__X?**********
143 ^____move?____/
144
145 After this movement, botInd becomes the new bottom, and old
146 bottom becomes the new top index, both as indices in the array
147 size range.
148 */
149 // starting here
150 currInd = (pool->top) & (pool->moduloSize); // mod
151
152 // copies of evacuated closures go to space from botInd on
153 // we keep oldBotInd to know when to stop
154 oldBotInd = botInd = (pool->bottom) & (pool->moduloSize); // mod
155
156 // on entry to loop, we are within the bounds
157 ASSERT( currInd < pool->size && botInd < pool->size );
158
159 while (currInd != oldBotInd ) {
160 /* must use != here, wrap-around at size
161 subtle: loop not entered if queue empty
162 */
163
164 /* check element at currInd. if valuable, evacuate and move to
165 botInd, otherwise move on */
166 spark = elements[currInd];
167
168 // We have to be careful here: in the parallel GC, another
169 // thread might evacuate this closure while we're looking at it,
170 // so grab the info pointer just once.
171 if (GET_CLOSURE_TAG(spark) != 0) {
172 // Tagged pointer is a value, so the spark has fizzled. It
173 // probably never happens that we get a tagged pointer in
174 // the spark pool, because we would have pruned the spark
175 // during the previous GC cycle if it turned out to be
176 // evaluated, but it doesn't hurt to have this check for
177 // robustness.
178 pruned_sparks++;
179 cap->spark_stats.fizzled++;
180 traceEventSparkFizzle(cap);
181 } else {
182 info = spark->header.info;
183 if (IS_FORWARDING_PTR(info)) {
184 tmp = (StgClosure*)UN_FORWARDING_PTR(info);
185 /* if valuable work: shift inside the pool */
186 if (closure_SHOULD_SPARK(tmp)) {
187 elements[botInd] = tmp; // keep entry (new address)
188 botInd++;
189 n++;
190 } else {
191 pruned_sparks++; // discard spark
192 cap->spark_stats.fizzled++;
193 traceEventSparkFizzle(cap);
194 }
195 } else if (HEAP_ALLOCED(spark)) {
196 if ((Bdescr((P_)spark)->flags & BF_EVACUATED)) {
197 if (closure_SHOULD_SPARK(spark)) {
198 elements[botInd] = spark; // keep entry (new address)
199 botInd++;
200 n++;
201 } else {
202 pruned_sparks++; // discard spark
203 cap->spark_stats.fizzled++;
204 traceEventSparkFizzle(cap);
205 }
206 } else {
207 pruned_sparks++; // discard spark
208 cap->spark_stats.gcd++;
209 traceEventSparkGC(cap);
210 }
211 } else {
212 if (INFO_PTR_TO_STRUCT(info)->type == THUNK_STATIC) {
213 if (*THUNK_STATIC_LINK(spark) != NULL) {
214 elements[botInd] = spark; // keep entry (new address)
215 botInd++;
216 n++;
217 } else {
218 pruned_sparks++; // discard spark
219 cap->spark_stats.gcd++;
220 traceEventSparkGC(cap);
221 }
222 } else {
223 pruned_sparks++; // discard spark
224 cap->spark_stats.fizzled++;
225 traceEventSparkFizzle(cap);
226 }
227 }
228 }
229
230 currInd++;
231
232 // in the loop, we may reach the bounds, and instantly wrap around
233 ASSERT( currInd <= pool->size && botInd <= pool->size );
234 if ( currInd == pool->size ) { currInd = 0; }
235 if ( botInd == pool->size ) { botInd = 0; }
236
237 } // while-loop over spark pool elements
238
239 ASSERT(currInd == oldBotInd);
240
241 pool->top = oldBotInd; // where we started writing
242 pool->topBound = pool->top;
243
244 pool->bottom = (oldBotInd <= botInd) ? botInd : (botInd + pool->size);
245 // first free place we did not use (corrected by wraparound)
246
247 debugTrace(DEBUG_sparks, "pruned %d sparks", pruned_sparks);
248
249 debugTrace(DEBUG_sparks,
250 "new spark queue len=%ld; (hd=%ld; tl=%ld)",
251 sparkPoolSize(pool), pool->bottom, pool->top);
252
253 ASSERT_WSDEQUE_INVARIANTS(pool);
254 }
255
256 /* GC for the spark pool, called inside Capability.c for all
257 capabilities in turn. Blindly "evac"s complete spark pool. */
258 void
259 traverseSparkQueue (evac_fn evac, void *user, Capability *cap)
260 {
261 StgClosure **sparkp;
262 SparkPool *pool;
263 StgWord top,bottom, modMask;
264
265 pool = cap->sparks;
266
267 ASSERT_WSDEQUE_INVARIANTS(pool);
268
269 top = pool->top;
270 bottom = pool->bottom;
271 sparkp = (StgClosurePtr*)pool->elements;
272 modMask = pool->moduloSize;
273
274 while (top < bottom) {
275 /* call evac for all closures in range (wrap-around via modulo)
276 * In GHC-6.10, evac takes an additional 1st argument to hold a
277 * GC-specific register, see rts/sm/GC.c::mark_root()
278 */
279 evac( user , sparkp + (top & modMask) );
280 top++;
281 }
282
283 debugTrace(DEBUG_sparks,
284 "traversed spark queue, len=%ld; (hd=%ld; tl=%ld)",
285 sparkPoolSize(pool), pool->bottom, pool->top);
286 }
287
288 /* ----------------------------------------------------------------------------
289 * balanceSparkPoolsCaps: takes an array of capabilities (usually: all
290 * capabilities) and its size. Accesses all spark pools and equally
291 * distributes the sparks among them.
292 *
293 * Could be called after GC, before Cap. release, from scheduler.
294 * -------------------------------------------------------------------------- */
295 void balanceSparkPoolsCaps(nat n_caps, Capability caps[])
296 GNUC3_ATTRIBUTE(__noreturn__);
297
298 void balanceSparkPoolsCaps(nat n_caps STG_UNUSED,
299 Capability caps[] STG_UNUSED) {
300 barf("not implemented");
301 }
302
303 #else
304
305 StgInt
306 newSpark (StgRegTable *reg STG_UNUSED, StgClosure *p STG_UNUSED)
307 {
308 /* nothing */
309 return 1;
310 }
311
312 #endif /* THREADED_RTS */