X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSanity.c;h=6d80898176e0c5240c57f2c4af7c663550db0a48;hb=524b54cec5d3c20edf65b46bf51fff6c839700ab;hp=383ef6409c7bc103f72d06121842d9fd095906b3;hpb=1da232fccdd01edac72180682540c4d5b5ba71ea;p=ghc-hetmet.git diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index 383ef64..6d80898 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: Sanity.c,v 1.33 2003/04/22 16:25:12 simonmar Exp $ * * (c) The GHC Team, 1998-2001 * @@ -26,7 +25,6 @@ #include "MBlock.h" #include "Storage.h" #include "Schedule.h" -#include "StoragePriv.h" // for END_OF_STATIC_LIST #include "Apply.h" /* ----------------------------------------------------------------------------- @@ -113,25 +111,28 @@ checkStackFrame( StgPtr c ) dyn = r->liveness; p = (P_)(r->payload); - checkSmallBitmap(p,GET_LIVENESS(r->liveness),RET_DYN_BITMAP_SIZE); + checkSmallBitmap(p,RET_DYN_LIVENESS(r->liveness),RET_DYN_BITMAP_SIZE); p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE; // skip over the non-pointers - p += GET_NONPTRS(dyn); + p += RET_DYN_NONPTRS(dyn); // follow the ptr words - for (size = GET_PTRS(dyn); size > 0; size--) { + for (size = RET_DYN_PTRS(dyn); size > 0; size--) { checkClosureShallow((StgClosure *)*p); p++; } return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE + - GET_NONPTRS(dyn) + GET_PTRS(dyn); + RET_DYN_NONPTRS(dyn) + RET_DYN_PTRS(dyn); } case UPDATE_FRAME: ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgUpdateFrame*)c)->updatee)); + case ATOMICALLY_FRAME: + case CATCH_RETRY_FRAME: + case CATCH_STM_FRAME: case CATCH_FRAME: // small bitmap cases (<= 32 entries) case STOP_FRAME: @@ -153,8 +154,8 @@ checkStackFrame( StgPtr c ) case RET_BIG: // large bitmap (> 32 entries) case RET_VEC_BIG: - size = info->i.layout.large_bitmap->size; - checkLargeBitmap((StgPtr)c + 1, info->i.layout.large_bitmap, size); + size = GET_LARGE_BITMAP(&info->i)->size; + checkLargeBitmap((StgPtr)c + 1, GET_LARGE_BITMAP(&info->i), size); return 1 + size; case RET_FUN: @@ -165,18 +166,18 @@ checkStackFrame( StgPtr c ) ret_fun = (StgRetFun *)c; fun_info = get_fun_itbl(ret_fun->fun); size = ret_fun->size; - switch (fun_info->fun_type) { + switch (fun_info->f.fun_type) { case ARG_GEN: checkSmallBitmap((StgPtr)ret_fun->payload, - BITMAP_BITS(fun_info->bitmap), size); + BITMAP_BITS(fun_info->f.bitmap), size); break; case ARG_GEN_BIG: checkLargeBitmap((StgPtr)ret_fun->payload, - (StgLargeBitmap *)fun_info->bitmap, size); + GET_FUN_LARGE_BITMAP(fun_info), size); break; default: checkSmallBitmap((StgPtr)ret_fun->payload, - BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]), + BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), size); break; } @@ -184,7 +185,7 @@ checkStackFrame( StgPtr c ) } default: - barf("checkStackFrame: weird activation record found on stack (%p).",c); + barf("checkStackFrame: weird activation record found on stack (%p %d).",c,info->i.type); } } @@ -275,7 +276,6 @@ checkClosure( StgClosure* p ) case FOREIGN: case STABLE_NAME: case MUT_VAR: - case MUT_CONS: case CONSTR_INTLIKE: case CONSTR_CHARLIKE: case CONSTR_STATIC: @@ -319,7 +319,7 @@ checkClosure( StgClosure* p ) case THUNK_SELECTOR: ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgSelector *)p)->selectee)); - return sizeofW(StgHeader) + MIN_UPD_SIZE; + return THUNK_SELECTOR_sizeW(); case IND: { @@ -343,6 +343,9 @@ checkClosure( StgClosure* p ) case UPDATE_FRAME: case STOP_FRAME: case CATCH_FRAME: + case ATOMICALLY_FRAME: + case CATCH_RETRY_FRAME: + case CATCH_STM_FRAME: barf("checkClosure: stack frame"); case AP: /* we can treat this as being the same as a PAP */ @@ -355,14 +358,14 @@ checkClosure( StgClosure* p ) fun_info = get_fun_itbl(pap->fun); p = (StgClosure *)pap->payload; - switch (fun_info->fun_type) { + switch (fun_info->f.fun_type) { case ARG_GEN: checkSmallBitmap( (StgPtr)pap->payload, - BITMAP_BITS(fun_info->bitmap), pap->n_args ); + BITMAP_BITS(fun_info->f.bitmap), pap->n_args ); break; case ARG_GEN_BIG: checkLargeBitmap( (StgPtr)pap->payload, - (StgLargeBitmap *)fun_info->bitmap, + GET_FUN_LARGE_BITMAP(fun_info), pap->n_args ); break; case ARG_BCO: @@ -372,7 +375,7 @@ checkClosure( StgClosure* p ) break; default: checkSmallBitmap( (StgPtr)pap->payload, - BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]), + BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), pap->n_args ); break; } @@ -435,6 +438,44 @@ checkClosure( StgClosure* p ) // sizeW_fromITBL(REVERT_INFOPTR(get_itbl((StgClosure *)p))); #endif + + case TVAR_WAIT_QUEUE: + { + StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->next_queue_entry)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->prev_queue_entry)); + return sizeofW(StgTVarWaitQueue); + } + + case TVAR: + { + StgTVar *tv = (StgTVar *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->current_value)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->first_wait_queue_entry)); + return sizeofW(StgTVar); + } + + case TREC_CHUNK: + { + nat i; + StgTRecChunk *tc = (StgTRecChunk *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->prev_chunk)); + for (i = 0; i < tc -> next_entry_idx; i ++) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].tvar)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].expected_value)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].new_value)); + } + return sizeofW(StgTRecChunk); + } + + case TREC_HEADER: + { + StgTRecHeader *trec = (StgTRecHeader *)p; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(trec -> enclosing_trec)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(trec -> current_chunk)); + return sizeofW(StgTRecHeader); + } + case EVACUATED: barf("checkClosure: found EVACUATED closure %d", @@ -610,6 +651,9 @@ checkTSO(StgTSO *tso) case BlockedOnRead: case BlockedOnWrite: case BlockedOnDelay: +#if defined(mingw32_HOST_OS) + case BlockedOnDoProc: +#endif /* isOnBQ(blocked_queue) */ break; case BlockedOnException: @@ -619,6 +663,9 @@ checkTSO(StgTSO *tso) 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 @@ -643,18 +690,18 @@ checkTSOsSanity(void) { nat i, tsos; StgTSO *tso; - belch("Checking sanity of all runnable TSOs:"); + debugBelch("Checking sanity of all runnable TSOs:"); for (i=0, tsos=0; ilink) { - fprintf(stderr, "TSO %p on PE %d ...", tso, i); + debugBelch("TSO %p on PE %d ...", tso, i); checkTSO(tso); - fprintf(stderr, "OK, "); + debugBelch("OK, "); tsos++; } } - belch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc); + debugBelch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc); } @@ -714,41 +761,16 @@ checkGlobalTSOList (rtsBool checkTSOs) -------------------------------------------------------------------------- */ void -checkMutableList( StgMutClosure *p, nat gen ) +checkMutableList( bdescr *mut_bd, nat gen ) { bdescr *bd; + StgPtr q; + StgClosure *p; - for (; p != END_MUT_LIST; p = p->mut_link) { - bd = Bdescr((P_)p); - ASSERT(closure_MUTABLE(p)); - ASSERT(bd->gen_no == gen); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->mut_link)); - } -} - -void -checkMutOnceList( StgMutClosure *p, nat gen ) -{ - bdescr *bd; - StgInfoTable *info; - - for (; p != END_MUT_LIST; p = p->mut_link) { - bd = Bdescr((P_)p); - info = get_itbl(p); - - ASSERT(!closure_MUTABLE(p)); - ASSERT(ip_STATIC(info) || bd->gen_no == gen); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->mut_link)); - - switch (info->type) { - case IND_STATIC: - case IND_OLDGEN: - case IND_OLDGEN_PERM: - case MUT_CONS: - break; - default: - barf("checkMutOnceList: strange closure %p (%s)", - p, info_type((StgClosure *)p)); + for (bd = mut_bd; bd != NULL; bd = bd->link) { + for (q = bd->start; q < bd->free; q++) { + p = (StgClosure *)*q; + ASSERT(!HEAP_ALLOCED(p) || Bdescr((P_)p)->gen_no == gen); } } }