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