Allow allocNursery() to allocate single blocks (#7257)

Forcing large allocations here can creates serious fragmentation in
some cases, and since the large allocations are only a small
optimisation we should allow the nursery to hoover up small blocks
before allocating large chunks.

1 files changed, 6 insertions, 10 deletions

diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 541da5df1c..755c65427c 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -437,16 +437,12 @@ allocNursery (bdescr *tail, W_ blocks)
     // tiny optimisation (~0.5%), but it's free.
 
     while (blocks > 0) {
-        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);
-            n = blocks;
-        }
-
+        n = stg_min(BLOCKS_PER_MBLOCK, blocks);
+        // allocLargeChunk will prefer large chunks, but will pick up
+        // small chunks if there are any available.  We must allow
+        // single blocks here to avoid fragmentation (#7257)
+        bd = allocLargeChunk(1, n);
+        n = bd->blocks;
         blocks -= n;
 
         for (i = 0; i < n; i++) {