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   Preliminaries:
  73     - most allocations are for single blocks
  74     - we cannot be dependent on address-space ordering; sometimes the
  75       OS gives us new memory backwards in the address space, sometimes
  76       forwards
  77     - We want to avoid fragmentation in the free list
  78
  79   Coalescing trick: when a bgroup is freed (freeGroup()), we can check
  80   whether it can be coalesced with othre free bgroups by checking the
  81   bdescrs for the blocks on either side of it.  This means that:
  82
  83     - freeGroup is O(1) if we coalesce with an existing free block
  84       group.  Otherwise we have to insert in the free list, but since
  85       most blocks are small and the free list is sorted by size, this
  86       is usually quick.
  87     - the free list must be double-linked, so we can insert into the
  88       middle.
  89     - every free group in the free list must have its head and tail
  90       bdescrs initialised, the rest don't matter.
  91     - we cannot play this trick with mblocks, because there is no
  92       requirement that the bdescrs in the second and subsequent mblock
  93       of an mgroup are initialised (the mgroup might be filled with a
  94       large array, overwriting the bdescrs for example).
  95
  96   So there are two free lists:
  97
  98     - free_list contains bgroups smaller than an mblock.
  99        - it is doubly-linked
 100        - sorted in *size* order: allocation is best-fit
 101        - free bgroups are always fully coalesced
 102        - we do the coalescing trick in freeGroup()
 103
 104     - free_mblock_list contains mgroups only
 105        - it is singly-linked (no need to double-link)
 106        - sorted in *address* order, so we can coalesce using the list
 107        - allocation is best-fit by traversing the whole list: we don't
 108          expect this list to be long, avoiding fragmentation is more
 109          important.
 110
 111   freeGroup() might end up moving a block from free_list to
 112   free_mblock_list, if after coalescing we end up with a full mblock.
 113
 114   checkFreeListSanity() checks all the invariants on the free lists.
 115
 116   --------------------------------------------------------------------------- */
 117
 118 static bdescr *free_list;
 119 static bdescr *free_mblock_list;
 120
 121
 122 /* -----------------------------------------------------------------------------
 123    Initialisation
 124    -------------------------------------------------------------------------- */
 125
 126 void initBlockAllocator(void)
 127 {
 128     free_list = NULL;
 129     free_mblock_list = NULL;
 130 }
 131
 132 /* -----------------------------------------------------------------------------
 133    Allocation
 134    -------------------------------------------------------------------------- */
 135
 136 STATIC_INLINE void
 137 initGroup(nat n, bdescr *head)
 138 {
 139   bdescr *bd;
 140   nat i;
 141
 142   if (n != 0) {
 143     head->free   = head->start;
 144     head->link   = NULL;
 145     for (i=1, bd = head+1; i < n; i++, bd++) {
 146       bd->free = 0;
 147       bd->blocks = 0;
 148       bd->link = head;
 149     }
 150   }
 151 }
 152
 153 // when a block has been shortened by allocGroup(), we need to push
 154 // the remaining chunk backwards in the free list in order to keep the
 155 // list sorted by size.
 156 static void
 157 free_list_push_backwards (bdescr *bd)
 158 {
 159     bdescr *p;
 160
 161     p = bd->u.back;
 162     while (p != NULL && p->blocks > bd->blocks) {
 163         p = p->u.back;
 164     }
 165     if (p != bd->u.back) {
 166         dbl_link_remove(bd, &free_list);
 167         if (p != NULL)
 168             dbl_link_insert_after(bd, p);
 169         else
 170             dbl_link_onto(bd, &free_list);
 171     }
 172 }
 173
 174 // when a block has been coalesced by freeGroup(), we need to push the
 175 // remaining chunk forwards in the free list in order to keep the list
 176 // sorted by size.
 177 static void
 178 free_list_push_forwards (bdescr *bd)
 179 {
 180     bdescr *p;
 181
 182     p = bd;
 183     while (p->link != NULL && p->link->blocks < bd->blocks) {
 184         p = p->link;
 185     }
 186     if (p != bd) {
 187         dbl_link_remove(bd, &free_list);
 188         dbl_link_insert_after(bd, p);
 189     }
 190 }
 191
 192 static void
 193 free_list_insert (bdescr *bd)
 194 {
 195     bdescr *p, *prev;
 196
 197     if (!free_list) {
 198         dbl_link_onto(bd, &free_list);
 199         return;
 200     }
 201
 202     prev = NULL;
 203     p = free_list;
 204     while (p != NULL && p->blocks < bd->blocks) {
 205         prev = p;
 206         p = p->link;
 207     }
 208     if (prev == NULL)
 209     {
 210         dbl_link_onto(bd, &free_list);
 211     }
 212     else
 213     {
 214         dbl_link_insert_after(bd, prev);
 215     }
 216 }
 217
 218
 219 STATIC_INLINE bdescr *
 220 tail_of (bdescr *bd)
 221 {
 222     return bd + bd->blocks - 1;
 223 }
 224
 225 // After splitting a group, the last block of each group must have a
 226 // tail that points to the head block, to keep our invariants for
 227 // coalescing.
 228 STATIC_INLINE void
 229 setup_tail (bdescr *bd)
 230 {
 231     bdescr *tail;
 232     tail = tail_of(bd);
 233     if (tail != bd) {
 234         tail->blocks = 0;
 235         tail->free = 0;
 236         tail->link = bd;
 237     }
 238 }
 239
 240
 241 // Take a free block group bd, and split off a group of size n from
 242 // it.  Adjust the free list as necessary, and return the new group.
 243 static bdescr *
 244 split_free_block (bdescr *bd, nat n)
 245 {
 246     bdescr *fg; // free group
 247
 248     ASSERT(bd->blocks > n);
 249     fg = bd + bd->blocks - n; // take n blocks off the end
 250     fg->blocks = n;
 251     bd->blocks -= n;
 252     setup_tail(bd);
 253     free_list_push_backwards(bd);
 254     return fg;
 255 }
 256
 257 static bdescr *
 258 alloc_mega_group (nat mblocks)
 259 {
 260     bdescr *best, *bd, *prev;
 261     nat n;
 262
 263     n = MBLOCK_GROUP_BLOCKS(mblocks);
 264
 265     best = NULL;
 266     prev = NULL;
 267     for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
 268     {
 269         if (bd->blocks == n)
 270         {
 271             if (prev) {
 272                 prev->link = bd->link;
 273             } else {
 274                 free_mblock_list = bd->link;
 275             }
 276             initGroup(n, bd);
 277             return bd;
 278         }
 279         else if (bd->blocks > n)
 280         {
 281             if (!best || bd->blocks < best->blocks)
 282             {
 283                 best = bd;
 284             }
 285         }
 286     }
 287
 288     if (best)
 289     {
 290         // we take our chunk off the end here.
 291         nat best_mblocks  = BLOCKS_TO_MBLOCKS(best->blocks);
 292         bd = FIRST_BDESCR(MBLOCK_ROUND_DOWN(best) +
 293                           (best_mblocks-mblocks)*MBLOCK_SIZE);
 294
 295         best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
 296         initMBlock(MBLOCK_ROUND_DOWN(bd));
 297     }
 298     else
 299     {
 300         void *mblock = getMBlocks(mblocks);
 301         initMBlock(mblock);             // only need to init the 1st one
 302         bd = FIRST_BDESCR(mblock);
 303     }
 304     bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
 305     return bd;
 306 }
 307
 308 bdescr *
 309 allocGroup (nat n)
 310 {
 311     bdescr *bd, *rem;
 312
 313     ASSERT_SM_LOCK();
 314
 315     if (n == 0) barf("allocGroup: requested zero 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(BLOCKS_PER_MBLOCK, bd);
 322         IF_DEBUG(sanity, checkFreeListSanity());
 323         return bd;
 324     }
 325
 326     // The free list is sorted by size, so we get best fit.
 327     for (bd = free_list; bd != NULL; bd = bd->link)
 328     {
 329         if (bd->blocks == n)            // exactly the right size!
 330         {
 331             dbl_link_remove(bd, &free_list);
 332             initGroup(n, bd);           // initialise it
 333             IF_DEBUG(sanity, checkFreeListSanity());
 334             return bd;
 335         }
 336         if (bd->blocks >  n)            // block too big...
 337         {
 338             bd = split_free_block(bd, n);
 339             initGroup(n, bd);           // initialise the new chunk
 340             IF_DEBUG(sanity, checkFreeListSanity());
 341             return bd;
 342         }
 343     }
 344
 345     bd = alloc_mega_group(1);
 346     bd->blocks = n;
 347     initGroup(n,bd);                     // we know the group will fit
 348     rem = bd + n;
 349     rem->blocks = BLOCKS_PER_MBLOCK-n;
 350     initGroup(BLOCKS_PER_MBLOCK-n, rem); // init the slop
 351     freeGroup(rem);                      // add the slop on to the free list
 352     IF_DEBUG(sanity, checkFreeListSanity());
 353     return bd;
 354 }
 355
 356 bdescr *
 357 allocGroup_lock(nat n)
 358 {
 359     bdescr *bd;
 360     ACQUIRE_SM_LOCK;
 361     bd = allocGroup(n);
 362     RELEASE_SM_LOCK;
 363     return bd;
 364 }
 365
 366 bdescr *
 367 allocBlock(void)
 368 {
 369     return allocGroup(1);
 370 }
 371
 372 bdescr *
 373 allocBlock_lock(void)
 374 {
 375     bdescr *bd;
 376     ACQUIRE_SM_LOCK;
 377     bd = allocBlock();
 378     RELEASE_SM_LOCK;
 379     return bd;
 380 }
 381
 382 /* -----------------------------------------------------------------------------
 383    De-Allocation
 384    -------------------------------------------------------------------------- */
 385
 386 STATIC_INLINE bdescr *
 387 coalesce_mblocks (bdescr *p)
 388 {
 389     bdescr *q;
 390
 391     q = p->link;
 392     if (q != NULL &&
 393         MBLOCK_ROUND_DOWN(q) ==
 394         MBLOCK_ROUND_DOWN(p) + BLOCKS_TO_MBLOCKS(p->blocks) * MBLOCK_SIZE) {
 395         // can coalesce
 396         p->blocks  = MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks) +
 397                                          BLOCKS_TO_MBLOCKS(q->blocks));
 398         p->link = q->link;
 399         return p;
 400     }
 401     return q;
 402 }
 403
 404 static void
 405 free_mega_group (bdescr *mg)
 406 {
 407     bdescr *bd, *prev;
 408
 409     // Find the right place in the free list.  free_mblock_list is
 410     // sorted by *address*, not by size as the free_list is.
 411     prev = NULL;
 412     bd = free_mblock_list;
 413     while (bd && bd->start < mg->start) {
 414         prev = bd;
 415         bd = bd->link;
 416     }
 417
 418     // coalesce backwards
 419     if (prev)
 420     {
 421         mg->link = prev->link;
 422         prev->link = mg;
 423         mg = coalesce_mblocks(prev);
 424     }
 425     else
 426     {
 427         mg->link = free_mblock_list;
 428         free_mblock_list = mg;
 429     }
 430     // coalesce forwards
 431     coalesce_mblocks(mg);
 432
 433     IF_DEBUG(sanity, checkFreeListSanity());
 434 }
 435
 436
 437 void
 438 freeGroup(bdescr *p)
 439 {
 440   nat p_on_free_list = 0;
 441
 442   ASSERT_SM_LOCK();
 443
 444   ASSERT(p->free != (P_)-1);
 445
 446   p->free = (void *)-1;  /* indicates that this block is free */
 447   p->step = NULL;
 448   p->gen_no = 0;
 449   /* fill the block group with garbage if sanity checking is on */
 450   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
 451
 452   if (p->blocks == 0) barf("freeGroup: block size is zero");
 453
 454   if (p->blocks >= BLOCKS_PER_MBLOCK)
 455   {
 456       // If this is an mgroup, make sure it has the right number of blocks
 457       ASSERT(p->blocks == MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks)));
 458       free_mega_group(p);
 459       return;
 460   }
 461
 462   // coalesce forwards
 463   {
 464       bdescr *next;
 465       next = p + p->blocks;
 466       if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(p)) && next->free == (P_)-1)
 467       {
 468           p->blocks += next->blocks;
 469           if (p->blocks == BLOCKS_PER_MBLOCK)
 470           {
 471               dbl_link_remove(next, &free_list);
 472               free_mega_group(p);
 473               return;
 474           }
 475           dbl_link_replace(p, next, &free_list);
 476           setup_tail(p);
 477           free_list_push_forwards(p);
 478           p_on_free_list = 1;
 479       }
 480   }
 481
 482   // coalesce backwards
 483   if (p != FIRST_BDESCR(MBLOCK_ROUND_DOWN(p)))
 484   {
 485       bdescr *prev;
 486       prev = p - 1;
 487       if (prev->blocks == 0) prev = prev->link; // find the head
 488
 489       if (prev->free == (P_)-1)
 490       {
 491           prev->blocks += p->blocks;
 492           if (prev->blocks >= BLOCKS_PER_MBLOCK)
 493           {
 494               if (p_on_free_list)
 495               {
 496                   dbl_link_remove(p, &free_list);
 497               }
 498               dbl_link_remove(prev, &free_list);
 499               free_mega_group(prev);
 500               return;
 501           }
 502           else if (p_on_free_list)
 503           {
 504               // p was already coalesced forwards
 505               dbl_link_remove(p, &free_list);
 506           }
 507           setup_tail(prev);
 508           free_list_push_forwards(prev);
 509           p = prev;
 510           p_on_free_list = 1;
 511       }
 512   }
 513
 514   if (!p_on_free_list)
 515   {
 516       setup_tail(p);
 517       free_list_insert(p);
 518   }
 519
 520   IF_DEBUG(sanity, checkFreeListSanity());
 521 }
 522
 523 void
 524 freeGroup_lock(bdescr *p)
 525 {
 526     ACQUIRE_SM_LOCK;
 527     freeGroup(p);
 528     RELEASE_SM_LOCK;
 529 }
 530
 531 void
 532 freeChain(bdescr *bd)
 533 {
 534   bdescr *next_bd;
 535   while (bd != NULL) {
 536     next_bd = bd->link;
 537     freeGroup(bd);
 538     bd = next_bd;
 539   }
 540 }
 541
 542 void
 543 freeChain_lock(bdescr *bd)
 544 {
 545     ACQUIRE_SM_LOCK;
 546     freeChain(bd);
 547     RELEASE_SM_LOCK;
 548 }
 549
 550 static void
 551 initMBlock(void *mblock)
 552 {
 553   bdescr *bd;
 554   void *block;
 555
 556   /* the first few Bdescr's in a block are unused, so we don't want to
 557    * put them all on the free list.
 558    */
 559   block = FIRST_BLOCK(mblock);
 560   bd    = FIRST_BDESCR(mblock);
 561
 562   /* Initialise the start field of each block descriptor
 563    */
 564   for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
 565     bd->start = block;
 566   }
 567 }
 568
 569 /* -----------------------------------------------------------------------------
 570    Debugging
 571    -------------------------------------------------------------------------- */
 572
 573 #ifdef DEBUG
 574 static void
 575 check_tail (bdescr *bd)
 576 {
 577     bdescr *tail = tail_of(bd);
 578
 579     if (tail != bd)
 580     {
 581         ASSERT(tail->blocks == 0);
 582         ASSERT(tail->free == 0);
 583         ASSERT(tail->link == bd);
 584     }
 585 }
 586
 587 void
 588 checkFreeListSanity(void)
 589 {
 590     bdescr *bd, *prev;
 591
 592     IF_DEBUG(block_alloc, debugBelch("free block list:\n"));
 593
 594     prev = NULL;
 595     for (bd = free_list; bd != NULL; prev = bd, bd = bd->link)
 596     {
 597         IF_DEBUG(block_alloc,
 598                  debugBelch("group at %p, length %ld blocks\n",
 599                             bd->start, (long)bd->blocks));
 600         ASSERT(bd->blocks > 0 && bd->blocks < BLOCKS_PER_MBLOCK);
 601         ASSERT(bd->link != bd); // catch easy loops
 602
 603         check_tail(bd);
 604
 605         if (prev)
 606             ASSERT(bd->u.back == prev);
 607         else
 608             ASSERT(bd->u.back == NULL);
 609
 610         if (bd->link != NULL)
 611         {
 612             // make sure the list is sorted
 613             ASSERT(bd->blocks <= bd->link->blocks);
 614         }
 615
 616         {
 617             bdescr *next;
 618             next = bd + bd->blocks;
 619             if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(bd)))
 620             {
 621                 ASSERT(next->free != (P_)-1);
 622             }
 623         }
 624     }
 625
 626     prev = NULL;
 627     for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
 628     {
 629         IF_DEBUG(block_alloc,
 630                  debugBelch("mega group at %p, length %ld blocks\n",
 631                             bd->start, (long)bd->blocks));
 632
 633         ASSERT(bd->link != bd); // catch easy loops
 634
 635         if (bd->link != NULL)
 636         {
 637             // make sure the list is sorted
 638             ASSERT(bd->start < bd->link->start);
 639         }
 640
 641         ASSERT(bd->blocks >= BLOCKS_PER_MBLOCK);
 642         ASSERT(MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(bd->blocks))
 643                == bd->blocks);
 644
 645         // make sure we're fully coalesced
 646         if (bd->link != NULL)
 647         {
 648             ASSERT (MBLOCK_ROUND_DOWN(bd->link) !=
 649                     MBLOCK_ROUND_DOWN(bd) +
 650                     BLOCKS_TO_MBLOCKS(bd->blocks) * MBLOCK_SIZE);
 651         }
 652     }
 653 }
 654
 655 nat /* BLOCKS */
 656 countFreeList(void)
 657 {
 658   bdescr *bd;
 659   lnat total_blocks = 0;
 660
 661   for (bd = free_list; bd != NULL; bd = bd->link) {
 662       total_blocks += bd->blocks;
 663   }
 664   for (bd = free_mblock_list; bd != NULL; bd = bd->link) {
 665       total_blocks += BLOCKS_PER_MBLOCK * BLOCKS_TO_MBLOCKS(bd->blocks);
 666       // The caller of this function, memInventory(), expects to match
 667       // the total number of blocks in the system against mblocks *
 668       // BLOCKS_PER_MBLOCK, so we must subtract the space for the
 669       // block descriptors from *every* mblock.
 670   }
 671   return total_blocks;
 672 }
 673 #endif