ghc/rts/BlockAlloc.c

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