ghc/rts/BlockAlloc.c

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