rts/sm/BlockAlloc.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team 1998-2008
   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(nat n);
  11  *
  12  * returns the address of an n*MBLOCK_SIZE region of memory, aligned on
  13  * an MBLOCK_SIZE boundary.  There are no other restrictions on the
  14  * addresses of memory returned by getMBlock().
  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
  30 // The free_list is kept sorted by size, smallest first.
  31 // In THREADED_RTS mode, the free list is protected by sm_mutex.
  32
  33 /* -----------------------------------------------------------------------------
  34
  35   Implementation notes
  36   ~~~~~~~~~~~~~~~~~~~~
  37
  38   Terminology:
  39     - bdescr = block descriptor
  40     - bgroup = block group (1 or more adjacent blocks)
  41     - mblock = mega block
  42     - mgroup = mega group (1 or more adjacent mblocks)
  43
  44    Invariants on block descriptors
  45    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  46    bd->start always points to the start of the block.
  47
  48    bd->free is either:
  49       - zero for a non-group-head; bd->link points to the head
  50       - (-1) for the head of a free block group
  51       - or it points within the block
  52
  53    bd->blocks is either:
  54       - zero for a non-group-head; bd->link points to the head
  55       - number of blocks in this group otherwise
  56
  57    bd->link either points to a block descriptor or is NULL
  58
  59    The following fields are not used by the allocator:
  60      bd->flags
  61      bd->gen_no
  62      bd->step
  63
  64   Exceptions: we don't maintain invariants for all the blocks within a
  65   group on the free list, because it is expensive to modify every
  66   bdescr in a group when coalescing.  Just the head and last bdescrs
  67   will be correct for a group on the free list.
  68
  69
  70   Free lists
  71   ~~~~~~~~~~
  72
  73   Preliminaries:
  74     - most allocations are for small blocks
  75     - sometimes the OS gives us new memory backwards in the address
  76       space, sometimes forwards, so we should not be biased towards
  77       any particular layout in the address space
  78     - We want to avoid fragmentation
  79     - We want allocation and freeing to be O(1) or close.
  80
  81   Coalescing trick: when a bgroup is freed (freeGroup()), we can check
  82   whether it can be coalesced with other free bgroups by checking the
  83   bdescrs for the blocks on either side of it.  This means that we can
  84   coalesce in O(1) time.  Every free bgroup must have its head and tail
  85   bdescrs initialised, the rest don't matter.
  86
  87   We keep the free list in buckets, using a heap-sort strategy.
  88   Bucket N contains blocks with sizes 2^N - 2^(N+1)-1.  The list of
  89   blocks in each bucket is doubly-linked, so that if a block is
  90   coalesced we can easily remove it from its current free list.
  91
  92   To allocate a new block of size S, grab a block from bucket
  93   log2ceiling(S) (i.e. log2() rounded up), in which all blocks are at
  94   least as big as S, and split it if necessary.  If there are no
  95   blocks in that bucket, look at bigger buckets until a block is found
  96   Allocation is therefore O(logN) time.
  97
  98   To free a block:
  99     - coalesce it with neighbours.
 100     - remove coalesced neighbour(s) from free list(s)
 101     - add the new (coalesced) block to the front of the appropriate
 102       bucket, given by log2(S) where S is the size of the block.
 103
 104   Free is O(1).
 105
 106   We cannot play this coalescing trick with mblocks, because there is
 107   no requirement that the bdescrs in the second and subsequent mblock
 108   of an mgroup are initialised (the mgroup might be filled with a
 109   large array, overwriting the bdescrs for example).
 110
 111   So there is a separate free list for megablocks, sorted in *address*
 112   order, so that we can coalesce.  Allocation in this list is best-fit
 113   by traversing the whole list: we don't expect this list to be long,
 114   and allocation/freeing of large blocks is rare; avoiding
 115   fragmentation is more important than performance here.
 116
 117   freeGroup() might end up moving a block from free_list to
 118   free_mblock_list, if after coalescing we end up with a full mblock.
 119
 120   checkFreeListSanity() checks all the invariants on the free lists.
 121
 122   --------------------------------------------------------------------------- */
 123
 124 #define MAX_FREE_LIST 9
 125
 126 static bdescr *free_list[MAX_FREE_LIST];
 127 static bdescr *free_mblock_list;
 128
 129 // free_list[i] contains blocks that are at least size 2^i, and at
 130 // most size 2^(i+1) - 1.
 131 //
 132 // To find the free list in which to place a block, use log_2(size).
 133 // To find a free block of the right size, use log_2_ceil(size).
 134
 135 lnat n_alloc_blocks;   // currently allocated blocks
 136 lnat hw_alloc_blocks;  // high-water allocated blocks
 137
 138 /* -----------------------------------------------------------------------------
 139    Initialisation
 140    -------------------------------------------------------------------------- */
 141
 142 void initBlockAllocator(void)
 143 {
 144     nat i;
 145     for (i=0; i < MAX_FREE_LIST; i++) {
 146         free_list[i] = NULL;
 147     }
 148     free_mblock_list = NULL;
 149     n_alloc_blocks = 0;
 150     hw_alloc_blocks = 0;
 151 }
 152
 153 /* -----------------------------------------------------------------------------
 154    Allocation
 155    -------------------------------------------------------------------------- */
 156
 157 STATIC_INLINE void
 158 initGroup(bdescr *head)
 159 {
 160   bdescr *bd;
 161   nat i, n;
 162
 163   n = head->blocks;
 164   head->free   = head->start;
 165   head->link   = NULL;
 166   for (i=1, bd = head+1; i < n; i++, bd++) {
 167       bd->free = 0;
 168       bd->blocks = 0;
 169       bd->link = head;
 170   }
 171 }
 172
 173 // There are quicker non-loopy ways to do log_2, but we expect n to be
 174 // usually small, and MAX_FREE_LIST is also small, so the loop version
 175 // might well be the best choice here.
 176 STATIC_INLINE nat
 177 log_2_ceil(nat n)
 178 {
 179     nat i, x;
 180     x = 1;
 181     for (i=0; i < MAX_FREE_LIST; i++) {
 182         if (x >= n) return i;
 183         x = x << 1;
 184     }
 185     return MAX_FREE_LIST;
 186 }
 187
 188 STATIC_INLINE nat
 189 log_2(nat n)
 190 {
 191     nat i, x;
 192     x = n;
 193     for (i=0; i < MAX_FREE_LIST; i++) {
 194         x = x >> 1;
 195         if (x == 0) return i;
 196     }
 197     return MAX_FREE_LIST;
 198 }
 199
 200 STATIC_INLINE void
 201 free_list_insert (bdescr *bd)
 202 {
 203     nat ln;
 204
 205     ASSERT(bd->blocks < BLOCKS_PER_MBLOCK);
 206     ln = log_2(bd->blocks);
 207
 208     dbl_link_onto(bd, &free_list[ln]);
 209 }
 210
 211
 212 STATIC_INLINE bdescr *
 213 tail_of (bdescr *bd)
 214 {
 215     return bd + bd->blocks - 1;
 216 }
 217
 218 // After splitting a group, the last block of each group must have a
 219 // tail that points to the head block, to keep our invariants for
 220 // coalescing.
 221 STATIC_INLINE void
 222 setup_tail (bdescr *bd)
 223 {
 224     bdescr *tail;
 225     tail = tail_of(bd);
 226     if (tail != bd) {
 227         tail->blocks = 0;
 228         tail->free = 0;
 229         tail->link = bd;
 230     }
 231 }
 232
 233
 234 // Take a free block group bd, and split off a group of size n from
 235 // it.  Adjust the free list as necessary, and return the new group.
 236 static bdescr *
 237 split_free_block (bdescr *bd, nat n, nat ln)
 238 {
 239     bdescr *fg; // free group
 240
 241     ASSERT(bd->blocks > n);
 242     dbl_link_remove(bd, &free_list[ln]);
 243     fg = bd + bd->blocks - n; // take n blocks off the end
 244     fg->blocks = n;
 245     bd->blocks -= n;
 246     setup_tail(bd);
 247     ln = log_2(bd->blocks);
 248     dbl_link_onto(bd, &free_list[ln]);
 249     return fg;
 250 }
 251
 252 static bdescr *
 253 alloc_mega_group (nat mblocks)
 254 {
 255     bdescr *best, *bd, *prev;
 256     nat n;
 257
 258     n = MBLOCK_GROUP_BLOCKS(mblocks);
 259
 260     best = NULL;
 261     prev = NULL;
 262     for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
 263     {
 264         if (bd->blocks == n)
 265         {
 266             if (prev) {
 267                 prev->link = bd->link;
 268             } else {
 269                 free_mblock_list = bd->link;
 270             }
 271             initGroup(bd);
 272             return bd;
 273         }
 274         else if (bd->blocks > n)
 275         {
 276             if (!best || bd->blocks < best->blocks)
 277             {
 278                 best = bd;
 279             }
 280         }
 281     }
 282
 283     if (best)
 284     {
 285         // we take our chunk off the end here.
 286         nat best_mblocks  = BLOCKS_TO_MBLOCKS(best->blocks);
 287         bd = FIRST_BDESCR(MBLOCK_ROUND_DOWN(best) +
 288                           (best_mblocks-mblocks)*MBLOCK_SIZE);
 289
 290         best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
 291         initMBlock(MBLOCK_ROUND_DOWN(bd));
 292     }
 293     else
 294     {
 295         void *mblock = getMBlocks(mblocks);
 296         initMBlock(mblock);             // only need to init the 1st one
 297         bd = FIRST_BDESCR(mblock);
 298     }
 299     bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
 300     return bd;
 301 }
 302
 303 bdescr *
 304 allocGroup (nat n)
 305 {
 306     bdescr *bd, *rem;
 307     nat ln;
 308
 309     // Todo: not true in multithreaded GC, where we use allocBlock_sync().
 310     // ASSERT_SM_LOCK();
 311
 312     if (n == 0) barf("allocGroup: requested zero blocks");
 313
 314     n_alloc_blocks += n;
 315     if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
 316
 317     if (n >= BLOCKS_PER_MBLOCK)
 318     {
 319         bd = alloc_mega_group(BLOCKS_TO_MBLOCKS(n));
 320         // only the bdescrs of the first MB are required to be initialised
 321         initGroup(bd);
 322         IF_DEBUG(sanity, checkFreeListSanity());
 323         return bd;
 324     }
 325
 326     ln = log_2_ceil(n);
 327
 328     while (free_list[ln] == NULL && ln < MAX_FREE_LIST) {
 329         ln++;
 330     }
 331
 332     if (ln == MAX_FREE_LIST) {
 333 #if 0
 334         if ((mblocks_allocated * MBLOCK_SIZE_W - n_alloc_blocks * BLOCK_SIZE_W) > (1024*1024)/sizeof(W_)) {
 335             debugBelch("Fragmentation, wanted %d blocks:", n);
 336             RtsFlags.DebugFlags.block_alloc = 1;
 337             checkFreeListSanity();
 338         }
 339 #endif
 340
 341         bd = alloc_mega_group(1);
 342         bd->blocks = n;
 343         initGroup(bd);                   // we know the group will fit
 344         rem = bd + n;
 345         rem->blocks = BLOCKS_PER_MBLOCK-n;
 346         initGroup(rem); // init the slop
 347         n_alloc_blocks += rem->blocks;
 348         freeGroup(rem);                  // add the slop on to the free list
 349         IF_DEBUG(sanity, checkFreeListSanity());
 350         return bd;
 351     }
 352
 353     bd = free_list[ln];
 354
 355     if (bd->blocks == n)                // exactly the right size!
 356     {
 357         dbl_link_remove(bd, &free_list[ln]);
 358     }
 359     else if (bd->blocks >  n)            // block too big...
 360     {
 361         bd = split_free_block(bd, n, ln);
 362     }
 363     else
 364     {
 365         barf("allocGroup: free list corrupted");
 366     }
 367     initGroup(bd);              // initialise it
 368     IF_DEBUG(sanity, checkFreeListSanity());
 369     ASSERT(bd->blocks == n);
 370     return bd;
 371 }
 372
 373 bdescr *
 374 allocGroup_lock(nat n)
 375 {
 376     bdescr *bd;
 377     ACQUIRE_SM_LOCK;
 378     bd = allocGroup(n);
 379     RELEASE_SM_LOCK;
 380     return bd;
 381 }
 382
 383 bdescr *
 384 allocBlock(void)
 385 {
 386     return allocGroup(1);
 387 }
 388
 389 bdescr *
 390 allocBlock_lock(void)
 391 {
 392     bdescr *bd;
 393     ACQUIRE_SM_LOCK;
 394     bd = allocBlock();
 395     RELEASE_SM_LOCK;
 396     return bd;
 397 }
 398
 399 /* -----------------------------------------------------------------------------
 400    De-Allocation
 401    -------------------------------------------------------------------------- */
 402
 403 STATIC_INLINE bdescr *
 404 coalesce_mblocks (bdescr *p)
 405 {
 406     bdescr *q;
 407
 408     q = p->link;
 409     if (q != NULL &&
 410         MBLOCK_ROUND_DOWN(q) ==
 411         MBLOCK_ROUND_DOWN(p) + BLOCKS_TO_MBLOCKS(p->blocks) * MBLOCK_SIZE) {
 412         // can coalesce
 413         p->blocks  = MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks) +
 414                                          BLOCKS_TO_MBLOCKS(q->blocks));
 415         p->link = q->link;
 416         return p;
 417     }
 418     return q;
 419 }
 420
 421 static void
 422 free_mega_group (bdescr *mg)
 423 {
 424     bdescr *bd, *prev;
 425
 426     // Find the right place in the free list.  free_mblock_list is
 427     // sorted by *address*, not by size as the free_list is.
 428     prev = NULL;
 429     bd = free_mblock_list;
 430     while (bd && bd->start < mg->start) {
 431         prev = bd;
 432         bd = bd->link;
 433     }
 434
 435     // coalesce backwards
 436     if (prev)
 437     {
 438         mg->link = prev->link;
 439         prev->link = mg;
 440         mg = coalesce_mblocks(prev);
 441     }
 442     else
 443     {
 444         mg->link = free_mblock_list;
 445         free_mblock_list = mg;
 446     }
 447     // coalesce forwards
 448     coalesce_mblocks(mg);
 449
 450     IF_DEBUG(sanity, checkFreeListSanity());
 451 }
 452
 453
 454 void
 455 freeGroup(bdescr *p)
 456 {
 457   nat ln;
 458
 459   // Todo: not true in multithreaded GC
 460   // ASSERT_SM_LOCK();
 461
 462   ASSERT(p->free != (P_)-1);
 463
 464   n_alloc_blocks -= p->blocks;
 465
 466   p->free = (void *)-1;  /* indicates that this block is free */
 467   p->step = NULL;
 468   p->gen_no = 0;
 469   /* fill the block group with garbage if sanity checking is on */
 470   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
 471
 472   if (p->blocks == 0) barf("freeGroup: block size is zero");
 473
 474   if (p->blocks >= BLOCKS_PER_MBLOCK)
 475   {
 476       // If this is an mgroup, make sure it has the right number of blocks
 477       ASSERT(p->blocks == MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks)));
 478       free_mega_group(p);
 479       return;
 480   }
 481
 482   // coalesce forwards
 483   {
 484       bdescr *next;
 485       next = p + p->blocks;
 486       if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(p)) && next->free == (P_)-1)
 487       {
 488           p->blocks += next->blocks;
 489           ln = log_2(next->blocks);
 490           dbl_link_remove(next, &free_list[ln]);
 491           if (p->blocks == BLOCKS_PER_MBLOCK)
 492           {
 493               free_mega_group(p);
 494               return;
 495           }
 496           setup_tail(p);
 497       }
 498   }
 499
 500   // coalesce backwards
 501   if (p != FIRST_BDESCR(MBLOCK_ROUND_DOWN(p)))
 502   {
 503       bdescr *prev;
 504       prev = p - 1;
 505       if (prev->blocks == 0) prev = prev->link; // find the head
 506
 507       if (prev->free == (P_)-1)
 508       {
 509           ln = log_2(prev->blocks);
 510           dbl_link_remove(prev, &free_list[ln]);
 511           prev->blocks += p->blocks;
 512           if (prev->blocks >= BLOCKS_PER_MBLOCK)
 513           {
 514               free_mega_group(prev);
 515               return;
 516           }
 517           p = prev;
 518       }
 519   }
 520
 521   setup_tail(p);
 522   free_list_insert(p);
 523
 524   IF_DEBUG(sanity, checkFreeListSanity());
 525 }
 526
 527 void
 528 freeGroup_lock(bdescr *p)
 529 {
 530     ACQUIRE_SM_LOCK;
 531     freeGroup(p);
 532     RELEASE_SM_LOCK;
 533 }
 534
 535 void
 536 freeChain(bdescr *bd)
 537 {
 538   bdescr *next_bd;
 539   while (bd != NULL) {
 540     next_bd = bd->link;
 541     freeGroup(bd);
 542     bd = next_bd;
 543   }
 544 }
 545
 546 void
 547 freeChain_lock(bdescr *bd)
 548 {
 549     ACQUIRE_SM_LOCK;
 550     freeChain(bd);
 551     RELEASE_SM_LOCK;
 552 }
 553
 554 bdescr *
 555 splitBlockGroup (bdescr *bd, nat blocks)
 556 {
 557     bdescr *new_bd;
 558
 559     if (bd->blocks <= blocks) {
 560         barf("splitLargeBlock: too small");
 561     }
 562
 563     if (bd->blocks > BLOCKS_PER_MBLOCK) {
 564         nat mblocks;
 565         void *new_mblock;
 566         if ((blocks - BLOCKS_PER_MBLOCK) % (MBLOCK_SIZE / BLOCK_SIZE) != 0) {
 567             barf("splitLargeBlock: not a multiple of a megablock");
 568         }
 569         mblocks = 1 + (blocks - BLOCKS_PER_MBLOCK) / (MBLOCK_SIZE / BLOCK_SIZE);
 570         new_mblock = (void *) ((P_)MBLOCK_ROUND_DOWN(bd) + mblocks * MBLOCK_SIZE_W);
 571         initMBlock(new_mblock);
 572         new_bd = FIRST_BDESCR(new_mblock);
 573         new_bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
 574     }
 575     else
 576     {
 577         // NB. we're not updating all the bdescrs in the split groups to
 578         // point to the new heads, so this can only be used for large
 579         // objects which do not start in the non-head block.
 580         new_bd = bd + blocks;
 581         new_bd->blocks = bd->blocks - blocks;
 582     }
 583     bd->blocks = blocks;
 584
 585     return new_bd;
 586 }
 587
 588 static void
 589 initMBlock(void *mblock)
 590 {
 591   bdescr *bd;
 592   void *block;
 593
 594   /* the first few Bdescr's in a block are unused, so we don't want to
 595    * put them all on the free list.
 596    */
 597   block = FIRST_BLOCK(mblock);
 598   bd    = FIRST_BDESCR(mblock);
 599
 600   /* Initialise the start field of each block descriptor
 601    */
 602   for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
 603     bd->start = block;
 604   }
 605 }
 606
 607 /* -----------------------------------------------------------------------------
 608    Debugging
 609    -------------------------------------------------------------------------- */
 610
 611 #ifdef DEBUG
 612 static void
 613 check_tail (bdescr *bd)
 614 {
 615     bdescr *tail = tail_of(bd);
 616
 617     if (tail != bd)
 618     {
 619         ASSERT(tail->blocks == 0);
 620         ASSERT(tail->free == 0);
 621         ASSERT(tail->link == bd);
 622     }
 623 }
 624
 625 void
 626 checkFreeListSanity(void)
 627 {
 628     bdescr *bd, *prev;
 629     nat ln, min;
 630
 631
 632     min = 1;
 633     for (ln = 0; ln < MAX_FREE_LIST; ln++) {
 634         IF_DEBUG(block_alloc, debugBelch("free block list [%d]:\n", ln));
 635
 636         prev = NULL;
 637         for (bd = free_list[ln]; bd != NULL; prev = bd, bd = bd->link)
 638         {
 639             IF_DEBUG(block_alloc,
 640                      debugBelch("group at %p, length %ld blocks\n",
 641                                 bd->start, (long)bd->blocks));
 642             ASSERT(bd->free == (P_)-1);
 643             ASSERT(bd->blocks > 0 && bd->blocks < BLOCKS_PER_MBLOCK);
 644             ASSERT(bd->blocks >= min && bd->blocks <= (min*2 - 1));
 645             ASSERT(bd->link != bd); // catch easy loops
 646
 647             check_tail(bd);
 648
 649             if (prev)
 650                 ASSERT(bd->u.back == prev);
 651             else
 652                 ASSERT(bd->u.back == NULL);
 653
 654             {
 655                 bdescr *next;
 656                 next = bd + bd->blocks;
 657                 if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(bd)))
 658                 {
 659                     ASSERT(next->free != (P_)-1);
 660                 }
 661             }
 662         }
 663         min = min << 1;
 664     }
 665
 666     prev = NULL;
 667     for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
 668     {
 669         IF_DEBUG(block_alloc,
 670                  debugBelch("mega group at %p, length %ld blocks\n",
 671                             bd->start, (long)bd->blocks));
 672
 673         ASSERT(bd->link != bd); // catch easy loops
 674
 675         if (bd->link != NULL)
 676         {
 677             // make sure the list is sorted
 678             ASSERT(bd->start < bd->link->start);
 679         }
 680
 681         ASSERT(bd->blocks >= BLOCKS_PER_MBLOCK);
 682         ASSERT(MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(bd->blocks))
 683                == bd->blocks);
 684
 685         // make sure we're fully coalesced
 686         if (bd->link != NULL)
 687         {
 688             ASSERT (MBLOCK_ROUND_DOWN(bd->link) !=
 689                     MBLOCK_ROUND_DOWN(bd) +
 690                     BLOCKS_TO_MBLOCKS(bd->blocks) * MBLOCK_SIZE);
 691         }
 692     }
 693 }
 694
 695 nat /* BLOCKS */
 696 countFreeList(void)
 697 {
 698   bdescr *bd;
 699   lnat total_blocks = 0;
 700   nat ln;
 701
 702   for (ln=0; ln < MAX_FREE_LIST; ln++) {
 703       for (bd = free_list[ln]; bd != NULL; bd = bd->link) {
 704           total_blocks += bd->blocks;
 705       }
 706   }
 707   for (bd = free_mblock_list; bd != NULL; bd = bd->link) {
 708       total_blocks += BLOCKS_PER_MBLOCK * BLOCKS_TO_MBLOCKS(bd->blocks);
 709       // The caller of this function, memInventory(), expects to match
 710       // the total number of blocks in the system against mblocks *
 711       // BLOCKS_PER_MBLOCK, so we must subtract the space for the
 712       // block descriptors from *every* mblock.
 713   }
 714   return total_blocks;
 715 }
 716 #endif