/* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.6 1999/01/19 16:56:50 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.
*
#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
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 );
void checkClosureShallow( StgClosure* p );
static StgOffset
-checkSmallBitmap( StgPtr payload, StgNat32 bitmap )
+checkSmallBitmap( StgPtr payload, StgWord32 bitmap )
{
StgOffset i;
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]));
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);
}
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;
/* 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); */
}
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:
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 STABLE_NAME:
case MUT_VAR:
case CONSTR_INTLIKE:
case CONSTR_CHARLIKE:
{ 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));
}
}
case ARR_WORDS:
- case MUT_ARR_WORDS:
return arr_words_sizeW(stgCast(StgArrWords*,p));
case MUT_ARR_PTRS:
/* 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) {