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 * ---------------------------------------------------------------------------*/
22 SpinLock gc_alloc_block_sync;
29 ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
31 RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
35 /* -----------------------------------------------------------------------------
37 -------------------------------------------------------------------------- */
40 grab_todo_block (step_workspace *ws)
48 if (ws->buffer_todo_bd)
50 bd = ws->buffer_todo_bd;
51 ASSERT(bd->link == NULL);
52 ws->buffer_todo_bd = NULL;
56 ACQUIRE_SPIN_LOCK(&stp->sync_todo);
59 stp->todos = bd->link;
62 RELEASE_SPIN_LOCK(&stp->sync_todo);
67 push_todo_block (bdescr *bd, step *stp)
69 ASSERT(bd->link == NULL);
70 ACQUIRE_SPIN_LOCK(&stp->sync_todo);
71 bd->link = stp->todos;
73 RELEASE_SPIN_LOCK(&stp->sync_todo);
77 push_scan_block (bdescr *bd, step_workspace *ws)
80 ASSERT(bd->link == NULL);
82 // update stats: this is a block that has been copied & scavenged
83 copied += bd->free - bd->start;
85 // put the scan block *second* in ws->scavd_list. The first block
86 // in this list is for evacuating objects that don't need to be
88 bd->link = ws->scavd_list->link;
89 ws->scavd_list->link = bd;
90 ws->n_scavd_blocks ++;
93 ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks));
97 gc_alloc_todo_block (step_workspace *ws)
101 // If we already have a todo block, it must be full, so we push it
102 // out: first to the buffer_todo_bd, then to the step. BUT, don't
103 // push out the block out if it is already the scan block.
104 if (ws->todo_bd != NULL && ws->scan_bd != ws->todo_bd) {
105 ASSERT(ws->todo_bd->link == NULL);
106 if (ws->buffer_todo_bd != NULL) {
107 ASSERT(ws->buffer_todo_bd->link == NULL);
108 push_todo_block(ws->buffer_todo_bd, ws->stp);
110 ws->buffer_todo_bd = ws->todo_bd;
114 bd = allocBlock_sync();
116 bd->gen_no = ws->stp->gen_no;
120 // blocks in to-space in generations up to and including N
121 // get the BF_EVACUATED flag.
122 if (ws->stp->gen_no <= N) {
123 bd->flags = BF_EVACUATED;
134 gc_alloc_scavd_block (step_workspace *ws)
138 bd = allocBlock_sync();
140 bd->gen_no = ws->stp->gen_no;
143 // blocks in to-space in generations up to and including N
144 // get the BF_EVACUATED flag.
145 if (ws->stp->gen_no <= N) {
146 bd->flags = BF_EVACUATED;
151 // update stats: this is a block that has been copied only
152 if (ws->scavd_list != NULL) {
153 scavd_copied += ws->scavd_list->free - ws->scavd_list->start;
156 bd->link = ws->scavd_list;
158 ws->n_scavd_blocks++;
163 /* -----------------------------------------------------------------------------
165 * -------------------------------------------------------------------------- */
169 printMutableList(generation *gen)
174 debugBelch("mutable list %p: ", gen->mut_list);
176 for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
177 for (p = bd->start; p < bd->free; p++) {
178 debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));