[project @ 1999-03-22 11:26:03 by simonm]

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

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index 00ebb3c..d0ffd14 100644 (file)
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -1,5 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.6 1999/01/19 16:56:50 simonm Exp $
+ * $Id: Sanity.c,v 1.11 1999/03/03 19:07:39 sof Exp $
+ *
+ * (c) The GHC Team, 1998-1999
  *
  * Sanity checking code for the heap and stack.
  *
@@ -21,8 +23,7 @@
 #include "BlockAlloc.h"
 #include "Sanity.h"
 
-#define LOOKS_LIKE_PTR(r) \
-  (IS_DATA_PTR(r) || ((IS_USER_PTR(r) && Bdescr((P_)r)->free != (void *)-1)))
+#define LOOKS_LIKE_PTR(r) (IS_DATA_PTR(r) || ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1)))
 
 /* -----------------------------------------------------------------------------
    Check stack sanity
@@ -34,7 +35,7 @@ StgOffset checkStackObject( StgPtr sp );
 
 void      checkStackChunk( StgPtr sp, StgPtr stack_end );
 
-static StgOffset checkSmallBitmap(  StgPtr payload, StgNat32 bitmap );
+static StgOffset checkSmallBitmap(  StgPtr payload, StgWord32 bitmap );
 
 static StgOffset checkLargeBitmap( StgPtr payload, 
                                   StgLargeBitmap* large_bitmap );
@@ -42,7 +43,7 @@ static StgOffset checkLargeBitmap( StgPtr payload,
 void checkClosureShallow( StgClosure* p );
 
 static StgOffset 
-checkSmallBitmap( StgPtr payload, StgNat32 bitmap )
+checkSmallBitmap( StgPtr payload, StgWord32 bitmap )
 {
     StgOffset i;
 
@@ -59,12 +60,12 @@ checkSmallBitmap( StgPtr payload, StgNat32 bitmap )
 static StgOffset 
 checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap )
 {
-    StgNat32 bmp;
+    StgWord32 bmp;
     StgOffset i;
 
     i = 0;
     for (bmp=0; bmp<large_bitmap->size; bmp++) {
-       StgNat32 bitmap = large_bitmap->bitmap[bmp];
+       StgWord32 bitmap = large_bitmap->bitmap[bmp];
        for(; bitmap != 0; ++i, bitmap >>= 1 ) {
            if ((bitmap & 1) == 0) {
                checkClosure(stgCast(StgClosure*,payload[i]));
@@ -203,9 +204,32 @@ checkClosure( StgClosure* p )
        return sizeofW(StgMVar);
       }
 
-    case FUN:
     case THUNK:
+    case THUNK_1_0:
+    case THUNK_0_1:
+    case THUNK_1_1:
+    case THUNK_0_2:
+    case THUNK_2_0:
+      {
+       nat i;
+       for (i = 0; i < info->layout.payload.ptrs; i++) {
+         ASSERT(LOOKS_LIKE_PTR(payloadPtr(p,i)));
+       }
+       return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
+      }
+
+    case FUN:
+    case FUN_1_0:
+    case FUN_0_1:
+    case FUN_1_1:
+    case FUN_0_2:
+    case FUN_2_0:
     case CONSTR:
+    case CONSTR_1_0:
+    case CONSTR_0_1:
+    case CONSTR_1_1:
+    case CONSTR_0_2:
+    case CONSTR_2_0:
     case IND_PERM:
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
@@ -215,6 +239,7 @@ checkClosure( StgClosure* p )
     case BLACKHOLE:
     case BLACKHOLE_BQ:
     case FOREIGN:
+    case STABLE_NAME:
     case MUT_VAR:
     case CONSTR_INTLIKE:
     case CONSTR_CHARLIKE:
@@ -238,7 +263,7 @@ checkClosure( StgClosure* p )
       { StgWeak *w = (StgWeak *)p;
        ASSERT(LOOKS_LIKE_PTR(w->key));
        ASSERT(LOOKS_LIKE_PTR(w->value));
-       ASSERT(LOOKS_LIKE_PTR(w->finaliser));
+       ASSERT(LOOKS_LIKE_PTR(w->finalizer));
        if (w->link) {
          ASSERT(LOOKS_LIKE_PTR(w->link));
        }
@@ -286,7 +311,6 @@ checkClosure( StgClosure* p )
        }
 
     case ARR_WORDS:
-    case MUT_ARR_WORDS:
            return arr_words_sizeW(stgCast(StgArrWords*,p));
 
     case MUT_ARR_PTRS:
@@ -343,7 +367,7 @@ checkHeap(bdescr *bd, StgPtr start)
 
        /* skip over slop */
        while (p < bd->free &&
-              (*p == 0 || !LOOKS_LIKE_GHC_INFO(*p))) { p++; } 
+              (*p == 0 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; } 
       }
       bd = bd->link;
       if (bd != NULL) {