X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSanity.c;h=0e68a86ba78d8b7edefd8c61b8e895e29f8cd04a;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=f1d43bdad3d8c973a91d841fbc14972f248366aa;hpb=153b9cb9b11e05c4edb1b6bc0a7b972660e41f70;p=ghc-hetmet.git diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index f1d43bd..0e68a86 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team, 1998-2001 + * (c) The GHC Team, 1998-2006 * * Sanity checking code for the heap and stack. * @@ -169,7 +169,7 @@ checkStackFrame( StgPtr c ) switch (fun_info->f.fun_type) { case ARG_GEN: checkSmallBitmap((StgPtr)ret_fun->payload, - BITMAP_BITS(fun_info->f.bitmap), size); + BITMAP_BITS(fun_info->f.b.bitmap), size); break; case ARG_GEN_BIG: checkLargeBitmap((StgPtr)ret_fun->payload, @@ -202,6 +202,40 @@ checkStackChunk( StgPtr sp, StgPtr stack_end ) // 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 ) { @@ -244,14 +278,11 @@ checkClosure( StgClosure* p ) { nat i; for (i = 0; i < info->layout.payload.ptrs; i++) { - ASSERT(LOOKS_LIKE_CLOSURE_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 thunk_sizeW_fromITBL(info); } - 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: @@ -273,10 +304,9 @@ checkClosure( StgClosure* p ) #endif case BLACKHOLE: case CAF_BLACKHOLE: - case FOREIGN: case STABLE_NAME: - case MUT_VAR: - case MUT_CONS: + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: case CONSTR_INTLIKE: case CONSTR_CHARLIKE: case CONSTR_STATIC: @@ -320,19 +350,16 @@ checkClosure( StgClosure* p ) case THUNK_SELECTOR: ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgSelector *)p)->selectee)); - return sizeofW(StgHeader) + MIN_UPD_SIZE; + 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_CLOSURE_PTR(ind->indirectee)); - q = (P_)p + sizeofW(StgInd); - while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/ - return q - (P_)p; + return sizeofW(StgInd); } case RET_BCO: @@ -349,39 +376,19 @@ checkClosure( StgClosure* p ) case CATCH_STM_FRAME: barf("checkClosure: stack frame"); - case AP: /* 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: - { - 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->f.fun_type) { - case ARG_GEN: - checkSmallBitmap( (StgPtr)pap->payload, - BITMAP_BITS(fun_info->f.bitmap), pap->n_args ); - break; - case ARG_GEN_BIG: - checkLargeBitmap( (StgPtr)pap->payload, - GET_FUN_LARGE_BITMAP(fun_info), - 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->f.fun_type]), - pap->n_args ); - break; - } - return pap_sizeW(pap); - } + { + StgPAP* pap = (StgPAP *)p; + checkPAP (pap->fun, pap->payload, pap->n_args); + return pap_sizeW(pap); + } case AP_STACK: { @@ -394,8 +401,10 @@ checkClosure( StgClosure* p ) 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; @@ -419,7 +428,7 @@ checkClosure( StgClosure* p ) #ifdef DIST case REMOTE_REF: return sizeofW(StgFetchMe); -#endif //DIST +#endif /*DIST */ case FETCH_ME: ASSERT(LOOKS_LIKE_GA(((StgFetchMe *)p)->ga)); @@ -540,12 +549,18 @@ checkHeap(bdescr *bd) { StgPtr p; +#if defined(THREADED_RTS) + // 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) { 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) ); + ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) ); p += size; /* skip over slop */ @@ -575,11 +590,11 @@ checkHeapChunk(StgPtr start, StgPtr end) size = sizeofW(StgFetchMe); } else if (get_itbl((StgClosure*)p)->type == IND) { *(p+2) = 0x0000ee11; /* mark slop in IND as garbage */ - size = MIN_UPD_SIZE; + size = sizeofW(StgInd); } 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) ); + ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) ); } } } @@ -594,7 +609,7 @@ checkHeapChunk(StgPtr start, StgPtr end) ASSERT(LOOKS_LIKE_INFO_PTR((void*)*p)); size = checkClosure((StgClosure *)p); /* This is the smallest size of closure that can live in the heap. */ - ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) ); + ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) ); } } #endif @@ -645,8 +660,7 @@ 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: @@ -762,41 +776,16 @@ 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_CLOSURE_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_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)); + 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); } } } @@ -820,20 +809,20 @@ checkStaticObjects ( StgClosure* static_objects ) ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee)); ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info)); - p = IND_STATIC_LINK((StgClosure *)p); + 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: @@ -856,8 +845,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) { @@ -886,7 +874,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) { @@ -903,30 +891,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