[project @ 2001-03-22 03:51:08 by hwloidl]

[ghc-hetmet.git] / ghc / rts / Sanity.c

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index bd5d96a..d5e4124 100644 (file)
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.25 2001/01/29 17:23:41 simonmar Exp $
+ * $Id: Sanity.c,v 1.27 2001/03/22 03:51:10 hwloidl Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -219,9 +219,7 @@ checkClosure( StgClosure* p )
 {
     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)) {
@@ -389,6 +387,11 @@ checkClosure( StgClosure* p )
       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()
@@ -502,12 +505,38 @@ checkHeap(bdescr *bd, StgPtr start)
            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;
 
@@ -518,6 +547,7 @@ checkHeapChunk(StgPtr start, StgPtr end)
     ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
   }
 }
+#endif
 
 //@cindex checkChain
 extern void
@@ -918,11 +948,9 @@ checkLAGAtable(rtsBool check_closures)
     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) {