ghc/rts/BlockAlloc.c

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