X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSanity.c;h=43200d2ba969ddd41b442fb346227e3e3d57be26;hb=acc7c96112e6554461ec6704f27fe4ae3fa7aae2;hp=a8f1f56c278ef14c3d8ce524ca00c4b02b1f9846;hpb=03dc2dd3dd814ad85cc4c45e9cafc7b73163c8be;p=ghc-hetmet.git diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index a8f1f56..43200d2 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -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 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: @@ -273,7 +304,6 @@ checkClosure( StgClosure* p ) #endif case BLACKHOLE: case CAF_BLACKHOLE: - case FOREIGN: case STABLE_NAME: case MUT_VAR: case CONSTR_INTLIKE: @@ -326,12 +356,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(StgHeader) + MIN_UPD_SIZE; } case RET_BCO: @@ -348,39 +375,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: { @@ -395,6 +402,7 @@ checkClosure( StgClosure* p ) case MUT_ARR_PTRS: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: { StgMutArrPtrs* a = (StgMutArrPtrs *)p; nat i; @@ -539,6 +547,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) { @@ -644,8 +658,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: @@ -794,20 +807,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: @@ -830,8 +843,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) { @@ -860,7 +872,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) { @@ -877,30 +889,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