X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSanity.c;h=a71f862a40e141b2d0a3e9a6860106c0a8ec7ea4;hb=272a418428beede04a9c4ae027474878c59d6ca1;hp=4218afa4a4311d8ce7374f04994d086e8fbbf495;hpb=e778a17045aac8aded0e0438f5e0178643ff678d;p=ghc-hetmet.git diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index 4218afa..a71f862 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -1,11 +1,11 @@ /* ----------------------------------------------------------------------------- - * $Id: Sanity.c,v 1.26 2001/02/09 13:09:16 simonmar Exp $ + * $Id: Sanity.c,v 1.34 2003/07/03 15:14:58 sof Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2001 * * Sanity checking code for the heap and stack. * - * Used when debugging: check that the stack looks reasonable. + * Used when debugging: check that everything reasonable. * * - All things that are supposed to be pointers look like pointers. * @@ -14,19 +14,7 @@ * * ---------------------------------------------------------------------------*/ -//@menu -//* Includes:: -//* Macros:: -//* Stack sanity:: -//* Heap Sanity:: -//* TSO Sanity:: -//* Thread Queue Sanity:: -//* Blackhole Sanity:: -//@end menu - -//@node Includes, Macros -//@subsection Includes - +#include "PosixSource.h" #include "Rts.h" #ifdef DEBUG /* whole file */ @@ -39,122 +27,50 @@ #include "Storage.h" #include "Schedule.h" #include "StoragePriv.h" // for END_OF_STATIC_LIST +#include "Apply.h" -//@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))) && \ - ((StgWord)(*(StgPtr)r)!=0xaaaaaaaa)) +/* ----------------------------------------------------------------------------- + Forward decls. + -------------------------------------------------------------------------- */ -//@node Stack sanity, Heap Sanity, Macros -//@subsection Stack sanity +static void checkSmallBitmap ( StgPtr payload, StgWord bitmap, nat ); +static void checkLargeBitmap ( StgPtr payload, StgLargeBitmap*, nat ); +static void checkClosureShallow ( StgClosure * ); /* ----------------------------------------------------------------------------- Check stack sanity -------------------------------------------------------------------------- */ -StgOffset checkStackClosure( StgClosure* c ); - -StgOffset checkStackObject( StgPtr sp ); - -void checkStackChunk( StgPtr sp, StgPtr stack_end ); - -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, StgWord32 bitmap ) +static void +checkSmallBitmap( StgPtr payload, StgWord bitmap, nat size ) { - StgOffset i; + StgPtr p; + nat i; - i = 0; - for(; bitmap != 0; ++i, bitmap >>= 1 ) { + p = payload; + for(i = 0; i < size; i++, bitmap >>= 1 ) { if ((bitmap & 1) == 0) { - checkClosure(stgCast(StgClosure*,payload[i])); + checkClosureShallow((StgClosure *)payload[i]); } } - return i; } -//@cindex checkLargeBitmap -static StgOffset -checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap ) +static void +checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, nat size ) { - StgWord32 bmp; - StgOffset i; + StgWord bmp; + nat i, j; i = 0; - for (bmp=0; bmpsize; bmp++) { - StgWord32 bitmap = large_bitmap->bitmap[bmp]; - for(; bitmap != 0; ++i, bitmap >>= 1 ) { + for (bmp=0; i < size; bmp++) { + StgWord bitmap = large_bitmap->bitmap[bmp]; + j = 0; + for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) { if ((bitmap & 1) == 0) { - checkClosure(stgCast(StgClosure*,payload[i])); + checkClosureShallow((StgClosure *)payload[i]); } } } - return i; -} - -//@cindex checkStackClosure -StgOffset -checkStackClosure( StgClosure* c ) -{ - const StgInfoTable* info = get_itbl(c); - - /* All activation records have 'bitmap' style layout info. */ - switch (info->type) { - case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */ - { - 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: - ASSERT(LOOKS_LIKE_PTR(((StgUpdateFrame*)c)->updatee)); - case CATCH_FRAME: - case SEQ_FRAME: - /* check that the link field points to another stack frame */ - ASSERT(get_itbl(((StgFrame*)c)->link)->type == UPDATE_FRAME || - get_itbl(((StgFrame*)c)->link)->type == CATCH_FRAME || - get_itbl(((StgFrame*)c)->link)->type == STOP_FRAME || - get_itbl(((StgFrame*)c)->link)->type == SEQ_FRAME); - /* fall through */ - case STOP_FRAME: -#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 1 + checkLargeBitmap((StgPtr)c + 1,info->layout.large_bitmap); - case FUN: - case FUN_STATIC: /* probably a slow-entry point return address: */ -#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(*(StgClosure **)c); - return 1; - /* barf("checkStackClosure: weird activation record found on stack (%p).",c); */ - } } /* @@ -163,44 +79,116 @@ checkStackClosure( StgClosure* c ) * chunks. */ -//@cindex checkClosureShallow -void +static void checkClosureShallow( StgClosure* p ) { - ASSERT(p); - ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info) - || IS_HUGS_CONSTR_INFO(GET_INFO(p))); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); - /* Is it a static closure (i.e. in the data segment)? */ - if (LOOKS_LIKE_STATIC(p)) { + /* Is it a static closure? */ + if (!HEAP_ALLOCED(p)) { ASSERT(closure_STATIC(p)); } else { ASSERT(!closure_STATIC(p)); - ASSERT(LOOKS_LIKE_PTR(p)); } } -/* check an individual stack object */ -//@cindex checkStackObject +// check an individual stack object StgOffset -checkStackObject( StgPtr sp ) +checkStackFrame( StgPtr c ) { - if (IS_ARG_TAG(*sp)) { - /* Tagged words might be "stubbed" pointers, so there's no - * point checking to see whether they look like pointers or - * not (some of them will). - */ - return ARG_SIZE(*sp) + 1; - } else if (LOOKS_LIKE_GHC_INFO(*stgCast(StgPtr*,sp))) { - return checkStackClosure(stgCast(StgClosure*,sp)); - } else { /* must be an untagged closure pointer in the stack */ - checkClosureShallow(*stgCast(StgClosure**,sp)); - return 1; + nat size; + const StgRetInfoTable* info; + + info = get_ret_itbl((StgClosure *)c); + + /* All activation records have 'bitmap' style layout info. */ + switch (info->i.type) { + case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */ + { + StgWord dyn; + StgPtr p; + StgRetDyn* r; + + r = (StgRetDyn *)c; + dyn = r->liveness; + + p = (P_)(r->payload); + checkSmallBitmap(p,GET_LIVENESS(r->liveness),RET_DYN_BITMAP_SIZE); + p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE; + + // skip over the non-pointers + p += GET_NONPTRS(dyn); + + // follow the ptr words + for (size = GET_PTRS(dyn); size > 0; size--) { + checkClosureShallow((StgClosure *)*p); + p++; + } + + return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + + RET_DYN_NONPTR_REGS_SIZE + + GET_NONPTRS(dyn) + GET_PTRS(dyn); + } + + case UPDATE_FRAME: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgUpdateFrame*)c)->updatee)); + case CATCH_FRAME: + // small bitmap cases (<= 32 entries) + case STOP_FRAME: + case RET_SMALL: + case RET_VEC_SMALL: + size = BITMAP_SIZE(info->i.layout.bitmap); + checkSmallBitmap((StgPtr)c + 1, + BITMAP_BITS(info->i.layout.bitmap), size); + return 1 + size; + + case RET_BCO: { + StgBCO *bco; + nat size; + bco = (StgBCO *)*(c+1); + size = BCO_BITMAP_SIZE(bco); + checkLargeBitmap((StgPtr)c + 2, BCO_BITMAP(bco), size); + return 2 + size; + } + + case RET_BIG: // large bitmap (> 32 entries) + case RET_VEC_BIG: + size = info->i.layout.large_bitmap->size; + checkLargeBitmap((StgPtr)c + 1, info->i.layout.large_bitmap, size); + return 1 + size; + + case RET_FUN: + { + StgFunInfoTable *fun_info; + StgRetFun *ret_fun; + + ret_fun = (StgRetFun *)c; + fun_info = get_fun_itbl(ret_fun->fun); + size = ret_fun->size; + switch (fun_info->fun_type) { + case ARG_GEN: + checkSmallBitmap((StgPtr)ret_fun->payload, + BITMAP_BITS(fun_info->bitmap), size); + break; + case ARG_GEN_BIG: + checkLargeBitmap((StgPtr)ret_fun->payload, + (StgLargeBitmap *)fun_info->bitmap, size); + break; + default: + checkSmallBitmap((StgPtr)ret_fun->payload, + BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]), + size); + break; + } + return sizeofW(StgRetFun) + size; + } + + default: + barf("checkStackFrame: weird activation record found on stack (%p).",c); } } -/* check sections of stack between update frames */ -//@cindex checkStackChunk +// check sections of stack between update frames void checkStackChunk( StgPtr sp, StgPtr stack_end ) { @@ -208,25 +196,23 @@ checkStackChunk( StgPtr sp, StgPtr stack_end ) p = sp; while (p < stack_end) { - p += checkStackObject( p ); + p += checkStackFrame( p ); } // ASSERT( p == stack_end ); -- HWL } -//@cindex checkStackChunk StgOffset checkClosure( StgClosure* p ) { const StgInfoTable *info; - ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info)); + ASSERT(LOOKS_LIKE_INFO_PTR(p->header.info)); /* Is it a static closure (i.e. in the data segment)? */ - if (LOOKS_LIKE_STATIC(p)) { + if (!HEAP_ALLOCED(p)) { ASSERT(closure_STATIC(p)); } else { ASSERT(!closure_STATIC(p)); - ASSERT(LOOKS_LIKE_PTR(p)); } info = get_itbl(p); @@ -235,9 +221,9 @@ checkClosure( StgClosure* p ) case MVAR: { StgMVar *mvar = (StgMVar *)p; - ASSERT(LOOKS_LIKE_PTR(mvar->head)); - ASSERT(LOOKS_LIKE_PTR(mvar->tail)); - ASSERT(LOOKS_LIKE_PTR(mvar->value)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->head)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->tail)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->value)); #if 0 #if defined(PAR) checkBQ((StgBlockingQueueElement *)mvar->head, p); @@ -257,7 +243,7 @@ checkClosure( StgClosure* p ) { nat i; for (i = 0; i < info->layout.payload.ptrs; i++) { - ASSERT(LOOKS_LIKE_PTR(p->payload[i])); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i])); } return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE); } @@ -287,9 +273,9 @@ checkClosure( StgClosure* p ) case BLACKHOLE: case CAF_BLACKHOLE: case FOREIGN: - case BCO: case STABLE_NAME: case MUT_VAR: + case MUT_CONS: case CONSTR_INTLIKE: case CONSTR_CHARLIKE: case CONSTR_STATIC: @@ -299,13 +285,22 @@ checkClosure( StgClosure* p ) { nat i; for (i = 0; i < info->layout.payload.ptrs; i++) { - ASSERT(LOOKS_LIKE_PTR(p->payload[i])); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i])); } return sizeW_fromITBL(info); } + case BCO: { + StgBCO *bco = (StgBCO *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->instrs)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->literals)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->ptrs)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->itbls)); + return bco_sizeW(bco); + } + case IND_STATIC: /* (1, 0) closure */ - ASSERT(LOOKS_LIKE_PTR(((StgIndStatic*)p)->indirectee)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgIndStatic*)p)->indirectee)); return sizeW_fromITBL(info); case WEAK: @@ -313,17 +308,17 @@ checkClosure( StgClosure* p ) * representative of the actual layout. */ { StgWeak *w = (StgWeak *)p; - ASSERT(LOOKS_LIKE_PTR(w->key)); - ASSERT(LOOKS_LIKE_PTR(w->value)); - ASSERT(LOOKS_LIKE_PTR(w->finalizer)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->key)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->value)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->finalizer)); if (w->link) { - ASSERT(LOOKS_LIKE_PTR(w->link)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->link)); } return sizeW_fromITBL(info); } case THUNK_SELECTOR: - ASSERT(LOOKS_LIKE_PTR(stgCast(StgSelector*,p)->selectee)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgSelector *)p)->selectee)); return sizeofW(StgHeader) + MIN_UPD_SIZE; case IND: @@ -332,8 +327,8 @@ checkClosure( StgClosure* p ) * but they might appear during execution */ P_ q; - StgInd *ind = stgCast(StgInd*,p); - ASSERT(LOOKS_LIKE_PTR(ind->indirectee)); + StgInd *ind = (StgInd *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ind->indirectee)); q = (P_)p + sizeofW(StgInd); while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/ return q - (P_)p; @@ -348,30 +343,60 @@ checkClosure( StgClosure* p ) case UPDATE_FRAME: case STOP_FRAME: case CATCH_FRAME: - case SEQ_FRAME: barf("checkClosure: stack frame"); - case AP_UPD: /* we can treat this as being the same as a PAP */ + case AP: /* we can treat this as being the same as a PAP */ case PAP: { - StgPAP *pap = stgCast(StgPAP*,p); - ASSERT(LOOKS_LIKE_PTR(pap->fun)); - checkStackChunk((StgPtr)pap->payload, - (StgPtr)pap->payload + pap->n_args - ); + StgFunInfoTable *fun_info; + StgPAP* pap = (StgPAP *)p; + + ASSERT(LOOKS_LIKE_CLOSURE_PTR(pap->fun)); + fun_info = get_fun_itbl(pap->fun); + + p = (StgClosure *)pap->payload; + switch (fun_info->fun_type) { + case ARG_GEN: + checkSmallBitmap( (StgPtr)pap->payload, + BITMAP_BITS(fun_info->bitmap), pap->n_args ); + break; + case ARG_GEN_BIG: + checkLargeBitmap( (StgPtr)pap->payload, + (StgLargeBitmap *)fun_info->bitmap, + pap->n_args ); + break; + case ARG_BCO: + checkLargeBitmap( (StgPtr)pap->payload, + BCO_BITMAP(pap->fun), + pap->n_args ); + break; + default: + checkSmallBitmap( (StgPtr)pap->payload, + BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]), + pap->n_args ); + break; + } return pap_sizeW(pap); } + case AP_STACK: + { + StgAP_STACK *ap = (StgAP_STACK *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ap->fun)); + checkStackChunk((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); + return ap_stack_sizeW(ap); + } + case ARR_WORDS: - return arr_words_sizeW(stgCast(StgArrWords*,p)); + return arr_words_sizeW((StgArrWords *)p); case MUT_ARR_PTRS: case MUT_ARR_PTRS_FROZEN: { - StgMutArrPtrs* a = stgCast(StgMutArrPtrs*,p); + StgMutArrPtrs* a = (StgMutArrPtrs *)p; nat i; for (i = 0; i < a->ptrs; i++) { - ASSERT(LOOKS_LIKE_PTR(a->payload[i])); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(a->payload[i])); } return mut_arr_ptrs_sizeW(a); } @@ -384,9 +409,14 @@ checkClosure( StgClosure* p ) case BLOCKED_FETCH: ASSERT(LOOKS_LIKE_GA(&(((StgBlockedFetch *)p)->ga))); - ASSERT(LOOKS_LIKE_PTR((((StgBlockedFetch *)p)->node))); + ASSERT(LOOKS_LIKE_CLOSURE_PTR((((StgBlockedFetch *)p)->node))); return sizeofW(StgBlockedFetch); // see size used in evacuate() +#ifdef DIST + case REMOTE_REF: + return sizeofW(StgFetchMe); +#endif //DIST + case FETCH_ME: ASSERT(LOOKS_LIKE_GA(((StgFetchMe *)p)->ga)); return sizeofW(StgFetchMe); // see size used in evacuate() @@ -400,7 +430,7 @@ checkClosure( StgClosure* p ) ASSERT(((StgRBH *)p)->blocking_queue!=NULL); if (((StgRBH *)p)->blocking_queue!=END_BQ_QUEUE) checkBQ(((StgRBH *)p)->blocking_queue, p); - ASSERT(LOOKS_LIKE_GHC_INFO(REVERT_INFOPTR(get_itbl((StgClosure *)p)))); + ASSERT(LOOKS_LIKE_INFO_PTR(REVERT_INFOPTR(get_itbl((StgClosure *)p)))); return BLACKHOLE_sizeW(); // see size used in evacuate() // sizeW_fromITBL(REVERT_INFOPTR(get_itbl((StgClosure *)p))); @@ -453,8 +483,6 @@ looks_like_ga(globalAddr *ga) #endif -//@node Heap Sanity, TSO Sanity, Stack sanity -//@subsection Heap Sanity /* ----------------------------------------------------------------------------- Check Heap Sanity @@ -465,60 +493,71 @@ looks_like_ga(globalAddr *ga) all the objects in the remainder of the chain. -------------------------------------------------------------------------- */ -//@cindex checkHeap -extern void -checkHeap(bdescr *bd, StgPtr start) +void +checkHeap(bdescr *bd) { StgPtr p; - nat xxx = 0; // tmp -- HWL - if (start == NULL) { - if (bd != NULL) p = bd->start; - } else { - p = start; - } - - while (bd != NULL) { - while (p < bd->free) { - nat size = checkClosure(stgCast(StgClosure*,p)); - /* This is the smallest size of closure that can live in the heap. */ - ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) ); - if (get_itbl(stgCast(StgClosure*,p))->type == IND_STATIC) - xxx++; - p += size; - - /* skip over slop */ - while (p < bd->free && - (*p < 0x1000 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; } - } - bd = bd->link; - if (bd != NULL) { + for (; bd != NULL; bd = bd->link) { p = bd->start; - } + while (p < bd->free) { + nat size = checkClosure((StgClosure *)p); + /* This is the smallest size of closure that can live in the heap */ + ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) ); + p += size; + + /* skip over slop */ + while (p < bd->free && + (*p < 0x1000 || !LOOKS_LIKE_INFO_PTR((void*)*p))) { p++; } + } } - fprintf(stderr,"@@@@ checkHeap: Heap ok; %d IND_STATIC closures checked\n", - xxx); } +#if defined(PAR) /* Check heap between start and end. Used after unpacking graphs. */ -extern void +void +checkHeapChunk(StgPtr start, StgPtr end) +{ + extern globalAddr *LAGAlookup(StgClosure *addr); + StgPtr p; + nat size; + + for (p=start; ptype == FETCH_ME && + *(p+1) == 0x0000eeee /* ie. unpack garbage (see SetGAandCommonUp) */) { + /* if it's a FM created during unpack and commoned up, it's not global */ + ASSERT(LAGAlookup((StgClosure*)p)==NULL); + size = sizeofW(StgFetchMe); + } else if (get_itbl((StgClosure*)p)->type == IND) { + *(p+2) = 0x0000ee11; /* mark slop in IND as garbage */ + size = MIN_UPD_SIZE; + } else { + size = checkClosure((StgClosure *)p); + /* This is the smallest size of closure that can live in the heap. */ + ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) ); + } + } +} +#else /* !PAR */ +void checkHeapChunk(StgPtr start, StgPtr end) { StgPtr p; nat size; for (p=start; p= MIN_NONUPD_SIZE + sizeofW(StgHeader) ); } } +#endif -//@cindex checkChain -extern void +void checkChain(bdescr *bd) { while (bd != NULL) { @@ -527,46 +566,11 @@ checkChain(bdescr *bd) } } -/* check stack - making sure that update frames are linked correctly */ -//@cindex checkStack -void -checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su ) -{ - /* check everything down to the first update frame */ - checkStackChunk( sp, stgCast(StgPtr,su) ); - while ( stgCast(StgPtr,su) < stack_end) { - sp = stgCast(StgPtr,su); - switch (get_itbl(su)->type) { - case UPDATE_FRAME: - su = su->link; - break; - case SEQ_FRAME: - su = stgCast(StgSeqFrame*,su)->link; - break; - case CATCH_FRAME: - su = stgCast(StgCatchFrame*,su)->link; - break; - case STOP_FRAME: - /* not quite: ASSERT(stgCast(StgPtr,su) == stack_end); */ - return; - default: - barf("checkStack: weird record found on update frame list."); - } - checkStackChunk( sp, stgCast(StgPtr,su) ); - } - ASSERT(stgCast(StgPtr,su) == stack_end); -} - -//@node TSO Sanity, Thread Queue Sanity, Heap Sanity -//@subsection TSO Sanity - -//@cindex checkTSO -extern void +void checkTSO(StgTSO *tso) { StgPtr sp = tso->sp; StgPtr stack = tso->stack; - StgUpdateFrame* su = tso->su; StgOffset stack_size = tso->stack_size; StgPtr stack_end = stack + stack_size; @@ -575,7 +579,7 @@ checkTSO(StgTSO *tso) return; } - if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) { + if (tso->what_next == ThreadKilled) { /* The garbage collector doesn't bother following any pointers * from dead threads, so don't check sanity here. */ @@ -583,7 +587,6 @@ checkTSO(StgTSO *tso) } ASSERT(stack <= sp && sp < stack_end); - ASSERT(sp <= stgCast(StgPtr,su)); #if defined(PAR) ASSERT(tso->par.magic==TSO_MAGIC); @@ -607,6 +610,9 @@ checkTSO(StgTSO *tso) case BlockedOnRead: case BlockedOnWrite: case BlockedOnDelay: +#if defined(mingw32_TARGET_OS) + case BlockedOnDoProc: +#endif /* isOnBQ(blocked_queue) */ break; case BlockedOnException: @@ -631,12 +637,11 @@ checkTSO(StgTSO *tso) get_itbl(tso->link)->type == CONSTR); #endif - checkStack(sp, stack_end, su); + checkStackChunk(sp, stack_end); } #if defined(GRAN) -//@cindex checkTSOsSanity -extern void +void checkTSOsSanity(void) { nat i, tsos; StgTSO *tso; @@ -655,13 +660,10 @@ checkTSOsSanity(void) { 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 +rtsBool checkThreadQSanity (PEs proc, rtsBool check_TSO_too) { StgTSO *tso, *prev; @@ -683,8 +685,7 @@ checkThreadQSanity (PEs proc, rtsBool check_TSO_too) ASSERT(prev==run_queue_tls[proc]); } -//@cindex checkThreadQsSanity -extern rtsBool +rtsBool checkThreadQsSanity (rtsBool check_TSO_too) { PEs p; @@ -704,60 +705,63 @@ checkGlobalTSOList (rtsBool checkTSOs) extern StgTSO *all_threads; StgTSO *tso; for (tso=all_threads; tso != END_TSO_QUEUE; tso = tso->global_link) { - ASSERT(Bdescr((P_)tso)->evacuated == 1); - if (checkTSOs) - checkTSO(tso); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso)); + ASSERT(get_itbl(tso)->type == TSO); + if (checkTSOs) + checkTSO(tso); } } -//@node Blackhole Sanity, GALA table sanity, Thread Queue Sanity -//@subsection Blackhole Sanity - /* ----------------------------------------------------------------------------- - Check Blackhole Sanity + Check mutable list sanity. + -------------------------------------------------------------------------- */ - Test whether an object is already on the update list. - It isn't necessarily an rts error if it is - it might be a programming - error. +void +checkMutableList( StgMutClosure *p, nat gen ) +{ + bdescr *bd; - Future versions might be able to test for a blackhole without traversing - the update frame list. + for (; p != END_MUT_LIST; p = p->mut_link) { + bd = Bdescr((P_)p); + ASSERT(closure_MUTABLE(p)); + ASSERT(bd->gen_no == gen); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->mut_link)); + } +} - -------------------------------------------------------------------------- */ -//@cindex isBlackhole -rtsBool -isBlackhole( StgTSO* tso, StgClosure* p ) +void +checkMutOnceList( StgMutClosure *p, nat gen ) { - StgUpdateFrame* su = tso->su; - do { - switch (get_itbl(su)->type) { - case UPDATE_FRAME: - if (su->updatee == p) { - return rtsTrue; - } else { - su = su->link; - } - break; - case SEQ_FRAME: - su = stgCast(StgSeqFrame*,su)->link; - break; - case CATCH_FRAME: - su = stgCast(StgCatchFrame*,su)->link; - break; - case STOP_FRAME: - return rtsFalse; - default: - barf("isBlackhole: weird record found on update frame list."); + bdescr *bd; + StgInfoTable *info; + + for (; p != END_MUT_LIST; p = p->mut_link) { + bd = Bdescr((P_)p); + info = get_itbl(p); + + ASSERT(!closure_MUTABLE(p)); + ASSERT(ip_STATIC(info) || bd->gen_no == gen); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->mut_link)); + + switch (info->type) { + case IND_STATIC: + case IND_OLDGEN: + case IND_OLDGEN_PERM: + case MUT_CONS: + break; + default: + barf("checkMutOnceList: strange closure %p (%s)", + p, info_type((StgClosure *)p)); + } } - } while (1); } /* Check the static objects list. */ -extern void -checkStaticObjects ( void ) { - extern StgClosure* static_objects; +void +checkStaticObjects ( StgClosure* static_objects ) +{ StgClosure *p = static_objects; StgInfoTable *info; @@ -767,10 +771,10 @@ checkStaticObjects ( void ) { switch (info->type) { case IND_STATIC: { - StgClosure *indirectee = stgCast(StgIndStatic*,p)->indirectee; + StgClosure *indirectee = ((StgIndStatic *)p)->indirectee; - ASSERT(LOOKS_LIKE_PTR(indirectee)); - ASSERT(LOOKS_LIKE_GHC_INFO(indirectee->header.info)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee)); + ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info)); p = IND_STATIC_LINK((StgClosure *)p); break; } @@ -800,7 +804,6 @@ checkStaticObjects ( void ) { Note that in GUM we can have several different closure types in a blocking queue */ -//@cindex checkBQ #if defined(PAR) void checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure) @@ -882,8 +885,6 @@ checkBQ (StgTSO *bqe, StgClosure *closure) #endif -//@node GALA table sanity, Index, Blackhole Sanity -//@subsection GALA table sanity /* This routine checks the sanity of the LAGA and GALA tables. They are @@ -903,7 +904,6 @@ extern GALA *liveIndirections; extern GALA *liveRemoteGAs; extern HashTable *LAtoGALAtable; -//@cindex checkLAGAtable void checkLAGAtable(rtsBool check_closures) { @@ -914,50 +914,26 @@ checkLAGAtable(rtsBool check_closures) n++; gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la); ASSERT(!gala->preferred || gala == gala0); - ASSERT(LOOKS_LIKE_GHC_INFO(((StgClosure *)gala->la)->header.info)); + ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info)); ASSERT(gala->next!=gala); // detect direct loops - /* if ( check_closures ) { - checkClosure(stgCast(StgClosure*,gala->la)); + checkClosure((StgClosure *)gala->la); } - */ } for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) { m++; gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la); ASSERT(!gala->preferred || gala == gala0); - ASSERT(LOOKS_LIKE_GHC_INFO(((StgClosure *)gala->la)->header.info)); + ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info)); ASSERT(gala->next!=gala); // detect direct loops /* if ( check_closures ) { - checkClosure(stgCast(StgClosure*,gala->la)); + checkClosure((StgClosure *)gala->la); } */ } } #endif -//@node Index, , GALA table sanity -//@subsection Index - #endif /* DEBUG */ - -//@index -//* checkBQ:: @cindex\s-+checkBQ -//* 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