Documentation for -fno-code and -fwrite-iface.

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

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index 89c1a7e..0e68a86 100644 (file)
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 1998-2001
+ * (c) The GHC Team, 1998-2006
  *
  * Sanity checking code for the heap and stack.
  *
@@ -280,7 +280,7 @@ checkClosure( StgClosure* p )
        for (i = 0; i < info->layout.payload.ptrs; i++) {
          ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgThunk *)p)->payload[i]));
        }
-       return stg_max(thunk_sizeW_fromITBL(info), sizeofW(StgHeader)+MIN_UPD_SIZE);
+       return thunk_sizeW_fromITBL(info);
       }
 
     case FUN:
@@ -304,9 +304,9 @@ checkClosure( StgClosure* p )
 #endif
     case BLACKHOLE:
     case CAF_BLACKHOLE:
-    case FOREIGN:
     case STABLE_NAME:
-    case MUT_VAR:
+    case MUT_VAR_CLEAN:
+    case MUT_VAR_DIRTY:
     case CONSTR_INTLIKE:
     case CONSTR_CHARLIKE:
     case CONSTR_STATIC:
@@ -357,12 +357,9 @@ checkClosure( StgClosure* p )
            /* we don't expect to see any of these after GC
             * but they might appear during execution
             */
-           P_ q;
            StgInd *ind = (StgInd *)p;
            ASSERT(LOOKS_LIKE_CLOSURE_PTR(ind->indirectee));
-           q = (P_)p + sizeofW(StgInd);
-           while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/
-           return q - (P_)p;
+           return sizeofW(StgInd);
        }
 
     case RET_BCO:
@@ -404,7 +401,8 @@ checkClosure( StgClosure* p )
     case ARR_WORDS:
            return arr_words_sizeW((StgArrWords *)p);
 
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
        {
@@ -551,12 +549,18 @@ checkHeap(bdescr *bd)
 {
     StgPtr p;
 
+#if defined(THREADED_RTS)
+    // heap sanity checking doesn't work with SMP, because we can't
+    // zero the slop (see Updates.h).
+    return;
+#endif
+
     for (; bd != NULL; bd = bd->link) {
        p = bd->start;
        while (p < bd->free) {
            nat size = checkClosure((StgClosure *)p);
            /* This is the smallest size of closure that can live in the heap */
-           ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
+           ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) );
            p += size;
            
            /* skip over slop */
@@ -586,11 +590,11 @@ checkHeapChunk(StgPtr start, StgPtr end)
       size = sizeofW(StgFetchMe);
     } else if (get_itbl((StgClosure*)p)->type == IND) {
       *(p+2) = 0x0000ee11; /* mark slop in IND as garbage */
-      size = MIN_UPD_SIZE;
+      size = sizeofW(StgInd);
     } else {
       size = checkClosure((StgClosure *)p);
       /* This is the smallest size of closure that can live in the heap. */
-      ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
+      ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) );
     }
   }
 }
@@ -605,7 +609,7 @@ checkHeapChunk(StgPtr start, StgPtr end)
     ASSERT(LOOKS_LIKE_INFO_PTR((void*)*p));
     size = checkClosure((StgClosure *)p);
     /* This is the smallest size of closure that can live in the heap. */
-    ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
+    ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) );
   }
 }
 #endif
@@ -887,30 +891,6 @@ checkBQ (StgTSO *bqe, StgClosure *closure)
     }
   } while (!end);
 }
-#else
-void
-checkBQ (StgTSO *bqe, StgClosure *closure) 
-{  
-  rtsBool end = rtsFalse;
-  StgInfoTable *info = get_itbl(closure);
-
-  ASSERT(info->type == MVAR);
-
-  do {
-    switch (get_itbl(bqe)->type) {
-    case TSO:
-      checkClosure((StgClosure *)bqe);
-      bqe = bqe->link;
-      end = (bqe==END_TSO_QUEUE);
-      break;
-
-    default:
-      barf("checkBQ: strange closure %d in blocking queue for closure %p\n", 
-          get_itbl(bqe)->type, closure, info->type);
-    }
-  } while (!end);
-}
-    
 #endif