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