X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FSanity.c;h=d666d57f3b3e5723686f88bf463ab8394daf5403;hp=c9a07725430cba314aac8b0d185239d2d4924a59;hb=a2a67cd520b9841114d69a87a423dabcb3b4368e;hpb=baca788631cfc07ca46ebffc538ff49e51a800b0 diff --git a/rts/Sanity.c b/rts/Sanity.c index c9a0772..d666d57 100644 --- a/rts/Sanity.c +++ b/rts/Sanity.c @@ -18,14 +18,13 @@ #ifdef DEBUG /* whole file */ -#include "RtsFlags.h" #include "RtsUtils.h" -#include "BlockAlloc.h" +#include "sm/Storage.h" +#include "sm/BlockAlloc.h" #include "Sanity.h" -#include "MBlock.h" -#include "Storage.h" #include "Schedule.h" #include "Apply.h" +#include "Printer.h" /* ----------------------------------------------------------------------------- Forward decls. @@ -247,7 +246,7 @@ 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)? */ @@ -257,7 +256,13 @@ 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_CLEAN: @@ -267,13 +272,6 @@ checkClosure( StgClosure* p ) ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->head)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->tail)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->value)); -#if 0 -#if defined(PAR) - checkBQ((StgBlockingQueueElement *)mvar->head, p); -#else - checkBQ(mvar->head, p); -#endif -#endif return sizeofW(StgMVar); } @@ -306,10 +304,6 @@ checkClosure( StgClosure* p ) case IND_PERM: case IND_OLDGEN: case IND_OLDGEN_PERM: -#ifdef TICKY_TICKY - case SE_BLACKHOLE: - case SE_CAF_BLACKHOLE: -#endif case BLACKHOLE: case CAF_BLACKHOLE: case STABLE_NAME: @@ -421,37 +415,6 @@ checkClosure( StgClosure* p ) checkTSO((StgTSO *)p); return tso_sizeW((StgTSO *)p); -#if defined(PAR) - - case BLOCKED_FETCH: - ASSERT(LOOKS_LIKE_GA(&(((StgBlockedFetch *)p)->ga))); - ASSERT(LOOKS_LIKE_CLOSURE_PTR((((StgBlockedFetch *)p)->node))); - return sizeofW(StgBlockedFetch); // see size used in evacuate() - -#ifdef DIST - case REMOTE_REF: - return sizeofW(StgFetchMe); -#endif /*DIST */ - - case FETCH_ME: - ASSERT(LOOKS_LIKE_GA(((StgFetchMe *)p)->ga)); - return sizeofW(StgFetchMe); // see size used in evacuate() - - case FETCH_ME_BQ: - checkBQ(((StgFetchMeBlockingQueue *)p)->blocking_queue, (StgClosure *)p); - return sizeofW(StgFetchMeBlockingQueue); // see size used in evacuate() - - case RBH: - /* In an RBH the BQ may be empty (ie END_BQ_QUEUE) but not NULL */ - ASSERT(((StgRBH *)p)->blocking_queue!=NULL); - if (((StgRBH *)p)->blocking_queue!=END_BQ_QUEUE) - checkBQ(((StgRBH *)p)->blocking_queue, p); - ASSERT(LOOKS_LIKE_INFO_PTR(REVERT_INFOPTR(get_itbl((StgClosure *)p)))); - return BLACKHOLE_sizeW(); // see size used in evacuate() - // sizeW_fromITBL(REVERT_INFOPTR(get_itbl((StgClosure *)p))); - -#endif - case TVAR_WATCH_QUEUE: { StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p; @@ -506,54 +469,11 @@ checkClosure( StgClosure* p ) return sizeofW(StgTRecHeader); } - - case EVACUATED: - barf("checkClosure: found EVACUATED closure %d", - info->type); default: barf("checkClosure (closure type %d)", info->type); } } -#if defined(PAR) - -#define PVM_PE_MASK 0xfffc0000 -#define MAX_PVM_PES MAX_PES -#define MAX_PVM_TIDS MAX_PES -#define MAX_SLOTS 100000 - -rtsBool -looks_like_tid(StgInt tid) -{ - StgInt hi = (tid & PVM_PE_MASK) >> 18; - StgInt lo = (tid & ~PVM_PE_MASK); - rtsBool ok = (hi != 0) && (lo < MAX_PVM_TIDS) && (hi < MAX_PVM_TIDS); - return ok; -} - -rtsBool -looks_like_slot(StgInt slot) -{ - /* if tid is known better use looks_like_ga!! */ - rtsBool ok = slotpayload.gc.gtid); - rtsBool is_slot = ((ga)->payload.gc.gtid==mytid) ? - (ga)->payload.gc.slot<=highest_slot() : - (ga)->payload.gc.slotfree && - (*p < 0x1000 || !LOOKS_LIKE_INFO_PTR((void*)*p))) { p++; } + (*p < 0x1000 || !LOOKS_LIKE_INFO_PTR(*p))) { p++; } } } } -#if defined(PAR) -/* - Check heap between start and end. Used after unpacking graphs. -*/ void checkHeapChunk(StgPtr start, StgPtr end) { - extern globalAddr *LAGAlookup(StgClosure *addr); StgPtr p; nat size; for (p=start; ptype == FETCH_ME && - *(p+1) == 0x0000eeee /* ie. unpack garbage (see SetGAandCommonUp) */) { - /* if it's a FM created during unpack and commoned up, it's not global */ - ASSERT(LAGAlookup((StgClosure*)p)==NULL); - size = sizeofW(StgFetchMe); - } else if (get_itbl((StgClosure*)p)->type == IND) { - *(p+2) = 0x0000ee11; /* mark slop in IND as garbage */ - size = sizeofW(StgInd); - } else { - size = checkClosure((StgClosure *)p); - /* This is the smallest size of closure that can live in the heap. */ - ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) ); - } - } -} -#else /* !PAR */ -void -checkHeapChunk(StgPtr start, StgPtr end) -{ - StgPtr p; - nat size; - - for (p=start; p= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) ); } } -#endif void -checkChain(bdescr *bd) +checkLargeObjects(bdescr *bd) { while (bd != NULL) { - checkClosure((StgClosure *)bd->start); + if (!(bd->flags & BF_PINNED)) { + checkClosure((StgClosure *)bd->start); + } bd = bd->link; } } @@ -652,7 +544,7 @@ checkTSO(StgTSO *tso) StgPtr stack_end = stack + stack_size; if (tso->what_next == ThreadRelocated) { - checkTSO(tso->link); + checkTSO(tso->_link); return; } @@ -665,115 +557,9 @@ checkTSO(StgTSO *tso) ASSERT(stack <= sp && sp < stack_end); -#if defined(PAR) - ASSERT(tso->par.magic==TSO_MAGIC); - - switch (tso->why_blocked) { - case BlockedOnGA: - checkClosureShallow(tso->block_info.closure); - ASSERT(/* Can't be a FETCH_ME because *this* closure is on its BQ */ - get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ); - break; - case BlockedOnGA_NoSend: - checkClosureShallow(tso->block_info.closure); - ASSERT(get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ); - break; - case BlockedOnBlackHole: - checkClosureShallow(tso->block_info.closure); - ASSERT(get_itbl(tso->block_info.closure)->type==BLACKHOLE || - get_itbl(tso->block_info.closure)->type==RBH); - break; - case BlockedOnRead: - case BlockedOnWrite: - case BlockedOnDelay: -#if defined(mingw32_HOST_OS) - case BlockedOnDoProc: -#endif - /* isOnBQ(blocked_queue) */ - break; - case BlockedOnException: - /* isOnSomeBQ(tso) */ - ASSERT(get_itbl(tso->block_info.tso)->type==TSO); - break; - case BlockedOnMVar: - ASSERT(get_itbl(tso->block_info.closure)->type==MVAR); - break; - case BlockedOnSTM: - ASSERT(tso->block_info.closure == END_TSO_QUEUE); - break; - default: - /* - Could check other values of why_blocked but I am more - lazy than paranoid (bad combination) -- HWL - */ - } - - /* if the link field is non-nil it most point to one of these - three closure types */ - ASSERT(tso->link == END_TSO_QUEUE || - get_itbl(tso->link)->type == TSO || - get_itbl(tso->link)->type == BLOCKED_FETCH || - get_itbl(tso->link)->type == CONSTR); -#endif - checkStackChunk(sp, stack_end); } -#if defined(GRAN) -void -checkTSOsSanity(void) { - nat i, tsos; - StgTSO *tso; - - debugBelch("Checking sanity of all runnable TSOs:"); - - for (i=0, tsos=0; ilink) { - debugBelch("TSO %p on PE %d ...", tso, i); - checkTSO(tso); - debugBelch("OK, "); - tsos++; - } - } - - debugBelch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc); -} - - -// still GRAN only - -rtsBool -checkThreadQSanity (PEs proc, rtsBool check_TSO_too) -{ - StgTSO *tso, *prev; - - /* the NIL value for TSOs is END_TSO_QUEUE; thus, finding NULL is an error */ - ASSERT(run_queue_hds[proc]!=NULL); - ASSERT(run_queue_tls[proc]!=NULL); - /* if either head or tail is NIL then the other one must be NIL, too */ - ASSERT(run_queue_hds[proc]!=END_TSO_QUEUE || run_queue_tls[proc]==END_TSO_QUEUE); - ASSERT(run_queue_tls[proc]!=END_TSO_QUEUE || run_queue_hds[proc]==END_TSO_QUEUE); - for (tso=run_queue_hds[proc], prev=END_TSO_QUEUE; - tso!=END_TSO_QUEUE; - prev=tso, tso=tso->link) { - ASSERT((prev!=END_TSO_QUEUE || tso==run_queue_hds[proc]) && - (prev==END_TSO_QUEUE || prev->link==tso)); - if (check_TSO_too) - checkTSO(tso); - } - ASSERT(prev==run_queue_tls[proc]); -} - -rtsBool -checkThreadQsSanity (rtsBool check_TSO_too) -{ - PEs p; - - for (p=0; pglobal_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; + } + } } } @@ -806,10 +604,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 (rtsBool checkTSOs) +{ + 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(checkTSOs); +} + /* Check the static objects list. */ @@ -828,7 +643,7 @@ checkStaticObjects ( StgClosure* static_objects ) 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; } @@ -852,117 +667,4 @@ checkStaticObjects ( StgClosure* static_objects ) } } -/* - Check the sanity of a blocking queue starting at bqe with closure being - the closure holding the blocking queue. - Note that in GUM we can have several different closure types in a - blocking queue -*/ -#if defined(PAR) -void -checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure) -{ - rtsBool end = rtsFalse; - StgInfoTable *info = get_itbl(closure); - - ASSERT(info->type == MVAR || info->type == FETCH_ME_BQ || info->type == RBH); - - do { - switch (get_itbl(bqe)->type) { - case BLOCKED_FETCH: - case TSO: - checkClosure((StgClosure *)bqe); - bqe = bqe->link; - end = (bqe==END_BQ_QUEUE); - break; - - case CONSTR: - checkClosure((StgClosure *)bqe); - end = rtsTrue; - break; - - default: - barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n", - get_itbl(bqe)->type, closure, info_type(closure)); - } - } while (!end); -} -#elif defined(GRAN) -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 BLOCKED_FETCH: - case TSO: - checkClosure((StgClosure *)bqe); - bqe = bqe->link; - end = (bqe==END_BQ_QUEUE); - break; - - default: - barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n", - get_itbl(bqe)->type, closure, info_type(closure)); - } - } while (!end); -} -#endif - - - -/* - This routine checks the sanity of the LAGA and GALA tables. They are - implemented as lists through one hash table, LAtoGALAtable, because entries - in both tables have the same structure: - - the LAGA table maps local addresses to global addresses; it starts - with liveIndirections - - the GALA table maps global addresses to local addresses; it starts - with liveRemoteGAs -*/ - -#if defined(PAR) -#include "Hash.h" - -/* hidden in parallel/Global.c; only accessed for testing here */ -extern GALA *liveIndirections; -extern GALA *liveRemoteGAs; -extern HashTable *LAtoGALAtable; - -void -checkLAGAtable(rtsBool check_closures) -{ - GALA *gala, *gala0; - nat n=0, m=0; // debugging - - for (gala = liveIndirections; gala != NULL; gala = gala->next) { - n++; - gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la); - ASSERT(!gala->preferred || gala == gala0); - ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info)); - ASSERT(gala->next!=gala); // detect direct loops - if ( check_closures ) { - checkClosure((StgClosure *)gala->la); - } - } - - for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) { - m++; - gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la); - ASSERT(!gala->preferred || gala == gala0); - ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info)); - ASSERT(gala->next!=gala); // detect direct loops - /* - if ( check_closures ) { - checkClosure((StgClosure *)gala->la); - } - */ - } -} -#endif - #endif /* DEBUG */