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