rts: Assert LDV_recordDead is not called for inherently used closures

The comments make it clear LDV_recordDead should not be called for
inhererently used closures, so add an assertion to codify this fact.

3 files changed, 44 insertions, 24 deletions

diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h
index 262a4380c4..ade8b34631 100644
--- a/includes/rts/storage/ClosureMacros.h
+++ b/includes/rts/storage/ClosureMacros.h
@@ -532,6 +532,7 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
 
 #if defined(PROFILING)
 void LDV_recordDead (const StgClosure *c, uint32_t size);
+RTS_PRIVATE bool isInherentlyUsed ( StgHalfWord closure_type );
 #endif
 
 EXTERN_INLINE void overwritingClosure_ (StgClosure *p,
@@ -559,6 +560,9 @@ EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t
 EXTERN_INLINE void overwritingClosure (StgClosure *p);
 EXTERN_INLINE void overwritingClosure (StgClosure *p)
 {
+#if defined(PROFILING)
+    ASSERT(!isInherentlyUsed(get_itbl(p)->type));
+#endif
     overwritingClosure_(p, sizeofW(StgThunkHeader), closure_sizeW(p),
                         /*inherently_used=*/false);
 }
@@ -589,5 +593,8 @@ EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset)
 EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */);
 EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size)
 {
+#if defined(PROFILING)
+    ASSERT(!isInherentlyUsed(get_itbl(p)->type));
+#endif
     overwritingClosure_(p, sizeofW(StgThunkHeader), size, /*inherently_used=*/false);
 }
diff --git a/rts/LdvProfile.c b/rts/LdvProfile.c
index cf57f28eae..71064ddbce 100644
--- a/rts/LdvProfile.c
+++ b/rts/LdvProfile.c
@@ -18,6 +18,37 @@
 #include "RtsUtils.h"
 #include "Schedule.h"
 
+bool isInherentlyUsed( StgHalfWord closure_type )
+{
+    switch(closure_type) {
+    case TSO:
+    case STACK:
+    case MVAR_CLEAN:
+    case MVAR_DIRTY:
+    case TVAR:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
+    case MUT_ARR_PTRS_FROZEN_CLEAN:
+    case MUT_ARR_PTRS_FROZEN_DIRTY:
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
+    case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
+    case ARR_WORDS:
+    case WEAK:
+    case MUT_VAR_CLEAN:
+    case MUT_VAR_DIRTY:
+    case BCO:
+    case PRIM:
+    case MUT_PRIM:
+    case TREC_CHUNK:
+        return true;
+
+    default:
+        return false;
+    }
+}
+
 /* --------------------------------------------------------------------------
  * This function is called eventually on every object destroyed during
  * a garbage collection, whether it is a major garbage collection or
@@ -55,33 +86,13 @@ processHeapClosureForDead( const StgClosure *c )
 
     size = closure_sizeW(c);
 
-    switch (info->type) {
-        /*
+    /*
           'inherently used' cases: do nothing.
-        */
-    case TSO:
-    case STACK:
-    case MVAR_CLEAN:
-    case MVAR_DIRTY:
-    case TVAR:
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-    case MUT_ARR_PTRS_FROZEN_CLEAN:
-    case MUT_ARR_PTRS_FROZEN_DIRTY:
-    case SMALL_MUT_ARR_PTRS_CLEAN:
-    case SMALL_MUT_ARR_PTRS_DIRTY:
-    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
-    case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
-    case ARR_WORDS:
-    case WEAK:
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY:
-    case BCO:
-    case PRIM:
-    case MUT_PRIM:
-    case TREC_CHUNK:
+    */
+    if(isInherentlyUsed(info->type))
         return size;
 
+    switch (info->type) {
         /*
           ordinary cases: call LDV_recordDead().
         */
diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index 8f7b65d7a4..03c99a0d49 100644
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -280,6 +280,8 @@ LDV_recordDead( const StgClosure *c, uint32_t size )
     uint32_t t;
     counter *ctr;
 
+    ASSERT(!isInherentlyUsed(get_itbl(c)->type));
+
     if (era > 0 && closureSatisfiesConstraints(c)) {
         size -= sizeofW(StgProfHeader);
         ASSERT(LDVW(c) != 0);