[project @ 1999-01-25 12:01:21 by simonm]

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

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index 874533a..00ebb3c 100644 (file)
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.3 1999/01/13 17:25:43 simonm Exp $
+ * $Id: Sanity.c,v 1.6 1999/01/19 16:56:50 simonm Exp $
  *
  * Sanity checking code for the heap and stack.
  *
@@ -193,6 +193,16 @@ checkClosure( StgClosure* p )
            }
            return bco_sizeW(bco);
        }
+
+    case MVAR:
+      { 
+       StgMVar *mvar = (StgMVar *)p;
+       ASSERT(LOOKS_LIKE_PTR(mvar->head));
+       ASSERT(LOOKS_LIKE_PTR(mvar->tail));
+       ASSERT(LOOKS_LIKE_PTR(mvar->value));
+       return sizeofW(StgMVar);
+      }
+
     case FUN:
     case THUNK:
     case CONSTR:
@@ -203,8 +213,8 @@ checkClosure( StgClosure* p )
     case CAF_ENTERED:
     case CAF_BLACKHOLE:
     case BLACKHOLE:
+    case BLACKHOLE_BQ:
     case FOREIGN:
-    case MVAR:
     case MUT_VAR:
     case CONSTR_INTLIKE:
     case CONSTR_CHARLIKE:
@@ -330,7 +340,10 @@ checkHeap(bdescr *bd, StgPtr start)
         /* This is the smallest size of closure that can live in the heap. */
         ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
        p += size;
-       while (*p == 0) { p++; } /* skip over slop */
+
+       /* skip over slop */
+       while (p < bd->free &&
+              (*p == 0 || !LOOKS_LIKE_GHC_INFO(*p))) { p++; } 
       }
       bd = bd->link;
       if (bd != NULL) {