ghc/rts/BlockAlloc.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team 1998-2005
   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();
  11  *
  12  * returns the address of an MBLOCK_SIZE region of memory, aligned on
  13  * an MBLOCK_SIZE boundary.  There is no requirement for successive
  14  * calls to getMBlock to return strictly increasing addresses.
  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
  25 #include <string.h>
  26
  27 static void    initMBlock(void *mblock);
  28 static bdescr *allocMegaGroup(nat mblocks);
  29 static void    freeMegaGroup(bdescr *bd);
  30
  31 static bdescr *free_list = NULL;
  32
  33 /* -----------------------------------------------------------------------------
  34    Initialisation
  35    -------------------------------------------------------------------------- */
  36
  37 void initBlockAllocator(void)
  38 {
  39     // The free list starts off NULL
  40 }
  41
  42 /* -----------------------------------------------------------------------------
  43    Allocation
  44    -------------------------------------------------------------------------- */
  45
  46 STATIC_INLINE void
  47 initGroupTail(nat n, bdescr *head, bdescr *tail)
  48 {
  49     bdescr *bd;
  50     nat i;
  51
  52     for (i=0, bd = tail; i < n; i++, bd++) {
  53       bd->flags  = 0;
  54       bd->free   = 0;
  55       bd->blocks = 0;
  56       bd->link   = head;
  57     }
  58 }
  59
  60 STATIC_INLINE void
  61 initGroup(nat n, bdescr *head)
  62 {
  63   if (n != 0) {
  64     head->blocks = n;
  65     head->free   = head->start;
  66     head->link   = NULL;
  67     head->flags  = 0;
  68     initGroupTail( n-1, head, head+1 );
  69   }
  70 }
  71
  72 bdescr *
  73 allocGroup(nat n)
  74 {
  75   void *mblock;
  76   bdescr *bd, **last;
  77
  78   ASSERT(n != 0);
  79
  80   if (n > BLOCKS_PER_MBLOCK) {
  81     return allocMegaGroup(BLOCKS_TO_MBLOCKS(n));
  82   }
  83
  84   last = &free_list;
  85   for (bd = free_list; bd != NULL; bd = bd->link) {
  86     if (bd->blocks == n) {      /* exactly the right size! */
  87       if (bd->link) {
  88         bd->link->u.back = bd->u.back;
  89       }
  90       *last = bd->link;
  91       /* no initialisation necessary - this is already a
  92        * self-contained block group. */
  93       bd->flags = 0;
  94       bd->free  = bd->start;
  95       bd->link  = NULL;
  96       return bd;
  97     }
  98     if (bd->blocks >  n) {      /* block too big... */
  99       bd->blocks -= n;          /* take a chunk off the *end* */
 100       bd += bd->blocks;
 101       initGroup(n, bd);         /* initialise it */
 102       return bd;
 103     }
 104     last = &bd->link;
 105   }
 106
 107   mblock = getMBlock();         /* get a new megablock */
 108   initMBlock(mblock);           /* initialise the start fields */
 109   bd = FIRST_BDESCR(mblock);
 110   initGroup(n,bd);              /* we know the group will fit */
 111   if (n < BLOCKS_PER_MBLOCK) {
 112     initGroup(BLOCKS_PER_MBLOCK-n, bd+n);
 113     freeGroup(bd+n);            /* add the rest on to the free list */
 114   }
 115   return bd;
 116 }
 117
 118 bdescr *
 119 allocBlock(void)
 120 {
 121   return allocGroup(1);
 122 }
 123
 124 /* -----------------------------------------------------------------------------
 125    Any request larger than BLOCKS_PER_MBLOCK needs a megablock group.
 126    First, search the free list for enough contiguous megablocks to
 127    fulfill the request - if we don't have enough, we need to
 128    allocate some new ones.
 129
 130    A megablock group looks just like a normal block group, except that
 131    the blocks field in the head will be larger than BLOCKS_PER_MBLOCK.
 132
 133    Note that any objects placed in this group must start in the first
 134    megablock, since the other blocks don't have block descriptors.
 135    -------------------------------------------------------------------------- */
 136
 137 static bdescr *
 138 allocMegaGroup(nat n)
 139 {
 140   nat mbs_found;
 141   bdescr *bd, *last, *grp_start, *grp_prev;
 142
 143   mbs_found = 0;
 144   grp_start = NULL;
 145   grp_prev  = NULL;
 146   last      = NULL;
 147   for (bd = free_list; bd != NULL; bd = bd->link) {
 148
 149     if (bd->blocks == BLOCKS_PER_MBLOCK) {      /* whole megablock found */
 150
 151       /* is it the first one we've found or a non-contiguous megablock? */
 152       if (grp_start == NULL ||
 153           bd->start != last->start + MBLOCK_SIZE/sizeof(W_)) {
 154         grp_start = bd;
 155         grp_prev  = last;
 156         mbs_found = 1;
 157       } else {
 158         mbs_found++;
 159       }
 160
 161       if (mbs_found == n) {     /* found enough contig megablocks? */
 162         break;
 163       }
 164     }
 165
 166     else {                      /* only a partial megablock, start again */
 167       grp_start = NULL;
 168     }
 169
 170     last = bd;
 171   }
 172
 173   /* found all the megablocks we need on the free list */
 174   if (mbs_found == n) {
 175     /* remove the megablocks from the free list */
 176     if (grp_prev == NULL) {     /* bd now points to the last mblock */
 177       free_list = bd->link;
 178       if (free_list) {
 179         free_list->u.back = NULL;
 180       }
 181     } else {
 182       grp_prev->link = bd->link;
 183       if (bd->link) {
 184         bd->link->u.back = grp_prev;
 185       }
 186     }
 187   }
 188
 189   /* the free list wasn't sufficient, allocate all new mblocks. */
 190   else {
 191     void *mblock = getMBlocks(n);
 192     initMBlock(mblock);         /* only need to init the 1st one */
 193     grp_start = FIRST_BDESCR(mblock);
 194   }
 195
 196   /* set up the megablock group */
 197   initGroup(BLOCKS_PER_MBLOCK, grp_start);
 198   grp_start->blocks = MBLOCK_GROUP_BLOCKS(n);
 199   return grp_start;
 200 }
 201
 202 /* -----------------------------------------------------------------------------
 203    De-Allocation
 204    -------------------------------------------------------------------------- */
 205
 206 /* coalesce the group p with its predecessor and successor groups, if possible
 207  *
 208  * Returns NULL if no coalescing was done, otherwise returns a
 209  * pointer to the newly enlarged group p.
 210  */
 211
 212 STATIC_INLINE bdescr *
 213 coalesce(bdescr *p)
 214 {
 215     bdescr *first, *q, *result = NULL;
 216
 217     /* Get first megablock descriptor */
 218     first = FIRST_BDESCR(MBLOCK_ROUND_DOWN(p->start));
 219
 220     /* Attempt to coalesce with predecessor if not the first block */
 221     if (p != first) {
 222         q = p - 1;
 223         if (!q->blocks) {   // not a block head?
 224             q = q->link;    // find the head.
 225         }
 226         /* Predecessor is free? */
 227         if (q->flags & BF_FREE) {
 228             q->blocks += p->blocks;
 229             initGroupTail( p->blocks, q, p );
 230             p = result = q;
 231         }
 232     }
 233
 234     /* Attempt to coalesce with successor if not the last block */
 235     q = p + p->blocks;
 236     if (q != first + BLOCKS_PER_MBLOCK) {
 237         /* Successor is free */
 238         if (q->flags & BF_FREE) {
 239             if (result) {
 240                 /* p is on free_list, q is on free_list, unlink
 241                  * q completely and patch up list
 242                  */
 243                 if (q->u.back) {
 244                     q->u.back->link = q->link;
 245                 }
 246                 if (q->link) {
 247                     q->link->u.back = q->u.back;
 248                 }
 249                 if (free_list == q) {
 250                     free_list = q->link;
 251                 }
 252             } else {
 253                 /* p is not on free_list just assume q's links */
 254                 p->u.back = q->u.back;
 255                 if (p->u.back) {
 256                     p->u.back->link = p;
 257                 }
 258                 p->link = q->link;
 259                 if (p->link) {
 260                     p->link->u.back = p;
 261                 }
 262                 if (q == free_list) {
 263                     free_list = p;
 264                     free_list->u.back = NULL;
 265                 }
 266             }
 267
 268             p->blocks += q->blocks;
 269             initGroupTail( q->blocks, p, q );
 270             result = p;
 271         }
 272     }
 273
 274     return result;
 275 }
 276
 277 void
 278 freeGroup(bdescr *p)
 279 {
 280   /* are we dealing with a megablock group? */
 281   if (p->blocks > BLOCKS_PER_MBLOCK) {
 282     freeMegaGroup(p);
 283     return;
 284   }
 285
 286   p->flags = BF_FREE;
 287   p->u.back = NULL;
 288   p->link = NULL;
 289   p->step = NULL;
 290   p->gen_no = 0;
 291   /* fill the block group with garbage if sanity checking is on */
 292   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
 293
 294   if (!coalesce(p)) {
 295     dbl_link_onto(p, &free_list);
 296   }
 297
 298   IF_DEBUG(sanity, checkFreeListSanity());
 299 }
 300
 301 static void
 302 freeMegaGroup(bdescr *p)
 303 {
 304   nat n;
 305   void *q = p;
 306
 307   n = ((bdescr *)q)->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
 308   for (; n > 0; q += MBLOCK_SIZE, n--) {
 309     initMBlock(MBLOCK_ROUND_DOWN(q));
 310     initGroup(BLOCKS_PER_MBLOCK, (bdescr *)q);
 311     freeGroup((bdescr *)q);
 312   }
 313 }
 314
 315 void
 316 freeChain(bdescr *bd)
 317 {
 318   bdescr *next_bd;
 319   while (bd != NULL) {
 320     next_bd = bd->link;
 321     freeGroup(bd);
 322     bd = next_bd;
 323   }
 324 }
 325
 326 static void
 327 initMBlock(void *mblock)
 328 {
 329   bdescr *bd;
 330   void *block;
 331
 332   /* the first few Bdescr's in a block are unused, so we don't want to
 333    * put them all on the free list.
 334    */
 335   block = FIRST_BLOCK(mblock);
 336   bd    = FIRST_BDESCR(mblock);
 337
 338   /* Initialise the start field of each block descriptor
 339    */
 340   for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
 341     bd->start = block;
 342   }
 343 }
 344
 345 /* -----------------------------------------------------------------------------
 346    Debugging
 347    -------------------------------------------------------------------------- */
 348
 349 #ifdef DEBUG
 350 static void
 351 checkWellFormedGroup(bdescr *bd)
 352 {
 353     nat i;
 354
 355     for (i = 1; i < bd->blocks; i++) {
 356         ASSERT(bd[i].blocks == 0);
 357         ASSERT(bd[i].free   == 0);
 358         ASSERT(bd[i].link   == bd);
 359     }
 360 }
 361
 362 void
 363 checkFreeListSanity(void)
 364 {
 365   bdescr *bd;
 366
 367   for (bd = free_list; bd != NULL; bd = bd->link) {
 368     IF_DEBUG(block_alloc,
 369              debugBelch("group at 0x%x, length %d blocks\n",
 370                         (nat)bd->start, bd->blocks));
 371     ASSERT(bd->blocks > 0);
 372     ASSERT(bd->link ? bd->link->u.back == bd : 1);
 373     ASSERT(bd->u.back ? bd->u.back->link == bd : 1);
 374     checkWellFormedGroup(bd);
 375     if (bd->link != NULL) {
 376       /* make sure we're fully coalesced */
 377       ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);
 378     }
 379   }
 380 }
 381
 382 nat /* BLOCKS */
 383 countFreeList(void)
 384 {
 385   bdescr *bd;
 386   lnat total_blocks = 0;
 387
 388   for (bd = free_list; bd != NULL; bd = bd->link) {
 389     total_blocks += bd->blocks;
 390   }
 391   return total_blocks;
 392 }
 393 #endif