X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSanity.c;h=4430c4b6bd4661acd491bd28815713939fcfb58a;hb=6cf8982ac30be6836a0cdd8be5a6ac1a1a144213;hp=71eae4490c2fda12a2f42990691760aabb12a57a;hpb=d600bf7a6afdbfc4a22f9379406a9c6f789a4c2d;p=ghc-hetmet.git diff --git a/rts/Sanity.c b/rts/Sanity.c index 71eae44..4430c4b 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. @@ -237,7 +236,7 @@ checkPAP (StgClosure *tagged_fun, StgClosure** payload, StgWord n_args) break; } - ASSERT(fun_info->f.arity > TAG_MASK ? GET_CLOSURE_TAG(tagged_fun) == 1 + ASSERT(fun_info->f.arity > TAG_MASK ? GET_CLOSURE_TAG(tagged_fun) == 0 : GET_CLOSURE_TAG(tagged_fun) == fun_info->f.arity); } @@ -273,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); } @@ -423,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; @@ -513,45 +474,6 @@ checkClosure( StgClosure* p ) } } -#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.slottype == 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) { @@ -630,13 +523,14 @@ checkHeapChunk(StgPtr start, StgPtr end) ASSERT( size >= 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; } } @@ -663,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; pwhat_next == ThreadRelocated) continue; - if (tso->flags & (TSO_DIRTY|TSO_LINK_DIRTY)) { - ASSERT(Bdescr((P_)tso)->gen_no == 0 || tso->flags & TSO_MARKED); + if (tso->dirty || (tso->flags & TSO_LINK_DIRTY)) { + ASSERT(Bdescr((P_)tso)->gen_no == 0 || (tso->flags & TSO_MARKED)); tso->flags &= ~TSO_MARKED; } } @@ -824,7 +612,7 @@ checkMutableList( bdescr *mut_bd, nat gen ) } void -checkMutableLists (void) +checkMutableLists (rtsBool checkTSOs) { nat g, i; @@ -834,7 +622,7 @@ checkMutableLists (void) checkMutableList(capabilities[i].mut_lists[g], g); } } - checkGlobalTSOList(rtsTrue); + checkGlobalTSOList(checkTSOs); } /* @@ -879,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 */