/* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.21 2000/04/14 15:18:06 sewardj Exp $
+ * $Id: Sanity.c,v 1.27 2001/03/22 03:51:10 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "RtsUtils.h"
#include "BlockAlloc.h"
#include "Sanity.h"
+#include "MBlock.h"
+#include "Storage.h"
+#include "Schedule.h"
#include "StoragePriv.h" // for END_OF_STATIC_LIST
//@node Macros, Stack sanity, Includes
{
const StgInfoTable *info;
-#ifndef INTERPRETER
ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
-#endif
/* Is it a static closure (i.e. in the data segment)? */
if (LOOKS_LIKE_STATIC(p)) {
info = get_itbl(p);
switch (info->type) {
- case BCO:
- {
- StgBCO* bco = stgCast(StgBCO*,p);
- nat i;
- for(i=0; i < bco->n_ptrs; ++i) {
- ASSERT(LOOKS_LIKE_PTR(bcoConstPtr(bco,i)));
- }
- return bco_sizeW(bco);
- }
case MVAR:
{
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:
+ case SE_CAF_BLACKHOLE:
#endif
case BLACKHOLE:
+ case CAF_BLACKHOLE:
case FOREIGN:
+ case BCO:
case STABLE_NAME:
case MUT_VAR:
case CONSTR_INTLIKE:
ASSERT(LOOKS_LIKE_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()
/* skip over slop */
while (p < bd->free &&
- (*p == 0 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; }
+ (*p < 0x1000 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; }
}
bd = bd->link;
if (bd != NULL) {
xxx);
}
+#if defined(PAR)
/*
Check heap between start and end. Used after unpacking graphs.
*/
extern void
checkHeapChunk(StgPtr start, StgPtr end)
{
+ extern globalAddr *LAGAlookup(StgClosure *addr);
+ StgPtr p;
+ nat size;
+
+ for (p=start; p<end; p+=size) {
+ ASSERT(LOOKS_LIKE_GHC_INFO((void*)*p));
+ if (get_itbl((StgClosure*)p)->type == 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 = MIN_UPD_SIZE;
+ } else {
+ 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) );
+ }
+ }
+}
+#else /* !PAR */
+extern void
+checkHeapChunk(StgPtr start, StgPtr end)
+{
StgPtr p;
nat size;
ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
}
}
+#endif
//@cindex checkChain
extern void
ASSERT(!gala->preferred || gala == gala0);
ASSERT(LOOKS_LIKE_GHC_INFO(((StgClosure *)gala->la)->header.info));
ASSERT(gala->next!=gala); // detect direct loops
- /*
if ( check_closures ) {
checkClosure(stgCast(StgClosure*,gala->la));
}
- */
}
for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {