X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSanity.c;h=9ee630c4e5c14178fa63dcae40af18a6f093fc04;hb=beb5737b7ee42c4e9373a505e7d957206d69a30e;hp=410df7450d98de2b89cb358ff786b8f26846e01a;hpb=1621421619df6f19dce3b8cb29471e5d3c731acb;p=ghc-hetmet.git diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index 410df74..9ee630c 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. * @@ -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,9 +278,9 @@ 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 FUN: @@ -270,9 +304,9 @@ checkClosure( StgClosure* p ) #endif case BLACKHOLE: case CAF_BLACKHOLE: - case FOREIGN: case STABLE_NAME: - case MUT_VAR: + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: case CONSTR_INTLIKE: case CONSTR_CHARLIKE: case CONSTR_STATIC: @@ -323,12 +357,9 @@ checkClosure( StgClosure* p ) /* 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: @@ -345,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.b.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: { @@ -390,7 +401,8 @@ 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: { @@ -537,12 +549,18 @@ 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) { 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 */ @@ -572,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) ); } } } @@ -591,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 @@ -791,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: @@ -873,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 == 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