X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSanity.c;h=3df5aef413cdf29b3341ff1936cdb05cbb56381f;hb=27de38efce6d73d2a0209f803cfa98c82773e773;hp=0e68a86ba78d8b7edefd8c61b8e895e29f8cd04a;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/rts/Sanity.c b/rts/Sanity.c index 0e68a86..3df5aef 100644 --- a/rts/Sanity.c +++ b/rts/Sanity.c @@ -80,13 +80,16 @@ checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, nat size ) static void checkClosureShallow( StgClosure* p ) { - ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + StgClosure *q; + + q = UNTAG_CLOSURE(p); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); /* Is it a static closure? */ - if (!HEAP_ALLOCED(p)) { - ASSERT(closure_STATIC(p)); + if (!HEAP_ALLOCED(q)) { + ASSERT(closure_STATIC(q)); } else { - ASSERT(!closure_STATIC(p)); + ASSERT(!closure_STATIC(q)); } } @@ -137,7 +140,6 @@ checkStackFrame( StgPtr c ) // 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); @@ -153,7 +155,6 @@ checkStackFrame( StgPtr c ) } 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; @@ -164,7 +165,7 @@ checkStackFrame( StgPtr c ) StgRetFun *ret_fun; ret_fun = (StgRetFun *)c; - fun_info = get_fun_itbl(ret_fun->fun); + fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); size = ret_fun->size; switch (fun_info->f.fun_type) { case ARG_GEN: @@ -203,11 +204,13 @@ checkStackChunk( StgPtr sp, StgPtr stack_end ) } static void -checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args) +checkPAP (StgClosure *tagged_fun, StgClosure** payload, StgWord n_args) { + StgClosure *fun; StgClosure *p; StgFunInfoTable *fun_info; + fun = UNTAG_CLOSURE(tagged_fun); ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun)); fun_info = get_fun_itbl(fun); @@ -233,6 +236,9 @@ checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args) n_args ); break; } + + ASSERT(fun_info->f.arity > TAG_MASK ? GET_CLOSURE_TAG(tagged_fun) == 1 + : GET_CLOSURE_TAG(tagged_fun) == fun_info->f.arity); } @@ -243,6 +249,7 @@ checkClosure( StgClosure* p ) ASSERT(LOOKS_LIKE_INFO_PTR(p->header.info)); + p = UNTAG_CLOSURE(p); /* Is it a static closure (i.e. in the data segment)? */ if (!HEAP_ALLOCED(p)) { ASSERT(closure_STATIC(p)); @@ -250,10 +257,17 @@ checkClosure( StgClosure* p ) ASSERT(!closure_STATIC(p)); } - info = get_itbl(p); + info = p->header.info; + + if (IS_FORWARDING_PTR(info)) { + barf("checkClosure: found EVACUATED closure %d", info->type); + } + info = INFO_PTR_TO_STRUCT(info); + switch (info->type) { - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: { StgMVar *mvar = (StgMVar *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->head)); @@ -307,8 +321,6 @@ checkClosure( StgClosure* p ) case STABLE_NAME: case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: - case CONSTR_INTLIKE: - case CONSTR_CHARLIKE: case CONSTR_STATIC: case CONSTR_NOCAF_STATIC: case THUNK_STATIC: @@ -326,7 +338,6 @@ checkClosure( StgClosure* 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); } @@ -364,9 +375,7 @@ checkClosure( StgClosure* p ) case RET_BCO: case RET_SMALL: - case RET_VEC_SMALL: case RET_BIG: - case RET_VEC_BIG: case RET_DYN: case UPDATE_FRAME: case STOP_FRAME: @@ -449,19 +458,36 @@ checkClosure( StgClosure* p ) #endif - case TVAR_WAIT_QUEUE: + case TVAR_WATCH_QUEUE: { - StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p; + StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->next_queue_entry)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->prev_queue_entry)); - return sizeofW(StgTVarWaitQueue); + return sizeofW(StgTVarWatchQueue); + } + + case INVARIANT_CHECK_QUEUE: + { + StgInvariantCheckQueue *q = (StgInvariantCheckQueue *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(q->invariant)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(q->my_execution)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(q->next_queue_entry)); + return sizeofW(StgInvariantCheckQueue); + } + + case ATOMIC_INVARIANT: + { + StgAtomicInvariant *invariant = (StgAtomicInvariant *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(invariant->code)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(invariant->last_execution)); + return sizeofW(StgAtomicInvariant); } case TVAR: { StgTVar *tv = (StgTVar *)p; ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->current_value)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->first_wait_queue_entry)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->first_watch_queue_entry)); return sizeofW(StgTVar); } @@ -486,10 +512,6 @@ checkClosure( StgClosure* p ) return sizeofW(StgTRecHeader); } - - case EVACUATED: - barf("checkClosure: found EVACUATED closure %d", - info->type); default: barf("checkClosure (closure type %d)", info->type); } @@ -632,7 +654,7 @@ checkTSO(StgTSO *tso) StgPtr stack_end = stack + stack_size; if (tso->what_next == ThreadRelocated) { - checkTSO(tso->link); + checkTSO(tso->_link); return; } @@ -761,13 +783,17 @@ checkThreadQsSanity (rtsBool check_TSO_too) void checkGlobalTSOList (rtsBool checkTSOs) { - extern StgTSO *all_threads; StgTSO *tso; - for (tso=all_threads; tso != END_TSO_QUEUE; tso = tso->global_link) { - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso)); - ASSERT(get_itbl(tso)->type == TSO); - if (checkTSOs) - checkTSO(tso); + nat s; + + for (s = 0; s < total_steps; s++) { + for (tso=all_steps[s].threads; tso != END_TSO_QUEUE; + tso = tso->global_link) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso)); + ASSERT(get_itbl(tso)->type == TSO); + if (checkTSOs) + checkTSO(tso); + } } } @@ -805,7 +831,7 @@ checkStaticObjects ( StgClosure* static_objects ) switch (info->type) { case IND_STATIC: { - StgClosure *indirectee = ((StgIndStatic *)p)->indirectee; + StgClosure *indirectee = UNTAG_CLOSURE(((StgIndStatic *)p)->indirectee); ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee)); ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info));