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 "Storage.h"
  16 #include "GC.h"
  17 #include "GCUtils.h"
  18
  19 /* -----------------------------------------------------------------------------
  20    Allocate a new to-space block in the given step.
  21    -------------------------------------------------------------------------- */
  22
  23 bdescr *
  24 gc_alloc_block(step *stp)
  25 {
  26     bdescr *bd = allocBlock();
  27     bd->gen_no = stp->gen_no;
  28     bd->step = stp;
  29     bd->link = NULL;
  30
  31     // blocks in to-space in generations up to and including N
  32     // get the BF_EVACUATED flag.
  33     if (stp->gen_no <= N) {
  34         bd->flags = BF_EVACUATED;
  35     } else {
  36         bd->flags = 0;
  37     }
  38
  39     // Start a new to-space block, chain it on after the previous one.
  40     if (stp->hp_bd != NULL) {
  41         stp->hp_bd->free = stp->hp;
  42         stp->hp_bd->link = bd;
  43     }
  44
  45     stp->hp_bd = bd;
  46     stp->hp    = bd->start;
  47     stp->hpLim = stp->hp + BLOCK_SIZE_W;
  48
  49     stp->n_blocks++;
  50     new_blocks++;
  51
  52     return bd;
  53 }
  54
  55 bdescr *
  56 gc_alloc_scavd_block(step *stp)
  57 {
  58     bdescr *bd = allocBlock();
  59     bd->gen_no = stp->gen_no;
  60     bd->step = stp;
  61
  62     // blocks in to-space in generations up to and including N
  63     // get the BF_EVACUATED flag.
  64     if (stp->gen_no <= N) {
  65         bd->flags = BF_EVACUATED;
  66     } else {
  67         bd->flags = 0;
  68     }
  69
  70     bd->link = stp->blocks;
  71     stp->blocks = bd;
  72
  73     if (stp->scavd_hp != NULL) {
  74         Bdescr(stp->scavd_hp)->free = stp->scavd_hp;
  75     }
  76     stp->scavd_hp    = bd->start;
  77     stp->scavd_hpLim = stp->scavd_hp + BLOCK_SIZE_W;
  78
  79     stp->n_blocks++;
  80     new_scavd_blocks++;
  81
  82     return bd;
  83 }
  84