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