X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FBlockAlloc.c;h=baa096a61a8ac570064afc321ede0beca242d550;hb=e7c3f957fd36fd9f6369183b7a31e2a4a4c21b43;hp=220928520ed8f264a0d122518d8420511014bfb2;hpb=18b3cd979a185d02c88df1de61814ed808c62010;p=ghc-hetmet.git diff --git a/ghc/rts/BlockAlloc.c b/ghc/rts/BlockAlloc.c index 2209285..baa096a 100644 --- a/ghc/rts/BlockAlloc.c +++ b/ghc/rts/BlockAlloc.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: BlockAlloc.c,v 1.11 2001/11/08 10:18:49 simonmar Exp $ * * (c) The GHC Team 1998-2000 * @@ -23,11 +22,13 @@ #include "BlockAlloc.h" #include "MBlock.h" +#include + static void initMBlock(void *mblock); static bdescr *allocMegaGroup(nat mblocks); static void freeMegaGroup(bdescr *bd); -static bdescr *free_list; +static bdescr *free_list = NULL; /* ----------------------------------------------------------------------------- Initialisation @@ -35,14 +36,14 @@ static bdescr *free_list; void initBlockAllocator(void) { - free_list = NULL; + // The free list starts off NULL } /* ----------------------------------------------------------------------------- Allocation -------------------------------------------------------------------------- */ -static inline void +STATIC_INLINE void initGroup(nat n, bdescr *head) { bdescr *bd; @@ -50,7 +51,8 @@ initGroup(nat n, bdescr *head) if (n != 0) { head->blocks = n; - head->free = head->start; + head->free = head->start; + head->link = NULL; for (i=1, bd = head+1; i < n; i++, bd++) { bd->free = 0; bd->blocks = 0; @@ -77,9 +79,8 @@ allocGroup(nat n) *last = bd->link; /* no initialisation necessary - this is already a * self-contained block group. */ -#ifdef DEBUG bd->free = bd->start; /* block isn't free now */ -#endif + bd->link = NULL; return bd; } if (bd->blocks > n) { /* block too big... */ @@ -192,19 +193,21 @@ allocMegaGroup(nat n) * pointer to the newly enlarged group p. */ -static inline bdescr * +STATIC_INLINE bdescr * coalesce(bdescr *p) { bdescr *bd, *q; - nat i; + nat i, blocks; q = p->link; if (q != NULL && p->start + p->blocks * BLOCK_SIZE_W == q->start) { /* can coalesce */ p->blocks += q->blocks; p->link = q->link; - for (i = 0, bd = q; i < q->blocks; bd++, i++) { + blocks = q->blocks; + for (i = 0, bd = q; i < blocks; bd++, i++) { bd->free = 0; + bd->blocks = 0; bd->link = p; } return p; @@ -223,13 +226,12 @@ freeGroup(bdescr *p) return; } -#ifdef DEBUG + p->free = (void *)-1; /* indicates that this block is free */ p->step = NULL; p->gen_no = 0; /* fill the block group with garbage if sanity checking is on */ IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE)); -#endif /* find correct place in free list to place new group */ last = NULL; @@ -258,12 +260,13 @@ static void freeMegaGroup(bdescr *p) { nat n; + void *q = p; - n = p->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1; - for (; n > 0; (W_)p += MBLOCK_SIZE, n--) { - initMBlock((void *)((W_)p & ~MBLOCK_MASK)); - initGroup(BLOCKS_PER_MBLOCK, p); - freeGroup(p); + n = ((bdescr *)q)->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1; + for (; n > 0; q += MBLOCK_SIZE, n--) { + initMBlock(MBLOCK_ROUND_DOWN(q)); + initGroup(BLOCKS_PER_MBLOCK, (bdescr *)q); + freeGroup((bdescr *)q); } } @@ -292,7 +295,7 @@ initMBlock(void *mblock) /* Initialise the start field of each block descriptor */ - for (; block <= LAST_BLOCK(mblock); bd += 1, (lnat)block += BLOCK_SIZE) { + for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) { bd->start = block; } } @@ -302,6 +305,18 @@ initMBlock(void *mblock) -------------------------------------------------------------------------- */ #ifdef DEBUG +static void +checkWellFormedGroup( bdescr *bd ) +{ + nat i; + + for (i = 1; i < bd->blocks; i++) { + ASSERT(bd[i].blocks == 0); + ASSERT(bd[i].free == 0); + ASSERT(bd[i].link == bd); + } +} + void checkFreeListSanity(void) { @@ -309,9 +324,10 @@ checkFreeListSanity(void) for (bd = free_list; bd != NULL; bd = bd->link) { IF_DEBUG(block_alloc, - fprintf(stderr,"group at 0x%x, length %d blocks\n", - (nat)bd->start, bd->blocks)); + debugBelch("group at 0x%x, length %d blocks\n", + (nat)bd->start, bd->blocks)); ASSERT(bd->blocks > 0); + checkWellFormedGroup(bd); if (bd->link != NULL) { /* make sure we're fully coalesced */ ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);