ghc/rts/BlockAlloc.c

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