ghc/rts/BlockAlloc.c

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