1 files changed, 47 insertions, 2 deletions

diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index 62d53e046d..6f6b15c4e8 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -28,6 +28,7 @@
 #include "Printer.h"
 #include "Arena.h"
 #include "RetainerProfile.h"
+#include "CNF.h"
 
 /* -----------------------------------------------------------------------------
    Forward decls.
@@ -424,7 +425,7 @@ checkClosure( const StgClosure* p )
       }
 
     default:
-            barf("checkClosure (closure type %d)", info->type);
+        barf("checkClosure (closure type %d)", info->type);
     }
 }
 
@@ -485,6 +486,37 @@ checkLargeObjects(bdescr *bd)
 }
 
 static void
+checkCompactObjects(bdescr *bd)
+{
+    // Compact objects are similar to large objects,
+    // but they have a StgCompactNFDataBlock at the beginning,
+    // before the actual closure
+
+    for ( ; bd != NULL; bd = bd->link) {
+        StgCompactNFDataBlock *block, *last;
+        StgCompactNFData *str;
+        StgWord totalW;
+
+        ASSERT (bd->flags & BF_COMPACT);
+
+        block = (StgCompactNFDataBlock*)bd->start;
+        str = block->owner;
+        ASSERT ((W_)str == (W_)block + sizeof(StgCompactNFDataBlock));
+
+        totalW = 0;
+        for ( ; block ; block = block->next) {
+            last = block;
+            ASSERT (block->owner == str);
+
+            totalW += Bdescr((P_)block)->blocks * BLOCK_SIZE_W;
+        }
+
+        ASSERT (str->totalW == totalW);
+        ASSERT (str->last == last);
+    }
+}
+
+static void
 checkSTACK (StgStack *stack)
 {
     StgPtr sp = stack->sp;
@@ -715,6 +747,7 @@ static void checkGeneration (generation *gen,
     }
 
     checkLargeObjects(gen->large_objects);
+    checkCompactObjects(gen->compact_objects);
 }
 
 /* Full heap sanity check. */
@@ -744,6 +777,14 @@ void checkSanity (rtsBool after_gc, rtsBool major_gc)
     }
 }
 
+static void
+markCompactBlocks(bdescr *bd)
+{
+    for (; bd != NULL; bd = bd->link) {
+        compactMarkKnown(((StgCompactNFDataBlock*)bd->start)->owner);
+    }
+}
+
 // If memInventory() calculates that we have a memory leak, this
 // function will try to find the block(s) that are leaking by marking
 // all the ones that we know about, and search through memory to find
@@ -764,6 +805,7 @@ findMemoryLeak (void)
         }
         markBlocks(generations[g].blocks);
         markBlocks(generations[g].large_objects);
+        markCompactBlocks(generations[g].compact_objects);
     }
 
     for (i = 0; i < n_nurseries; i++) {
@@ -833,8 +875,11 @@ genBlocks (generation *gen)
 {
     ASSERT(countBlocks(gen->blocks) == gen->n_blocks);
     ASSERT(countBlocks(gen->large_objects) == gen->n_large_blocks);
+    ASSERT(countCompactBlocks(gen->compact_objects) == gen->n_compact_blocks);
+    ASSERT(countCompactBlocks(gen->compact_blocks_in_import) == gen->n_compact_blocks_in_import);
     return gen->n_blocks + gen->n_old_blocks +
-            countAllocdBlocks(gen->large_objects);
+        countAllocdBlocks(gen->large_objects) +
+        gen->n_compact_blocks + gen->n_compact_blocks_in_import;
 }
 
 void