ghc/rts/BlockAlloc.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team 1998-2000
   4  *
   5  * The block allocator and free list manager.
   6  *
   7  * This is the architecture independent part of the block allocator.
   8  * It requires only the following support from the operating system:
   9  *
  10  *    void *getMBlock();
  11  *
  12  * returns the address of an MBLOCK_SIZE region of memory, aligned on
  13  * an MBLOCK_SIZE boundary.  There is no requirement for successive
  14  * calls to getMBlock to return strictly increasing addresses.
  15  *
  16  * ---------------------------------------------------------------------------*/
  17
  18 #include "PosixSource.h"
  19 #include "Rts.h"
  20 #include "RtsFlags.h"
  21 #include "RtsUtils.h"
  22 #include "BlockAlloc.h"
  23 #include "MBlock.h"
  24
  25 #include <string.h>
  26
  27 static void    initMBlock(void *mblock);
  28 static bdescr *allocMegaGroup(nat mblocks);
  29 static void    freeMegaGroup(bdescr *bd);
  30
  31 static bdescr *free_list = NULL;
  32
  33 /* -----------------------------------------------------------------------------
  34    Initialisation
  35    -------------------------------------------------------------------------- */
  36
  37 void initBlockAllocator(void)
  38 {
  39     // The free list starts off NULL
  40 }
  41
  42 /* -----------------------------------------------------------------------------
  43    Allocation
  44    -------------------------------------------------------------------------- */
  45
  46 STATIC_INLINE void
  47 initGroup(nat n, bdescr *head)
  48 {
  49   bdescr *bd;
  50   nat i;
  51
  52   if (n != 0) {
  53     head->blocks = n;
  54     head->free   = head->start;
  55     head->link   = NULL;
  56     for (i=1, bd = head+1; i < n; i++, bd++) {
  57       bd->free = 0;
  58       bd->blocks = 0;
  59       bd->link = head;
  60     }
  61   }
  62 }
  63
  64 bdescr *
  65 allocGroup(nat n)
  66 {
  67   void *mblock;
  68   bdescr *bd, **last;
  69
  70   ASSERT(n != 0);
  71
  72   if (n > BLOCKS_PER_MBLOCK) {
  73     return allocMegaGroup(BLOCKS_TO_MBLOCKS(n));
  74   }
  75
  76   last = &free_list;
  77   for (bd = free_list; bd != NULL; bd = bd->link) {
  78     if (bd->blocks == n) {      /* exactly the right size! */
  79       *last = bd->link;
  80       /* no initialisation necessary - this is already a
  81        * self-contained block group. */
  82       bd->free = bd->start;     /* block isn't free now */
  83       bd->link = NULL;
  84       return bd;
  85     }
  86     if (bd->blocks >  n) {      /* block too big... */
  87       bd->blocks -= n;          /* take a chunk off the *end* */
  88       bd += bd->blocks;
  89       initGroup(n, bd);         /* initialise it */
  90       return bd;
  91     }
  92     last = &bd->link;
  93   }
  94
  95   mblock = getMBlock();         /* get a new megablock */
  96   initMBlock(mblock);           /* initialise the start fields */
  97   bd = FIRST_BDESCR(mblock);
  98   initGroup(n,bd);              /* we know the group will fit */
  99   if (n < BLOCKS_PER_MBLOCK) {
 100     initGroup(BLOCKS_PER_MBLOCK-n, bd+n);
 101     freeGroup(bd+n);            /* add the rest on to the free list */
 102   }
 103   return bd;
 104 }
 105
 106 bdescr *
 107 allocBlock(void)
 108 {
 109   return allocGroup(1);
 110 }
 111
 112 /* -----------------------------------------------------------------------------
 113    Any request larger than BLOCKS_PER_MBLOCK needs a megablock group.
 114    First, search the free list for enough contiguous megablocks to
 115    fulfill the request - if we don't have enough, we need to
 116    allocate some new ones.
 117
 118    A megablock group looks just like a normal block group, except that
 119    the blocks field in the head will be larger than BLOCKS_PER_MBLOCK.
 120
 121    Note that any objects placed in this group must start in the first
 122    megablock, since the other blocks don't have block descriptors.
 123    -------------------------------------------------------------------------- */
 124
 125 static bdescr *
 126 allocMegaGroup(nat n)
 127 {
 128   nat mbs_found;
 129   bdescr *bd, *last, *grp_start, *grp_prev;
 130
 131   mbs_found = 0;
 132   grp_start = NULL;
 133   grp_prev  = NULL;
 134   last      = NULL;
 135   for (bd = free_list; bd != NULL; bd = bd->link) {
 136
 137     if (bd->blocks == BLOCKS_PER_MBLOCK) {      /* whole megablock found */
 138
 139       /* is it the first one we've found or a non-contiguous megablock? */
 140       if (grp_start == NULL ||
 141           bd->start != last->start + MBLOCK_SIZE/sizeof(W_)) {
 142         grp_start = bd;
 143         grp_prev  = last;
 144         mbs_found = 1;
 145       } else {
 146         mbs_found++;
 147       }
 148
 149       if (mbs_found == n) {     /* found enough contig megablocks? */
 150         break;
 151       }
 152     }
 153
 154     else {                      /* only a partial megablock, start again */
 155       grp_start = NULL;
 156     }
 157
 158     last = bd;
 159   }
 160
 161   /* found all the megablocks we need on the free list
 162    */
 163   if (mbs_found == n) {
 164     /* remove the megablocks from the free list */
 165     if (grp_prev == NULL) {     /* bd now points to the last mblock */
 166       free_list = bd->link;
 167     } else {
 168       grp_prev->link = bd->link;
 169     }
 170   }
 171
 172   /* the free list wasn't sufficient, allocate all new mblocks.
 173    */
 174   else {
 175     void *mblock = getMBlocks(n);
 176     initMBlock(mblock);         /* only need to init the 1st one */
 177     grp_start = FIRST_BDESCR(mblock);
 178   }
 179
 180   /* set up the megablock group */
 181   initGroup(BLOCKS_PER_MBLOCK, grp_start);
 182   grp_start->blocks = MBLOCK_GROUP_BLOCKS(n);
 183   return grp_start;
 184 }
 185
 186 /* -----------------------------------------------------------------------------
 187    De-Allocation
 188    -------------------------------------------------------------------------- */
 189
 190 /* coalesce the group p with p->link if possible.
 191  *
 192  * Returns p->link if no coalescing was done, otherwise returns a
 193  * pointer to the newly enlarged group p.
 194  */
 195
 196 STATIC_INLINE bdescr *
 197 coalesce(bdescr *p)
 198 {
 199   bdescr *bd, *q;
 200   nat i, blocks;
 201
 202   q = p->link;
 203   if (q != NULL && p->start + p->blocks * BLOCK_SIZE_W == q->start) {
 204     /* can coalesce */
 205     p->blocks += q->blocks;
 206     p->link    = q->link;
 207     blocks = q->blocks;
 208     for (i = 0, bd = q; i < blocks; bd++, i++) {
 209         bd->free = 0;
 210         bd->blocks = 0;
 211         bd->link = p;
 212     }
 213     return p;
 214   }
 215   return q;
 216 }
 217
 218 void
 219 freeGroup(bdescr *p)
 220 {
 221   bdescr *bd, *last;
 222
 223   /* are we dealing with a megablock group? */
 224   if (p->blocks > BLOCKS_PER_MBLOCK) {
 225     freeMegaGroup(p);
 226     return;
 227   }
 228
 229
 230   p->free = (void *)-1;  /* indicates that this block is free */
 231   p->step = NULL;
 232   p->gen_no = 0;
 233   /* fill the block group with garbage if sanity checking is on */
 234   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
 235
 236   /* find correct place in free list to place new group */
 237   last = NULL;
 238   for (bd = free_list; bd != NULL && bd->start < p->start;
 239        bd = bd->link) {
 240     last = bd;
 241   }
 242
 243   /* now, last = previous group (or NULL) */
 244   if (last == NULL) {
 245     p->link = free_list;
 246     free_list = p;
 247   } else {
 248     /* coalesce with previous group if possible */
 249     p->link = last->link;
 250     last->link = p;
 251     p = coalesce(last);
 252   }
 253
 254   /* coalesce with next group if possible */
 255   coalesce(p);
 256   IF_DEBUG(sanity, checkFreeListSanity());
 257 }
 258
 259 static void
 260 freeMegaGroup(bdescr *p)
 261 {
 262   nat n;
 263   void *q = p;
 264
 265   n = ((bdescr *)q)->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
 266   for (; n > 0; q += MBLOCK_SIZE, n--) {
 267     initMBlock(MBLOCK_ROUND_DOWN(q));
 268     initGroup(BLOCKS_PER_MBLOCK, (bdescr *)q);
 269     freeGroup((bdescr *)q);
 270   }
 271 }
 272
 273 void
 274 freeChain(bdescr *bd)
 275 {
 276   bdescr *next_bd;
 277   while (bd != NULL) {
 278     next_bd = bd->link;
 279     freeGroup(bd);
 280     bd = next_bd;
 281   }
 282 }
 283
 284 static void
 285 initMBlock(void *mblock)
 286 {
 287   bdescr *bd;
 288   void *block;
 289
 290   /* the first few Bdescr's in a block are unused, so we don't want to
 291    * put them all on the free list.
 292    */
 293   block = FIRST_BLOCK(mblock);
 294   bd    = FIRST_BDESCR(mblock);
 295
 296   /* Initialise the start field of each block descriptor
 297    */
 298   for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
 299     bd->start = block;
 300   }
 301 }
 302
 303 /* -----------------------------------------------------------------------------
 304    Debugging
 305    -------------------------------------------------------------------------- */
 306
 307 #ifdef DEBUG
 308 static void
 309 checkWellFormedGroup( bdescr *bd )
 310 {
 311     nat i;
 312
 313     for (i = 1; i < bd->blocks; i++) {
 314         ASSERT(bd[i].blocks == 0);
 315         ASSERT(bd[i].free   == 0);
 316         ASSERT(bd[i].link   == bd);
 317     }
 318 }
 319
 320 void
 321 checkFreeListSanity(void)
 322 {
 323   bdescr *bd;
 324
 325   for (bd = free_list; bd != NULL; bd = bd->link) {
 326     IF_DEBUG(block_alloc,
 327              debugBelch("group at 0x%x, length %d blocks\n",
 328                         (nat)bd->start, bd->blocks));
 329     ASSERT(bd->blocks > 0);
 330     checkWellFormedGroup(bd);
 331     if (bd->link != NULL) {
 332       /* make sure we're fully coalesced */
 333       ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);
 334       ASSERT(bd->start < bd->link->start);
 335     }
 336   }
 337 }
 338
 339 nat /* BLOCKS */
 340 countFreeList(void)
 341 {
 342   bdescr *bd;
 343   lnat total_blocks = 0;
 344
 345   for (bd = free_list; bd != NULL; bd = bd->link) {
 346     total_blocks += bd->blocks;
 347   }
 348   return total_blocks;
 349 }
 350 #endif