X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSanity.c;h=8f3b627a2bbae3c8505b81ae16de6d1e6625f9e2;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hp=48d913c46ea54ae629e2c51c5ee5966740b167f3;hpb=9cef40bd4dd2536c7a370a1a9b78461c152805cc;p=ghc-hetmet.git diff --git a/rts/Sanity.c b/rts/Sanity.c index 48d913c..8f3b627 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); } @@ -241,8 +247,9 @@ checkClosure( StgClosure* p ) { const StgInfoTable *info; - ASSERT(LOOKS_LIKE_INFO_PTR(p->header.info)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + 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)); @@ -324,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); } @@ -362,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: @@ -501,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); } @@ -580,7 +587,7 @@ checkHeap(bdescr *bd) /* skip over slop */ while (p < bd->free && - (*p < 0x1000 || !LOOKS_LIKE_INFO_PTR((void*)*p))) { p++; } + (*p < 0x1000 || !LOOKS_LIKE_INFO_PTR(*p))) { p++; } } } } @@ -621,7 +628,7 @@ checkHeapChunk(StgPtr start, StgPtr end) nat size; for (p=start; p= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) ); @@ -647,7 +654,7 @@ checkTSO(StgTSO *tso) StgPtr stack_end = stack + stack_size; if (tso->what_next == ThreadRelocated) { - checkTSO(tso->link); + checkTSO(tso->_link); return; } @@ -776,13 +783,25 @@ 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); + + // If this TSO is dirty and in an old generation, it better + // be on the mutable list. + if (tso->what_next == ThreadRelocated) continue; + if (tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) { + ASSERT(Bdescr((P_)tso)->gen_no == 0 || tso->flags & TSO_MARKED); + tso->flags &= ~TSO_MARKED; + } + } } } @@ -801,10 +820,27 @@ checkMutableList( bdescr *mut_bd, nat gen ) for (q = bd->start; q < bd->free; q++) { p = (StgClosure *)*q; ASSERT(!HEAP_ALLOCED(p) || Bdescr((P_)p)->gen_no == gen); + if (get_itbl(p)->type == TSO) { + ((StgTSO *)p)->flags |= TSO_MARKED; + } } } } +void +checkMutableLists (void) +{ + nat g, i; + + for (g = 0; g < RtsFlags.GcFlags.generations; g++) { + checkMutableList(generations[g].mut_list, g); + for (i = 0; i < n_capabilities; i++) { + checkMutableList(capabilities[i].mut_lists[g], g); + } + } + checkGlobalTSOList(rtsTrue); +} + /* Check the static objects list. */ @@ -820,10 +856,10 @@ 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)); + ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)indirectee->header.info)); p = *IND_STATIC_LINK((StgClosure *)p); break; }