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);
36 /* -----------------------------------------------------------------------------
38 -------------------------------------------------------------------------- */
41 grab_todo_block (step_workspace *ws)
49 if (ws->buffer_todo_bd)
51 bd = ws->buffer_todo_bd;
52 ASSERT(bd->link == NULL);
53 ws->buffer_todo_bd = NULL;
57 ACQUIRE_SPIN_LOCK(&stp->sync_todo);
60 stp->todos = bd->link;
64 RELEASE_SPIN_LOCK(&stp->sync_todo);
69 push_todo_block (bdescr *bd, step *stp)
71 ASSERT(bd->link == NULL);
72 ACQUIRE_SPIN_LOCK(&stp->sync_todo);
73 bd->link = stp->todos;
76 trace(TRACE_gc, "step %d, n_todos: %d", stp->abs_no, stp->n_todos);
77 RELEASE_SPIN_LOCK(&stp->sync_todo);
81 push_scan_block (bdescr *bd, step_workspace *ws)
84 ASSERT(bd->link == NULL);
86 // update stats: this is a block that has been copied & scavenged
87 copied += bd->free - bd->start;
89 // put the scan block on the ws->scavd_list.
90 bd->link = ws->scavd_list;
92 ws->n_scavd_blocks ++;
95 ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks));
99 gc_alloc_todo_block (step_workspace *ws)
103 if (ws->todo_bd != NULL) {
104 ws->todo_bd->free = ws->todo_free;
107 // If we already have a todo block, it must be full, so we push it
108 // out: first to the buffer_todo_bd, then to the step. BUT, don't
109 // push out the block out if it is already the scan block.
110 if (ws->todo_bd != NULL && ws->scan_bd != ws->todo_bd) {
111 ASSERT(ws->todo_bd->link == NULL);
112 if (ws->buffer_todo_bd == NULL) {
113 // If the global todo list is empty, push this block
114 // out immediately rather than caching it in
115 // buffer_todo_bd, because there might be other threads
117 if (ws->stp->todos == NULL) {
118 push_todo_block(ws->todo_bd, ws->stp);
120 ws->buffer_todo_bd = ws->todo_bd;
123 ASSERT(ws->buffer_todo_bd->link == NULL);
124 push_todo_block(ws->buffer_todo_bd, ws->stp);
125 ws->buffer_todo_bd = ws->todo_bd;
130 bd = allocBlock_sync();
132 bd->gen_no = ws->stp->gen_no;
136 // blocks in to-space in generations up to and including N
137 // get the BF_EVACUATED flag.
138 if (ws->stp->gen_no <= N) {
139 bd->flags = BF_EVACUATED;
145 ws->todo_free = bd->start;
146 ws->todo_lim = bd->start + BLOCK_SIZE_W;
148 return ws->todo_free;
151 /* -----------------------------------------------------------------------------
153 * -------------------------------------------------------------------------- */
157 printMutableList(generation *gen)
162 debugBelch("mutable list %p: ", gen->mut_list);
164 for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
165 for (p = bd->start; p < bd->free; p++) {
166 debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));