From: Simon Marlow <marlowsd@gmail.com>
Date: Tue, 9 Sep 2008 13:37:48 +0000 (+0000)
Subject: More sanity checking for the TSO write barrier
X-Git-Tag: 2008-09-12~40
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=c1580e72e315576b5f58427f1c29f268b565e95e

More sanity checking for the TSO write barrier
Check that all threads marked as dirty are really on the mutable list.
---

diff --git a/includes/Constants.h b/includes/Constants.h
index f0f3ce7..967a852 100644
--- a/includes/Constants.h
+++ b/includes/Constants.h
@@ -266,6 +266,8 @@
  */
 #define TSO_LINK_DIRTY 32
 
+#define TSO_MARKED 64
+
 /* -----------------------------------------------------------------------------
    RET_DYN stack frames
    -------------------------------------------------------------------------- */
diff --git a/rts/Sanity.c b/rts/Sanity.c
index 3eea3cd..8f3b627 100644
--- a/rts/Sanity.c
+++ b/rts/Sanity.c
@@ -793,6 +793,14 @@ checkGlobalTSOList (rtsBool checkTSOs)
           ASSERT(get_itbl(tso)->type == TSO);
           if (checkTSOs)
               checkTSO(tso);
+
+          // If this TSO is dirty and in an old generation, it better
+          // be on the mutable list.
+          if (tso->what_next == ThreadRelocated) continue;
+          if (tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) {
+              ASSERT(Bdescr((P_)tso)->gen_no == 0 || tso->flags & TSO_MARKED);
+              tso->flags &= ~TSO_MARKED;
+          }
       }
   }
 }
@@ -812,10 +820,27 @@ checkMutableList( bdescr *mut_bd, nat gen )
 	for (q = bd->start; q < bd->free; q++) {
 	    p = (StgClosure *)*q;
 	    ASSERT(!HEAP_ALLOCED(p) || Bdescr((P_)p)->gen_no == gen);
+            if (get_itbl(p)->type == TSO) {
+                ((StgTSO *)p)->flags |= TSO_MARKED;
+            }
 	}
     }
 }
 
+void
+checkMutableLists (void)
+{
+    nat g, i;
+
+    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+        checkMutableList(generations[g].mut_list, g);
+        for (i = 0; i < n_capabilities; i++) {
+            checkMutableList(capabilities[i].mut_lists[g], g);
+        }
+    }
+    checkGlobalTSOList(rtsTrue);
+}
+
 /*
   Check the static objects list.
 */
diff --git a/rts/Sanity.h b/rts/Sanity.h
index 8cf3f9e..b86dc97 100644
--- a/rts/Sanity.h
+++ b/rts/Sanity.h
@@ -29,6 +29,7 @@ extern StgOffset checkStackFrame ( StgPtr sp );
 extern StgOffset checkClosure  ( StgClosure* p );
 
 extern void checkMutableList   ( bdescr *bd, nat gen );
+extern void checkMutableLists (void);
 
 #if defined(GRAN)
 extern void checkTSOsSanity(void);
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index f8a0980..ef0c79a 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -268,8 +268,9 @@ GarbageCollect ( rtsBool force_major_gc )
   memInventory(traceClass(DEBUG_gc));
 #endif
 
-  // check stack sanity *before* GC (ToDo: check all threads) 
+  // check stack sanity *before* GC
   IF_DEBUG(sanity, checkFreeListSanity());
+  IF_DEBUG(sanity, checkMutableLists());
 
   // Initialise all our gc_thread structures
   for (t = 0; t < n_gc_threads; t++) {