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 bdescr *
  95 gc_alloc_todo_block (step_workspace *ws)
  96 {
  97     bdescr *bd;
  98
  99     // If we already have a todo block, it must be full, so we push it
 100     // out: first to the buffer_todo_bd, then to the step.  BUT, don't
 101     // push out the block out if it is already the scan block.
 102     if (ws->todo_bd != NULL && ws->scan_bd != ws->todo_bd) {
 103         ASSERT(ws->todo_bd->link == NULL);
 104         if (ws->buffer_todo_bd != NULL) {
 105             ASSERT(ws->buffer_todo_bd->link == NULL);
 106             push_todo_block(ws->buffer_todo_bd, ws->stp);
 107         }
 108         ws->buffer_todo_bd = ws->todo_bd;
 109         ws->todo_bd = NULL;
 110     }
 111
 112     bd = allocBlock_sync();
 113
 114     bd->gen_no = ws->stp->gen_no;
 115     bd->step = ws->stp;
 116     bd->link = NULL;
 117
 118     // blocks in to-space in generations up to and including N
 119     // get the BF_EVACUATED flag.
 120     if (ws->stp->gen_no <= N) {
 121         bd->flags = BF_EVACUATED;
 122     } else {
 123         bd->flags = 0;
 124     }
 125
 126     ws->todo_bd = bd;
 127
 128     return bd;
 129 }
 130
 131 /* -----------------------------------------------------------------------------
 132  * Debugging
 133  * -------------------------------------------------------------------------- */
 134
 135 #if DEBUG
 136 void
 137 printMutableList(generation *gen)
 138 {
 139     bdescr *bd;
 140     StgPtr p;
 141
 142     debugBelch("mutable list %p: ", gen->mut_list);
 143
 144     for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
 145         for (p = bd->start; p < bd->free; p++) {
 146             debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
 147         }
 148     }
 149     debugBelch("\n");
 150 }
 151 #endif /* DEBUG */