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(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 #if 0
 335         if ((mblocks_allocated * MBLOCK_SIZE_W - n_alloc_blocks * BLOCK_SIZE_W) > (1024*1024)/sizeof(W_)) {
 336             debugBelch("Fragmentation, wanted %d blocks:", n);
 337             RtsFlags.DebugFlags.block_alloc = 1;
 338             checkFreeListSanity();
 339         }
 340 #endif
 341
 342         bd = alloc_mega_group(1);
 343         bd->blocks = n;
 344         initGroup(n,bd);                         // we know the group will fit
 345         rem = bd + n;
 346         rem->blocks = BLOCKS_PER_MBLOCK-n;
 347         initGroup(BLOCKS_PER_MBLOCK-n, rem); // init the slop
 348         n_alloc_blocks += rem->blocks;
 349         freeGroup(rem);                  // add the slop on to the free list
 350         IF_DEBUG(sanity, checkFreeListSanity());
 351         return bd;
 352     }
 353
 354     bd = free_list[ln];
 355
 356     if (bd->blocks == n)                // exactly the right size!
 357     {
 358         dbl_link_remove(bd, &free_list[ln]);
 359     }
 360     else if (bd->blocks >  n)            // block too big...
 361     {
 362         bd = split_free_block(bd, n, ln);
 363     }
 364     else
 365     {
 366         barf("allocGroup: free list corrupted");
 367     }
 368     initGroup(n, bd);           // initialise it
 369     IF_DEBUG(sanity, checkFreeListSanity());
 370     ASSERT(bd->blocks == n);
 371     return bd;
 372 }
 373
 374 bdescr *
 375 allocGroup_lock(nat n)
 376 {
 377     bdescr *bd;
 378     ACQUIRE_SM_LOCK;
 379     bd = allocGroup(n);
 380     RELEASE_SM_LOCK;
 381     return bd;
 382 }
 383
 384 bdescr *
 385 allocBlock(void)
 386 {
 387     return allocGroup(1);
 388 }
 389
 390 bdescr *
 391 allocBlock_lock(void)
 392 {
 393     bdescr *bd;
 394     ACQUIRE_SM_LOCK;
 395     bd = allocBlock();
 396     RELEASE_SM_LOCK;
 397     return bd;
 398 }
 399
 400 /* -----------------------------------------------------------------------------
 401    De-Allocation
 402    -------------------------------------------------------------------------- */
 403
 404 STATIC_INLINE bdescr *
 405 coalesce_mblocks (bdescr *p)
 406 {
 407     bdescr *q;
 408
 409     q = p->link;
 410     if (q != NULL &&
 411         MBLOCK_ROUND_DOWN(q) ==
 412         MBLOCK_ROUND_DOWN(p) + BLOCKS_TO_MBLOCKS(p->blocks) * MBLOCK_SIZE) {
 413         // can coalesce
 414         p->blocks  = MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks) +
 415                                          BLOCKS_TO_MBLOCKS(q->blocks));
 416         p->link = q->link;
 417         return p;
 418     }
 419     return q;
 420 }
 421
 422 static void
 423 free_mega_group (bdescr *mg)
 424 {
 425     bdescr *bd, *prev;
 426
 427     // Find the right place in the free list.  free_mblock_list is
 428     // sorted by *address*, not by size as the free_list is.
 429     prev = NULL;
 430     bd = free_mblock_list;
 431     while (bd && bd->start < mg->start) {
 432         prev = bd;
 433         bd = bd->link;
 434     }
 435
 436     // coalesce backwards
 437     if (prev)
 438     {
 439         mg->link = prev->link;
 440         prev->link = mg;
 441         mg = coalesce_mblocks(prev);
 442     }
 443     else
 444     {
 445         mg->link = free_mblock_list;
 446         free_mblock_list = mg;
 447     }
 448     // coalesce forwards
 449     coalesce_mblocks(mg);
 450
 451     IF_DEBUG(sanity, checkFreeListSanity());
 452 }
 453
 454
 455 void
 456 freeGroup(bdescr *p)
 457 {
 458   nat ln;
 459
 460   // Todo: not true in multithreaded GC
 461   // ASSERT_SM_LOCK();
 462
 463   ASSERT(p->free != (P_)-1);
 464
 465   n_alloc_blocks -= p->blocks;
 466
 467   p->free = (void *)-1;  /* indicates that this block is free */
 468   p->step = NULL;
 469   p->gen_no = 0;
 470   /* fill the block group with garbage if sanity checking is on */
 471   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
 472
 473   if (p->blocks == 0) barf("freeGroup: block size is zero");
 474
 475   if (p->blocks >= BLOCKS_PER_MBLOCK)
 476   {
 477       // If this is an mgroup, make sure it has the right number of blocks
 478       ASSERT(p->blocks == MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks)));
 479       free_mega_group(p);
 480       return;
 481   }
 482
 483   // coalesce forwards
 484   {
 485       bdescr *next;
 486       next = p + p->blocks;
 487       if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(p)) && next->free == (P_)-1)
 488       {
 489           p->blocks += next->blocks;
 490           ln = log_2(next->blocks);
 491           dbl_link_remove(next, &free_list[ln]);
 492           if (p->blocks == BLOCKS_PER_MBLOCK)
 493           {
 494               free_mega_group(p);
 495               return;
 496           }
 497           setup_tail(p);
 498       }
 499   }
 500
 501   // coalesce backwards
 502   if (p != FIRST_BDESCR(MBLOCK_ROUND_DOWN(p)))
 503   {
 504       bdescr *prev;
 505       prev = p - 1;
 506       if (prev->blocks == 0) prev = prev->link; // find the head
 507
 508       if (prev->free == (P_)-1)
 509       {
 510           ln = log_2(prev->blocks);
 511           dbl_link_remove(prev, &free_list[ln]);
 512           prev->blocks += p->blocks;
 513           if (prev->blocks >= BLOCKS_PER_MBLOCK)
 514           {
 515               free_mega_group(prev);
 516               return;
 517           }
 518           p = prev;
 519       }
 520   }
 521
 522   setup_tail(p);
 523   free_list_insert(p);
 524
 525   IF_DEBUG(sanity, checkFreeListSanity());
 526 }
 527
 528 void
 529 freeGroup_lock(bdescr *p)
 530 {
 531     ACQUIRE_SM_LOCK;
 532     freeGroup(p);
 533     RELEASE_SM_LOCK;
 534 }
 535
 536 void
 537 freeChain(bdescr *bd)
 538 {
 539   bdescr *next_bd;
 540   while (bd != NULL) {
 541     next_bd = bd->link;
 542     freeGroup(bd);
 543     bd = next_bd;
 544   }
 545 }
 546
 547 void
 548 freeChain_lock(bdescr *bd)
 549 {
 550     ACQUIRE_SM_LOCK;
 551     freeChain(bd);
 552     RELEASE_SM_LOCK;
 553 }
 554
 555 bdescr *
 556 splitBlockGroup (bdescr *bd, nat blocks)
 557 {
 558     bdescr *new_bd;
 559
 560     if (bd->blocks <= blocks) {
 561         barf("splitLargeBlock: too small");
 562     }
 563
 564     if (bd->blocks > BLOCKS_PER_MBLOCK) {
 565         nat mblocks;
 566         void *new_mblock;
 567         if ((blocks - BLOCKS_PER_MBLOCK) % (MBLOCK_SIZE / BLOCK_SIZE) != 0) {
 568             barf("splitLargeBlock: not a multiple of a megablock");
 569         }
 570         mblocks = 1 + (blocks - BLOCKS_PER_MBLOCK) / (MBLOCK_SIZE / BLOCK_SIZE);
 571         new_mblock = (void *) ((P_)MBLOCK_ROUND_DOWN(bd) + mblocks * MBLOCK_SIZE_W);
 572         initMBlock(new_mblock);
 573         new_bd = FIRST_BDESCR(new_mblock);
 574         new_bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
 575     }
 576     else
 577     {
 578         // NB. we're not updating all the bdescrs in the split groups to
 579         // point to the new heads, so this can only be used for large
 580         // objects which do not start in the non-head block.
 581         new_bd = bd + blocks;
 582         new_bd->blocks = bd->blocks - blocks;
 583     }
 584     bd->blocks = blocks;
 585
 586     return new_bd;
 587 }
 588
 589 static void
 590 initMBlock(void *mblock)
 591 {
 592   bdescr *bd;
 593   void *block;
 594
 595   /* the first few Bdescr's in a block are unused, so we don't want to
 596    * put them all on the free list.
 597    */
 598   block = FIRST_BLOCK(mblock);
 599   bd    = FIRST_BDESCR(mblock);
 600
 601   /* Initialise the start field of each block descriptor
 602    */
 603   for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
 604     bd->start = block;
 605   }
 606 }
 607
 608 /* -----------------------------------------------------------------------------
 609    Debugging
 610    -------------------------------------------------------------------------- */
 611
 612 #ifdef DEBUG
 613 static void
 614 check_tail (bdescr *bd)
 615 {
 616     bdescr *tail = tail_of(bd);
 617
 618     if (tail != bd)
 619     {
 620         ASSERT(tail->blocks == 0);
 621         ASSERT(tail->free == 0);
 622         ASSERT(tail->link == bd);
 623     }
 624 }
 625
 626 void
 627 checkFreeListSanity(void)
 628 {
 629     bdescr *bd, *prev;
 630     nat ln, min;
 631
 632
 633     min = 1;
 634     for (ln = 0; ln < MAX_FREE_LIST; ln++) {
 635         IF_DEBUG(block_alloc, debugBelch("free block list [%d]:\n", ln));
 636
 637         prev = NULL;
 638         for (bd = free_list[ln]; bd != NULL; prev = bd, bd = bd->link)
 639         {
 640             IF_DEBUG(block_alloc,
 641                      debugBelch("group at %p, length %ld blocks\n",
 642                                 bd->start, (long)bd->blocks));
 643             ASSERT(bd->free == (P_)-1);
 644             ASSERT(bd->blocks > 0 && bd->blocks < BLOCKS_PER_MBLOCK);
 645             ASSERT(bd->blocks >= min && bd->blocks <= (min*2 - 1));
 646             ASSERT(bd->link != bd); // catch easy loops
 647
 648             check_tail(bd);
 649
 650             if (prev)
 651                 ASSERT(bd->u.back == prev);
 652             else
 653                 ASSERT(bd->u.back == NULL);
 654
 655             {
 656                 bdescr *next;
 657                 next = bd + bd->blocks;
 658                 if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(bd)))
 659                 {
 660                     ASSERT(next->free != (P_)-1);
 661                 }
 662             }
 663         }
 664         min = min << 1;
 665     }
 666
 667     prev = NULL;
 668     for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
 669     {
 670         IF_DEBUG(block_alloc,
 671                  debugBelch("mega group at %p, length %ld blocks\n",
 672                             bd->start, (long)bd->blocks));
 673
 674         ASSERT(bd->link != bd); // catch easy loops
 675
 676         if (bd->link != NULL)
 677         {
 678             // make sure the list is sorted
 679             ASSERT(bd->start < bd->link->start);
 680         }
 681
 682         ASSERT(bd->blocks >= BLOCKS_PER_MBLOCK);
 683         ASSERT(MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(bd->blocks))
 684                == bd->blocks);
 685
 686         // make sure we're fully coalesced
 687         if (bd->link != NULL)
 688         {
 689             ASSERT (MBLOCK_ROUND_DOWN(bd->link) !=
 690                     MBLOCK_ROUND_DOWN(bd) +
 691                     BLOCKS_TO_MBLOCKS(bd->blocks) * MBLOCK_SIZE);
 692         }
 693     }
 694 }
 695
 696 nat /* BLOCKS */
 697 countFreeList(void)
 698 {
 699   bdescr *bd;
 700   lnat total_blocks = 0;
 701   nat ln;
 702
 703   for (ln=0; ln < MAX_FREE_LIST; ln++) {
 704       for (bd = free_list[ln]; bd != NULL; bd = bd->link) {
 705           total_blocks += bd->blocks;
 706       }
 707   }
 708   for (bd = free_mblock_list; bd != NULL; bd = bd->link) {
 709       total_blocks += BLOCKS_PER_MBLOCK * BLOCKS_TO_MBLOCKS(bd->blocks);
 710       // The caller of this function, memInventory(), expects to match
 711       // the total number of blocks in the system against mblocks *
 712       // BLOCKS_PER_MBLOCK, so we must subtract the space for the
 713       // block descriptors from *every* mblock.
 714   }
 715   return total_blocks;
 716 }
 717 #endif