From f4068203328cd00a1935e4f4a8e3cab400db01ea Mon Sep 17 00:00:00 2001
From: Simon Marlow <simonmarhaskell@gmail.com>
Date: Wed, 16 Apr 2008 22:38:24 +0000
Subject: [PATCH] allocate more blocks in one go, to reduce contention for the
 block allocator

---
 rts/sm/GCUtils.c |   43 +++++++++++++++++++++++++++++++++++--------
 1 file changed, 35 insertions(+), 8 deletions(-)

diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c
index f7b1819..36fc4f3 100644
--- a/rts/sm/GCUtils.c
+++ b/rts/sm/GCUtils.c
@@ -33,6 +33,29 @@ allocBlock_sync(void)
     return bd;
 }
 
+
+static void
+allocBlocks_sync(nat n, bdescr **hd, bdescr **tl, 
+                 nat gen_no, step *stp,
+                 StgWord32 flags)
+{
+    bdescr *bd;
+    nat i;
+    ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
+    bd = allocGroup(n);
+    for (i = 0; i < n; i++) {
+        bd[i].blocks = 1;
+        bd[i].gen_no = gen_no;
+        bd[i].step = stp;
+        bd[i].flags = flags;
+        bd[i].link = &bd[i+1];
+        bd[i].u.scan = bd[i].free = bd[i].start;
+    }
+    *hd = bd;
+    *tl = &bd[n-1];
+    RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
+}
+
 void
 freeChain_sync(bdescr *bd)
 {
@@ -180,7 +203,8 @@ todo_block_full (nat size, step_workspace *ws)
 StgPtr
 alloc_todo_block (step_workspace *ws, nat size)
 {
-    bdescr *bd;
+    bdescr *bd, *hd, *tl;
+    StgWord32 flags;
 
     // Grab a part block if we have one, and it has enough room
     if (ws->part_list != NULL && 
@@ -192,18 +216,21 @@ alloc_todo_block (step_workspace *ws, nat size)
     }
     else
     {
-        bd = allocBlock_sync();
-        bd->gen_no = ws->step->gen_no;
-        bd->step = ws->step;
-        bd->u.scan = bd->start;
-
         // blocks in to-space in generations up to and including N
         // get the BF_EVACUATED flag.
         if (ws->step->gen_no <= N) {
-            bd->flags = BF_EVACUATED;
+            flags = BF_EVACUATED;
         } else {
-            bd->flags = 0;
+            flags = 0;
         }
+        allocBlocks_sync(4, &hd, &tl, 
+                         ws->step->gen_no, ws->step, flags);
+
+        tl->link = ws->part_list;
+        ws->part_list = hd->link;
+        ws->n_part_blocks += 3;
+
+        bd = hd;
     }
 
     bd->link = NULL;
-- 
1.7.10.4