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       /* no initialisation necessary - this is already a
  84        * self-contained block group. */
  85       bd->free = bd->start;     /* block isn't free now */
  86       bd->link = NULL;
  87       return bd;
  88     }
  89     if (bd->blocks >  n) {      /* block too big... */
  90       bd->blocks -= n;          /* take a chunk off the *end* */
  91       bd += bd->blocks;
  92       initGroup(n, bd);         /* initialise it */
  93       return bd;
  94     }
  95     last = &bd->link;
  96   }
  97
  98   mblock = getMBlock();         /* get a new megablock */
  99   initMBlock(mblock);           /* initialise the start fields */
 100   bd = FIRST_BDESCR(mblock);
 101   initGroup(n,bd);              /* we know the group will fit */
 102   if (n < BLOCKS_PER_MBLOCK) {
 103     initGroup(BLOCKS_PER_MBLOCK-n, bd+n);
 104     freeGroup(bd+n);            /* add the rest on to the free list */
 105   }
 106   return bd;
 107 }
 108
 109 bdescr *
 110 allocGroup_lock(nat n)
 111 {
 112     bdescr *bd;
 113     ACQUIRE_SM_LOCK;
 114     bd = allocGroup(n);
 115     RELEASE_SM_LOCK;
 116     return bd;
 117 }
 118
 119 bdescr *
 120 allocBlock(void)
 121 {
 122   return allocGroup(1);
 123 }
 124
 125 bdescr *
 126 allocBlock_lock(void)
 127 {
 128     bdescr *bd;
 129     ACQUIRE_SM_LOCK;
 130     bd = allocBlock();
 131     RELEASE_SM_LOCK;
 132     return bd;
 133 }
 134
 135 /* -----------------------------------------------------------------------------
 136    Any request larger than BLOCKS_PER_MBLOCK needs a megablock group.
 137    First, search the free list for enough contiguous megablocks to
 138    fulfill the request - if we don't have enough, we need to
 139    allocate some new ones.
 140
 141    A megablock group looks just like a normal block group, except that
 142    the blocks field in the head will be larger than BLOCKS_PER_MBLOCK.
 143
 144    Note that any objects placed in this group must start in the first
 145    megablock, since the other blocks don't have block descriptors.
 146    -------------------------------------------------------------------------- */
 147
 148 static bdescr *
 149 allocMegaGroup(nat n)
 150 {
 151   nat mbs_found;
 152   bdescr *bd, *last, *grp_start, *grp_prev;
 153
 154   mbs_found = 0;
 155   grp_start = NULL;
 156   grp_prev  = NULL;
 157   last      = NULL;
 158   for (bd = free_list; bd != NULL; bd = bd->link) {
 159
 160     if (bd->blocks == BLOCKS_PER_MBLOCK) {      /* whole megablock found */
 161
 162       /* is it the first one we've found or a non-contiguous megablock? */
 163       if (grp_start == NULL ||
 164           bd->start != last->start + MBLOCK_SIZE/sizeof(W_)) {
 165         grp_start = bd;
 166         grp_prev  = last;
 167         mbs_found = 1;
 168       } else {
 169         mbs_found++;
 170       }
 171
 172       if (mbs_found == n) {     /* found enough contig megablocks? */
 173         break;
 174       }
 175     }
 176
 177     else {                      /* only a partial megablock, start again */
 178       grp_start = NULL;
 179     }
 180
 181     last = bd;
 182   }
 183
 184   /* found all the megablocks we need on the free list
 185    */
 186   if (mbs_found == n) {
 187     /* remove the megablocks from the free list */
 188     if (grp_prev == NULL) {     /* bd now points to the last mblock */
 189       free_list = bd->link;
 190     } else {
 191       grp_prev->link = bd->link;
 192     }
 193   }
 194
 195   /* the free list wasn't sufficient, allocate all new mblocks.
 196    */
 197   else {
 198     void *mblock = getMBlocks(n);
 199     initMBlock(mblock);         /* only need to init the 1st one */
 200     grp_start = FIRST_BDESCR(mblock);
 201   }
 202
 203   /* set up the megablock group */
 204   initGroup(BLOCKS_PER_MBLOCK, grp_start);
 205   grp_start->blocks = MBLOCK_GROUP_BLOCKS(n);
 206   return grp_start;
 207 }
 208
 209 /* -----------------------------------------------------------------------------
 210    De-Allocation
 211    -------------------------------------------------------------------------- */
 212
 213 /* coalesce the group p with p->link if possible.
 214  *
 215  * Returns p->link if no coalescing was done, otherwise returns a
 216  * pointer to the newly enlarged group p.
 217  */
 218
 219 STATIC_INLINE bdescr *
 220 coalesce(bdescr *p)
 221 {
 222   bdescr *bd, *q;
 223   nat i, blocks;
 224
 225   q = p->link;
 226   if (q != NULL && p->start + p->blocks * BLOCK_SIZE_W == q->start) {
 227     /* can coalesce */
 228     p->blocks += q->blocks;
 229     p->link    = q->link;
 230     blocks = q->blocks;
 231     for (i = 0, bd = q; i < blocks; bd++, i++) {
 232         bd->free = 0;
 233         bd->blocks = 0;
 234         bd->link = p;
 235     }
 236     return p;
 237   }
 238   return q;
 239 }
 240
 241 void
 242 freeGroup(bdescr *p)
 243 {
 244   bdescr *bd, *last;
 245
 246   ASSERT_SM_LOCK();
 247
 248   /* are we dealing with a megablock group? */
 249   if (p->blocks > BLOCKS_PER_MBLOCK) {
 250     freeMegaGroup(p);
 251     return;
 252   }
 253
 254
 255   p->free = (void *)-1;  /* indicates that this block is free */
 256   p->step = NULL;
 257   p->gen_no = 0;
 258   /* fill the block group with garbage if sanity checking is on */
 259   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
 260
 261   /* find correct place in free list to place new group */
 262   last = NULL;
 263   for (bd = free_list; bd != NULL && bd->start < p->start;
 264        bd = bd->link) {
 265     last = bd;
 266   }
 267
 268   /* now, last = previous group (or NULL) */
 269   if (last == NULL) {
 270     p->link = free_list;
 271     free_list = p;
 272   } else {
 273     /* coalesce with previous group if possible */
 274     p->link = last->link;
 275     last->link = p;
 276     p = coalesce(last);
 277   }
 278
 279   /* coalesce with next group if possible */
 280   coalesce(p);
 281   IF_DEBUG(sanity, checkFreeListSanity());
 282 }
 283
 284 void
 285 freeGroup_lock(bdescr *p)
 286 {
 287     ACQUIRE_SM_LOCK;
 288     freeGroup(p);
 289     RELEASE_SM_LOCK;
 290 }
 291
 292 static void
 293 freeMegaGroup(bdescr *p)
 294 {
 295   nat n;
 296   void *q = p;
 297
 298   n = ((bdescr *)q)->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
 299   for (; n > 0; q += MBLOCK_SIZE, n--) {
 300     initMBlock(MBLOCK_ROUND_DOWN(q));
 301     initGroup(BLOCKS_PER_MBLOCK, (bdescr *)q);
 302     freeGroup((bdescr *)q);
 303   }
 304 }
 305
 306 void
 307 freeChain(bdescr *bd)
 308 {
 309   bdescr *next_bd;
 310   while (bd != NULL) {
 311     next_bd = bd->link;
 312     freeGroup(bd);
 313     bd = next_bd;
 314   }
 315 }
 316
 317 void
 318 freeChain_lock(bdescr *bd)
 319 {
 320     ACQUIRE_SM_LOCK;
 321     freeChain(bd);
 322     RELEASE_SM_LOCK;
 323 }
 324
 325 static void
 326 initMBlock(void *mblock)
 327 {
 328   bdescr *bd;
 329   void *block;
 330
 331   /* the first few Bdescr's in a block are unused, so we don't want to
 332    * put them all on the free list.
 333    */
 334   block = FIRST_BLOCK(mblock);
 335   bd    = FIRST_BDESCR(mblock);
 336
 337   /* Initialise the start field of each block descriptor
 338    */
 339   for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
 340     bd->start = block;
 341   }
 342 }
 343
 344 /* -----------------------------------------------------------------------------
 345    Debugging
 346    -------------------------------------------------------------------------- */
 347
 348 #ifdef DEBUG
 349 static void
 350 checkWellFormedGroup( bdescr *bd )
 351 {
 352     nat i;
 353
 354     for (i = 1; i < bd->blocks; i++) {
 355         ASSERT(bd[i].blocks == 0);
 356         ASSERT(bd[i].free   == 0);
 357         ASSERT(bd[i].link   == bd);
 358     }
 359 }
 360
 361 void
 362 checkFreeListSanity(void)
 363 {
 364   bdescr *bd;
 365
 366   for (bd = free_list; bd != NULL; bd = bd->link) {
 367     IF_DEBUG(block_alloc,
 368              debugBelch("group at 0x%p, length %ld blocks\n",
 369                         bd->start, (long)bd->blocks));
 370     ASSERT(bd->blocks > 0);
 371     checkWellFormedGroup(bd);
 372     if (bd->link != NULL) {
 373       /* make sure we're fully coalesced */
 374       ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);
 375       ASSERT(bd->start < bd->link->start);
 376     }
 377   }
 378 }
 379
 380 nat /* BLOCKS */
 381 countFreeList(void)
 382 {
 383   bdescr *bd;
 384   lnat total_blocks = 0;
 385
 386   for (bd = free_list; bd != NULL; bd = bd->link) {
 387     total_blocks += bd->blocks;
 388   }
 389   return total_blocks;
 390 }
 391 #endif