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 *second* in ws->scavd_list.  The first block
  86     // in this list is for evacuating objects that don't need to be
  87     // scavenged.
  88     bd->link = ws->scavd_list->link;
  89     ws->scavd_list->link = bd;
  90     ws->n_scavd_blocks ++;
  91
  92     IF_DEBUG(sanity,
  93              ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks));
  94 }
  95
  96 bdescr *
  97 gc_alloc_todo_block (step_workspace *ws)
  98 {
  99     bdescr *bd;
 100
 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);
 109         }
 110         ws->buffer_todo_bd = ws->todo_bd;
 111         ws->todo_bd = NULL;
 112     }
 113
 114     bd = allocBlock_sync();
 115
 116     bd->gen_no = ws->stp->gen_no;
 117     bd->step = ws->stp;
 118     bd->link = NULL;
 119
 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;
 124     } else {
 125         bd->flags = 0;
 126     }
 127
 128     ws->todo_bd = bd;
 129
 130     return bd;
 131 }
 132
 133 bdescr *
 134 gc_alloc_scavd_block (step_workspace *ws)
 135 {
 136     bdescr *bd;
 137
 138     bd = allocBlock_sync();
 139
 140     bd->gen_no = ws->stp->gen_no;
 141     bd->step = ws->stp;
 142
 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;
 147     } else {
 148         bd->flags = 0;
 149     }
 150
 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;
 154     }
 155
 156     bd->link = ws->scavd_list;
 157     ws->scavd_list = bd;
 158     ws->n_scavd_blocks++;
 159
 160     return bd;
 161 }
 162
 163 /* -----------------------------------------------------------------------------
 164  * Debugging
 165  * -------------------------------------------------------------------------- */
 166
 167 #if DEBUG
 168 void
 169 printMutableList(generation *gen)
 170 {
 171     bdescr *bd;
 172     StgPtr p;
 173
 174     debugBelch("mutable list %p: ", gen->mut_list);
 175
 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));
 179         }
 180     }
 181     debugBelch("\n");
 182 }
 183 #endif /* DEBUG */