X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSanity.c;h=f6947c9f8c75368bb02300fdc939c44b2252cb9d;hb=da69fa9c5047c5b0d05bdb05eaddefa1eb5d5a36;hp=4150916e0bae9a6b7c7f37c88a59f86fdf1d9235;hpb=030787e51b95d3320d2b9032c119c32f7549a31a;p=ghc-hetmet.git diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index 4150916..f6947c9 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: Sanity.c,v 1.29 2001/07/24 05:04:59 ken Exp $ * * (c) The GHC Team, 1998-2001 * @@ -14,6 +13,7 @@ * * ---------------------------------------------------------------------------*/ +#include "PosixSource.h" #include "Rts.h" #ifdef DEBUG /* whole file */ @@ -25,133 +25,50 @@ #include "MBlock.h" #include "Storage.h" #include "Schedule.h" -#include "StoragePriv.h" // for END_OF_STATIC_LIST - -/* ----------------------------------------------------------------------------- - A valid pointer is either: - - - a pointer to a static closure, or - - a pointer into the heap, and - - the block is not free - - either: - the object is large, or - - it is not after the free pointer in the block - - the contents of the pointer is not 0xaaaaaaaa - - -------------------------------------------------------------------------- */ - -#define LOOKS_LIKE_PTR(r) \ - ({ bdescr *bd = Bdescr((P_)r); \ - LOOKS_LIKE_STATIC_CLOSURE(r) || \ - (HEAP_ALLOCED(r) \ - && bd != (void *)-1 \ - && ((StgWord)(*(StgPtr)r)!=0xaaaaaaaa) \ - ); \ - }) - -// NOT always true, but can be useful for spotting bugs: (generally -// true after GC, but not for things just allocated using allocate(), -// for example): -// (bd->flags & BF_LARGE || bd->free > (P_)r) +#include "Apply.h" /* ----------------------------------------------------------------------------- Forward decls. -------------------------------------------------------------------------- */ -static StgOffset checkStackClosure ( StgClosure* c ); -static StgOffset checkStackObject ( StgPtr sp ); -static StgOffset checkSmallBitmap ( StgPtr payload, StgWord bitmap ); -static StgOffset checkLargeBitmap ( StgPtr payload, StgLargeBitmap* ); -static void checkClosureShallow ( StgClosure* p ); +static void checkSmallBitmap ( StgPtr payload, StgWord bitmap, nat ); +static void checkLargeBitmap ( StgPtr payload, StgLargeBitmap*, nat ); +static void checkClosureShallow ( StgClosure * ); /* ----------------------------------------------------------------------------- Check stack sanity -------------------------------------------------------------------------- */ -static StgOffset -checkSmallBitmap( StgPtr payload, StgWord 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((StgClosure *)payload[i]); + checkClosureShallow((StgClosure *)payload[i]); } } - return i; } -static StgOffset -checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap ) +static void +checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, nat size ) { StgWord bmp; - StgOffset i; + nat i, j; i = 0; - for (bmp=0; bmpsize; bmp++) { + for (bmp=0; i < size; bmp++) { StgWord bitmap = large_bitmap->bitmap[bmp]; - for(; bitmap != 0; ++i, bitmap >>= 1 ) { + j = 0; + for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) { if ((bitmap & 1) == 0) { - checkClosure((StgClosure *)payload[i]); + checkClosureShallow((StgClosure *)payload[i]); } } } - return i; -} - -static 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); */ - } } /* @@ -160,36 +77,115 @@ checkStackClosure( StgClosure* c ) * chunks. */ -void +static void checkClosureShallow( StgClosure* p ) { - ASSERT(p); - ASSERT(LOOKS_LIKE_GHC_INFO(GET_INFO(p)) - || 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 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(*(StgPtr *)sp)) { - return checkStackClosure((StgClosure *)sp); - } else { // must be an untagged closure pointer in the stack - checkClosureShallow(*(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,RET_DYN_LIVENESS(r->liveness),RET_DYN_BITMAP_SIZE); + p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE; + + // skip over the non-pointers + p += RET_DYN_NONPTRS(dyn); + + // follow the ptr words + for (size = RET_DYN_PTRS(dyn); size > 0; size--) { + checkClosureShallow((StgClosure *)*p); + p++; + } + + return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + + RET_DYN_NONPTR_REGS_SIZE + + RET_DYN_NONPTRS(dyn) + RET_DYN_PTRS(dyn); + } + + case UPDATE_FRAME: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgUpdateFrame*)c)->updatee)); + case ATOMICALLY_FRAME: + case CATCH_RETRY_FRAME: + case CATCH_STM_FRAME: + 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 = GET_LARGE_BITMAP(&info->i)->size; + checkLargeBitmap((StgPtr)c + 1, GET_LARGE_BITMAP(&info->i), 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->f.fun_type) { + case ARG_GEN: + checkSmallBitmap((StgPtr)ret_fun->payload, + BITMAP_BITS(fun_info->f.b.bitmap), size); + break; + case ARG_GEN_BIG: + checkLargeBitmap((StgPtr)ret_fun->payload, + GET_FUN_LARGE_BITMAP(fun_info), size); + break; + default: + checkSmallBitmap((StgPtr)ret_fun->payload, + BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), + size); + break; + } + return sizeofW(StgRetFun) + size; + } + + default: + barf("checkStackFrame: weird activation record found on stack (%p %d).",c,info->i.type); } } @@ -201,24 +197,57 @@ checkStackChunk( StgPtr sp, StgPtr stack_end ) p = sp; while (p < stack_end) { - p += checkStackObject( p ); + p += checkStackFrame( p ); } // ASSERT( p == stack_end ); -- HWL } +static void +checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args) +{ + StgClosure *p; + StgFunInfoTable *fun_info; + + ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun)); + fun_info = get_fun_itbl(fun); + + p = (StgClosure *)payload; + switch (fun_info->f.fun_type) { + case ARG_GEN: + checkSmallBitmap( (StgPtr)payload, + BITMAP_BITS(fun_info->f.b.bitmap), n_args ); + break; + case ARG_GEN_BIG: + checkLargeBitmap( (StgPtr)payload, + GET_FUN_LARGE_BITMAP(fun_info), + n_args ); + break; + case ARG_BCO: + checkLargeBitmap( (StgPtr)payload, + BCO_BITMAP(fun), + n_args ); + break; + default: + checkSmallBitmap( (StgPtr)payload, + BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), + n_args ); + break; + } +} + + 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); @@ -227,9 +256,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); @@ -249,14 +278,11 @@ 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(((StgThunk *)p)->payload[i])); } - return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE); + return stg_max(thunk_sizeW_fromITBL(info), sizeofW(StgHeader)+MIN_UPD_SIZE); } - case BLACKHOLE_BQ: - checkBQ(((StgBlockingQueue *)p)->blocking_queue, p); - /* fall through to basic ptr check */ case FUN: case FUN_1_0: case FUN_0_1: @@ -278,11 +304,8 @@ checkClosure( StgClosure* p ) #endif 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: @@ -292,13 +315,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: @@ -306,30 +338,27 @@ 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(((StgSelector *)p)->selectee)); - return sizeofW(StgHeader) + MIN_UPD_SIZE; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgSelector *)p)->selectee)); + return THUNK_SELECTOR_sizeW(); case IND: { /* we don't expect to see any of these after GC * but they might appear during execution */ - P_ q; StgInd *ind = (StgInd *)p; - ASSERT(LOOKS_LIKE_PTR(ind->indirectee)); - q = (P_)p + sizeofW(StgInd); - while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/ - return q - (P_)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ind->indirectee)); + return sizeofW(StgHeader) + MIN_UPD_SIZE; } case RET_BCO: @@ -341,30 +370,45 @@ checkClosure( StgClosure* p ) case UPDATE_FRAME: case STOP_FRAME: case CATCH_FRAME: - case SEQ_FRAME: + case ATOMICALLY_FRAME: + case CATCH_RETRY_FRAME: + case CATCH_STM_FRAME: barf("checkClosure: stack frame"); - case AP_UPD: /* we can treat this as being the same as a PAP */ + case AP: + { + StgAP* ap = (StgAP *)p; + checkPAP (ap->fun, ap->payload, ap->n_args); + return ap_sizeW(ap); + } + case PAP: - { - StgPAP *pap = (StgPAP *)p; - ASSERT(LOOKS_LIKE_PTR(pap->fun)); - checkStackChunk((StgPtr)pap->payload, - (StgPtr)pap->payload + pap->n_args - ); - return pap_sizeW(pap); - } + { + StgPAP* pap = (StgPAP *)p; + checkPAP (pap->fun, pap->payload, pap->n_args); + 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((StgArrWords *)p); - case MUT_ARR_PTRS: + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: { 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); } @@ -377,13 +421,13 @@ 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 +#endif /*DIST */ case FETCH_ME: ASSERT(LOOKS_LIKE_GA(((StgFetchMe *)p)->ga)); @@ -398,11 +442,49 @@ 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))); #endif + + case TVAR_WAIT_QUEUE: + { + StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->next_queue_entry)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->prev_queue_entry)); + return sizeofW(StgTVarWaitQueue); + } + + case TVAR: + { + StgTVar *tv = (StgTVar *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->current_value)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->first_wait_queue_entry)); + return sizeofW(StgTVar); + } + + case TREC_CHUNK: + { + nat i; + StgTRecChunk *tc = (StgTRecChunk *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->prev_chunk)); + for (i = 0; i < tc -> next_entry_idx; i ++) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].tvar)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].expected_value)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].new_value)); + } + return sizeofW(StgTRecChunk); + } + + case TREC_HEADER: + { + StgTRecHeader *trec = (StgTRecHeader *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(trec -> enclosing_trec)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(trec -> current_chunk)); + return sizeofW(StgTRecHeader); + } + case EVACUATED: barf("checkClosure: found EVACUATED closure %d", @@ -466,6 +548,12 @@ checkHeap(bdescr *bd) { StgPtr p; +#if defined(SMP) + // heap sanity checking doesn't work with SMP, because we can't + // zero the slop (see Updates.h). + return; +#endif + for (; bd != NULL; bd = bd->link) { p = bd->start; while (p < bd->free) { @@ -476,7 +564,7 @@ checkHeap(bdescr *bd) /* skip over slop */ while (p < bd->free && - (*p < 0x1000 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; } + (*p < 0x1000 || !LOOKS_LIKE_INFO_PTR((void*)*p))) { p++; } } } } @@ -493,7 +581,7 @@ checkHeapChunk(StgPtr start, StgPtr end) 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 */ @@ -517,7 +605,7 @@ checkHeapChunk(StgPtr start, StgPtr end) nat size; for (p=start; p= MIN_NONUPD_SIZE + sizeofW(StgHeader) ); @@ -534,42 +622,11 @@ checkChain(bdescr *bd) } } -/* check stack - making sure that update frames are linked correctly */ -void -checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su ) -{ - /* check everything down to the first update frame */ - checkStackChunk( sp, (StgPtr)su ); - while ( (StgPtr)su < stack_end) { - sp = (StgPtr)su; - switch (get_itbl(su)->type) { - case UPDATE_FRAME: - su = su->link; - break; - case SEQ_FRAME: - su = ((StgSeqFrame *)su)->link; - break; - case CATCH_FRAME: - su = ((StgCatchFrame *)su)->link; - break; - case STOP_FRAME: - /* not quite: ASSERT((StgPtr)su == stack_end); */ - return; - default: - barf("checkStack: weird record found on update frame list."); - } - checkStackChunk( sp, (StgPtr)su ); - } - ASSERT((StgPtr)su == stack_end); -} - - 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; @@ -578,7 +635,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. */ @@ -586,7 +643,6 @@ checkTSO(StgTSO *tso) } ASSERT(stack <= sp && sp < stack_end); - ASSERT(sp <= (StgPtr)su); #if defined(PAR) ASSERT(tso->par.magic==TSO_MAGIC); @@ -603,13 +659,15 @@ checkTSO(StgTSO *tso) break; case BlockedOnBlackHole: checkClosureShallow(tso->block_info.closure); - ASSERT(/* Can't be a BLACKHOLE because *this* closure is on its BQ */ - get_itbl(tso->block_info.closure)->type==BLACKHOLE_BQ || + ASSERT(get_itbl(tso->block_info.closure)->type==BLACKHOLE || get_itbl(tso->block_info.closure)->type==RBH); break; case BlockedOnRead: case BlockedOnWrite: case BlockedOnDelay: +#if defined(mingw32_HOST_OS) + case BlockedOnDoProc: +#endif /* isOnBQ(blocked_queue) */ break; case BlockedOnException: @@ -619,6 +677,9 @@ checkTSO(StgTSO *tso) case BlockedOnMVar: ASSERT(get_itbl(tso->block_info.closure)->type==MVAR); break; + case BlockedOnSTM: + ASSERT(tso->block_info.closure == END_TSO_QUEUE); + break; default: /* Could check other values of why_blocked but I am more @@ -634,7 +695,7 @@ checkTSO(StgTSO *tso) get_itbl(tso->link)->type == CONSTR); #endif - checkStack(sp, stack_end, su); + checkStackChunk(sp, stack_end); } #if defined(GRAN) @@ -643,18 +704,18 @@ checkTSOsSanity(void) { nat i, tsos; StgTSO *tso; - belch("Checking sanity of all runnable TSOs:"); + debugBelch("Checking sanity of all runnable TSOs:"); for (i=0, tsos=0; ilink) { - fprintf(stderr, "TSO %p on PE %d ...", tso, i); + debugBelch("TSO %p on PE %d ...", tso, i); checkTSO(tso); - fprintf(stderr, "OK, "); + debugBelch("OK, "); tsos++; } } - belch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc); + debugBelch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc); } @@ -702,7 +763,7 @@ checkGlobalTSOList (rtsBool checkTSOs) extern StgTSO *all_threads; StgTSO *tso; for (tso=all_threads; tso != END_TSO_QUEUE; tso = tso->global_link) { - ASSERT(LOOKS_LIKE_PTR(tso)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso)); ASSERT(get_itbl(tso)->type == TSO); if (checkTSOs) checkTSO(tso); @@ -714,83 +775,20 @@ checkGlobalTSOList (rtsBool checkTSOs) -------------------------------------------------------------------------- */ void -checkMutableList( StgMutClosure *p, nat gen ) +checkMutableList( bdescr *mut_bd, nat gen ) { bdescr *bd; + StgPtr q; + StgClosure *p; - 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_PTR(p->mut_link)); - } -} - -void -checkMutOnceList( StgMutClosure *p, nat gen ) -{ - 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_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)); + for (bd = mut_bd; bd != NULL; bd = bd->link) { + for (q = bd->start; q < bd->free; q++) { + p = (StgClosure *)*q; + ASSERT(!HEAP_ALLOCED(p) || Bdescr((P_)p)->gen_no == gen); } } } -/* ----------------------------------------------------------------------------- - Check Blackhole 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. - - Future versions might be able to test for a blackhole without traversing - the update frame list. - - -------------------------------------------------------------------------- */ -rtsBool -isBlackhole( StgTSO* tso, StgClosure* p ) -{ - 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 = ((StgSeqFrame *)su)->link; - break; - case CATCH_FRAME: - su = ((StgCatchFrame *)su)->link; - break; - case STOP_FRAME: - return rtsFalse; - default: - barf("isBlackhole: weird record found on update frame list."); - } - } while (1); -} - /* Check the static objects list. */ @@ -808,22 +806,22 @@ checkStaticObjects ( StgClosure* static_objects ) { StgClosure *indirectee = ((StgIndStatic *)p)->indirectee; - ASSERT(LOOKS_LIKE_PTR(indirectee)); - ASSERT(LOOKS_LIKE_GHC_INFO(indirectee->header.info)); - p = IND_STATIC_LINK((StgClosure *)p); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee)); + ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info)); + p = *IND_STATIC_LINK((StgClosure *)p); break; } case THUNK_STATIC: - p = THUNK_STATIC_LINK((StgClosure *)p); + p = *THUNK_STATIC_LINK((StgClosure *)p); break; case FUN_STATIC: - p = FUN_STATIC_LINK((StgClosure *)p); + p = *FUN_STATIC_LINK((StgClosure *)p); break; case CONSTR_STATIC: - p = STATIC_LINK(info,(StgClosure *)p); + p = *STATIC_LINK(info,(StgClosure *)p); break; default: @@ -846,8 +844,7 @@ checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure) rtsBool end = rtsFalse; StgInfoTable *info = get_itbl(closure); - ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR - || info->type == FETCH_ME_BQ || info->type == RBH); + ASSERT(info->type == MVAR || info->type == FETCH_ME_BQ || info->type == RBH); do { switch (get_itbl(bqe)->type) { @@ -876,7 +873,7 @@ checkBQ (StgTSO *bqe, StgClosure *closure) rtsBool end = rtsFalse; StgInfoTable *info = get_itbl(closure); - ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR); + ASSERT(info->type == MVAR); do { switch (get_itbl(bqe)->type) { @@ -893,30 +890,6 @@ checkBQ (StgTSO *bqe, StgClosure *closure) } } while (!end); } -#else -void -checkBQ (StgTSO *bqe, StgClosure *closure) -{ - rtsBool end = rtsFalse; - StgInfoTable *info = get_itbl(closure); - - ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR); - - do { - switch (get_itbl(bqe)->type) { - case TSO: - checkClosure((StgClosure *)bqe); - bqe = bqe->link; - end = (bqe==END_TSO_QUEUE); - break; - - default: - barf("checkBQ: strange closure %d in blocking queue for closure %p\n", - get_itbl(bqe)->type, closure, info->type); - } - } while (!end); -} - #endif @@ -949,7 +922,7 @@ 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((StgClosure *)gala->la); @@ -960,7 +933,7 @@ checkLAGAtable(rtsBool check_closures) 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 ) {