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:
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:
switch (fun_info->f.fun_type) {
case ARG_GEN:
checkSmallBitmap((StgPtr)ret_fun->payload,
- BITMAP_BITS(fun_info->f.bitmap), size);
+ BITMAP_BITS(fun_info->f.b.bitmap), size);
break;
case ARG_GEN_BIG:
checkLargeBitmap((StgPtr)ret_fun->payload,
- (StgLargeBitmap *)fun_info->f.bitmap, size);
+ GET_FUN_LARGE_BITMAP(fun_info), size);
break;
default:
checkSmallBitmap((StgPtr)ret_fun->payload,
}
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);
}
}
// ASSERT( p == stack_end ); -- HWL
}
+static void
+checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args)
+{
+ StgClosure *p;
+ StgFunInfoTable *fun_info;
+
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun));
+ fun_info = get_fun_itbl(fun);
+
+ p = (StgClosure *)payload;
+ switch (fun_info->f.fun_type) {
+ case ARG_GEN:
+ checkSmallBitmap( (StgPtr)payload,
+ BITMAP_BITS(fun_info->f.b.bitmap), n_args );
+ break;
+ case ARG_GEN_BIG:
+ checkLargeBitmap( (StgPtr)payload,
+ GET_FUN_LARGE_BITMAP(fun_info),
+ n_args );
+ break;
+ case ARG_BCO:
+ checkLargeBitmap( (StgPtr)payload,
+ BCO_BITMAP(fun),
+ n_args );
+ break;
+ default:
+ checkSmallBitmap( (StgPtr)payload,
+ BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
+ n_args );
+ break;
+ }
+}
+
+
StgOffset
checkClosure( StgClosure* p )
{
{
nat i;
for (i = 0; i < info->layout.payload.ptrs; i++) {
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i]));
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgThunk *)p)->payload[i]));
}
- return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
+ return stg_max(thunk_sizeW_fromITBL(info), sizeofW(StgHeader)+MIN_UPD_SIZE);
}
- case BLACKHOLE_BQ:
- checkBQ(((StgBlockingQueue *)p)->blocking_queue, p);
- /* fall through to basic ptr check */
case FUN:
case FUN_1_0:
case FUN_0_1:
#endif
case BLACKHOLE:
case CAF_BLACKHOLE:
- case FOREIGN:
case STABLE_NAME:
case MUT_VAR:
- case MUT_CONS:
case CONSTR_INTLIKE:
case CONSTR_CHARLIKE:
case CONSTR_STATIC:
case THUNK_SELECTOR:
ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgSelector *)p)->selectee));
- return sizeofW(StgHeader) + MIN_UPD_SIZE;
+ return THUNK_SELECTOR_sizeW();
case IND:
{
/* we don't expect to see any of these after GC
* but they might appear during execution
*/
- P_ q;
StgInd *ind = (StgInd *)p;
ASSERT(LOOKS_LIKE_CLOSURE_PTR(ind->indirectee));
- q = (P_)p + sizeofW(StgInd);
- while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/
- return q - (P_)p;
+ return sizeofW(StgHeader) + MIN_UPD_SIZE;
}
case RET_BCO:
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 */
+ case AP:
+ {
+ StgAP* ap = (StgAP *)p;
+ checkPAP (ap->fun, ap->payload, ap->n_args);
+ return ap_sizeW(ap);
+ }
+
case PAP:
- {
- StgFunInfoTable *fun_info;
- StgPAP* pap = (StgPAP *)p;
-
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(pap->fun));
- fun_info = get_fun_itbl(pap->fun);
-
- p = (StgClosure *)pap->payload;
- switch (fun_info->f.fun_type) {
- case ARG_GEN:
- checkSmallBitmap( (StgPtr)pap->payload,
- BITMAP_BITS(fun_info->f.bitmap), pap->n_args );
- break;
- case ARG_GEN_BIG:
- checkLargeBitmap( (StgPtr)pap->payload,
- (StgLargeBitmap *)fun_info->f.bitmap,
- pap->n_args );
- break;
- case ARG_BCO:
- checkLargeBitmap( (StgPtr)pap->payload,
- BCO_BITMAP(pap->fun),
- pap->n_args );
- break;
- default:
- checkSmallBitmap( (StgPtr)pap->payload,
- BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
- pap->n_args );
- break;
- }
- return pap_sizeW(pap);
- }
+ {
+ StgPAP* pap = (StgPAP *)p;
+ checkPAP (pap->fun, pap->payload, pap->n_args);
+ return pap_sizeW(pap);
+ }
case AP_STACK:
{
case ARR_WORDS:
return arr_words_sizeW((StgArrWords *)p);
- case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
{
StgMutArrPtrs* a = (StgMutArrPtrs *)p;
nat i;
#ifdef DIST
case REMOTE_REF:
return sizeofW(StgFetchMe);
-#endif //DIST
+#endif /*DIST */
case FETCH_ME:
ASSERT(LOOKS_LIKE_GA(((StgFetchMe *)p)->ga));
// 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",
{
StgPtr p;
+#if defined(SMP)
+ // heap sanity checking doesn't work with SMP, because we can't
+ // zero the slop (see Updates.h).
+ return;
+#endif
+
for (; bd != NULL; bd = bd->link) {
p = bd->start;
while (p < bd->free) {
break;
case BlockedOnBlackHole:
checkClosureShallow(tso->block_info.closure);
- ASSERT(/* Can't be a BLACKHOLE because *this* closure is on its BQ */
- get_itbl(tso->block_info.closure)->type==BLACKHOLE_BQ ||
+ 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_TARGET_OS)
+#if defined(mingw32_HOST_OS)
case BlockedOnDoProc:
#endif
/* isOnBQ(blocked_queue) */
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
nat i, tsos;
StgTSO *tso;
- belch("Checking sanity of all runnable TSOs:");
+ debugBelch("Checking sanity of all runnable TSOs:");
for (i=0, tsos=0; i<RtsFlags.GranFlags.proc; i++) {
for (tso=run_queue_hds[i]; tso!=END_TSO_QUEUE; tso=tso->link) {
- 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);
}
-------------------------------------------------------------------------- */
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);
}
}
}
ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee));
ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info));
- p = IND_STATIC_LINK((StgClosure *)p);
+ p = *IND_STATIC_LINK((StgClosure *)p);
break;
}
case THUNK_STATIC:
- p = THUNK_STATIC_LINK((StgClosure *)p);
+ p = *THUNK_STATIC_LINK((StgClosure *)p);
break;
case FUN_STATIC:
- p = FUN_STATIC_LINK((StgClosure *)p);
+ p = *FUN_STATIC_LINK((StgClosure *)p);
break;
case CONSTR_STATIC:
- p = STATIC_LINK(info,(StgClosure *)p);
+ p = *STATIC_LINK(info,(StgClosure *)p);
break;
default:
rtsBool end = rtsFalse;
StgInfoTable *info = get_itbl(closure);
- ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR
- || info->type == FETCH_ME_BQ || info->type == RBH);
+ ASSERT(info->type == MVAR || info->type == FETCH_ME_BQ || info->type == RBH);
do {
switch (get_itbl(bqe)->type) {
rtsBool end = rtsFalse;
StgInfoTable *info = get_itbl(closure);
- ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR);
+ ASSERT(info->type == MVAR);
do {
switch (get_itbl(bqe)->type) {
}
} while (!end);
}
-#else
-void
-checkBQ (StgTSO *bqe, StgClosure *closure)
-{
- rtsBool end = rtsFalse;
- StgInfoTable *info = get_itbl(closure);
-
- ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR);
-
- do {
- switch (get_itbl(bqe)->type) {
- case TSO:
- checkClosure((StgClosure *)bqe);
- bqe = bqe->link;
- end = (bqe==END_TSO_QUEUE);
- break;
-
- default:
- barf("checkBQ: strange closure %d in blocking queue for closure %p\n",
- get_itbl(bqe)->type, closure, info->type);
- }
- } while (!end);
-}
-
#endif
projects / ghc-hetmet.git / blobdiff