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(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(nat n, bdescr *head)
 159 {
 160   bdescr *bd;
 161   nat i;
 162
 163   if (n != 0) {
 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
 174 // There are quicker non-loopy ways to do log_2, but we expect n to be
 175 // usually small, and MAX_FREE_LIST is also small, so the loop version
 176 // might well be the best choice here.
 177 STATIC_INLINE nat
 178 log_2_ceil(nat n)
 179 {
 180     nat i, x;
 181     x = 1;
 182     for (i=0; i < MAX_FREE_LIST; i++) {
 183         if (x >= n) return i;
 184         x = x << 1;
 185     }
 186     return MAX_FREE_LIST;
 187 }
 188
 189 STATIC_INLINE nat
 190 log_2(nat n)
 191 {
 192     nat i, x;
 193     x = n;
 194     for (i=0; i < MAX_FREE_LIST; i++) {
 195         x = x >> 1;
 196         if (x == 0) return i;
 197     }
 198     return MAX_FREE_LIST;
 199 }
 200
 201 STATIC_INLINE void
 202 free_list_insert (bdescr *bd)
 203 {
 204     nat ln;
 205
 206     ASSERT(bd->blocks < BLOCKS_PER_MBLOCK);
 207     ln = log_2(bd->blocks);
 208
 209     dbl_link_onto(bd, &free_list[ln]);
 210 }
 211
 212
 213 STATIC_INLINE bdescr *
 214 tail_of (bdescr *bd)
 215 {
 216     return bd + bd->blocks - 1;
 217 }
 218
 219 // After splitting a group, the last block of each group must have a
 220 // tail that points to the head block, to keep our invariants for
 221 // coalescing.
 222 STATIC_INLINE void
 223 setup_tail (bdescr *bd)
 224 {
 225     bdescr *tail;
 226     tail = tail_of(bd);
 227     if (tail != bd) {
 228         tail->blocks = 0;
 229         tail->free = 0;
 230         tail->link = bd;
 231     }
 232 }
 233
 234
 235 // Take a free block group bd, and split off a group of size n from
 236 // it.  Adjust the free list as necessary, and return the new group.
 237 static bdescr *
 238 split_free_block (bdescr *bd, nat n, nat ln)
 239 {
 240     bdescr *fg; // free group
 241
 242     ASSERT(bd->blocks > n);
 243     dbl_link_remove(bd, &free_list[ln]);
 244     fg = bd + bd->blocks - n; // take n blocks off the end
 245     fg->blocks = n;
 246     bd->blocks -= n;
 247     setup_tail(bd);
 248     ln = log_2(bd->blocks);
 249     dbl_link_onto(bd, &free_list[ln]);
 250     return fg;
 251 }
 252
 253 static bdescr *
 254 alloc_mega_group (nat mblocks)
 255 {
 256     bdescr *best, *bd, *prev;
 257     nat n;
 258
 259     n = MBLOCK_GROUP_BLOCKS(mblocks);
 260
 261     best = NULL;
 262     prev = NULL;
 263     for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
 264     {
 265         if (bd->blocks == n)
 266         {
 267             if (prev) {
 268                 prev->link = bd->link;
 269             } else {
 270                 free_mblock_list = bd->link;
 271             }
 272             initGroup(n, bd);
 273             return bd;
 274         }
 275         else if (bd->blocks > n)
 276         {
 277             if (!best || bd->blocks < best->blocks)
 278             {
 279                 best = bd;
 280             }
 281         }
 282     }
 283
 284     if (best)
 285     {
 286         // we take our chunk off the end here.
 287         nat best_mblocks  = BLOCKS_TO_MBLOCKS(best->blocks);
 288         bd = FIRST_BDESCR(MBLOCK_ROUND_DOWN(best) +
 289                           (best_mblocks-mblocks)*MBLOCK_SIZE);
 290
 291         best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
 292         initMBlock(MBLOCK_ROUND_DOWN(bd));
 293     }
 294     else
 295     {
 296         void *mblock = getMBlocks(mblocks);
 297         initMBlock(mblock);             // only need to init the 1st one
 298         bd = FIRST_BDESCR(mblock);
 299     }
 300     bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
 301     return bd;
 302 }
 303
 304 bdescr *
 305 allocGroup (nat n)
 306 {
 307     bdescr *bd, *rem;
 308     nat ln;
 309
 310     // Todo: not true in multithreaded GC, where we use allocBlock_sync().
 311     // ASSERT_SM_LOCK();
 312
 313     if (n == 0) barf("allocGroup: requested zero blocks");
 314
 315     n_alloc_blocks += n;
 316     if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
 317
 318     if (n >= BLOCKS_PER_MBLOCK)
 319     {
 320         bd = alloc_mega_group(BLOCKS_TO_MBLOCKS(n));
 321         // only the bdescrs of the first MB are required to be initialised
 322         initGroup(BLOCKS_PER_MBLOCK, bd);
 323         IF_DEBUG(sanity, checkFreeListSanity());
 324         return bd;
 325     }
 326
 327     ln = log_2_ceil(n);
 328
 329     while (free_list[ln] == NULL && ln < MAX_FREE_LIST) {
 330         ln++;
 331     }
 332
 333     if (ln == MAX_FREE_LIST) {
 334         bd = alloc_mega_group(1);
 335         bd->blocks = n;
 336         initGroup(n,bd);                         // we know the group will fit
 337         rem = bd + n;
 338         rem->blocks = BLOCKS_PER_MBLOCK-n;
 339         initGroup(BLOCKS_PER_MBLOCK-n, rem); // init the slop
 340         n_alloc_blocks += rem->blocks;
 341         freeGroup(rem);                  // add the slop on to the free list
 342         IF_DEBUG(sanity, checkFreeListSanity());
 343         return bd;
 344     }
 345
 346     bd = free_list[ln];
 347
 348     if (bd->blocks == n)                // exactly the right size!
 349     {
 350         dbl_link_remove(bd, &free_list[ln]);
 351     }
 352     else if (bd->blocks >  n)            // block too big...
 353     {
 354         bd = split_free_block(bd, n, ln);
 355     }
 356     else
 357     {
 358         barf("allocGroup: free list corrupted");
 359     }
 360     initGroup(n, bd);           // initialise it
 361     IF_DEBUG(sanity, checkFreeListSanity());
 362     ASSERT(bd->blocks == n);
 363     return bd;
 364 }
 365
 366 bdescr *
 367 allocGroup_lock(nat n)
 368 {
 369     bdescr *bd;
 370     ACQUIRE_SM_LOCK;
 371     bd = allocGroup(n);
 372     RELEASE_SM_LOCK;
 373     return bd;
 374 }
 375
 376 bdescr *
 377 allocBlock(void)
 378 {
 379     return allocGroup(1);
 380 }
 381
 382 bdescr *
 383 allocBlock_lock(void)
 384 {
 385     bdescr *bd;
 386     ACQUIRE_SM_LOCK;
 387     bd = allocBlock();
 388     RELEASE_SM_LOCK;
 389     return bd;
 390 }
 391
 392 /* -----------------------------------------------------------------------------
 393    De-Allocation
 394    -------------------------------------------------------------------------- */
 395
 396 STATIC_INLINE bdescr *
 397 coalesce_mblocks (bdescr *p)
 398 {
 399     bdescr *q;
 400
 401     q = p->link;
 402     if (q != NULL &&
 403         MBLOCK_ROUND_DOWN(q) ==
 404         MBLOCK_ROUND_DOWN(p) + BLOCKS_TO_MBLOCKS(p->blocks) * MBLOCK_SIZE) {
 405         // can coalesce
 406         p->blocks  = MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks) +
 407                                          BLOCKS_TO_MBLOCKS(q->blocks));
 408         p->link = q->link;
 409         return p;
 410     }
 411     return q;
 412 }
 413
 414 static void
 415 free_mega_group (bdescr *mg)
 416 {
 417     bdescr *bd, *prev;
 418
 419     // Find the right place in the free list.  free_mblock_list is
 420     // sorted by *address*, not by size as the free_list is.
 421     prev = NULL;
 422     bd = free_mblock_list;
 423     while (bd && bd->start < mg->start) {
 424         prev = bd;
 425         bd = bd->link;
 426     }
 427
 428     // coalesce backwards
 429     if (prev)
 430     {
 431         mg->link = prev->link;
 432         prev->link = mg;
 433         mg = coalesce_mblocks(prev);
 434     }
 435     else
 436     {
 437         mg->link = free_mblock_list;
 438         free_mblock_list = mg;
 439     }
 440     // coalesce forwards
 441     coalesce_mblocks(mg);
 442
 443     IF_DEBUG(sanity, checkFreeListSanity());
 444 }
 445
 446
 447 void
 448 freeGroup(bdescr *p)
 449 {
 450   nat ln;
 451
 452   // Todo: not true in multithreaded GC
 453   // ASSERT_SM_LOCK();
 454
 455   ASSERT(p->free != (P_)-1);
 456
 457   n_alloc_blocks -= p->blocks;
 458
 459   p->free = (void *)-1;  /* indicates that this block is free */
 460   p->step = NULL;
 461   p->gen_no = 0;
 462   /* fill the block group with garbage if sanity checking is on */
 463   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
 464
 465   if (p->blocks == 0) barf("freeGroup: block size is zero");
 466
 467   if (p->blocks >= BLOCKS_PER_MBLOCK)
 468   {
 469       // If this is an mgroup, make sure it has the right number of blocks
 470       ASSERT(p->blocks == MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks)));
 471       free_mega_group(p);
 472       return;
 473   }
 474
 475   // coalesce forwards
 476   {
 477       bdescr *next;
 478       next = p + p->blocks;
 479       if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(p)) && next->free == (P_)-1)
 480       {
 481           p->blocks += next->blocks;
 482           ln = log_2(next->blocks);
 483           dbl_link_remove(next, &free_list[ln]);
 484           if (p->blocks == BLOCKS_PER_MBLOCK)
 485           {
 486               free_mega_group(p);
 487               return;
 488           }
 489           setup_tail(p);
 490       }
 491   }
 492
 493   // coalesce backwards
 494   if (p != FIRST_BDESCR(MBLOCK_ROUND_DOWN(p)))
 495   {
 496       bdescr *prev;
 497       prev = p - 1;
 498       if (prev->blocks == 0) prev = prev->link; // find the head
 499
 500       if (prev->free == (P_)-1)
 501       {
 502           ln = log_2(prev->blocks);
 503           dbl_link_remove(prev, &free_list[ln]);
 504           prev->blocks += p->blocks;
 505           if (prev->blocks >= BLOCKS_PER_MBLOCK)
 506           {
 507               free_mega_group(prev);
 508               return;
 509           }
 510           p = prev;
 511       }
 512   }
 513
 514   setup_tail(p);
 515   free_list_insert(p);
 516
 517   IF_DEBUG(sanity, checkFreeListSanity());
 518 }
 519
 520 void
 521 freeGroup_lock(bdescr *p)
 522 {
 523     ACQUIRE_SM_LOCK;
 524     freeGroup(p);
 525     RELEASE_SM_LOCK;
 526 }
 527
 528 void
 529 freeChain(bdescr *bd)
 530 {
 531   bdescr *next_bd;
 532   while (bd != NULL) {
 533     next_bd = bd->link;
 534     freeGroup(bd);
 535     bd = next_bd;
 536   }
 537 }
 538
 539 void
 540 freeChain_lock(bdescr *bd)
 541 {
 542     ACQUIRE_SM_LOCK;
 543     freeChain(bd);
 544     RELEASE_SM_LOCK;
 545 }
 546
 547 bdescr *
 548 splitBlockGroup (bdescr *bd, nat blocks)
 549 {
 550     bdescr *new_bd;
 551
 552     if (bd->blocks <= blocks) {
 553         barf("splitLargeBlock: too small");
 554     }
 555
 556     if (bd->blocks > BLOCKS_PER_MBLOCK) {
 557         nat mblocks;
 558         void *new_mblock;
 559         if ((blocks - BLOCKS_PER_MBLOCK) % (MBLOCK_SIZE / BLOCK_SIZE) != 0) {
 560             barf("splitLargeBlock: not a multiple of a megablock");
 561         }
 562         mblocks = 1 + (blocks - BLOCKS_PER_MBLOCK) / (MBLOCK_SIZE / BLOCK_SIZE);
 563         new_mblock = (void *) ((P_)MBLOCK_ROUND_DOWN(bd) + mblocks * MBLOCK_SIZE_W);
 564         initMBlock(new_mblock);
 565         new_bd = FIRST_BDESCR(new_mblock);
 566         new_bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
 567     }
 568     else
 569     {
 570         // NB. we're not updating all the bdescrs in the split groups to
 571         // point to the new heads, so this can only be used for large
 572         // objects which do not start in the non-head block.
 573         new_bd = bd + blocks;
 574         new_bd->blocks = bd->blocks - blocks;
 575     }
 576     bd->blocks = blocks;
 577
 578     return new_bd;
 579 }
 580
 581 static void
 582 initMBlock(void *mblock)
 583 {
 584   bdescr *bd;
 585   void *block;
 586
 587   /* the first few Bdescr's in a block are unused, so we don't want to
 588    * put them all on the free list.
 589    */
 590   block = FIRST_BLOCK(mblock);
 591   bd    = FIRST_BDESCR(mblock);
 592
 593   /* Initialise the start field of each block descriptor
 594    */
 595   for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
 596     bd->start = block;
 597   }
 598 }
 599
 600 /* -----------------------------------------------------------------------------
 601    Debugging
 602    -------------------------------------------------------------------------- */
 603
 604 #ifdef DEBUG
 605 static void
 606 check_tail (bdescr *bd)
 607 {
 608     bdescr *tail = tail_of(bd);
 609
 610     if (tail != bd)
 611     {
 612         ASSERT(tail->blocks == 0);
 613         ASSERT(tail->free == 0);
 614         ASSERT(tail->link == bd);
 615     }
 616 }
 617
 618 void
 619 checkFreeListSanity(void)
 620 {
 621     bdescr *bd, *prev;
 622     nat ln, min;
 623
 624
 625     min = 1;
 626     for (ln = 0; ln < MAX_FREE_LIST; ln++) {
 627         IF_DEBUG(block_alloc, debugBelch("free block list [%d]:\n", ln));
 628
 629         prev = NULL;
 630         for (bd = free_list[ln]; bd != NULL; prev = bd, bd = bd->link)
 631         {
 632             IF_DEBUG(block_alloc,
 633                      debugBelch("group at %p, length %ld blocks\n",
 634                                 bd->start, (long)bd->blocks));
 635             ASSERT(bd->free == (P_)-1);
 636             ASSERT(bd->blocks > 0 && bd->blocks < BLOCKS_PER_MBLOCK);
 637             ASSERT(bd->blocks >= min && bd->blocks <= (min*2 - 1));
 638             ASSERT(bd->link != bd); // catch easy loops
 639
 640             check_tail(bd);
 641
 642             if (prev)
 643                 ASSERT(bd->u.back == prev);
 644             else
 645                 ASSERT(bd->u.back == NULL);
 646
 647             {
 648                 bdescr *next;
 649                 next = bd + bd->blocks;
 650                 if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(bd)))
 651                 {
 652                     ASSERT(next->free != (P_)-1);
 653                 }
 654             }
 655         }
 656         min = min << 1;
 657     }
 658
 659     prev = NULL;
 660     for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
 661     {
 662         IF_DEBUG(block_alloc,
 663                  debugBelch("mega group at %p, length %ld blocks\n",
 664                             bd->start, (long)bd->blocks));
 665
 666         ASSERT(bd->link != bd); // catch easy loops
 667
 668         if (bd->link != NULL)
 669         {
 670             // make sure the list is sorted
 671             ASSERT(bd->start < bd->link->start);
 672         }
 673
 674         ASSERT(bd->blocks >= BLOCKS_PER_MBLOCK);
 675         ASSERT(MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(bd->blocks))
 676                == bd->blocks);
 677
 678         // make sure we're fully coalesced
 679         if (bd->link != NULL)
 680         {
 681             ASSERT (MBLOCK_ROUND_DOWN(bd->link) !=
 682                     MBLOCK_ROUND_DOWN(bd) +
 683                     BLOCKS_TO_MBLOCKS(bd->blocks) * MBLOCK_SIZE);
 684         }
 685     }
 686 }
 687
 688 nat /* BLOCKS */
 689 countFreeList(void)
 690 {
 691   bdescr *bd;
 692   lnat total_blocks = 0;
 693   nat ln;
 694
 695   for (ln=0; ln < MAX_FREE_LIST; ln++) {
 696       for (bd = free_list[ln]; bd != NULL; bd = bd->link) {
 697           total_blocks += bd->blocks;
 698       }
 699   }
 700   for (bd = free_mblock_list; bd != NULL; bd = bd->link) {
 701       total_blocks += BLOCKS_PER_MBLOCK * BLOCKS_TO_MBLOCKS(bd->blocks);
 702       // The caller of this function, memInventory(), expects to match
 703       // the total number of blocks in the system against mblocks *
 704       // BLOCKS_PER_MBLOCK, so we must subtract the space for the
 705       // block descriptors from *every* mblock.
 706   }
 707   return total_blocks;
 708 }
 709 #endif