X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSanity.c;h=a5d61268af66a057ed1a35f9b0b31a9c40f09800;hb=d811abf65c8a370f490e104bef8224f1998e2325;hp=874533a086178cca08c2519c3bd71754647a3792;hpb=4391e44f910ce579f269986faef9e5db8907a6c0;p=ghc-hetmet.git diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index 874533a..a5d6126 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -1,5 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: Sanity.c,v 1.3 1999/01/13 17:25:43 simonm Exp $ + * $Id: Sanity.c,v 1.16 2000/01/30 10:16:09 simonmar Exp $ + * + * (c) The GHC Team, 1998-1999 * * Sanity checking code for the heap and stack. * @@ -12,17 +14,35 @@ * * ---------------------------------------------------------------------------*/ +//@menu +//* Includes:: +//* Macros:: +//* Stack sanity:: +//* Heap Sanity:: +//* TSO Sanity:: +//* Thread Queue Sanity:: +//* Blackhole Sanity:: +//@end menu + +//@node Includes, Macros +//@subsection Includes + #include "Rts.h" -#ifdef DEBUG +#ifdef DEBUG /* whole file */ #include "RtsFlags.h" #include "RtsUtils.h" #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))) +//@node Macros, Stack sanity, Includes +//@subsection Macros + +#define LOOKS_LIKE_PTR(r) (LOOKS_LIKE_STATIC_CLOSURE(r) || ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1))) + +//@node Stack sanity, Heap Sanity, Macros +//@subsection Stack sanity /* ----------------------------------------------------------------------------- Check stack sanity @@ -34,15 +54,16 @@ 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 ); void checkClosureShallow( StgClosure* p ); +//@cindex checkSmallBitmap static StgOffset -checkSmallBitmap( StgPtr payload, StgNat32 bitmap ) +checkSmallBitmap( StgPtr payload, StgWord32 bitmap ) { StgOffset i; @@ -55,16 +76,16 @@ checkSmallBitmap( StgPtr payload, StgNat32 bitmap ) return i; } - +//@cindex checkLargeBitmap static StgOffset checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap ) { - StgNat32 bmp; + StgWord32 bmp; StgOffset i; i = 0; for (bmp=0; bmpsize; 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])); @@ -74,6 +95,7 @@ checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap ) return i; } +//@cindex checkStackClosure StgOffset checkStackClosure( StgClosure* c ) { @@ -83,32 +105,40 @@ 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); } case RET_BCO: /* small bitmap (<= 32 entries) */ case RET_SMALL: case RET_VEC_SMALL: + return 1 + checkSmallBitmap((StgPtr)c + 1,info->layout.bitmap); + case UPDATE_FRAME: case CATCH_FRAME: case STOP_FRAME: case SEQ_FRAME: - return sizeofW(StgClosure) + - checkSmallBitmap((StgPtr)c->payload,info->layout.bitmap); +#if defined(GRAN) + return 2 + +#else + return 1 + +#endif + 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 0 && defined(GRAN) + return 2; +#else + return 1; +#endif default: /* 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); */ } @@ -120,6 +150,7 @@ checkStackClosure( StgClosure* c ) * chunks. */ +//@cindex checkClosureShallow void checkClosureShallow( StgClosure* p ) { @@ -135,6 +166,7 @@ checkClosureShallow( StgClosure* p ) } /* check an individual stack object */ +//@cindex checkStackObject StgOffset checkStackObject( StgPtr sp ) { @@ -153,6 +185,7 @@ checkStackObject( StgPtr sp ) } /* check sections of stack between update frames */ +//@cindex checkStackChunk void checkStackChunk( StgPtr sp, StgPtr stack_end ) { @@ -162,9 +195,10 @@ checkStackChunk( StgPtr sp, StgPtr stack_end ) while (p < stack_end) { p += checkStackObject( p ); } - ASSERT( p == stack_end ); + // ASSERT( p == stack_end ); -- HWL } +//@cindex checkStackChunk StgOffset checkClosure( StgClosure* p ) { @@ -193,18 +227,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: @@ -228,7 +300,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)); } @@ -276,7 +348,6 @@ checkClosure( StgClosure* p ) } case ARR_WORDS: - case MUT_ARR_WORDS: return arr_words_sizeW(stgCast(StgArrWords*,p)); case MUT_ARR_PTRS: @@ -297,13 +368,17 @@ checkClosure( StgClosure* p ) case BLOCKED_FETCH: case FETCH_ME: case EVACUATED: - barf("checkClosure: unimplemented/strange closure type"); + barf("checkClosure: unimplemented/strange closure type %d", + info->type); default: - barf("checkClosure"); + barf("checkClosure (closure type %d)", info->type); } #undef LOOKS_LIKE_PTR } +//@node Heap Sanity, TSO Sanity, Stack sanity +//@subsection Heap Sanity + /* ----------------------------------------------------------------------------- Check Heap Sanity @@ -313,6 +388,7 @@ checkClosure( StgClosure* p ) all the objects in the remainder of the chain. -------------------------------------------------------------------------- */ +//@cindex checkHeap extern void checkHeap(bdescr *bd, StgPtr start) { @@ -330,7 +406,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) { @@ -339,6 +418,7 @@ checkHeap(bdescr *bd, StgPtr start) } } +//@cindex checkChain extern void checkChain(bdescr *bd) { @@ -349,6 +429,7 @@ checkChain(bdescr *bd) } /* check stack - making sure that update frames are linked correctly */ +//@cindex checkStack void checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su ) { @@ -377,6 +458,10 @@ checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su ) ASSERT(stgCast(StgPtr,su) == stack_end); } +//@node TSO Sanity, Thread Queue Sanity, Heap Sanity +//@subsection TSO Sanity + +//@cindex checkTSO extern void checkTSO(StgTSO *tso) { @@ -386,7 +471,12 @@ checkTSO(StgTSO *tso) StgOffset stack_size = tso->stack_size; StgPtr stack_end = stack + stack_size; - if (tso->whatNext == ThreadComplete || tso->whatNext == ThreadKilled) { + if (tso->whatNext == ThreadRelocated) { + checkTSO(tso->link); + return; + } + + if (tso->whatNext == ThreadComplete || tso->whatNext == ThreadKilled) { /* The garbage collector doesn't bother following any pointers * from dead threads, so don't check sanity here. */ @@ -399,6 +489,69 @@ checkTSO(StgTSO *tso) checkStack(sp, stack_end, su); } +#if defined(GRAN) +//@cindex checkTSOsSanity +extern void +checkTSOsSanity(void) { + nat i, tsos; + StgTSO *tso; + + belch("Checking sanity of all runnable TSOs:"); + + for (i=0, tsos=0; ilink) { + fprintf(stderr, "TSO %p on PE %d ...", tso, i); + checkTSO(tso); + fprintf(stderr, "OK, "); + tsos++; + } + } + + belch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc); +} + +//@node Thread Queue Sanity, Blackhole Sanity, TSO Sanity +//@subsection Thread Queue Sanity + +// still GRAN only + +//@cindex checkThreadQSanity +extern rtsBool +checkThreadQSanity (PEs proc, rtsBool check_TSO_too) +{ + StgTSO *tso, *prev; + + /* the NIL value for TSOs is END_TSO_QUEUE; thus, finding NULL is an error */ + ASSERT(run_queue_hds[proc]!=NULL); + ASSERT(run_queue_tls[proc]!=NULL); + /* if either head or tail is NIL then the other one must be NIL, too */ + ASSERT(run_queue_hds[proc]!=END_TSO_QUEUE || run_queue_tls[proc]==END_TSO_QUEUE); + ASSERT(run_queue_tls[proc]!=END_TSO_QUEUE || run_queue_hds[proc]==END_TSO_QUEUE); + for (tso=run_queue_hds[proc], prev=END_TSO_QUEUE; + tso!=END_TSO_QUEUE; + prev=tso, tso=tso->link) { + ASSERT((prev!=END_TSO_QUEUE || tso==run_queue_hds[proc]) && + (prev==END_TSO_QUEUE || prev->link==tso)); + if (check_TSO_too) + checkTSO(tso); + } + ASSERT(prev==run_queue_tls[proc]); +} + +//@cindex checkThreadQsSanity +extern rtsBool +checkThreadQsSanity (rtsBool check_TSO_too) +{ + PEs p; + + for (p=0; psu; do { @@ -436,4 +591,26 @@ rtsBool isBlackhole( StgTSO* tso, StgClosure* p ) } while (1); } +//@node Index, , Blackhole Sanity +//@subsection Index + +//@index +//* checkChain:: @cindex\s-+checkChain +//* checkClosureShallow:: @cindex\s-+checkClosureShallow +//* checkHeap:: @cindex\s-+checkHeap +//* checkLargeBitmap:: @cindex\s-+checkLargeBitmap +//* checkSmallBitmap:: @cindex\s-+checkSmallBitmap +//* checkStack:: @cindex\s-+checkStack +//* checkStackChunk:: @cindex\s-+checkStackChunk +//* checkStackChunk:: @cindex\s-+checkStackChunk +//* checkStackClosure:: @cindex\s-+checkStackClosure +//* checkStackObject:: @cindex\s-+checkStackObject +//* checkTSO:: @cindex\s-+checkTSO +//* checkTSOsSanity:: @cindex\s-+checkTSOsSanity +//* checkThreadQSanity:: @cindex\s-+checkThreadQSanity +//* checkThreadQsSanity:: @cindex\s-+checkThreadQsSanity +//* isBlackhole:: @cindex\s-+isBlackhole +//@end index + #endif /* DEBUG */ +