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