rts/sm/BlockAlloc.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team 1998-2006
   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 #include "Storage.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 // In THREADED_RTS mode, the free list is protected by sm_mutex.
  33 static bdescr *free_list = NULL;
  34
  35 /* -----------------------------------------------------------------------------
  36    Initialisation
  37    -------------------------------------------------------------------------- */
  38
  39 void initBlockAllocator(void)
  40 {
  41     // The free list starts off NULL
  42 }
  43
  44 /* -----------------------------------------------------------------------------
  45    Allocation
  46    -------------------------------------------------------------------------- */
  47
  48 STATIC_INLINE void
  49 initGroup(nat n, bdescr *head)
  50 {
  51   bdescr *bd;
  52   nat i;
  53
  54   if (n != 0) {
  55     head->blocks = n;
  56     head->free   = head->start;
  57     head->link   = NULL;
  58     for (i=1, bd = head+1; i < n; i++, bd++) {
  59       bd->free = 0;
  60       bd->blocks = 0;
  61       bd->link = head;
  62     }
  63   }
  64 }
  65
  66 bdescr *
  67 allocGroup(nat n)
  68 {
  69   void *mblock;
  70   bdescr *bd, **last;
  71
  72   ASSERT_SM_LOCK();
  73   ASSERT(n != 0);
  74
  75   if (n > BLOCKS_PER_MBLOCK) {
  76     return allocMegaGroup(BLOCKS_TO_MBLOCKS(n));
  77   }
  78
  79   last = &free_list;
  80   for (bd = free_list; bd != NULL; bd = bd->link) {
  81     if (bd->blocks == n) {      /* exactly the right size! */
  82       *last = bd->link;
  83       initGroup(n, bd);         /* initialise it */
  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 allocGroup_lock(nat n)
 108 {
 109     bdescr *bd;
 110     ACQUIRE_SM_LOCK;
 111     bd = allocGroup(n);
 112     RELEASE_SM_LOCK;
 113     return bd;
 114 }
 115
 116 bdescr *
 117 allocBlock(void)
 118 {
 119   return allocGroup(1);
 120 }
 121
 122 bdescr *
 123 allocBlock_lock(void)
 124 {
 125     bdescr *bd;
 126     ACQUIRE_SM_LOCK;
 127     bd = allocBlock();
 128     RELEASE_SM_LOCK;
 129     return bd;
 130 }
 131
 132 /* -----------------------------------------------------------------------------
 133    Any request larger than BLOCKS_PER_MBLOCK needs a megablock group.
 134    First, search the free list for enough contiguous megablocks to
 135    fulfill the request - if we don't have enough, we need to
 136    allocate some new ones.
 137
 138    A megablock group looks just like a normal block group, except that
 139    the blocks field in the head will be larger than BLOCKS_PER_MBLOCK.
 140
 141    Note that any objects placed in this group must start in the first
 142    megablock, since the other blocks don't have block descriptors.
 143    -------------------------------------------------------------------------- */
 144
 145 static bdescr *
 146 allocMegaGroup(nat n)
 147 {
 148   nat mbs_found;
 149   bdescr *bd, *last, *grp_start, *grp_prev;
 150
 151   mbs_found = 0;
 152   grp_start = NULL;
 153   grp_prev  = NULL;
 154   last      = NULL;
 155   for (bd = free_list; bd != NULL; bd = bd->link) {
 156
 157     if (bd->blocks == BLOCKS_PER_MBLOCK) {      /* whole megablock found */
 158
 159       /* is it the first one we've found or a non-contiguous megablock? */
 160       if (grp_start == NULL ||
 161           bd->start != last->start + MBLOCK_SIZE/sizeof(W_)) {
 162         grp_start = bd;
 163         grp_prev  = last;
 164         mbs_found = 1;
 165       } else {
 166         mbs_found++;
 167       }
 168
 169       if (mbs_found == n) {     /* found enough contig megablocks? */
 170         break;
 171       }
 172     }
 173
 174     else {                      /* only a partial megablock, start again */
 175       grp_start = NULL;
 176     }
 177
 178     last = bd;
 179   }
 180
 181   /* found all the megablocks we need on the free list
 182    */
 183   if (mbs_found == n) {
 184     /* remove the megablocks from the free list */
 185     if (grp_prev == NULL) {     /* bd now points to the last mblock */
 186       free_list = bd->link;
 187     } else {
 188       grp_prev->link = bd->link;
 189     }
 190   }
 191
 192   /* the free list wasn't sufficient, allocate all new mblocks.
 193    */
 194   else {
 195     void *mblock = getMBlocks(n);
 196     initMBlock(mblock);         /* only need to init the 1st one */
 197     grp_start = FIRST_BDESCR(mblock);
 198   }
 199
 200   /* set up the megablock group */
 201   initGroup(BLOCKS_PER_MBLOCK, grp_start);
 202   grp_start->blocks = MBLOCK_GROUP_BLOCKS(n);
 203   return grp_start;
 204 }
 205
 206 /* -----------------------------------------------------------------------------
 207    De-Allocation
 208    -------------------------------------------------------------------------- */
 209
 210 /* coalesce the group p with p->link if possible.
 211  *
 212  * Returns p->link if no coalescing was done, otherwise returns a
 213  * pointer to the newly enlarged group p.
 214  */
 215
 216 STATIC_INLINE bdescr *
 217 coalesce(bdescr *p)
 218 {
 219   bdescr *q;
 220
 221   q = p->link;
 222   if (q != NULL && p->start + p->blocks * BLOCK_SIZE_W == q->start) {
 223     /* can coalesce */
 224     p->blocks += q->blocks;
 225     p->link    = q->link;
 226 #ifdef DEBUG
 227     {
 228         nat i, blocks;
 229         bdescr *bd;
 230         blocks = q->blocks;
 231         // not strictly necessary to do this, but helpful if we have a
 232         // random ptr and want to figure out what block it belongs to.
 233         // Also required for sanity checking (see checkFreeListSanity()).
 234         for (i = 0, bd = q; i < blocks; bd++, i++) {
 235             bd->free = 0;
 236             bd->blocks = 0;
 237             bd->link = p;
 238         }
 239     }
 240 #endif
 241     return p;
 242   }
 243   return q;
 244 }
 245
 246 void
 247 freeGroup(bdescr *p)
 248 {
 249   bdescr *bd, *last;
 250
 251   ASSERT_SM_LOCK();
 252
 253   /* are we dealing with a megablock group? */
 254   if (p->blocks > BLOCKS_PER_MBLOCK) {
 255     freeMegaGroup(p);
 256     return;
 257   }
 258
 259
 260   p->free = (void *)-1;  /* indicates that this block is free */
 261   p->step = NULL;
 262   p->gen_no = 0;
 263   /* fill the block group with garbage if sanity checking is on */
 264   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
 265
 266   /* find correct place in free list to place new group */
 267   last = NULL;
 268   for (bd = free_list; bd != NULL && bd->start < p->start;
 269        bd = bd->link) {
 270     last = bd;
 271   }
 272
 273   /* now, last = previous group (or NULL) */
 274   if (last == NULL) {
 275     p->link = free_list;
 276     free_list = p;
 277   } else {
 278     /* coalesce with previous group if possible */
 279     p->link = last->link;
 280     last->link = p;
 281     p = coalesce(last);
 282   }
 283
 284   /* coalesce with next group if possible */
 285   coalesce(p);
 286   IF_DEBUG(sanity, checkFreeListSanity());
 287 }
 288
 289 void
 290 freeGroup_lock(bdescr *p)
 291 {
 292     ACQUIRE_SM_LOCK;
 293     freeGroup(p);
 294     RELEASE_SM_LOCK;
 295 }
 296
 297 static void
 298 freeMegaGroup(bdescr *p)
 299 {
 300   nat n;
 301   void *q = p;
 302
 303   n = ((bdescr *)q)->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
 304   for (; n > 0; q += MBLOCK_SIZE, n--) {
 305     initMBlock(MBLOCK_ROUND_DOWN(q));
 306     initGroup(BLOCKS_PER_MBLOCK, (bdescr *)q);
 307     freeGroup((bdescr *)q);
 308   }
 309 }
 310
 311 void
 312 freeChain(bdescr *bd)
 313 {
 314   bdescr *next_bd;
 315   while (bd != NULL) {
 316     next_bd = bd->link;
 317     freeGroup(bd);
 318     bd = next_bd;
 319   }
 320 }
 321
 322 void
 323 freeChain_lock(bdescr *bd)
 324 {
 325     ACQUIRE_SM_LOCK;
 326     freeChain(bd);
 327     RELEASE_SM_LOCK;
 328 }
 329
 330 static void
 331 initMBlock(void *mblock)
 332 {
 333   bdescr *bd;
 334   void *block;
 335
 336   /* the first few Bdescr's in a block are unused, so we don't want to
 337    * put them all on the free list.
 338    */
 339   block = FIRST_BLOCK(mblock);
 340   bd    = FIRST_BDESCR(mblock);
 341
 342   /* Initialise the start field of each block descriptor
 343    */
 344   for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
 345     bd->start = block;
 346   }
 347 }
 348
 349 /* -----------------------------------------------------------------------------
 350    Debugging
 351    -------------------------------------------------------------------------- */
 352
 353 #ifdef DEBUG
 354 static void
 355 checkWellFormedGroup( bdescr *bd )
 356 {
 357     nat i;
 358
 359     for (i = 1; i < bd->blocks; i++) {
 360         ASSERT(bd[i].blocks == 0);
 361         ASSERT(bd[i].free   == 0);
 362         ASSERT(bd[i].link   == bd);
 363     }
 364 }
 365
 366 void
 367 checkFreeListSanity(void)
 368 {
 369   bdescr *bd;
 370
 371   for (bd = free_list; bd != NULL; bd = bd->link) {
 372     IF_DEBUG(block_alloc,
 373              debugBelch("group at 0x%p, length %ld blocks\n",
 374                         bd->start, (long)bd->blocks));
 375     ASSERT(bd->blocks > 0);
 376     checkWellFormedGroup(bd);
 377     if (bd->link != NULL) {
 378       /* make sure we're fully coalesced */
 379       ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);
 380       ASSERT(bd->start < bd->link->start);
 381     }
 382   }
 383 }
 384
 385 nat /* BLOCKS */
 386 countFreeList(void)
 387 {
 388   bdescr *bd;
 389   lnat total_blocks = 0;
 390
 391   for (bd = free_list; bd != NULL; bd = bd->link) {
 392     total_blocks += bd->blocks;
 393   }
 394   return total_blocks;
 395 }
 396 #endif