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             // If the global todo list is empty, push this block
 114             // out immediately rather than caching it in
 115             // buffer_todo_bd, because there might be other threads
 116             // waiting for work.
 117             if (ws->stp->todos == NULL) {
 118                 push_todo_block(ws->todo_bd, ws->stp);
 119             } else {
 120                 ws->buffer_todo_bd = ws->todo_bd;
 121             }
 122         } else {
 123             ASSERT(ws->buffer_todo_bd->link == NULL);
 124             push_todo_block(ws->buffer_todo_bd, ws->stp);
 125             ws->buffer_todo_bd = ws->todo_bd;
 126         }
 127         ws->todo_bd = NULL;
 128     }
 129
 130     bd = allocBlock_sync();
 131
 132     bd->gen_no = ws->stp->gen_no;
 133     bd->step = ws->stp;
 134     bd->link = NULL;
 135
 136     // blocks in to-space in generations up to and including N
 137     // get the BF_EVACUATED flag.
 138     if (ws->stp->gen_no <= N) {
 139         bd->flags = BF_EVACUATED;
 140     } else {
 141         bd->flags = 0;
 142     }
 143
 144     ws->todo_bd = bd;
 145     ws->todo_free = bd->start;
 146     ws->todo_lim  = bd->start + BLOCK_SIZE_W;
 147
 148     return ws->todo_free;
 149 }
 150
 151 /* -----------------------------------------------------------------------------
 152  * Debugging
 153  * -------------------------------------------------------------------------- */
 154
 155 #if DEBUG
 156 void
 157 printMutableList(generation *gen)
 158 {
 159     bdescr *bd;
 160     StgPtr p;
 161
 162     debugBelch("mutable list %p: ", gen->mut_list);
 163
 164     for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
 165         for (p = bd->start; p < bd->free; p++) {
 166             debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
 167         }
 168     }
 169     debugBelch("\n");
 170 }
 171 #endif /* DEBUG */