ghc/rts/BlockAlloc.c

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