ghc/rts/BlockAlloc.c

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