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 bd->free = ws->todo_free;
120 // If the global list is not empty, or there's not much work in
121 // this block to push, and there's enough room in
122 // this block to evacuate the current object, then just increase
124 if (ws->step->todos != NULL ||
125 (bd->free - bd->u.scan < WORK_UNIT_WORDS / 2)) {
126 if (bd->free + size < bd->start + BLOCK_SIZE_W) {
127 debugTrace(DEBUG_gc, "increasing limit for %p", bd->start);
128 ws->todo_lim = stg_min(bd->start + BLOCK_SIZE_W,
129 ws->todo_lim + stg_max(WORK_UNIT_WORDS,size));
130 return ws->todo_free;
134 ASSERT(bd->u.scan >= bd->start && bd->u.scan <= bd->free);
136 // If this block is not the scan block, we want to push it out and
137 // make room for a new todo block.
138 if (bd != ws->scan_bd)
140 // If this block does not have enough space to allocate the
141 // current object, but it also doesn't have any work to push, then
142 // push it on to the scanned list. It cannot be empty, because
143 // then there would be enough room to copy the current object.
144 if (bd->u.scan == bd->free)
146 ASSERT(bd->free != bd->start);
147 push_scanned_block(bd, ws);
149 // Otherwise, push this block out to the global list.
154 trace(TRACE_gc|DEBUG_gc, "push todo block %p (%d words), step %d, n_todos: %d",
155 bd->start, bd->free - bd->u.scan, stp->abs_no, stp->n_todos);
156 // ToDo: use buffer_todo
157 ACQUIRE_SPIN_LOCK(&stp->sync_todo);
158 if (stp->todos_last == NULL) {
159 stp->todos_last = bd;
162 stp->todos_last->link = bd;
163 stp->todos_last = bd;
166 RELEASE_SPIN_LOCK(&stp->sync_todo);
171 ws->todo_free = NULL;
174 alloc_todo_block(ws, size);
176 return ws->todo_free;
180 alloc_todo_block (step_workspace *ws, nat size)
184 // Grab a part block if we have one, and it has enough room
185 if (ws->part_list != NULL &&
186 ws->part_list->start + BLOCK_SIZE_W - ws->part_list->free > (int)size)
189 ws->part_list = bd->link;
194 bd = allocBlock_sync();
195 bd->gen_no = ws->step->gen_no;
197 bd->u.scan = bd->start;
199 // blocks in to-space in generations up to and including N
200 // get the BF_EVACUATED flag.
201 if (ws->step->gen_no <= N) {
202 bd->flags = BF_EVACUATED;
211 ws->todo_free = bd->free;
212 ws->todo_lim = stg_min(bd->start + BLOCK_SIZE_W,
213 bd->free + stg_max(WORK_UNIT_WORDS,size));
215 debugTrace(DEBUG_gc, "alloc new todo block %p for step %d",
216 bd->start, ws->step->abs_no);
218 return ws->todo_free;
221 /* -----------------------------------------------------------------------------
223 * -------------------------------------------------------------------------- */
227 printMutableList(generation *gen)
232 debugBelch("mutable list %p: ", gen->mut_list);
234 for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
235 for (p = bd->start; p < bd->free; p++) {
236 debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));