1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 1998-2006
5 * Generational garbage collector: utilities
7 * Documentation on the architecture of the Garbage Collector can be
8 * found in the online commentary:
10 * http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
12 * ---------------------------------------------------------------------------*/
23 SpinLock gc_alloc_block_sync;
30 ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
32 RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
37 freeChain_sync(bdescr *bd)
39 ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
41 RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
44 /* -----------------------------------------------------------------------------
46 -------------------------------------------------------------------------- */
49 grab_todo_block (step_workspace *ws)
57 if (ws->buffer_todo_bd)
59 bd = ws->buffer_todo_bd;
60 ASSERT(bd->link == NULL);
61 ws->buffer_todo_bd = NULL;
65 ACQUIRE_SPIN_LOCK(&stp->sync_todo);
68 if (stp->todos == stp->todos_last) {
69 stp->todos_last = NULL;
71 stp->todos = bd->link;
75 RELEASE_SPIN_LOCK(&stp->sync_todo);
80 push_scanned_block (bdescr *bd, step_workspace *ws)
83 ASSERT(bd->link == NULL);
84 ASSERT(bd->step == ws->step);
85 ASSERT(bd->u.scan == bd->free);
87 if (bd->start + BLOCK_SIZE_W - bd->free > WORK_UNIT_WORDS)
89 // a partially full block: put it on the part_list list.
90 bd->link = ws->part_list;
94 ASSERT(countBlocks(ws->part_list) == ws->n_part_blocks));
98 // put the scan block on the ws->scavd_list.
99 bd->link = ws->scavd_list;
101 ws->n_scavd_blocks ++;
103 ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks));
108 todo_block_full (nat size, step_workspace *ws)
115 ASSERT(bd->link == NULL);
116 ASSERT(bd->step == ws->step);
118 // If the global list is not empty, or there's not much work in
119 // this block to push, and there's enough room in
120 // this block to evacuate the current object, then just increase
122 if (ws->step->todos != NULL ||
123 (ws->todo_free - bd->u.scan < WORK_UNIT_WORDS / 2)) {
124 if (ws->todo_free + size < bd->start + BLOCK_SIZE_W) {
125 ws->todo_lim = stg_min(bd->start + BLOCK_SIZE_W,
126 ws->todo_lim + stg_max(WORK_UNIT_WORDS,size));
127 debugTrace(DEBUG_gc, "increasing limit for %p to %p", bd->start, ws->todo_lim);
128 return ws->todo_free;
132 gct->copied += ws->todo_free - bd->free;
133 bd->free = ws->todo_free;
135 ASSERT(bd->u.scan >= bd->start && bd->u.scan <= bd->free);
137 // If this block is not the scan block, we want to push it out and
138 // make room for a new todo block.
139 if (bd != gct->scan_bd)
141 // If this block does not have enough space to allocate the
142 // current object, but it also doesn't have any work to push, then
143 // push it on to the scanned list. It cannot be empty, because
144 // then there would be enough room to copy the current object.
145 if (bd->u.scan == bd->free)
147 ASSERT(bd->free != bd->start);
148 push_scanned_block(bd, ws);
150 // Otherwise, push this block out to the global list.
155 trace(TRACE_gc|DEBUG_gc, "push todo block %p (%d words), step %d, n_todos: %d",
156 bd->start, bd->free - bd->u.scan, stp->abs_no, stp->n_todos);
157 // ToDo: use buffer_todo
158 ACQUIRE_SPIN_LOCK(&stp->sync_todo);
159 if (stp->todos_last == NULL) {
160 stp->todos_last = bd;
163 stp->todos_last->link = bd;
164 stp->todos_last = bd;
167 RELEASE_SPIN_LOCK(&stp->sync_todo);
172 ws->todo_free = NULL;
175 alloc_todo_block(ws, size);
177 return ws->todo_free;
181 alloc_todo_block (step_workspace *ws, nat size)
185 // Grab a part block if we have one, and it has enough room
186 if (ws->part_list != NULL &&
187 ws->part_list->start + BLOCK_SIZE_W - ws->part_list->free > (int)size)
190 ws->part_list = bd->link;
195 bd = allocBlock_sync();
196 bd->gen_no = ws->step->gen_no;
198 bd->u.scan = bd->start;
200 // blocks in to-space in generations up to and including N
201 // get the BF_EVACUATED flag.
202 if (ws->step->gen_no <= N) {
203 bd->flags = BF_EVACUATED;
212 ws->todo_free = bd->free;
213 ws->todo_lim = stg_min(bd->start + BLOCK_SIZE_W,
214 bd->free + stg_max(WORK_UNIT_WORDS,size));
216 debugTrace(DEBUG_gc, "alloc new todo block %p for step %d",
217 bd->free, ws->step->abs_no);
219 return ws->todo_free;
222 /* -----------------------------------------------------------------------------
224 * -------------------------------------------------------------------------- */
228 printMutableList(generation *gen)
233 debugBelch("mutable list %p: ", gen->mut_list);
235 for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
236 for (p = bd->start; p < bd->free; p++) {
237 debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));