From 30387408c5e471e8f8ff61f80754ad2c07880a7d Mon Sep 17 00:00:00 2001
From: Simon Marlow <simonmarhaskell@gmail.com>
Date: Wed, 16 Apr 2008 23:30:58 +0000
Subject: [PATCH] add debugging code to check for fragmentation

---
 rts/sm/BlockAlloc.c |    8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index 5bcce7b..98afdd4 100644
--- a/rts/sm/BlockAlloc.c
+++ b/rts/sm/BlockAlloc.c
@@ -331,6 +331,14 @@ allocGroup (nat n)
     }
 
     if (ln == MAX_FREE_LIST) {
+#if 0
+        if ((mblocks_allocated * MBLOCK_SIZE_W - n_alloc_blocks * BLOCK_SIZE_W) > (1024*1024)/sizeof(W_)) {
+            debugBelch("Fragmentation, wanted %d blocks:", n);
+            RtsFlags.DebugFlags.block_alloc = 1;
+            checkFreeListSanity();
+        }
+#endif
+
         bd = alloc_mega_group(1);
         bd->blocks = n;
         initGroup(n,bd);		         // we know the group will fit
-- 
1.7.10.4