Do not link ghc stage1 using -threaded, only for stage2 or 3

[ghc-hetmet.git] / rts / Sanity.c

diff --git a/rts/Sanity.c b/rts/Sanity.c
index 3eea3cd..3f4b3cf 100644 (file)
--- a/rts/Sanity.c
+++ b/rts/Sanity.c
@@ -312,10 +312,6 @@ checkClosure( StgClosure* p )
     case IND_PERM:
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
-#ifdef TICKY_TICKY
-    case SE_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-#endif
     case BLACKHOLE:
     case CAF_BLACKHOLE:
     case STABLE_NAME:
@@ -637,10 +633,12 @@ checkHeapChunk(StgPtr start, StgPtr end)
 #endif
 
 void
-checkChain(bdescr *bd)
+checkLargeObjects(bdescr *bd)
 {
   while (bd != NULL) {
-    checkClosure((StgClosure *)bd->start);
+    if (!(bd->flags & BF_PINNED)) {
+      checkClosure((StgClosure *)bd->start);
+    }
     bd = bd->link;
   }
 }
@@ -793,6 +791,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 +818,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 (rtsBool checkTSOs)
+{
+    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(checkTSOs);
+}
+
 /*
   Check the static objects list.
 */