Some further tweaks to reduce fragmentation when allocating the nursery
authorSimon Marlow <marlowsd@gmail.com>
Fri, 7 Sep 2012 12:36:09 +0000 (13:36 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Fri, 7 Sep 2012 14:32:14 +0000 (15:32 +0100)
rts/sm/BlockAlloc.c
rts/sm/BlockAlloc.h
rts/sm/Storage.c

index 9fd3ef5..72d5b29 100644 (file)
@@ -390,35 +390,51 @@ finish:
 }
 
 //
-// Allocate a chunk of blocks that is at most a megablock in size.
-// This API is used by the nursery allocator that wants contiguous
-// memory preferably, but doesn't require it.  When memory is
-// fragmented we might have lots of large chunks that are less than a
-// full megablock, so allowing the nursery allocator to use these
-// reduces fragmentation considerably.  e.g. on a GHC build with +RTS
-// -H, I saw fragmentation go from 17MB down to 3MB on a single compile.
+// Allocate a chunk of blocks that is at least min and at most max
+// blocks in size. This API is used by the nursery allocator that
+// wants contiguous memory preferably, but doesn't require it.  When
+// memory is fragmented we might have lots of large chunks that are
+// less than a full megablock, so allowing the nursery allocator to
+// use these reduces fragmentation considerably.  e.g. on a GHC build
+// with +RTS -H, I saw fragmentation go from 17MB down to 3MB on a
+// single compile.
 //
 bdescr *
-allocLargeChunk (void)
+allocLargeChunk (nat min, nat max)
 {
     bdescr *bd;
-    nat ln;
+    nat ln, lnmax;
 
-    ln = 5; // start in the 32-63 block bucket
-    while (ln < MAX_FREE_LIST && free_list[ln] == NULL) {
+    if (min >= BLOCKS_PER_MBLOCK) {
+        return allocGroup(max);
+    }
+
+    ln = log_2_ceil(min);
+    lnmax = log_2_ceil(max); // tops out at MAX_FREE_LIST
+
+    while (ln < lnmax && free_list[ln] == NULL) {
         ln++;
     }
-    if (ln == MAX_FREE_LIST) {
-        return allocGroup(BLOCKS_PER_MBLOCK);
+    if (ln == lnmax) {
+        return allocGroup(max);
     }
     bd = free_list[ln];
 
+    if (bd->blocks <= max)              // exactly the right size!
+    {
+        dbl_link_remove(bd, &free_list[ln]);
+        initGroup(bd);
+    }
+    else   // block too big...
+    {                              
+        bd = split_free_block(bd, max, ln);
+        ASSERT(bd->blocks == max);
+        initGroup(bd);
+    }
+
     n_alloc_blocks += bd->blocks;
     if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
 
-    dbl_link_remove(bd, &free_list[ln]);
-    initGroup(bd);
-
     IF_DEBUG(sanity, memset(bd->start, 0xaa, bd->blocks * BLOCK_SIZE));
     IF_DEBUG(sanity, checkFreeListSanity());
     return bd;
index d26bb24..a4890e5 100644 (file)
@@ -11,7 +11,7 @@
 
 #include "BeginPrivate.h"
 
-bdescr *allocLargeChunk (void);
+bdescr *allocLargeChunk (nat min, nat max);
 
 /* Debugging  -------------------------------------------------------------- */
 
index 6b32593..1345705 100644 (file)
@@ -437,8 +437,10 @@ allocNursery (bdescr *tail, nat blocks)
     // tiny optimisation (~0.5%), but it's free.
 
     while (blocks > 0) {
-        if (blocks >= BLOCKS_PER_MBLOCK) {
-            bd = allocLargeChunk(); // see comment with allocLargeChunk()
+        if (blocks >= BLOCKS_PER_MBLOCK / 4) {
+            n = stg_min(BLOCKS_PER_MBLOCK, blocks);
+            bd = allocLargeChunk(16, n); // see comment with allocLargeChunk()
+            // NB. we want a nice power of 2 for the minimum here
             n = bd->blocks;
         } else {
             bd = allocGroup(blocks);