ghc/rts/BlockAlloc.c

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