rts/sm/GCUtils.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team 1998-2008
   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 "GCThread.h"
  19 #include "GCUtils.h"
  20 #include "Printer.h"
  21 #include "Trace.h"
  22
  23 #ifdef THREADED_RTS
  24 SpinLock gc_alloc_block_sync;
  25 #endif
  26
  27 bdescr *
  28 allocBlock_sync(void)
  29 {
  30     bdescr *bd;
  31     ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
  32     bd = allocBlock();
  33     RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
  34     return bd;
  35 }
  36
  37
  38 #if 0
  39 static void
  40 allocBlocks_sync(nat n, bdescr **hd, bdescr **tl,
  41                  nat gen_no, step *stp,
  42                  StgWord32 flags)
  43 {
  44     bdescr *bd;
  45     nat i;
  46     ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
  47     bd = allocGroup(n);
  48     for (i = 0; i < n; i++) {
  49         bd[i].blocks = 1;
  50         bd[i].gen_no = gen_no;
  51         bd[i].step = stp;
  52         bd[i].flags = flags;
  53         bd[i].link = &bd[i+1];
  54         bd[i].u.scan = bd[i].free = bd[i].start;
  55     }
  56     *hd = bd;
  57     *tl = &bd[n-1];
  58     RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
  59 }
  60 #endif
  61
  62 void
  63 freeChain_sync(bdescr *bd)
  64 {
  65     ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
  66     freeChain(bd);
  67     RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
  68 }
  69
  70 /* -----------------------------------------------------------------------------
  71    Workspace utilities
  72    -------------------------------------------------------------------------- */
  73
  74 bdescr *
  75 grab_todo_block (step_workspace *ws)
  76 {
  77     bdescr *bd;
  78     step *stp;
  79
  80     stp = ws->step;
  81     bd = NULL;
  82
  83     if (ws->buffer_todo_bd)
  84     {
  85         bd = ws->buffer_todo_bd;
  86         ASSERT(bd->link == NULL);
  87         ws->buffer_todo_bd = NULL;
  88         return bd;
  89     }
  90
  91     ACQUIRE_SPIN_LOCK(&stp->sync_todo);
  92     if (stp->todos) {
  93         bd = stp->todos;
  94         if (stp->todos == stp->todos_last) {
  95             stp->todos_last = NULL;
  96         }
  97         stp->todos = bd->link;
  98         stp->n_todos--;
  99         bd->link = NULL;
 100     }
 101     RELEASE_SPIN_LOCK(&stp->sync_todo);
 102     return bd;
 103 }
 104
 105 void
 106 push_scanned_block (bdescr *bd, step_workspace *ws)
 107 {
 108     ASSERT(bd != NULL);
 109     ASSERT(bd->link == NULL);
 110     ASSERT(bd->step == ws->step);
 111     ASSERT(bd->u.scan == bd->free);
 112
 113     if (bd->start + BLOCK_SIZE_W - bd->free > WORK_UNIT_WORDS)
 114     {
 115         // a partially full block: put it on the part_list list.
 116         bd->link = ws->part_list;
 117         ws->part_list = bd;
 118         ws->n_part_blocks++;
 119         IF_DEBUG(sanity,
 120                  ASSERT(countBlocks(ws->part_list) == ws->n_part_blocks));
 121     }
 122     else
 123     {
 124         // put the scan block on the ws->scavd_list.
 125         bd->link = ws->scavd_list;
 126         ws->scavd_list = bd;
 127         ws->n_scavd_blocks ++;
 128         IF_DEBUG(sanity,
 129                  ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks));
 130     }
 131 }
 132
 133 StgPtr
 134 todo_block_full (nat size, step_workspace *ws)
 135 {
 136     bdescr *bd;
 137
 138     bd = ws->todo_bd;
 139
 140     ASSERT(bd != NULL);
 141     ASSERT(bd->link == NULL);
 142     ASSERT(bd->step == ws->step);
 143
 144     // If the global list is not empty, or there's not much work in
 145     // this block to push, and there's enough room in
 146     // this block to evacuate the current object, then just increase
 147     // the limit.
 148     if (ws->step->todos != NULL ||
 149         (ws->todo_free - bd->u.scan < WORK_UNIT_WORDS / 2)) {
 150         if (ws->todo_free + size < bd->start + BLOCK_SIZE_W) {
 151             ws->todo_lim = stg_min(bd->start + BLOCK_SIZE_W,
 152                                    ws->todo_lim + stg_max(WORK_UNIT_WORDS,size));
 153             debugTrace(DEBUG_gc, "increasing limit for %p to %p", bd->start, ws->todo_lim);
 154             return ws->todo_free;
 155         }
 156     }
 157
 158     gct->copied += ws->todo_free - bd->free;
 159     bd->free = ws->todo_free;
 160
 161     ASSERT(bd->u.scan >= bd->start && bd->u.scan <= bd->free);
 162
 163     // If this block is not the scan block, we want to push it out and
 164     // make room for a new todo block.
 165     if (bd != gct->scan_bd)
 166     {
 167         // If this block does not have enough space to allocate the
 168         // current object, but it also doesn't have any work to push, then
 169         // push it on to the scanned list.  It cannot be empty, because
 170         // then there would be enough room to copy the current object.
 171         if (bd->u.scan == bd->free)
 172         {
 173             ASSERT(bd->free != bd->start);
 174             push_scanned_block(bd, ws);
 175         }
 176         // Otherwise, push this block out to the global list.
 177         else
 178         {
 179             step *stp;
 180             stp = ws->step;
 181             trace(TRACE_gc|DEBUG_gc, "push todo block %p (%ld words), step %d, n_todos: %d",
 182                   bd->start, (unsigned long)(bd->free - bd->u.scan),
 183                   stp->abs_no, stp->n_todos);
 184             // ToDo: use buffer_todo
 185             ACQUIRE_SPIN_LOCK(&stp->sync_todo);
 186             if (stp->todos_last == NULL) {
 187                 stp->todos_last = bd;
 188                 stp->todos = bd;
 189             } else {
 190                 stp->todos_last->link = bd;
 191                 stp->todos_last = bd;
 192             }
 193             stp->n_todos++;
 194             RELEASE_SPIN_LOCK(&stp->sync_todo);
 195         }
 196     }
 197
 198     ws->todo_bd   = NULL;
 199     ws->todo_free = NULL;
 200     ws->todo_lim  = NULL;
 201
 202     alloc_todo_block(ws, size);
 203
 204     return ws->todo_free;
 205 }
 206
 207 StgPtr
 208 alloc_todo_block (step_workspace *ws, nat size)
 209 {
 210     bdescr *bd/*, *hd, *tl*/;
 211
 212     // Grab a part block if we have one, and it has enough room
 213     if (ws->part_list != NULL &&
 214         ws->part_list->start + BLOCK_SIZE_W - ws->part_list->free > (int)size)
 215     {
 216         bd = ws->part_list;
 217         ws->part_list = bd->link;
 218         ws->n_part_blocks--;
 219     }
 220     else
 221     {
 222         // blocks in to-space get the BF_EVACUATED flag.
 223
 224 //        allocBlocks_sync(4, &hd, &tl,
 225 //                         ws->step->gen_no, ws->step, BF_EVACUATED);
 226 //
 227 //        tl->link = ws->part_list;
 228 //        ws->part_list = hd->link;
 229 //        ws->n_part_blocks += 3;
 230 //
 231 //        bd = hd;
 232
 233         bd = allocBlock_sync();
 234         bd->step = ws->step;
 235         bd->gen_no = ws->step->gen_no;
 236         bd->flags = BF_EVACUATED;
 237         bd->u.scan = bd->free = bd->start;
 238     }
 239
 240     bd->link = NULL;
 241
 242     ws->todo_bd = bd;
 243     ws->todo_free = bd->free;
 244     ws->todo_lim  = stg_min(bd->start + BLOCK_SIZE_W,
 245                             bd->free + stg_max(WORK_UNIT_WORDS,size));
 246
 247     debugTrace(DEBUG_gc, "alloc new todo block %p for step %d",
 248                bd->free, ws->step->abs_no);
 249
 250     return ws->todo_free;
 251 }
 252
 253 /* -----------------------------------------------------------------------------
 254  * Debugging
 255  * -------------------------------------------------------------------------- */
 256
 257 #if DEBUG
 258 void
 259 printMutableList(generation *gen)
 260 {
 261     bdescr *bd;
 262     StgPtr p;
 263
 264     debugBelch("mutable list %p: ", gen->mut_list);
 265
 266     for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
 267         for (p = bd->start; p < bd->free; p++) {
 268             debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
 269         }
 270     }
 271     debugBelch("\n");
 272 }
 273 #endif /* DEBUG */