X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FBlockAlloc.c;h=98afdd4caf8da6ce349ea59822d8e68e28d17ee4;hb=30387408c5e471e8f8ff61f80754ad2c07880a7d;hp=5bcce7bf4ff9d66ca3238f15717675f253232345;hpb=a370654a872838c43e63bdd6cc279c0ee9913cdf;p=ghc-hetmet.git

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