Reduce fragmentation when using +RTS -H (with or without a size)
authorSimon Marlow <marlowsd@gmail.com>
Tue, 21 Aug 2012 10:39:06 +0000 (11:39 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Tue, 21 Aug 2012 10:50:45 +0000 (11:50 +0100)
rts/sm/BlockAlloc.c
rts/sm/BlockAlloc.h
rts/sm/Storage.c

index 8a1cfab..9fd3ef5 100644 (file)
@@ -389,6 +389,41 @@ finish:
     return bd;
 }
 
+//
+// 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.
+//
+bdescr *
+allocLargeChunk (void)
+{
+    bdescr *bd;
+    nat ln;
+
+    ln = 5; // start in the 32-63 block bucket
+    while (ln < MAX_FREE_LIST && free_list[ln] == NULL) {
+        ln++;
+    }
+    if (ln == MAX_FREE_LIST) {
+        return allocGroup(BLOCKS_PER_MBLOCK);
+    }
+    bd = free_list[ln];
+
+    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;
+}
+
 bdescr *
 allocGroup_lock(nat n)
 {
index f8b4204..d26bb24 100644 (file)
@@ -11,6 +11,8 @@
 
 #include "BeginPrivate.h"
 
+bdescr *allocLargeChunk (void);
+
 /* Debugging  -------------------------------------------------------------- */
 
 extern nat countBlocks       (bdescr *bd);
index cadaf4d..6b32593 100644 (file)
@@ -437,10 +437,16 @@ allocNursery (bdescr *tail, nat blocks)
     // tiny optimisation (~0.5%), but it's free.
 
     while (blocks > 0) {
-        n = stg_min(blocks, BLOCKS_PER_MBLOCK);
+        if (blocks >= BLOCKS_PER_MBLOCK) {
+            bd = allocLargeChunk(); // see comment with allocLargeChunk()
+            n = bd->blocks;
+        } else {
+            bd = allocGroup(blocks);
+            n = blocks;
+        }
+
         blocks -= n;
 
-        bd = allocGroup(n);
         for (i = 0; i < n; i++) {
             initBdescr(&bd[i], g0, g0);