add debugging code to check for fragmentation

1 files changed, 8 insertions, 0 deletions

diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index 5bcce7bf4f..98afdd4caf 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