Enable new warning for fragile/incorrect CPP #if usage
[ghc.git] / rts / sm / GCUtils.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team 1998-2008
4 *
5 * Generational garbage collector: utilities
6 *
7 * Documentation on the architecture of the Garbage Collector can be
8 * found in the online commentary:
9 *
10 * http://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
11 *
12 * ---------------------------------------------------------------------------*/
13
14 #include "PosixSource.h"
15 #include "Rts.h"
16
17 #include "BlockAlloc.h"
18 #include "Storage.h"
19 #include "GC.h"
20 #include "GCThread.h"
21 #include "GCTDecl.h"
22 #include "GCUtils.h"
23 #include "Printer.h"
24 #include "Trace.h"
25 #ifdef THREADED_RTS
26 #include "WSDeque.h"
27 #endif
28
29 #ifdef THREADED_RTS
30 SpinLock gc_alloc_block_sync;
31 #endif
32
33 bdescr* allocGroup_sync(uint32_t n)
34 {
35 bdescr *bd;
36 uint32_t node = capNoToNumaNode(gct->thread_index);
37 ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
38 bd = allocGroupOnNode(node,n);
39 RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
40 return bd;
41 }
42
43 bdescr* allocGroupOnNode_sync(uint32_t node, uint32_t n)
44 {
45 bdescr *bd;
46 ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
47 bd = allocGroupOnNode(node,n);
48 RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
49 return bd;
50 }
51
52 static uint32_t
53 allocBlocks_sync(uint32_t n, bdescr **hd)
54 {
55 bdescr *bd;
56 uint32_t i;
57 uint32_t node = capNoToNumaNode(gct->thread_index);
58 ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
59 bd = allocLargeChunkOnNode(node,1,n);
60 // NB. allocLargeChunk, rather than allocGroup(n), to allocate in a
61 // fragmentation-friendly way.
62 n = bd->blocks;
63 for (i = 0; i < n; i++) {
64 bd[i].blocks = 1;
65 bd[i].link = &bd[i+1];
66 bd[i].free = bd[i].start;
67 }
68 bd[n-1].link = NULL;
69 // We have to hold the lock until we've finished fiddling with the metadata,
70 // otherwise the block allocator can get confused.
71 RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
72 *hd = bd;
73 return n;
74 }
75
76 void
77 freeChain_sync(bdescr *bd)
78 {
79 ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
80 freeChain(bd);
81 RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
82 }
83
84 /* -----------------------------------------------------------------------------
85 Workspace utilities
86 -------------------------------------------------------------------------- */
87
88 bdescr *
89 grab_local_todo_block (gen_workspace *ws)
90 {
91 bdescr *bd;
92
93 bd = ws->todo_overflow;
94 if (bd != NULL)
95 {
96 ws->todo_overflow = bd->link;
97 bd->link = NULL;
98 ws->n_todo_overflow--;
99 return bd;
100 }
101
102 bd = popWSDeque(ws->todo_q);
103 if (bd != NULL)
104 {
105 ASSERT(bd->link == NULL);
106 return bd;
107 }
108
109 return NULL;
110 }
111
112 #if defined(THREADED_RTS)
113 bdescr *
114 steal_todo_block (uint32_t g)
115 {
116 uint32_t n;
117 bdescr *bd;
118
119 // look for work to steal
120 for (n = 0; n < n_gc_threads; n++) {
121 if (n == gct->thread_index) continue;
122 bd = stealWSDeque(gc_threads[n]->gens[g].todo_q);
123 if (bd) {
124 return bd;
125 }
126 }
127 return NULL;
128 }
129 #endif
130
131 void
132 push_scanned_block (bdescr *bd, gen_workspace *ws)
133 {
134 ASSERT(bd != NULL);
135 ASSERT(bd->link == NULL);
136 ASSERT(bd->gen == ws->gen);
137 ASSERT(bd->u.scan == bd->free);
138
139 if (bd->blocks == 1 &&
140 bd->start + BLOCK_SIZE_W - bd->free > WORK_UNIT_WORDS)
141 {
142 // A partially full block: put it on the part_list list.
143 // Only for single objects - see Note [big objects]
144 bd->link = ws->part_list;
145 ws->part_list = bd;
146 ws->n_part_blocks += bd->blocks;
147 ws->n_part_words += bd->free - bd->start;
148 IF_DEBUG(sanity,
149 ASSERT(countBlocks(ws->part_list) == ws->n_part_blocks));
150 }
151 else
152 {
153 // put the scan block on the ws->scavd_list.
154 bd->link = ws->scavd_list;
155 ws->scavd_list = bd;
156 ws->n_scavd_blocks += bd->blocks;
157 ws->n_scavd_words += bd->free - bd->start;
158 IF_DEBUG(sanity,
159 ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks));
160 }
161 }
162
163 /* Note [big objects]
164
165 We can get an ordinary object (CONSTR, FUN, THUNK etc.) that is
166 larger than a block (see #7919). Let's call these "big objects".
167 These objects don't behave like large objects - they live in
168 ordinary heap space (not the large_objects list), and are copied by
169 evacuate().
170
171 Clearly to copy one of these objects we need a block group, not an
172 ordinary block, so when alloc_todo_block() will correctly allocate a
173 block group.
174
175 The question is what to do with the space that is left at the end
176 of the block group after copying the big object into it. We could
177 continue to copy more objects into that space, but unfortunately
178 the rest of the GC is not set up to handle objects that start in
179 the second or later blocks of a group. We just about manage this
180 in the nursery (see scheduleHandleHeapOverflow()) so evacuate() can
181 handle this, but other parts of the GC can't. We could probably
182 fix this, but it's a rare case, so for now we ensure that we never
183 copy objects into the second and subsequent blocks of a block
184 group.
185
186 To ensure this:
187 - alloc_todo_block() sets todo_lim to be exactly the size of the
188 large object
189 - push_scanned_block doesn't put these blocks on the part_list
190 */
191
192 StgPtr
193 todo_block_full (uint32_t size, gen_workspace *ws)
194 {
195 bool urgent_to_push, can_extend;
196 StgPtr p;
197 bdescr *bd;
198
199 // todo_free has been pre-incremented by Evac.c:alloc_for_copy(). We
200 // are expected to leave it bumped when we've finished here.
201 ws->todo_free -= size;
202
203 bd = ws->todo_bd;
204
205 ASSERT(bd != NULL);
206 ASSERT(bd->link == NULL);
207 ASSERT(bd->gen == ws->gen);
208
209 // We intentionally set ws->todo_lim lower than the full size of
210 // the block, so that we can push out some work to the global list
211 // and get the parallel threads working as soon as possible.
212 //
213 // So when ws->todo_lim is reached, we end up here and have to
214 // decide whether it's worth pushing out the work we have or not.
215 // If we have enough room in the block to evacuate the current
216 // object, and it's not urgent to push this work, then we just
217 // extend the limit and keep going. Where "urgent" is defined as:
218 // the global pool is empty, and there's enough work in this block
219 // to make it worth pushing.
220 //
221 urgent_to_push =
222 looksEmptyWSDeque(ws->todo_q) &&
223 (ws->todo_free - bd->u.scan >= WORK_UNIT_WORDS / 2);
224
225 // We can extend the limit for the current block if there's enough
226 // room for the current object, *and* we're not into the second or
227 // subsequent block of a large block (see Note [big objects]).
228 can_extend =
229 ws->todo_free + size <= bd->start + bd->blocks * BLOCK_SIZE_W
230 && ws->todo_free < ws->todo_bd->start + BLOCK_SIZE_W;
231
232 if (!urgent_to_push && can_extend)
233 {
234 ws->todo_lim = stg_min(bd->start + bd->blocks * BLOCK_SIZE_W,
235 ws->todo_lim + stg_max(WORK_UNIT_WORDS,size));
236 debugTrace(DEBUG_gc, "increasing limit for %p to %p",
237 bd->start, ws->todo_lim);
238 p = ws->todo_free;
239 ws->todo_free += size;
240
241 return p;
242 }
243
244 gct->copied += ws->todo_free - bd->free;
245 bd->free = ws->todo_free;
246
247 ASSERT(bd->u.scan >= bd->start && bd->u.scan <= bd->free);
248
249 // If this block is not the scan block, we want to push it out and
250 // make room for a new todo block.
251 if (bd != gct->scan_bd)
252 {
253 // If this block does not have enough space to allocate the
254 // current object, but it also doesn't have any work to push, then
255 // push it on to the scanned list.
256 if (bd->u.scan == bd->free)
257 {
258 if (bd->free == bd->start) {
259 // Normally the block would not be empty, because then
260 // there would be enough room to copy the current
261 // object. However, if the object we're copying is
262 // larger than a block, then we might have an empty
263 // block here.
264 freeGroup(bd);
265 } else {
266 push_scanned_block(bd, ws);
267 }
268 }
269 // Otherwise, push this block out to the global list.
270 else
271 {
272 DEBUG_ONLY( generation *gen );
273 DEBUG_ONLY( gen = ws->gen );
274 debugTrace(DEBUG_gc, "push todo block %p (%ld words), step %d, todo_q: %ld",
275 bd->start, (unsigned long)(bd->free - bd->u.scan),
276 gen->no, dequeElements(ws->todo_q));
277
278 if (!pushWSDeque(ws->todo_q, bd)) {
279 bd->link = ws->todo_overflow;
280 ws->todo_overflow = bd;
281 ws->n_todo_overflow++;
282 }
283 }
284 }
285
286 ws->todo_bd = NULL;
287 ws->todo_free = NULL;
288 ws->todo_lim = NULL;
289
290 alloc_todo_block(ws, size);
291
292 p = ws->todo_free;
293 ws->todo_free += size;
294 return p;
295 }
296
297 StgPtr
298 alloc_todo_block (gen_workspace *ws, uint32_t size)
299 {
300 bdescr *bd/*, *hd, *tl */;
301
302 // Grab a part block if we have one, and it has enough room
303 bd = ws->part_list;
304 if (bd != NULL &&
305 bd->start + bd->blocks * BLOCK_SIZE_W - bd->free > (int)size)
306 {
307 ws->part_list = bd->link;
308 ws->n_part_blocks -= bd->blocks;
309 ws->n_part_words -= bd->free - bd->start;
310 }
311 else
312 {
313 if (size > BLOCK_SIZE_W) {
314 bd = allocGroup_sync((W_)BLOCK_ROUND_UP(size*sizeof(W_))
315 / BLOCK_SIZE);
316 } else {
317 if (gct->free_blocks) {
318 bd = gct->free_blocks;
319 gct->free_blocks = bd->link;
320 } else {
321 allocBlocks_sync(16, &bd);
322 gct->free_blocks = bd->link;
323 }
324 }
325 // blocks in to-space get the BF_EVACUATED flag.
326 bd->flags = BF_EVACUATED;
327 bd->u.scan = bd->start;
328 initBdescr(bd, ws->gen, ws->gen->to);
329 }
330
331 bd->link = NULL;
332
333 ws->todo_bd = bd;
334 ws->todo_free = bd->free;
335 ws->todo_lim = stg_min(bd->start + bd->blocks * BLOCK_SIZE_W,
336 bd->free + stg_max(WORK_UNIT_WORDS,size));
337 // See Note [big objects]
338
339 debugTrace(DEBUG_gc, "alloc new todo block %p for gen %d",
340 bd->free, ws->gen->no);
341
342 return ws->todo_free;
343 }
344
345 /* -----------------------------------------------------------------------------
346 * Debugging
347 * -------------------------------------------------------------------------- */
348
349 #ifdef DEBUG
350 void
351 printMutableList(bdescr *bd)
352 {
353 StgPtr p;
354
355 debugBelch("mutable list %p: ", bd);
356
357 for (; bd != NULL; bd = bd->link) {
358 for (p = bd->start; p < bd->free; p++) {
359 debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
360 }
361 }
362 debugBelch("\n");
363 }
364 #endif /* DEBUG */