ghc/rts/BlockAlloc.c

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