From 485b8d1a00a65aa565e3b30ef8f63fa2880d4093 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 14 Dec 2006 11:09:01 +0000 Subject: [PATCH] Rework the block allocator The main goal here is to reduce fragmentation, which turns out to be the case of #743. While I was here I found some opportunities to improve performance too. The code is rather more complex, but it also contains a long comment describing the strategy, so please take a look at that for the details. --- includes/Block.h | 44 ++++ rts/sm/BlockAlloc.c | 683 ++++++++++++++++++++++++++++++++++++--------------- rts/sm/Storage.c | 9 +- 3 files changed, 525 insertions(+), 211 deletions(-) diff --git a/includes/Block.h b/includes/Block.h index 4080880..dd3e201 100644 --- a/includes/Block.h +++ b/includes/Block.h @@ -130,6 +130,11 @@ INLINE_HEADER bdescr *Bdescr(StgPtr p) #define FIRST_BDESCR(m) \ ((bdescr *)((FIRST_BLOCK_OFF>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m))) +/* Last real block descriptor in a megablock */ + +#define LAST_BDESCR(m) \ + ((bdescr *)(((MBLOCK_SIZE-BLOCK_SIZE)>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m))) + /* Number of usable blocks in a megablock */ #define BLOCKS_PER_MBLOCK ((MBLOCK_SIZE - FIRST_BLOCK_OFF) / BLOCK_SIZE) @@ -161,6 +166,45 @@ dbl_link_onto(bdescr *bd, bdescr **list) *list = bd; } +INLINE_HEADER void +dbl_link_remove(bdescr *bd, bdescr **list) +{ + if (bd->u.back) { + bd->u.back->link = bd->link; + } else { + *list = bd->link; + } + if (bd->link) { + bd->link->u.back = bd->u.back; + } +} + +INLINE_HEADER void +dbl_link_insert_after(bdescr *bd, bdescr *after) +{ + bd->link = after->link; + bd->u.back = after; + if (after->link) { + after->link->u.back = bd; + } + after->link = bd; +} + +INLINE_HEADER void +dbl_link_replace(bdescr *new, bdescr *old, bdescr **list) +{ + new->link = old->link; + new->u.back = old->u.back; + if (old->link) { + old->link->u.back = new; + } + if (old->u.back) { + old->u.back->link = new; + } else { + *list = new; + } +} + /* Initialisation ---------------------------------------------------------- */ extern void initBlockAllocator(void); diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c index 763f2e7..1c4899e 100644 --- a/rts/sm/BlockAlloc.c +++ b/rts/sm/BlockAlloc.c @@ -7,11 +7,11 @@ * This is the architecture independent part of the block allocator. * It requires only the following support from the operating system: * - * void *getMBlock(); + * void *getMBlock(nat n); * - * returns the address of an MBLOCK_SIZE region of memory, aligned on - * an MBLOCK_SIZE boundary. There is no requirement for successive - * calls to getMBlock to return strictly increasing addresses. + * returns the address of an n*MBLOCK_SIZE region of memory, aligned on + * an MBLOCK_SIZE boundary. There are no other restrictions on the + * addresses of memory returned by getMBlock(). * * ---------------------------------------------------------------------------*/ @@ -25,12 +25,99 @@ #include -static void initMBlock(void *mblock); -static bdescr *allocMegaGroup(nat mblocks); -static void freeMegaGroup(bdescr *bd); +static void initMBlock(void *mblock); +// The free_list is kept sorted by size, smallest first. // In THREADED_RTS mode, the free list is protected by sm_mutex. -static bdescr *free_list = NULL; + +/* ----------------------------------------------------------------------------- + + Implementation notes + ~~~~~~~~~~~~~~~~~~~~ + + Terminology: + - bdescr = block descriptor + - bgroup = block group (1 or more adjacent blocks) + - mblock = mega block + - mgroup = mega group (1 or more adjacent mblocks) + + Invariants on block descriptors + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + bd->start always points to the start of the block. + + bd->free is either: + - zero for a non-group-head; bd->link points to the head + - (-1) for the head of a free block group + - or it points within the block + + bd->blocks is either: + - zero for a non-group-head; bd->link points to the head + - number of blocks in this group otherwise + + bd->link either points to a block descriptor or is NULL + + The following fields are not used by the allocator: + bd->flags + bd->gen_no + bd->step + + Exceptions: we don't maintain invariants for all the blocks within a + group on the free list, because it is expensive to modify every + bdescr in a group when coalescing. Just the head and last bdescrs + will be correct for a group on the free list. + + + Free lists + ~~~~~~~~~~ + Preliminaries: + - most allocations are for single blocks + - we cannot be dependent on address-space ordering; sometimes the + OS gives us new memory backwards in the address space, sometimes + forwards + - We want to avoid fragmentation in the free list + + Coalescing trick: when a bgroup is freed (freeGroup()), we can check + whether it can be coalesced with othre free bgroups by checking the + bdescrs for the blocks on either side of it. This means that: + + - freeGroup is O(1) if we coalesce with an existing free block + group. Otherwise we have to insert in the free list, but since + most blocks are small and the free list is sorted by size, this + is usually quick. + - the free list must be double-linked, so we can insert into the + middle. + - every free group in the free list must have its head and tail + bdescrs initialised, the rest don't matter. + - we cannot play this trick with mblocks, because there is no + requirement that the bdescrs in the second and subsequent mblock + of an mgroup are initialised (the mgroup might be filled with a + large array, overwriting the bdescrs for example). + + So there are two free lists: + + - free_list contains bgroups smaller than an mblock. + - it is doubly-linked + - sorted in *size* order: allocation is best-fit + - free bgroups are always fully coalesced + - we do the coalescing trick in freeGroup() + + - free_mblock_list contains mgroups only + - it is singly-linked (no need to double-link) + - sorted in *address* order, so we can coalesce using the list + - allocation is best-fit by traversing the whole list: we don't + expect this list to be long, avoiding fragmentation is more + important. + + freeGroup() might end up moving a block from free_list to + free_mblock_list, if after coalescing we end up with a full mblock. + + checkFreeListSanity() checks all the invariants on the free lists. + + --------------------------------------------------------------------------- */ + +static bdescr *free_list; +static bdescr *free_mblock_list; + /* ----------------------------------------------------------------------------- Initialisation @@ -38,7 +125,8 @@ static bdescr *free_list = NULL; void initBlockAllocator(void) { - // The free list starts off NULL + free_list = NULL; + free_mblock_list = NULL; } /* ----------------------------------------------------------------------------- @@ -52,7 +140,6 @@ initGroup(nat n, bdescr *head) nat i; if (n != 0) { - head->blocks = n; head->free = head->start; head->link = NULL; for (i=1, bd = head+1; i < n; i++, bd++) { @@ -63,44 +150,207 @@ initGroup(nat n, bdescr *head) } } -bdescr * -allocGroup(nat n) +// when a block has been shortened by allocGroup(), we need to push +// the remaining chunk backwards in the free list in order to keep the +// list sorted by size. +static void +free_list_push_backwards (bdescr *bd) { - void *mblock; - bdescr *bd, **last; + bdescr *p; - ASSERT_SM_LOCK(); - ASSERT(n != 0); + p = bd->u.back; + while (p != NULL && p->blocks > bd->blocks) { + p = p->u.back; + } + if (p != bd->u.back) { + dbl_link_remove(bd, &free_list); + if (p != NULL) + dbl_link_insert_after(bd, p); + else + dbl_link_onto(bd, &free_list); + } +} - if (n > BLOCKS_PER_MBLOCK) { - return allocMegaGroup(BLOCKS_TO_MBLOCKS(n)); - } +// when a block has been coalesced by freeGroup(), we need to push the +// remaining chunk forwards in the free list in order to keep the list +// sorted by size. +static void +free_list_push_forwards (bdescr *bd) +{ + bdescr *p; - last = &free_list; - for (bd = free_list; bd != NULL; bd = bd->link) { - if (bd->blocks == n) { /* exactly the right size! */ - *last = bd->link; - initGroup(n, bd); /* initialise it */ - return bd; + p = bd; + while (p->link != NULL && p->link->blocks < bd->blocks) { + p = p->link; } - if (bd->blocks > n) { /* block too big... */ - bd->blocks -= n; /* take a chunk off the *end* */ - bd += bd->blocks; - initGroup(n, bd); /* initialise it */ - return bd; + if (p != bd) { + dbl_link_remove(bd, &free_list); + dbl_link_insert_after(bd, p); } - last = &bd->link; - } - - mblock = getMBlock(); /* get a new megablock */ - initMBlock(mblock); /* initialise the start fields */ - bd = FIRST_BDESCR(mblock); - initGroup(n,bd); /* we know the group will fit */ - if (n < BLOCKS_PER_MBLOCK) { - initGroup(BLOCKS_PER_MBLOCK-n, bd+n); - freeGroup(bd+n); /* add the rest on to the free list */ - } - return bd; +} + +static void +free_list_insert (bdescr *bd) +{ + bdescr *p, *prev; + + if (!free_list) { + dbl_link_onto(bd, &free_list); + return; + } + + prev = NULL; + p = free_list; + while (p != NULL && p->blocks < bd->blocks) { + prev = p; + p = p->link; + } + if (prev == NULL) + { + dbl_link_onto(bd, &free_list); + } + else + { + dbl_link_insert_after(bd, prev); + } +} + + +STATIC_INLINE bdescr * +tail_of (bdescr *bd) +{ + return bd + bd->blocks - 1; +} + +// After splitting a group, the last block of each group must have a +// tail that points to the head block, to keep our invariants for +// coalescing. +STATIC_INLINE void +setup_tail (bdescr *bd) +{ + bdescr *tail; + tail = tail_of(bd); + if (tail != bd) { + tail->blocks = 0; + tail->free = 0; + tail->link = bd; + } +} + + +// Take a free block group bd, and split off a group of size n from +// it. Adjust the free list as necessary, and return the new group. +static bdescr * +split_free_block (bdescr *bd, nat n) +{ + bdescr *fg; // free group + + ASSERT(bd->blocks > n); + fg = bd + bd->blocks - n; // take n blocks off the end + fg->blocks = n; + bd->blocks -= n; + setup_tail(bd); + free_list_push_backwards(bd); + return fg; +} + +static bdescr * +alloc_mega_group (nat mblocks) +{ + bdescr *best, *bd, *prev; + nat n; + + n = MBLOCK_GROUP_BLOCKS(mblocks); + + best = NULL; + prev = NULL; + for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link) + { + if (bd->blocks == n) + { + if (prev) { + prev->link = bd->link; + } else { + free_mblock_list = bd->link; + } + initGroup(n, bd); + return bd; + } + else if (bd->blocks > n) + { + if (!best || bd->blocks < best->blocks) + { + best = bd; + } + } + } + + if (best) + { + // we take our chunk off the end here. + nat best_mblocks = BLOCKS_TO_MBLOCKS(best->blocks); + bd = FIRST_BDESCR(MBLOCK_ROUND_DOWN(best) + + (best_mblocks-mblocks)*MBLOCK_SIZE); + + best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks); + initMBlock(MBLOCK_ROUND_DOWN(bd)); + } + else + { + void *mblock = getMBlocks(mblocks); + initMBlock(mblock); // only need to init the 1st one + bd = FIRST_BDESCR(mblock); + } + bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks); + return bd; +} + +bdescr * +allocGroup (nat n) +{ + bdescr *bd, *rem; + + ASSERT_SM_LOCK(); + + if (n == 0) barf("allocGroup: requested zero blocks"); + + if (n >= BLOCKS_PER_MBLOCK) + { + bd = alloc_mega_group(BLOCKS_TO_MBLOCKS(n)); + // only the bdescrs of the first MB are required to be initialised + initGroup(BLOCKS_PER_MBLOCK, bd); + IF_DEBUG(sanity, checkFreeListSanity()); + return bd; + } + + // The free list is sorted by size, so we get best fit. + for (bd = free_list; bd != NULL; bd = bd->link) + { + if (bd->blocks == n) // exactly the right size! + { + dbl_link_remove(bd, &free_list); + initGroup(n, bd); // initialise it + IF_DEBUG(sanity, checkFreeListSanity()); + return bd; + } + if (bd->blocks > n) // block too big... + { + bd = split_free_block(bd, n); + initGroup(n, bd); // initialise the new chunk + IF_DEBUG(sanity, checkFreeListSanity()); + return bd; + } + } + + bd = alloc_mega_group(1); + bd->blocks = n; + initGroup(n,bd); // we know the group will fit + rem = bd + n; + rem->blocks = BLOCKS_PER_MBLOCK-n; + initGroup(BLOCKS_PER_MBLOCK-n, rem); // init the slop + freeGroup(rem); // add the slop on to the free list + IF_DEBUG(sanity, checkFreeListSanity()); + return bd; } bdescr * @@ -116,7 +366,7 @@ allocGroup_lock(nat n) bdescr * allocBlock(void) { - return allocGroup(1); + return allocGroup(1); } bdescr * @@ -130,132 +380,68 @@ allocBlock_lock(void) } /* ----------------------------------------------------------------------------- - Any request larger than BLOCKS_PER_MBLOCK needs a megablock group. - First, search the free list for enough contiguous megablocks to - fulfill the request - if we don't have enough, we need to - allocate some new ones. - - A megablock group looks just like a normal block group, except that - the blocks field in the head will be larger than BLOCKS_PER_MBLOCK. - - Note that any objects placed in this group must start in the first - megablock, since the other blocks don't have block descriptors. + De-Allocation -------------------------------------------------------------------------- */ - -static bdescr * -allocMegaGroup(nat n) -{ - nat mbs_found; - bdescr *bd, *last, *grp_start, *grp_prev; - - mbs_found = 0; - grp_start = NULL; - grp_prev = NULL; - last = NULL; - for (bd = free_list; bd != NULL; bd = bd->link) { - - if (bd->blocks == BLOCKS_PER_MBLOCK) { /* whole megablock found */ - - /* is it the first one we've found or a non-contiguous megablock? */ - if (grp_start == NULL || - bd->start != last->start + MBLOCK_SIZE/sizeof(W_)) { - grp_start = bd; - grp_prev = last; - mbs_found = 1; - } else { - mbs_found++; - } - - if (mbs_found == n) { /* found enough contig megablocks? */ - break; - } - } - - else { /* only a partial megablock, start again */ - grp_start = NULL; - } - - last = bd; - } - /* found all the megablocks we need on the free list - */ - if (mbs_found == n) { - /* remove the megablocks from the free list */ - if (grp_prev == NULL) { /* bd now points to the last mblock */ - free_list = bd->link; - } else { - grp_prev->link = bd->link; +STATIC_INLINE bdescr * +coalesce_mblocks (bdescr *p) +{ + bdescr *q; + + q = p->link; + if (q != NULL && + MBLOCK_ROUND_DOWN(q) == + MBLOCK_ROUND_DOWN(p) + BLOCKS_TO_MBLOCKS(p->blocks) * MBLOCK_SIZE) { + // can coalesce + p->blocks = MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks) + + BLOCKS_TO_MBLOCKS(q->blocks)); + p->link = q->link; + return p; } - } - - /* the free list wasn't sufficient, allocate all new mblocks. - */ - else { - void *mblock = getMBlocks(n); - initMBlock(mblock); /* only need to init the 1st one */ - grp_start = FIRST_BDESCR(mblock); - } - - /* set up the megablock group */ - initGroup(BLOCKS_PER_MBLOCK, grp_start); - grp_start->blocks = MBLOCK_GROUP_BLOCKS(n); - return grp_start; + return q; } -/* ----------------------------------------------------------------------------- - De-Allocation - -------------------------------------------------------------------------- */ - -/* coalesce the group p with p->link if possible. - * - * Returns p->link if no coalescing was done, otherwise returns a - * pointer to the newly enlarged group p. - */ - -STATIC_INLINE bdescr * -coalesce(bdescr *p) +static void +free_mega_group (bdescr *mg) { - bdescr *q; + bdescr *bd, *prev; + + // Find the right place in the free list. free_mblock_list is + // sorted by *address*, not by size as the free_list is. + prev = NULL; + bd = free_mblock_list; + while (bd && bd->start < mg->start) { + prev = bd; + bd = bd->link; + } - 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; -#ifdef DEBUG + // coalesce backwards + if (prev) { - nat i, blocks; - bdescr *bd; - blocks = q->blocks; - // not strictly necessary to do this, but helpful if we have a - // random ptr and want to figure out what block it belongs to. - // Also required for sanity checking (see checkFreeListSanity()). - for (i = 0, bd = q; i < blocks; bd++, i++) { - bd->free = 0; - bd->blocks = 0; - bd->link = p; - } + mg->link = prev->link; + prev->link = mg; + mg = coalesce_mblocks(prev); } -#endif - return p; - } - return q; -} + else + { + mg->link = free_mblock_list; + free_mblock_list = mg; + } + // coalesce forwards + coalesce_mblocks(mg); + + IF_DEBUG(sanity, checkFreeListSanity()); +} + void freeGroup(bdescr *p) { - bdescr *bd, *last; - - ASSERT_SM_LOCK(); + nat p_on_free_list = 0; - /* are we dealing with a megablock group? */ - if (p->blocks > BLOCKS_PER_MBLOCK) { - freeMegaGroup(p); - return; - } + ASSERT_SM_LOCK(); + ASSERT(p->free != (P_)-1); p->free = (void *)-1; /* indicates that this block is free */ p->step = NULL; @@ -263,26 +449,74 @@ freeGroup(bdescr *p) /* fill the block group with garbage if sanity checking is on */ IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE)); - /* find correct place in free list to place new group */ - last = NULL; - for (bd = free_list; bd != NULL && bd->start < p->start; - bd = bd->link) { - last = bd; + if (p->blocks == 0) barf("freeGroup: block size is zero"); + + if (p->blocks >= BLOCKS_PER_MBLOCK) + { + // If this is an mgroup, make sure it has the right number of blocks + ASSERT(p->blocks == MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks))); + free_mega_group(p); + return; } - /* now, last = previous group (or NULL) */ - if (last == NULL) { - p->link = free_list; - free_list = p; - } else { - /* coalesce with previous group if possible */ - p->link = last->link; - last->link = p; - p = coalesce(last); + // coalesce forwards + { + bdescr *next; + next = p + p->blocks; + if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(p)) && next->free == (P_)-1) + { + p->blocks += next->blocks; + if (p->blocks == BLOCKS_PER_MBLOCK) + { + dbl_link_remove(next, &free_list); + free_mega_group(p); + return; + } + dbl_link_replace(p, next, &free_list); + setup_tail(p); + free_list_push_forwards(p); + p_on_free_list = 1; + } + } + + // coalesce backwards + if (p != FIRST_BDESCR(MBLOCK_ROUND_DOWN(p))) + { + bdescr *prev; + prev = p - 1; + if (prev->blocks == 0) prev = prev->link; // find the head + + if (prev->free == (P_)-1) + { + prev->blocks += p->blocks; + if (prev->blocks >= BLOCKS_PER_MBLOCK) + { + if (p_on_free_list) + { + dbl_link_remove(p, &free_list); + } + dbl_link_remove(prev, &free_list); + free_mega_group(prev); + return; + } + else if (p_on_free_list) + { + // p was already coalesced forwards + dbl_link_remove(p, &free_list); + } + setup_tail(prev); + free_list_push_forwards(prev); + p = prev; + p_on_free_list = 1; + } + } + + if (!p_on_free_list) + { + setup_tail(p); + free_list_insert(p); } - /* coalesce with next group if possible */ - coalesce(p); IF_DEBUG(sanity, checkFreeListSanity()); } @@ -294,20 +528,6 @@ freeGroup_lock(bdescr *p) RELEASE_SM_LOCK; } -static void -freeMegaGroup(bdescr *p) -{ - nat n; - void *q = 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); - } -} - void freeChain(bdescr *bd) { @@ -352,34 +572,84 @@ initMBlock(void *mblock) #ifdef DEBUG static void -checkWellFormedGroup( bdescr *bd ) +check_tail (bdescr *bd) { - nat i; + bdescr *tail = tail_of(bd); - for (i = 1; i < bd->blocks; i++) { - ASSERT(bd[i].blocks == 0); - ASSERT(bd[i].free == 0); - ASSERT(bd[i].link == bd); + if (tail != bd) + { + ASSERT(tail->blocks == 0); + ASSERT(tail->free == 0); + ASSERT(tail->link == bd); } } void checkFreeListSanity(void) { - bdescr *bd; + bdescr *bd, *prev; - for (bd = free_list; bd != NULL; bd = bd->link) { - IF_DEBUG(block_alloc, - debugBelch("group at 0x%p, length %ld blocks\n", - bd->start, (long)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); - ASSERT(bd->start < bd->link->start); + IF_DEBUG(block_alloc, debugBelch("free block list:\n")); + + prev = NULL; + for (bd = free_list; bd != NULL; prev = bd, bd = bd->link) + { + IF_DEBUG(block_alloc, + debugBelch("group at %p, length %ld blocks\n", + bd->start, (long)bd->blocks)); + ASSERT(bd->blocks > 0 && bd->blocks < BLOCKS_PER_MBLOCK); + ASSERT(bd->link != bd); // catch easy loops + + check_tail(bd); + + if (prev) + ASSERT(bd->u.back == prev); + else + ASSERT(bd->u.back == NULL); + + if (bd->link != NULL) + { + // make sure the list is sorted + ASSERT(bd->blocks <= bd->link->blocks); + } + + { + bdescr *next; + next = bd + bd->blocks; + if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(bd))) + { + ASSERT(next->free != (P_)-1); + } + } + } + + prev = NULL; + for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link) + { + IF_DEBUG(block_alloc, + debugBelch("mega group at %p, length %ld blocks\n", + bd->start, (long)bd->blocks)); + + ASSERT(bd->link != bd); // catch easy loops + + if (bd->link != NULL) + { + // make sure the list is sorted + ASSERT(bd->start < bd->link->start); + } + + ASSERT(bd->blocks >= BLOCKS_PER_MBLOCK); + ASSERT(MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(bd->blocks)) + == bd->blocks); + + // make sure we're fully coalesced + if (bd->link != NULL) + { + ASSERT (MBLOCK_ROUND_DOWN(bd->link) != + MBLOCK_ROUND_DOWN(bd) + + BLOCKS_TO_MBLOCKS(bd->blocks) * MBLOCK_SIZE); + } } - } } nat /* BLOCKS */ @@ -389,7 +659,14 @@ countFreeList(void) lnat total_blocks = 0; for (bd = free_list; bd != NULL; bd = bd->link) { - total_blocks += bd->blocks; + total_blocks += bd->blocks; + } + for (bd = free_mblock_list; bd != NULL; bd = bd->link) { + total_blocks += BLOCKS_PER_MBLOCK * BLOCKS_TO_MBLOCKS(bd->blocks); + // The caller of this function, memInventory(), expects to match + // the total number of blocks in the system against mblocks * + // BLOCKS_PER_MBLOCK, so we must subtract the space for the + // block descriptors from *every* mblock. } return total_blocks; } diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index fba30bb..1d08a85 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -1049,14 +1049,7 @@ void freeExec (void *addr) // the head of the queue. if (bd->gen_no == 0 && bd != exec_block) { debugTrace(DEBUG_gc, "free exec block %p", bd->start); - if (bd->u.back) { - bd->u.back->link = bd->link; - } else { - exec_block = bd->link; - } - if (bd->link) { - bd->link->u.back = bd->u.back; - } + dbl_link_remove(bd, &exec_block); setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse); freeGroup(bd); } -- 1.7.10.4