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