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     StgPtr p;
 153     bdescr *bd;
 154
 155     // todo_free has been pre-incremented by Evac.c:alloc_for_copy().  We
 156     // are expected to leave it bumped when we've finished here.
 157     ws->todo_free -= size;
 158
 159     bd = ws->todo_bd;
 160
 161     ASSERT(bd != NULL);
 162     ASSERT(bd->link == NULL);
 163     ASSERT(bd->step == ws->step);
 164
 165     // If the global list is not empty, or there's not much work in
 166     // this block to push, and there's enough room in
 167     // this block to evacuate the current object, then just increase
 168     // the limit.
 169     if (!looksEmptyWSDeque(ws->todo_q) ||
 170         (ws->todo_free - bd->u.scan < WORK_UNIT_WORDS / 2)) {
 171         if (ws->todo_free + size < bd->start + BLOCK_SIZE_W) {
 172             ws->todo_lim = stg_min(bd->start + BLOCK_SIZE_W,
 173                                    ws->todo_lim + stg_max(WORK_UNIT_WORDS,size));
 174             debugTrace(DEBUG_gc, "increasing limit for %p to %p", bd->start, ws->todo_lim);
 175             p = ws->todo_free;
 176             ws->todo_free += size;
 177             return p;
 178         }
 179     }
 180
 181     gct->copied += ws->todo_free - bd->free;
 182     bd->free = ws->todo_free;
 183
 184     ASSERT(bd->u.scan >= bd->start && bd->u.scan <= bd->free);
 185
 186     // If this block is not the scan block, we want to push it out and
 187     // make room for a new todo block.
 188     if (bd != gct->scan_bd)
 189     {
 190         // If this block does not have enough space to allocate the
 191         // current object, but it also doesn't have any work to push, then
 192         // push it on to the scanned list.  It cannot be empty, because
 193         // then there would be enough room to copy the current object.
 194         if (bd->u.scan == bd->free)
 195         {
 196             ASSERT(bd->free != bd->start);
 197             push_scanned_block(bd, ws);
 198         }
 199         // Otherwise, push this block out to the global list.
 200         else
 201         {
 202             step *stp;
 203             stp = ws->step;
 204             debugTrace(DEBUG_gc, "push todo block %p (%ld words), step %d, todo_q: %ld",
 205                   bd->start, (unsigned long)(bd->free - bd->u.scan),
 206                   stp->abs_no, dequeElements(ws->todo_q));
 207
 208             if (!pushWSDeque(ws->todo_q, bd)) {
 209                 bd->link = ws->todo_overflow;
 210                 ws->todo_overflow = bd;
 211                 ws->n_todo_overflow++;
 212             }
 213         }
 214     }
 215
 216     ws->todo_bd   = NULL;
 217     ws->todo_free = NULL;
 218     ws->todo_lim  = NULL;
 219
 220     alloc_todo_block(ws, size);
 221
 222     p = ws->todo_free;
 223     ws->todo_free += size;
 224     return p;
 225 }
 226
 227 StgPtr
 228 alloc_todo_block (step_workspace *ws, nat size)
 229 {
 230     bdescr *bd/*, *hd, *tl */;
 231
 232     // Grab a part block if we have one, and it has enough room
 233     if (ws->part_list != NULL &&
 234         ws->part_list->start + BLOCK_SIZE_W - ws->part_list->free > (int)size)
 235     {
 236         bd = ws->part_list;
 237         ws->part_list = bd->link;
 238         ws->n_part_blocks--;
 239     }
 240     else
 241     {
 242         // blocks in to-space get the BF_EVACUATED flag.
 243
 244 //        allocBlocks_sync(16, &hd, &tl,
 245 //                         ws->step->gen_no, ws->step, BF_EVACUATED);
 246 //
 247 //        tl->link = ws->part_list;
 248 //        ws->part_list = hd->link;
 249 //        ws->n_part_blocks += 15;
 250 //
 251 //        bd = hd;
 252
 253         bd = allocBlock_sync();
 254         bd->step = ws->step;
 255         bd->gen_no = ws->step->gen_no;
 256         bd->flags = BF_EVACUATED;
 257         bd->u.scan = bd->free = bd->start;
 258     }
 259
 260     bd->link = NULL;
 261
 262     ws->todo_bd = bd;
 263     ws->todo_free = bd->free;
 264     ws->todo_lim  = stg_min(bd->start + BLOCK_SIZE_W,
 265                             bd->free + stg_max(WORK_UNIT_WORDS,size));
 266
 267     debugTrace(DEBUG_gc, "alloc new todo block %p for step %d",
 268                bd->free, ws->step->abs_no);
 269
 270     return ws->todo_free;
 271 }
 272
 273 /* -----------------------------------------------------------------------------
 274  * Debugging
 275  * -------------------------------------------------------------------------- */
 276
 277 #if DEBUG
 278 void
 279 printMutableList(generation *gen)
 280 {
 281     bdescr *bd;
 282     StgPtr p;
 283
 284     debugBelch("mutable list %p: ", gen->mut_list);
 285
 286     for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
 287         for (p = bd->start; p < bd->free; p++) {
 288             debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
 289         }
 290     }
 291     debugBelch("\n");
 292 }
 293 #endif /* DEBUG */