Block allocator patch
Andrew Cheadle
amc4 at doc.ic.ac.uk
Sun Jun 5 10:36:57 EDT 2005
Hi Simon,
Here's a patch for the block allocator that reduces the coalescing
algorithm from O(N^2) to N.
I created the mods and tested them on my 6.2 builds and then prop'd them
to the current 6.4 CVS HEAD. When I get a chance and HEAD is unb0rked
I'll test them on it. Hopefully the attached patch as is fine though ;-)
Any problems/bugs/idiocy let me know!
Cheers
Andy
*********************************************************************
* Andrew Cheadle email: a.cheadle at doc.ic.ac.uk *
* Department of Computing http://www.doc.ic.ac.uk/~amc4/ *
* Imperial College *
* University of London *
*********************************************************************
-------------- next part --------------
diff --unified --recursive --exclude=CVS fptools/ghc/includes/Block.h patched/fptools/ghc/includes/Block.h
--- fptools/ghc/includes/Block.h 2005-06-04 14:50:23.000000000 +0100
+++ patched/fptools/ghc/includes/Block.h 2005-04-12 10:04:23.000000000 +0100
@@ -85,8 +85,6 @@
#define BF_PINNED 4
/* Block is part of a compacted generation */
#define BF_COMPACTED 8
-/* Block is allocated */
-#define BF_ALLOCATED 16
/* Finding the block descriptor for a given block -------------------------- */
diff --unified --recursive --exclude=CVS fptools/ghc/rts/Arena.c patched/fptools/ghc/rts/Arena.c
--- fptools/ghc/rts/Arena.c 2005-06-06 14:13:52.308597576 +0100
+++ patched/fptools/ghc/rts/Arena.c 2005-02-23 10:59:17.000000000 +0000
@@ -87,6 +87,7 @@
bd->gen_no = 0;
bd->step = NULL;
+ bd->flags = 0;
bd->free = bd->start;
bd->link = arena->current;
arena->current = bd;
diff --unified --recursive --exclude=CVS fptools/ghc/rts/BlockAlloc.c patched/fptools/ghc/rts/BlockAlloc.c
--- fptools/ghc/rts/BlockAlloc.c 2005-06-06 14:57:10.983538936 +0100
+++ patched/fptools/ghc/rts/BlockAlloc.c 2005-02-10 13:02:07.000000000 +0000
@@ -53,9 +53,7 @@
head->blocks = n;
head->free = head->start;
head->link = NULL;
- head->flags = BF_ALLOCATED;
for (i=1, bd = head+1; i < n; i++, bd++) {
- bd->flags = BF_ALLOCATED;
bd->free = 0;
bd->blocks = 0;
bd->link = head;
@@ -78,14 +76,10 @@
last = &free_list;
for (bd = free_list; bd != NULL; bd = bd->link) {
if (bd->blocks == n) { /* exactly the right size! */
- if (bd->link) {
- bd->link->u.back = bd->u.back;
- }
*last = bd->link;
/* no initialisation necessary - this is already a
* self-contained block group. */
- bd->flags = BF_ALLOCATED;
- bd->free = bd->start;
+ bd->free = bd->start; /* block isn't free now */
bd->link = NULL;
return bd;
}
@@ -164,23 +158,19 @@
last = bd;
}
- /* found all the megablocks we need on the free list */
+ /* 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;
- if (free_list) {
- free_list->u.back = NULL;
- }
} else {
grp_prev->link = bd->link;
- if (bd->link) {
- bd->link->u.back = grp_prev;
- }
}
}
- /* the free list wasn't sufficient, allocate all new mblocks. */
+ /* the free list wasn't sufficient, allocate all new mblocks.
+ */
else {
void *mblock = getMBlocks(n);
initMBlock(mblock); /* only need to init the 1st one */
@@ -197,117 +187,72 @@
De-Allocation
-------------------------------------------------------------------------- */
-/* coalesce the group p with its predecessor and successor groups, if possible
+/* coalesce the group p with p->link if possible.
*
- * Returns NULL if no coalescing was done, otherwise returns a
+ * Returns p->link if no coalescing was done, otherwise returns a
* pointer to the newly enlarged group p.
*/
STATIC_INLINE bdescr *
coalesce(bdescr *p)
{
- bdescr *first, *bd, *q, *result = NULL;
+ bdescr *bd, *q;
nat i, blocks;
- /* Get first megablock descriptor */
- first = FIRST_BDESCR(MBLOCK_ROUND_DOWN(p->start));
-
- /* Attempt to coalesce with predecessor if not the first block */
- if (p != first) {
- q = Bdescr(BLOCK_ROUND_DOWN(p->start - 1));
- if (!q->blocks) {
- q = q->link;
- }
- /* Predecessor is free? */
- if (!(q->flags & BF_ALLOCATED)) {
- q->blocks += p->blocks;
- blocks = p->blocks;
- for (i = 0, bd = p; i < blocks; bd++, i++) {
- bd->flags = BF_ALLOCATED;
- bd->free = 0;
- bd->blocks = 0;
- bd->link = q;
- }
- p = result = q;
- }
- }
-
- /* Attempt to coalesce with successor if not the last block */
- q = p + p->blocks;
- if (q != first + BLOCKS_PER_MBLOCK) {
- /* Successor is free */
- if (!(q->flags & BF_ALLOCATED)) {
- if (result) {
- /* p is on free_list, q is on free_list, unlink
- * q completely and patch up list
- */
- if (q->u.back) {
- q->u.back->link = q->link;
- }
- if (q->link) {
- q->link->u.back = q->u.back;
- }
- if (free_list == q) {
- free_list = q->link;
- }
- } else {
- /* p is not on free_list just assume q's links */
- p->u.back = q->u.back;
- if (p->u.back) {
- p->u.back->link = p;
- }
- p->link = q->link;
- if (p->link) {
- p->link->u.back = p;
- }
-
- if (q == free_list) {
- free_list = p;
- free_list->u.back = NULL;
- }
- }
-
- p->blocks += q->blocks;
- blocks = q->blocks;
- for (i = 0, bd = q; i < blocks; bd++, i++) {
- bd->flags = BF_ALLOCATED;
+ 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;
+ blocks = q->blocks;
+ for (i = 0, bd = q; i < blocks; bd++, i++) {
bd->free = 0;
bd->blocks = 0;
bd->link = p;
- }
- result = p;
}
+ return p;
}
-
- return result;
+ return q;
}
void
freeGroup(bdescr *p)
{
+ bdescr *bd, *last;
+
/* are we dealing with a megablock group? */
if (p->blocks > BLOCKS_PER_MBLOCK) {
freeMegaGroup(p);
return;
}
- p->flags = 0;
- p->u.back = NULL;
- p->link = NULL;
- p->free = (void *)-1;
+
+ 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));
- if (!coalesce(p)) {
- dbl_link_onto(p, &free_list);
+ /* 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 (!free_list) {
+ /* 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 with next group if possible */
+ coalesce(p);
IF_DEBUG(sanity, checkFreeListSanity());
}
@@ -361,15 +306,13 @@
#ifdef DEBUG
static void
-checkWellFormedGroup(bdescr *bd)
+checkWellFormedGroup( bdescr *bd )
{
nat i;
- ASSERT(!(bd[0].flags & BF_ALLOCATED));
for (i = 1; i < bd->blocks; i++) {
ASSERT(bd[i].blocks == 0);
ASSERT(bd[i].free == 0);
- ASSERT(bd[i].flags & BF_ALLOCATED);
ASSERT(bd[i].link == bd);
}
}
@@ -388,6 +331,7 @@
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);
}
}
}
diff --unified --recursive --exclude=CVS fptools/ghc/rts/FrontPanel.c patched/fptools/ghc/rts/FrontPanel.c
--- fptools/ghc/rts/FrontPanel.c 2005-06-04 11:31:28.000000000 +0100
+++ patched/fptools/ghc/rts/FrontPanel.c 2004-09-12 12:27:10.000000000 +0100
@@ -400,11 +400,11 @@
for (; a <= LAST_BLOCK(m); (char *)a += BLOCK_SIZE) {
bd = Bdescr((P_)a);
ASSERT(bd->start == a);
- if (bd->flags & BF_ALLOCATED) {
- colorBlock( a, &gen_colors[bd->gen_no],
+ if (bd->free == (void *)-1) {
+ colorBlock( a, &free_color,
block_width, block_height, blocks_per_line );
} else {
- colorBlock( a, &free_color,
+ colorBlock( a, &gen_colors[bd->gen_no],
block_width, block_height, blocks_per_line );
}
}
diff --unified --recursive --exclude=CVS fptools/ghc/rts/GC.c patched/fptools/ghc/rts/GC.c
--- fptools/ghc/rts/GC.c 2005-06-06 14:21:53.258482080 +0100
+++ patched/fptools/ghc/rts/GC.c 2005-05-27 15:47:08.000000000 +0100
@@ -240,7 +240,9 @@
// blocks in to-space in generations up to and including N
// get the BF_EVACUATED flag.
if (stp->gen_no <= N) {
- bd->flags |= BF_EVACUATED;
+ bd->flags = BF_EVACUATED;
+ } else {
+ bd->flags = 0;
}
// Start a new to-space block, chain it on after the previous one.
@@ -946,7 +948,7 @@
freeChain(old_to_blocks);
}
for (bd = g0s0->to_blocks; bd != NULL; bd = bd->link) {
- bd->flags = BF_ALLOCATED; // now from-space
+ bd->flags = 0; // now from-space
}
/* For a two-space collector, we need to resize the nursery. */
diff --unified --recursive --exclude=CVS fptools/ghc/rts/RetainerProfile.c patched/fptools/ghc/rts/RetainerProfile.c
--- fptools/ghc/rts/RetainerProfile.c 2005-06-04 11:37:33.000000000 +0100
+++ patched/fptools/ghc/rts/RetainerProfile.c 2005-04-26 16:44:48.000000000 +0100
@@ -2027,7 +2027,7 @@
#ifdef DEBUG_RETAINER
#define LOOKS_LIKE_PTR(r) ((LOOKS_LIKE_STATIC_CLOSURE(r) || \
- ((HEAP_ALLOCED(r) && (Bdescr((P_)r)->flags & BF_ALLOCATED)))) && \
+ ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1))) && \
((StgWord)(*(StgPtr)r)!=0xaaaaaaaa))
static nat
diff --unified --recursive --exclude=CVS fptools/ghc/rts/Schedule.c patched/fptools/ghc/rts/Schedule.c
--- fptools/ghc/rts/Schedule.c 2005-06-06 14:23:11.777545368 +0100
+++ patched/fptools/ghc/rts/Schedule.c 2005-05-27 15:47:09.000000000 +0100
@@ -1515,7 +1515,7 @@
for (x = bd; x < bd + blocks; x++) {
x->step = cap->r.rNursery;
x->gen_no = 0;
- x->flags = BF_ALLOCATED;
+ x->flags = 0;
}
}
diff --unified --recursive --exclude=CVS fptools/ghc/rts/Storage.c patched/fptools/ghc/rts/Storage.c
--- fptools/ghc/rts/Storage.c 2005-06-06 14:27:28.211561472 +0100
+++ patched/fptools/ghc/rts/Storage.c 2005-05-12 12:36:50.000000000 +0100
@@ -391,6 +391,7 @@
}
bd->step = stp;
bd->gen_no = 0;
+ bd->flags = 0;
bd->free = bd->start;
tail = bd;
}
@@ -555,7 +556,7 @@
g0s0->n_large_blocks += req_blocks;
bd->gen_no = 0;
bd->step = g0s0;
- bd->flags |= BF_LARGE;
+ bd->flags = BF_LARGE;
bd->free = bd->start + n;
alloc_blocks += req_blocks;
RELEASE_SM_LOCK;
@@ -571,6 +572,7 @@
small_alloc_list = bd;
bd->gen_no = 0;
bd->step = g0s0;
+ bd->flags = 0;
alloc_Hp = bd->start;
alloc_HpLim = bd->start + BLOCK_SIZE_W;
alloc_blocks++;
@@ -638,7 +640,7 @@
g0s0->n_large_blocks += req_blocks;
bd->gen_no = 0;
bd->step = g0s0;
- bd->flags |= BF_LARGE;
+ bd->flags = BF_LARGE;
bd->free = bd->start + n;
alloc_blocks += req_blocks;
RELEASE_SM_LOCK;
@@ -664,6 +666,7 @@
RELEASE_SM_LOCK;
bd->gen_no = 0;
bd->step = g0s0;
+ bd->flags = 0;
} else {
// we have a block in the nursery: take it and put
// it at the *front* of the nursery list, and use it
@@ -737,7 +740,7 @@
dbl_link_onto(bd, &g0s0->large_objects);
bd->gen_no = 0;
bd->step = g0s0;
- bd->flags |= BF_PINNED | BF_LARGE;
+ bd->flags = BF_PINNED | BF_LARGE;
bd->free = bd->start;
alloc_blocks++;
}
More information about the Cvs-ghc
mailing list