/* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.2 1998/12/02 13:28:43 simonm Exp $
+ * $Id: Sanity.c,v 1.11 1999/03/03 19:07:39 sof Exp $
+ *
+ * (c) The GHC Team, 1998-1999
*
* Sanity checking code for the heap and stack.
*
#include "BlockAlloc.h"
#include "Sanity.h"
-static nat heap_step;
-
-#define LOOKS_LIKE_PTR(r) \
- (IS_DATA_PTR(r) || ((IS_USER_PTR(r) && Bdescr((P_)r)->step == heap_step)))
+#define LOOKS_LIKE_PTR(r) (IS_DATA_PTR(r) || ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1)))
/* -----------------------------------------------------------------------------
Check stack sanity
void checkStackChunk( StgPtr sp, StgPtr stack_end );
-static StgOffset checkSmallBitmap( StgPtr payload, StgNat32 bitmap );
+static StgOffset checkSmallBitmap( StgPtr payload, StgWord32 bitmap );
static StgOffset checkLargeBitmap( StgPtr payload,
StgLargeBitmap* large_bitmap );
void checkClosureShallow( StgClosure* p );
static StgOffset
-checkSmallBitmap( StgPtr payload, StgNat32 bitmap )
+checkSmallBitmap( StgPtr payload, StgWord32 bitmap )
{
StgOffset i;
static StgOffset
checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap )
{
- StgNat32 bmp;
+ StgWord32 bmp;
StgOffset i;
i = 0;
for (bmp=0; bmp<large_bitmap->size; bmp++) {
- StgNat32 bitmap = large_bitmap->bitmap[bmp];
+ StgWord32 bitmap = large_bitmap->bitmap[bmp];
for(; bitmap != 0; ++i, bitmap >>= 1 ) {
if ((bitmap & 1) == 0) {
checkClosure(stgCast(StgClosure*,payload[i]));
}
return bco_sizeW(bco);
}
- case FUN:
+
+ case MVAR:
+ {
+ StgMVar *mvar = (StgMVar *)p;
+ ASSERT(LOOKS_LIKE_PTR(mvar->head));
+ ASSERT(LOOKS_LIKE_PTR(mvar->tail));
+ ASSERT(LOOKS_LIKE_PTR(mvar->value));
+ return sizeofW(StgMVar);
+ }
+
case THUNK:
+ case THUNK_1_0:
+ case THUNK_0_1:
+ case THUNK_1_1:
+ case THUNK_0_2:
+ case THUNK_2_0:
+ {
+ nat i;
+ for (i = 0; i < info->layout.payload.ptrs; i++) {
+ ASSERT(LOOKS_LIKE_PTR(payloadPtr(p,i)));
+ }
+ return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
+ }
+
+ case FUN:
+ case FUN_1_0:
+ case FUN_0_1:
+ case FUN_1_1:
+ case FUN_0_2:
+ case FUN_2_0:
case CONSTR:
+ case CONSTR_1_0:
+ case CONSTR_0_1:
+ case CONSTR_1_1:
+ case CONSTR_0_2:
+ case CONSTR_2_0:
case IND_PERM:
+ case IND_OLDGEN:
case IND_OLDGEN_PERM:
case CAF_UNENTERED:
case CAF_ENTERED:
case CAF_BLACKHOLE:
case BLACKHOLE:
+ case BLACKHOLE_BQ:
case FOREIGN:
- case MVAR:
+ case STABLE_NAME:
case MUT_VAR:
case CONSTR_INTLIKE:
case CONSTR_CHARLIKE:
{ StgWeak *w = (StgWeak *)p;
ASSERT(LOOKS_LIKE_PTR(w->key));
ASSERT(LOOKS_LIKE_PTR(w->value));
- ASSERT(LOOKS_LIKE_PTR(w->finaliser));
+ ASSERT(LOOKS_LIKE_PTR(w->finalizer));
if (w->link) {
ASSERT(LOOKS_LIKE_PTR(w->link));
}
return sizeofW(StgHeader) + MIN_UPD_SIZE;
case IND:
- case IND_OLDGEN:
{
/* we don't expect to see any of these after GC
* but they might appear during execution
*/
+ P_ q;
StgInd *ind = stgCast(StgInd*,p);
ASSERT(LOOKS_LIKE_PTR(ind->indirectee));
- return sizeofW(StgInd);
+ q = (P_)p + sizeofW(StgInd);
+ while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/
+ return q - (P_)p;
}
case RET_BCO:
}
case ARR_WORDS:
- case MUT_ARR_WORDS:
return arr_words_sizeW(stgCast(StgArrWords*,p));
- case ARR_PTRS:
case MUT_ARR_PTRS:
case MUT_ARR_PTRS_FROZEN:
{
- StgArrPtrs* a = stgCast(StgArrPtrs*,p);
+ StgMutArrPtrs* a = stgCast(StgMutArrPtrs*,p);
nat i;
for (i = 0; i < a->ptrs; i++) {
- ASSERT(LOOKS_LIKE_PTR(payloadPtr(a,i)));
+ ASSERT(LOOKS_LIKE_PTR(a->payload[i]));
}
- return arr_ptrs_sizeW(a);
+ return mut_arr_ptrs_sizeW(a);
}
case TSO:
- checkTSO((StgTSO *)p, heap_step);
+ checkTSO((StgTSO *)p);
return tso_sizeW((StgTSO *)p);
case BLOCKED_FETCH:
After garbage collection, the live heap is in a state where we can
run through and check that all the pointers point to the right
- place.
+ place. This function starts at a given position and sanity-checks
+ all the objects in the remainder of the chain.
-------------------------------------------------------------------------- */
extern void
-checkHeap(bdescr *bd, nat step)
+checkHeap(bdescr *bd, StgPtr start)
{
StgPtr p;
- heap_step = step;
+ if (start == NULL) {
+ p = bd->start;
+ } else {
+ p = start;
+ }
while (bd != NULL) {
- p = bd->start;
while (p < bd->free) {
nat size = checkClosure(stgCast(StgClosure*,p));
/* This is the smallest size of closure that can live in the heap. */
ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
p += size;
+
+ /* skip over slop */
+ while (p < bd->free &&
+ (*p == 0 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; }
}
bd = bd->link;
+ if (bd != NULL) {
+ p = bd->start;
+ }
}
-}
+}
+
+extern void
+checkChain(bdescr *bd)
+{
+ while (bd != NULL) {
+ checkClosure((StgClosure *)bd->start);
+ bd = bd->link;
+ }
+}
/* check stack - making sure that update frames are linked correctly */
void
}
extern void
-checkTSO(StgTSO *tso, nat step)
+checkTSO(StgTSO *tso)
{
StgPtr sp = tso->sp;
StgPtr stack = tso->stack;
StgOffset stack_size = tso->stack_size;
StgPtr stack_end = stack + stack_size;
- heap_step = step;
+ if (tso->whatNext == ThreadComplete || tso->whatNext == ThreadKilled) {
+ /* The garbage collector doesn't bother following any pointers
+ * from dead threads, so don't check sanity here.
+ */
+ return;
+ }
ASSERT(stack <= sp && sp < stack_end);
ASSERT(sp <= stgCast(StgPtr,su));
projects / ghc-hetmet.git / blobdiff