/* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.3 1999/01/13 17:25:43 simonm Exp $
+ * $Id: Sanity.c,v 1.16 2000/01/30 10:16:09 simonmar Exp $
+ *
+ * (c) The GHC Team, 1998-1999
*
* Sanity checking code for the heap and stack.
*
*
* ---------------------------------------------------------------------------*/
+//@menu
+//* Includes::
+//* Macros::
+//* Stack sanity::
+//* Heap Sanity::
+//* TSO Sanity::
+//* Thread Queue Sanity::
+//* Blackhole Sanity::
+//@end menu
+
+//@node Includes, Macros
+//@subsection Includes
+
#include "Rts.h"
-#ifdef DEBUG
+#ifdef DEBUG /* whole file */
#include "RtsFlags.h"
#include "RtsUtils.h"
#include "BlockAlloc.h"
#include "Sanity.h"
-#define LOOKS_LIKE_PTR(r) \
- (IS_DATA_PTR(r) || ((IS_USER_PTR(r) && Bdescr((P_)r)->free != (void *)-1)))
+//@node Macros, Stack sanity, Includes
+//@subsection Macros
+
+#define LOOKS_LIKE_PTR(r) (LOOKS_LIKE_STATIC_CLOSURE(r) || ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1)))
+
+//@node Stack sanity, Heap Sanity, Macros
+//@subsection Stack sanity
/* -----------------------------------------------------------------------------
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 );
+//@cindex checkSmallBitmap
static StgOffset
-checkSmallBitmap( StgPtr payload, StgNat32 bitmap )
+checkSmallBitmap( StgPtr payload, StgWord32 bitmap )
{
StgOffset i;
return i;
}
-
+//@cindex checkLargeBitmap
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 i;
}
+//@cindex checkStackClosure
StgOffset
checkStackClosure( StgClosure* c )
{
switch (info->type) {
case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */
{
- StgRetDyn* r = stgCast(StgRetDyn*,c);
+ StgRetDyn* r = (StgRetDyn *)c;
return sizeofW(StgRetDyn) +
checkSmallBitmap(r->payload,r->liveness);
}
case RET_BCO: /* small bitmap (<= 32 entries) */
case RET_SMALL:
case RET_VEC_SMALL:
+ return 1 + checkSmallBitmap((StgPtr)c + 1,info->layout.bitmap);
+
case UPDATE_FRAME:
case CATCH_FRAME:
case STOP_FRAME:
case SEQ_FRAME:
- return sizeofW(StgClosure) +
- checkSmallBitmap((StgPtr)c->payload,info->layout.bitmap);
+#if defined(GRAN)
+ return 2 +
+#else
+ return 1 +
+#endif
+ checkSmallBitmap((StgPtr)c + 1,info->layout.bitmap);
case RET_BIG: /* large bitmap (> 32 entries) */
case RET_VEC_BIG:
- return sizeofW(StgClosure) +
- checkLargeBitmap((StgPtr)c->payload,
- info->layout.large_bitmap);
+ return 1 + checkLargeBitmap((StgPtr)c + 1,info->layout.large_bitmap);
case FUN:
case FUN_STATIC: /* probably a slow-entry point return address: */
- return 1;
+#if 0 && defined(GRAN)
+ return 2;
+#else
+ return 1;
+#endif
default:
/* if none of the above, maybe it's a closure which looks a
* little like an infotable
*/
- checkClosureShallow(*stgCast(StgClosure**,c));
+ checkClosureShallow(*(StgClosure **)c);
return 1;
/* barf("checkStackClosure: weird activation record found on stack (%p).",c); */
}
* chunks.
*/
+//@cindex checkClosureShallow
void
checkClosureShallow( StgClosure* p )
{
}
/* check an individual stack object */
+//@cindex checkStackObject
StgOffset
checkStackObject( StgPtr sp )
{
}
/* check sections of stack between update frames */
+//@cindex checkStackChunk
void
checkStackChunk( StgPtr sp, StgPtr stack_end )
{
while (p < stack_end) {
p += checkStackObject( p );
}
- ASSERT( p == stack_end );
+ // ASSERT( p == stack_end ); -- HWL
}
+//@cindex checkStackChunk
StgOffset
checkClosure( StgClosure* p )
{
}
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:
+#ifdef TICKY_TICKY
+ case SE_CAF_BLACKHOLE:
+ case SE_BLACKHOLE:
+#endif
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));
}
}
case ARR_WORDS:
- case MUT_ARR_WORDS:
return arr_words_sizeW(stgCast(StgArrWords*,p));
case MUT_ARR_PTRS:
case BLOCKED_FETCH:
case FETCH_ME:
case EVACUATED:
- barf("checkClosure: unimplemented/strange closure type");
+ barf("checkClosure: unimplemented/strange closure type %d",
+ info->type);
default:
- barf("checkClosure");
+ barf("checkClosure (closure type %d)", info->type);
}
#undef LOOKS_LIKE_PTR
}
+//@node Heap Sanity, TSO Sanity, Stack sanity
+//@subsection Heap Sanity
+
/* -----------------------------------------------------------------------------
Check Heap Sanity
all the objects in the remainder of the chain.
-------------------------------------------------------------------------- */
+//@cindex checkHeap
extern void
checkHeap(bdescr *bd, StgPtr start)
{
/* This is the smallest size of closure that can live in the heap. */
ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
p += size;
- while (*p == 0) { p++; } /* skip over slop */
+
+ /* skip over slop */
+ while (p < bd->free &&
+ (*p == 0 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; }
}
bd = bd->link;
if (bd != NULL) {
}
}
+//@cindex checkChain
extern void
checkChain(bdescr *bd)
{
}
/* check stack - making sure that update frames are linked correctly */
+//@cindex checkStack
void
checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su )
{
ASSERT(stgCast(StgPtr,su) == stack_end);
}
+//@node TSO Sanity, Thread Queue Sanity, Heap Sanity
+//@subsection TSO Sanity
+
+//@cindex checkTSO
extern void
checkTSO(StgTSO *tso)
{
StgOffset stack_size = tso->stack_size;
StgPtr stack_end = stack + stack_size;
- if (tso->whatNext == ThreadComplete || tso->whatNext == ThreadKilled) {
+ if (tso->whatNext == ThreadRelocated) {
+ checkTSO(tso->link);
+ return;
+ }
+
+ 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.
*/
checkStack(sp, stack_end, su);
}
+#if defined(GRAN)
+//@cindex checkTSOsSanity
+extern void
+checkTSOsSanity(void) {
+ nat i, tsos;
+ StgTSO *tso;
+
+ belch("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);
+ checkTSO(tso);
+ fprintf(stderr, "OK, ");
+ tsos++;
+ }
+ }
+
+ belch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc);
+}
+
+//@node Thread Queue Sanity, Blackhole Sanity, TSO Sanity
+//@subsection Thread Queue Sanity
+
+// still GRAN only
+
+//@cindex checkThreadQSanity
+extern 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]);
+}
+
+//@cindex checkThreadQsSanity
+extern rtsBool
+checkThreadQsSanity (rtsBool check_TSO_too)
+{
+ PEs p;
+
+ for (p=0; p<RtsFlags.GranFlags.proc; p++)
+ checkThreadQSanity(p, check_TSO_too);
+}
+#endif /* GRAN */
+
+//@node Blackhole Sanity, Index, Thread Queue Sanity
+//@subsection Blackhole Sanity
+
/* -----------------------------------------------------------------------------
Check Blackhole Sanity
the update frame list.
-------------------------------------------------------------------------- */
-rtsBool isBlackhole( StgTSO* tso, StgClosure* p )
+//@cindex isBlackhole
+rtsBool
+isBlackhole( StgTSO* tso, StgClosure* p )
{
StgUpdateFrame* su = tso->su;
do {
} while (1);
}
+//@node Index, , Blackhole Sanity
+//@subsection Index
+
+//@index
+//* checkChain:: @cindex\s-+checkChain
+//* checkClosureShallow:: @cindex\s-+checkClosureShallow
+//* checkHeap:: @cindex\s-+checkHeap
+//* checkLargeBitmap:: @cindex\s-+checkLargeBitmap
+//* checkSmallBitmap:: @cindex\s-+checkSmallBitmap
+//* checkStack:: @cindex\s-+checkStack
+//* checkStackChunk:: @cindex\s-+checkStackChunk
+//* checkStackChunk:: @cindex\s-+checkStackChunk
+//* checkStackClosure:: @cindex\s-+checkStackClosure
+//* checkStackObject:: @cindex\s-+checkStackObject
+//* checkTSO:: @cindex\s-+checkTSO
+//* checkTSOsSanity:: @cindex\s-+checkTSOsSanity
+//* checkThreadQSanity:: @cindex\s-+checkThreadQSanity
+//* checkThreadQsSanity:: @cindex\s-+checkThreadQsSanity
+//* isBlackhole:: @cindex\s-+isBlackhole
+//@end index
+
#endif /* DEBUG */
+
projects / ghc-hetmet.git / blobdiff