From: Simon Marlow <simonmarhaskell@gmail.com>
Date: Wed, 16 Apr 2008 23:30:58 +0000 (+0000)
Subject: add debugging code to check for fragmentation
X-Git-Tag: Before_cabalised-GHC~199
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=30387408c5e471e8f8ff61f80754ad2c07880a7d

add debugging code to check for fragmentation
---

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