X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSanity.c;h=920530a7642f06ba88d639fcde05f37b88e66b8d;hb=1ea67691a1d115d95d6c3e8e593c2c2dbc36aa9c;hp=1ba464d1c291d64f012bea272bfa238899d2d62d;hpb=4ec89230a959370114357e4c1d45a82b430d374e;p=ghc-hetmet.git

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index 1ba464d..920530a 100644
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -1,5 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.4 1999/01/15 17:57:10 simonm Exp $
+ * $Id: Sanity.c,v 1.14 1999/05/21 14:37:12 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) (LOOKS_LIKE_STATIC_CLOSURE(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]));
@@ -83,7 +84,7 @@ checkStackClosure( StgClosure* c )
     switch (info->type) {
     case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */
 	{
-	    StgRetDyn* r = stgCast(StgRetDyn*,c);
+	    StgRetDyn* r = (StgRetDyn *)c;
 	    return sizeofW(StgRetDyn) + 
 	           checkSmallBitmap(r->payload,r->liveness);
 	}
@@ -94,13 +95,10 @@ checkStackClosure( StgClosure* c )
     case CATCH_FRAME:
     case STOP_FRAME:
     case SEQ_FRAME:
-	    return sizeofW(StgClosure) + 
-	           checkSmallBitmap((StgPtr)c->payload,info->layout.bitmap);
+	    return 1 + checkSmallBitmap((StgPtr)c + 1,info->layout.bitmap);
     case RET_BIG: /* large bitmap (> 32 entries) */
     case RET_VEC_BIG:
-	    return sizeofW(StgClosure) + 
-	           checkLargeBitmap((StgPtr)c->payload,
-				    info->layout.large_bitmap);
+	    return 1 + checkLargeBitmap((StgPtr)c + 1,info->layout.large_bitmap);
     case FUN:
     case FUN_STATIC: /* probably a slow-entry point return address: */
 	    return 1;
@@ -108,7 +106,7 @@ checkStackClosure( StgClosure* c )
        	    /* if none of the above, maybe it's a closure which looks a
        	     * little like an infotable
        	     */
-	    checkClosureShallow(*stgCast(StgClosure**,c));
+	    checkClosureShallow(*(StgClosure **)c);
 	    return 1;
 	    /* barf("checkStackClosure: weird activation record found on stack (%p).",c); */
     }
@@ -193,19 +191,56 @@ checkClosure( StgClosure* p )
 	    }
 	    return bco_sizeW(bco);
 	}
-    case FUN:
+
+    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 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:
     case CAF_UNENTERED:
     case CAF_ENTERED:
     case CAF_BLACKHOLE:
+#ifdef TICKY_TICKY
+    case SE_CAF_BLACKHOLE:
+    case SE_BLACKHOLE:
+#endif
     case BLACKHOLE:
     case BLACKHOLE_BQ:
     case FOREIGN:
-    case MVAR:
+    case STABLE_NAME:
     case MUT_VAR:
     case CONSTR_INTLIKE:
     case CONSTR_CHARLIKE:
@@ -229,7 +264,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));
 	}
@@ -277,7 +312,6 @@ checkClosure( StgClosure* p )
 	}
 
     case ARR_WORDS:
-    case MUT_ARR_WORDS:
 	    return arr_words_sizeW(stgCast(StgArrWords*,p));
 
     case MUT_ARR_PTRS:
@@ -331,7 +365,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((void*)*p))) { p++; } 
       }
       bd = bd->link;
       if (bd != NULL) {