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 void
  37 freeChain_sync(bdescr *bd)
  38 {
  39     ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
  40     freeChain(bd);
  41     RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
  42 }
  43
  44 /* -----------------------------------------------------------------------------
  45    Workspace utilities
  46    -------------------------------------------------------------------------- */
  47
  48 bdescr *
  49 grab_todo_block (step_workspace *ws)
  50 {
  51     bdescr *bd;
  52     step *stp;
  53
  54     stp = ws->stp;
  55     bd = NULL;
  56
  57     if (ws->buffer_todo_bd)
  58     {
  59         bd = ws->buffer_todo_bd;
  60         ASSERT(bd->link == NULL);
  61         ws->buffer_todo_bd = NULL;
  62         return bd;
  63     }
  64
  65     ACQUIRE_SPIN_LOCK(&stp->sync_todo);
  66     if (stp->todos) {
  67         bd = stp->todos;
  68         stp->todos = bd->link;
  69         stp->n_todos--;
  70         bd->link = NULL;
  71     }
  72     RELEASE_SPIN_LOCK(&stp->sync_todo);
  73     return bd;
  74 }
  75
  76 static void
  77 push_todo_block (bdescr *bd, step *stp)
  78 {
  79     ASSERT(bd->link == NULL);
  80     ACQUIRE_SPIN_LOCK(&stp->sync_todo);
  81     bd->link = stp->todos;
  82     stp->todos = bd;
  83     stp->n_todos++;
  84     trace(TRACE_gc, "step %d, n_todos: %d", stp->abs_no, stp->n_todos);
  85     RELEASE_SPIN_LOCK(&stp->sync_todo);
  86 }
  87
  88 void
  89 push_scan_block (bdescr *bd, step_workspace *ws)
  90 {
  91     ASSERT(bd != NULL);
  92     ASSERT(bd->link == NULL);
  93
  94     // update stats: this is a block that has been copied & scavenged
  95     copied += bd->free - bd->start;
  96
  97     // put the scan block on the ws->scavd_list.
  98     bd->link = ws->scavd_list;
  99     ws->scavd_list = bd;
 100     ws->n_scavd_blocks ++;
 101
 102     IF_DEBUG(sanity,
 103              ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks));
 104 }
 105
 106 StgPtr
 107 gc_alloc_todo_block (step_workspace *ws)
 108 {
 109     bdescr *bd;
 110
 111     if (ws->todo_bd != NULL) {
 112         ws->todo_bd->free = ws->todo_free;
 113     }
 114
 115     // If we already have a todo block, it must be full, so we push it
 116     // out: first to the buffer_todo_bd, then to the step.  BUT, don't
 117     // push out the block out if it is already the scan block.
 118     if (ws->todo_bd != NULL && ws->scan_bd != ws->todo_bd) {
 119         ASSERT(ws->todo_bd->link == NULL);
 120         if (ws->buffer_todo_bd == NULL) {
 121             // If the global todo list is empty, push this block
 122             // out immediately rather than caching it in
 123             // buffer_todo_bd, because there might be other threads
 124             // waiting for work.
 125             if (ws->stp->todos == NULL) {
 126                 push_todo_block(ws->todo_bd, ws->stp);
 127             } else {
 128                 ws->buffer_todo_bd = ws->todo_bd;
 129             }
 130         } else {
 131             ASSERT(ws->buffer_todo_bd->link == NULL);
 132             push_todo_block(ws->buffer_todo_bd, ws->stp);
 133             ws->buffer_todo_bd = ws->todo_bd;
 134         }
 135         ws->todo_bd = NULL;
 136     }
 137
 138     bd = allocBlock_sync();
 139
 140     bd->gen_no = ws->stp->gen_no;
 141     bd->step = ws->stp;
 142     bd->link = NULL;
 143
 144     // blocks in to-space in generations up to and including N
 145     // get the BF_EVACUATED flag.
 146     if (ws->stp->gen_no <= N) {
 147         bd->flags = BF_EVACUATED;
 148     } else {
 149         bd->flags = 0;
 150     }
 151
 152     ws->todo_bd = bd;
 153     ws->todo_free = bd->start;
 154     ws->todo_lim  = bd->start + BLOCK_SIZE_W;
 155
 156     return ws->todo_free;
 157 }
 158
 159 /* -----------------------------------------------------------------------------
 160  * Debugging
 161  * -------------------------------------------------------------------------- */
 162
 163 #if DEBUG
 164 void
 165 printMutableList(generation *gen)
 166 {
 167     bdescr *bd;
 168     StgPtr p;
 169
 170     debugBelch("mutable list %p: ", gen->mut_list);
 171
 172     for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
 173         for (p = bd->start; p < bd->free; p++) {
 174             debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
 175         }
 176     }
 177     debugBelch("\n");
 178 }
 179 #endif /* DEBUG */