[project @ 2001-02-13 17:13:39 by sewardj]

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

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index 3b69393..4218afa 100644 (file)
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.19 2000/03/31 03:09:36 hwloidl Exp $
+ * $Id: Sanity.c,v 1.26 2001/02/09 13:09:16 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -35,6 +35,9 @@
 #include "RtsUtils.h"
 #include "BlockAlloc.h"
 #include "Sanity.h"
+#include "MBlock.h"
+#include "Storage.h"
+#include "Schedule.h"
 #include "StoragePriv.h"   // for END_OF_STATIC_LIST
 
 //@node Macros, Stack sanity, Includes
@@ -164,7 +167,9 @@ checkStackClosure( StgClosure* c )
 void 
 checkClosureShallow( StgClosure* p )
 {
-    ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
+    ASSERT(p);
+    ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info)
+           || IS_HUGS_CONSTR_INFO(GET_INFO(p)));
 
     /* Is it a static closure (i.e. in the data segment)? */
     if (LOOKS_LIKE_STATIC(p)) {
@@ -214,9 +219,7 @@ checkClosure( StgClosure* p )
 {
     const StgInfoTable *info;
 
-#ifndef INTERPRETER    
     ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
-#endif
 
     /* Is it a static closure (i.e. in the data segment)? */
     if (LOOKS_LIKE_STATIC(p)) {
@@ -228,15 +231,6 @@ checkClosure( StgClosure* p )
 
     info = get_itbl(p);
     switch (info->type) {
-    case BCO:
-       {
-           StgBCO* bco = stgCast(StgBCO*,p);
-           nat i;
-           for(i=0; i < bco->n_ptrs; ++i) {
-               ASSERT(LOOKS_LIKE_PTR(bcoConstPtr(bco,i)));
-           }
-           return bco_sizeW(bco);
-       }
 
     case MVAR:
       { 
@@ -286,15 +280,14 @@ checkClosure( StgClosure* p )
     case IND_PERM:
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
-    case CAF_UNENTERED:
-    case CAF_ENTERED:
-    case CAF_BLACKHOLE:
 #ifdef TICKY_TICKY
-    case SE_CAF_BLACKHOLE:
     case SE_BLACKHOLE:
+    case SE_CAF_BLACKHOLE:
 #endif
     case BLACKHOLE:
+    case CAF_BLACKHOLE:
     case FOREIGN:
+    case BCO:
     case STABLE_NAME:
     case MUT_VAR:
     case CONSTR_INTLIKE:
@@ -480,7 +473,7 @@ checkHeap(bdescr *bd, StgPtr start)
     nat xxx = 0; // tmp -- HWL
 
     if (start == NULL) {
-      p = bd->start;
+      if (bd != NULL) p = bd->start;
     } else {
       p = start;
     }
@@ -496,7 +489,7 @@ checkHeap(bdescr *bd, StgPtr start)
 
        /* skip over slop */
        while (p < bd->free &&
-              (*p == 0 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; } 
+              (*p < 0x1000 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; } 
       }
       bd = bd->link;
       if (bd != NULL) {