ghc/rts/BlockAlloc.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: BlockAlloc.c,v 1.10 2001/08/14 13:40:09 sewardj Exp $
   3  *
   4  * (c) The GHC Team 1998-2000
   5  *
   6  * The block allocator and free list manager.
   7  *
   8  * This is the architecture independent part of the block allocator.
   9  * It requires only the following support from the operating system:
  10  *
  11  *    void *getMBlock();
  12  *
  13  * returns the address of an MBLOCK_SIZE region of memory, aligned on
  14  * an MBLOCK_SIZE boundary.  There is no requirement for successive
  15  * calls to getMBlock to return strictly increasing addresses.
  16  *
  17  * ---------------------------------------------------------------------------*/
  18
  19 #include "PosixSource.h"
  20 #include "Rts.h"
  21 #include "RtsFlags.h"
  22 #include "RtsUtils.h"
  23 #include "BlockAlloc.h"
  24 #include "MBlock.h"
  25
  26 static void    initMBlock(void *mblock);
  27 static bdescr *allocMegaGroup(nat mblocks);
  28 static void    freeMegaGroup(bdescr *bd);
  29
  30 static bdescr *free_list;
  31
  32 /* -----------------------------------------------------------------------------
  33    Initialisation
  34    -------------------------------------------------------------------------- */
  35
  36 void initBlockAllocator(void)
  37 {
  38   free_list = NULL;
  39 }
  40
  41 /* -----------------------------------------------------------------------------
  42    Allocation
  43    -------------------------------------------------------------------------- */
  44
  45 static inline void
  46 initGroup(nat n, bdescr *head)
  47 {
  48   bdescr *bd;
  49   nat i;
  50
  51   if (n != 0) {
  52     head->blocks = n;
  53     head->free = head->start;
  54     for (i=1, bd = head+1; i < n; i++, bd++) {
  55       bd->free = 0;
  56       bd->link = head;
  57     }
  58   }
  59 }
  60
  61 bdescr *
  62 allocGroup(nat n)
  63 {
  64   void *mblock;
  65   bdescr *bd, **last;
  66
  67   ASSERT(n != 0);
  68
  69   if (n > BLOCKS_PER_MBLOCK) {
  70     return allocMegaGroup(BLOCKS_TO_MBLOCKS(n));
  71   }
  72
  73   last = &free_list;
  74   for (bd = free_list; bd != NULL; bd = bd->link) {
  75     if (bd->blocks == n) {      /* exactly the right size! */
  76       *last = bd->link;
  77       /* no initialisation necessary - this is already a
  78        * self-contained block group. */
  79 #ifdef DEBUG
  80       bd->free = bd->start;     /* block isn't free now */
  81 #endif
  82       return bd;
  83     }
  84     if (bd->blocks >  n) {      /* block too big... */
  85       bd->blocks -= n;          /* take a chunk off the *end* */
  86       bd += bd->blocks;
  87       initGroup(n, bd);         /* initialise it */
  88       return bd;
  89     }
  90     last = &bd->link;
  91   }
  92
  93   mblock = getMBlock();         /* get a new megablock */
  94   initMBlock(mblock);           /* initialise the start fields */
  95   bd = FIRST_BDESCR(mblock);
  96   initGroup(n,bd);              /* we know the group will fit */
  97   if (n < BLOCKS_PER_MBLOCK) {
  98     initGroup(BLOCKS_PER_MBLOCK-n, bd+n);
  99     freeGroup(bd+n);            /* add the rest on to the free list */
 100   }
 101   return bd;
 102 }
 103
 104 bdescr *
 105 allocBlock(void)
 106 {
 107   return allocGroup(1);
 108 }
 109
 110 /* -----------------------------------------------------------------------------
 111    Any request larger than BLOCKS_PER_MBLOCK needs a megablock group.
 112    First, search the free list for enough contiguous megablocks to
 113    fulfill the request - if we don't have enough, we need to
 114    allocate some new ones.
 115
 116    A megablock group looks just like a normal block group, except that
 117    the blocks field in the head will be larger than BLOCKS_PER_MBLOCK.
 118
 119    Note that any objects placed in this group must start in the first
 120    megablock, since the other blocks don't have block descriptors.
 121    -------------------------------------------------------------------------- */
 122
 123 static bdescr *
 124 allocMegaGroup(nat n)
 125 {
 126   nat mbs_found;
 127   bdescr *bd, *last, *grp_start, *grp_prev;
 128
 129   mbs_found = 0;
 130   grp_start = NULL;
 131   grp_prev  = NULL;
 132   last      = NULL;
 133   for (bd = free_list; bd != NULL; bd = bd->link) {
 134
 135     if (bd->blocks == BLOCKS_PER_MBLOCK) {      /* whole megablock found */
 136
 137       /* is it the first one we've found or a non-contiguous megablock? */
 138       if (grp_start == NULL ||
 139           bd->start != last->start + MBLOCK_SIZE/sizeof(W_)) {
 140         grp_start = bd;
 141         grp_prev  = last;
 142         mbs_found = 1;
 143       } else {
 144         mbs_found++;
 145       }
 146
 147       if (mbs_found == n) {     /* found enough contig megablocks? */
 148         break;
 149       }
 150     }
 151
 152     else {                      /* only a partial megablock, start again */
 153       grp_start = NULL;
 154     }
 155
 156     last = bd;
 157   }
 158
 159   /* found all the megablocks we need on the free list
 160    */
 161   if (mbs_found == n) {
 162     /* remove the megablocks from the free list */
 163     if (grp_prev == NULL) {     /* bd now points to the last mblock */
 164       free_list = bd->link;
 165     } else {
 166       grp_prev->link = bd->link;
 167     }
 168   }
 169
 170   /* the free list wasn't sufficient, allocate all new mblocks.
 171    */
 172   else {
 173     void *mblock = getMBlocks(n);
 174     initMBlock(mblock);         /* only need to init the 1st one */
 175     grp_start = FIRST_BDESCR(mblock);
 176   }
 177
 178   /* set up the megablock group */
 179   initGroup(BLOCKS_PER_MBLOCK, grp_start);
 180   grp_start->blocks = MBLOCK_GROUP_BLOCKS(n);
 181   return grp_start;
 182 }
 183
 184 /* -----------------------------------------------------------------------------
 185    De-Allocation
 186    -------------------------------------------------------------------------- */
 187
 188 /* coalesce the group p with p->link if possible.
 189  *
 190  * Returns p->link if no coalescing was done, otherwise returns a
 191  * pointer to the newly enlarged group p.
 192  */
 193
 194 static inline bdescr *
 195 coalesce(bdescr *p)
 196 {
 197   bdescr *bd, *q;
 198   nat i;
 199
 200   q = p->link;
 201   if (q != NULL && p->start + p->blocks * BLOCK_SIZE_W == q->start) {
 202     /* can coalesce */
 203     p->blocks += q->blocks;
 204     p->link    = q->link;
 205     for (i = 0, bd = q; i < q->blocks; bd++, i++) {
 206         bd->free = 0;
 207         bd->link = p;
 208     }
 209     return p;
 210   }
 211   return q;
 212 }
 213
 214 void
 215 freeGroup(bdescr *p)
 216 {
 217   bdescr *bd, *last;
 218
 219   /* are we dealing with a megablock group? */
 220   if (p->blocks > BLOCKS_PER_MBLOCK) {
 221     freeMegaGroup(p);
 222     return;
 223   }
 224
 225 #ifdef DEBUG
 226   p->free = (void *)-1;  /* indicates that this block is free */
 227   p->step = NULL;
 228   p->gen_no = 0;
 229   /* fill the block group with garbage if sanity checking is on */
 230   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
 231 #endif
 232
 233   /* find correct place in free list to place new group */
 234   last = NULL;
 235   for (bd = free_list; bd != NULL && bd->start < p->start;
 236        bd = bd->link) {
 237     last = bd;
 238   }
 239
 240   /* now, last = previous group (or NULL) */
 241   if (last == NULL) {
 242     p->link = free_list;
 243     free_list = p;
 244   } else {
 245     /* coalesce with previous group if possible */
 246     p->link = last->link;
 247     last->link = p;
 248     p = coalesce(last);
 249   }
 250
 251   /* coalesce with next group if possible */
 252   coalesce(p);
 253   IF_DEBUG(sanity, checkFreeListSanity());
 254 }
 255
 256 static void
 257 freeMegaGroup(bdescr *p)
 258 {
 259   nat n;
 260
 261   n = p->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
 262   for (; n > 0; (W_)p += MBLOCK_SIZE, n--) {
 263     initMBlock((void *)((W_)p & ~MBLOCK_MASK));
 264     initGroup(BLOCKS_PER_MBLOCK, p);
 265     freeGroup(p);
 266   }
 267 }
 268
 269 void
 270 freeChain(bdescr *bd)
 271 {
 272   bdescr *next_bd;
 273   while (bd != NULL) {
 274     next_bd = bd->link;
 275     freeGroup(bd);
 276     bd = next_bd;
 277   }
 278 }
 279
 280 static void
 281 initMBlock(void *mblock)
 282 {
 283   bdescr *bd;
 284   void *block;
 285
 286   /* the first few Bdescr's in a block are unused, so we don't want to
 287    * put them all on the free list.
 288    */
 289   block = FIRST_BLOCK(mblock);
 290   bd    = FIRST_BDESCR(mblock);
 291
 292   /* Initialise the start field of each block descriptor
 293    */
 294   for (; block <= LAST_BLOCK(mblock); bd += 1, (lnat)block += BLOCK_SIZE) {
 295     bd->start = block;
 296   }
 297 }
 298
 299 /* -----------------------------------------------------------------------------
 300    Debugging
 301    -------------------------------------------------------------------------- */
 302
 303 #ifdef DEBUG
 304 void
 305 checkFreeListSanity(void)
 306 {
 307   bdescr *bd;
 308
 309   for (bd = free_list; bd != NULL; bd = bd->link) {
 310     IF_DEBUG(block_alloc,
 311              fprintf(stderr,"group at 0x%x, length %d blocks\n",
 312                      (nat)bd->start, bd->blocks));
 313     ASSERT(bd->blocks > 0);
 314     if (bd->link != NULL) {
 315       /* make sure we're fully coalesced */
 316       ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);
 317       ASSERT(bd->start < bd->link->start);
 318     }
 319   }
 320 }
 321
 322 nat /* BLOCKS */
 323 countFreeList(void)
 324 {
 325   bdescr *bd;
 326   lnat total_blocks = 0;
 327
 328   for (bd = free_list; bd != NULL; bd = bd->link) {
 329     total_blocks += bd->blocks;
 330   }
 331   return total_blocks;
 332 }
 333 #endif