rts/sm/GCUtils.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team 1998-2006
   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://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
  11  *
  12  * ---------------------------------------------------------------------------*/
  13
  14 #include "Rts.h"
  15 #include "RtsFlags.h"
  16 #include "Storage.h"
  17 #include "GC.h"
  18 #include "GCUtils.h"
  19 #include "Printer.h"
  20 #include "Trace.h"
  21
  22 #ifdef THREADED_RTS
  23 SpinLock gc_alloc_block_sync;
  24 #endif
  25
  26 bdescr *
  27 allocBlock_sync(void)
  28 {
  29     bdescr *bd;
  30     ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
  31     bd = allocBlock();
  32     RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
  33     return bd;
  34 }
  35
  36 /* -----------------------------------------------------------------------------
  37    Workspace utilities
  38    -------------------------------------------------------------------------- */
  39
  40 bdescr *
  41 grab_todo_block (step_workspace *ws)
  42 {
  43     bdescr *bd;
  44     step *stp;
  45
  46     stp = ws->stp;
  47     bd = NULL;
  48
  49     if (ws->buffer_todo_bd)
  50     {
  51         bd = ws->buffer_todo_bd;
  52         ASSERT(bd->link == NULL);
  53         ws->buffer_todo_bd = NULL;
  54         return bd;
  55     }
  56
  57     ACQUIRE_SPIN_LOCK(&stp->sync_todo);
  58     if (stp->todos) {
  59         bd = stp->todos;
  60         stp->todos = bd->link;
  61         stp->n_todos--;
  62         bd->link = NULL;
  63     }
  64     RELEASE_SPIN_LOCK(&stp->sync_todo);
  65     return bd;
  66 }
  67
  68 static void
  69 push_todo_block (bdescr *bd, step *stp)
  70 {
  71     ASSERT(bd->link == NULL);
  72     ACQUIRE_SPIN_LOCK(&stp->sync_todo);
  73     bd->link = stp->todos;
  74     stp->todos = bd;
  75     stp->n_todos++;
  76     trace(TRACE_gc, "step %d, n_todos: %d", stp->abs_no, stp->n_todos);
  77     RELEASE_SPIN_LOCK(&stp->sync_todo);
  78 }
  79
  80 void
  81 push_scan_block (bdescr *bd, step_workspace *ws)
  82 {
  83     ASSERT(bd != NULL);
  84     ASSERT(bd->link == NULL);
  85
  86     // update stats: this is a block that has been copied & scavenged
  87     copied += bd->free - bd->start;
  88
  89     // put the scan block on the ws->scavd_list.
  90     bd->link = ws->scavd_list;
  91     ws->scavd_list = bd;
  92     ws->n_scavd_blocks ++;
  93
  94     IF_DEBUG(sanity,
  95              ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks));
  96 }
  97
  98 StgPtr
  99 gc_alloc_todo_block (step_workspace *ws)
 100 {
 101     bdescr *bd;
 102
 103     if (ws->todo_bd != NULL) {
 104         ws->todo_bd->free = ws->todo_free;
 105     }
 106
 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             ASSERT(ws->buffer_todo_bd->link == NULL);
 114             push_todo_block(ws->buffer_todo_bd, ws->stp);
 115         }
 116         ws->buffer_todo_bd = ws->todo_bd;
 117         ws->todo_bd = NULL;
 118     }
 119
 120     bd = allocBlock_sync();
 121
 122     bd->gen_no = ws->stp->gen_no;
 123     bd->step = ws->stp;
 124     bd->link = NULL;
 125
 126     // blocks in to-space in generations up to and including N
 127     // get the BF_EVACUATED flag.
 128     if (ws->stp->gen_no <= N) {
 129         bd->flags = BF_EVACUATED;
 130     } else {
 131         bd->flags = 0;
 132     }
 133
 134     ws->todo_bd = bd;
 135     ws->todo_free = bd->start;
 136     ws->todo_lim  = bd->start + BLOCK_SIZE_W;
 137
 138     return ws->todo_free;
 139 }
 140
 141 /* -----------------------------------------------------------------------------
 142  * Debugging
 143  * -------------------------------------------------------------------------- */
 144
 145 #if DEBUG
 146 void
 147 printMutableList(generation *gen)
 148 {
 149     bdescr *bd;
 150     StgPtr p;
 151
 152     debugBelch("mutable list %p: ", gen->mut_list);
 153
 154     for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
 155         for (p = bd->start; p < bd->free; p++) {
 156             debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
 157         }
 158     }
 159     debugBelch("\n");
 160 }
 161 #endif /* DEBUG */