Remove CONSTR_STATIC
[ghc.git] / rts / sm / Sanity.c
index 794bce7..413aee9 100644 (file)
@@ -28,6 +28,7 @@
 #include "Printer.h"
 #include "Arena.h"
 #include "RetainerProfile.h"
+#include "CNF.h"
 
 /* -----------------------------------------------------------------------------
    Forward decls.
@@ -35,7 +36,7 @@
 
 static void  checkSmallBitmap    ( StgPtr payload, StgWord bitmap, uint32_t );
 static void  checkLargeBitmap    ( StgPtr payload, StgLargeBitmap*, uint32_t );
-static void  checkClosureShallow ( StgClosure * );
+static void  checkClosureShallow ( const StgClosure * );
 static void  checkSTACK          (StgStack *stack);
 
 /* -----------------------------------------------------------------------------
@@ -79,19 +80,12 @@ checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, uint32_t size )
  */
 
 static void
-checkClosureShallow( StgClosure* p )
+checkClosureShallow( const StgClosure* p )
 {
-    StgClosure *q;
+    const StgClosure *q;
 
-    q = UNTAG_CLOSURE(p);
+    q = UNTAG_CONST_CLOSURE(p);
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
-
-    /* Is it a static closure? */
-    if (!HEAP_ALLOCED(q)) {
-        ASSERT(closure_STATIC(q));
-    } else {
-        ASSERT(!closure_STATIC(q));
-    }
 }
 
 // check an individual stack object
@@ -137,11 +131,11 @@ checkStackFrame( StgPtr c )
 
     case RET_FUN:
     {
-        StgFunInfoTable *fun_info;
+        const StgFunInfoTable *fun_info;
         StgRetFun *ret_fun;
 
         ret_fun = (StgRetFun *)c;
-        fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
+        fun_info = get_fun_itbl(UNTAG_CONST_CLOSURE(ret_fun->fun));
         size = ret_fun->size;
         switch (fun_info->f.fun_type) {
         case ARG_GEN:
@@ -182,10 +176,10 @@ checkStackChunk( StgPtr sp, StgPtr stack_end )
 static void
 checkPAP (StgClosure *tagged_fun, StgClosure** payload, StgWord n_args)
 {
-    StgClosure *fun;
-    StgFunInfoTable *fun_info;
+    const StgClosure *fun;
+    const StgFunInfoTable *fun_info;
 
-    fun = UNTAG_CLOSURE(tagged_fun);
+    fun = UNTAG_CONST_CLOSURE(tagged_fun);
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun));
     fun_info = get_fun_itbl(fun);
 
@@ -217,19 +211,13 @@ checkPAP (StgClosure *tagged_fun, StgClosure** payload, StgWord n_args)
 
 
 StgOffset
-checkClosure( StgClosure* p )
+checkClosure( const StgClosure* p )
 {
     const StgInfoTable *info;
 
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
 
-    p = UNTAG_CLOSURE(p);
-    /* Is it a static closure (i.e. in the data segment)? */
-    if (!HEAP_ALLOCED(p)) {
-        ASSERT(closure_STATIC(p));
-    } else {
-        ASSERT(!closure_STATIC(p));
-    }
+    p = UNTAG_CONST_CLOSURE(p);
 
     info = p->header.info;
 
@@ -271,6 +259,7 @@ checkClosure( StgClosure* p )
     case FUN_0_2:
     case FUN_2_0:
     case CONSTR:
+    case CONSTR_NOCAF:
     case CONSTR_1_0:
     case CONSTR_0_1:
     case CONSTR_1_1:
@@ -282,8 +271,6 @@ checkClosure( StgClosure* p )
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY:
     case TVAR:
-    case CONSTR_STATIC:
-    case CONSTR_NOCAF_STATIC:
     case THUNK_STATIC:
     case FUN_STATIC:
         {
@@ -424,7 +411,7 @@ checkClosure( StgClosure* p )
       }
 
     default:
-            barf("checkClosure (closure type %d)", info->type);
+        barf("checkClosure (closure type %d)", info->type);
     }
 }
 
@@ -485,6 +472,37 @@ checkLargeObjects(bdescr *bd)
 }
 
 static void
+checkCompactObjects(bdescr *bd)
+{
+    // Compact objects are similar to large objects,
+    // but they have a StgCompactNFDataBlock at the beginning,
+    // before the actual closure
+
+    for ( ; bd != NULL; bd = bd->link) {
+        StgCompactNFDataBlock *block, *last;
+        StgCompactNFData *str;
+        StgWord totalW;
+
+        ASSERT (bd->flags & BF_COMPACT);
+
+        block = (StgCompactNFDataBlock*)bd->start;
+        str = block->owner;
+        ASSERT ((W_)str == (W_)block + sizeof(StgCompactNFDataBlock));
+
+        totalW = 0;
+        for ( ; block ; block = block->next) {
+            last = block;
+            ASSERT (block->owner == str);
+
+            totalW += Bdescr((P_)block)->blocks * BLOCK_SIZE_W;
+        }
+
+        ASSERT (str->totalW == totalW);
+        ASSERT (str->last == last);
+    }
+}
+
+static void
 checkSTACK (StgStack *stack)
 {
     StgPtr sp = stack->sp;
@@ -634,7 +652,7 @@ void
 checkStaticObjects ( StgClosure* static_objects )
 {
   StgClosure *p = static_objects;
-  StgInfoTable *info;
+  const StgInfoTable *info;
 
   while (p != END_OF_STATIC_OBJECT_LIST) {
     p = UNTAG_STATIC_LIST_PTR(p);
@@ -643,8 +661,9 @@ checkStaticObjects ( StgClosure* static_objects )
     switch (info->type) {
     case IND_STATIC:
       {
-        StgClosure *indirectee = UNTAG_CLOSURE(((StgIndStatic *)p)->indirectee);
+        const StgClosure *indirectee;
 
+        indirectee = UNTAG_CONST_CLOSURE(((StgIndStatic *)p)->indirectee);
         ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee));
         ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)indirectee->header.info));
         p = *IND_STATIC_LINK((StgClosure *)p);
@@ -659,7 +678,11 @@ checkStaticObjects ( StgClosure* static_objects )
       p = *FUN_STATIC_LINK((StgClosure *)p);
       break;
 
-    case CONSTR_STATIC:
+    case CONSTR:
+    case CONSTR_NOCAF:
+    case CONSTR_1_0:
+    case CONSTR_2_0:
+    case CONSTR_1_1:
       p = *STATIC_LINK(info,(StgClosure *)p);
       break;
 
@@ -714,6 +737,7 @@ static void checkGeneration (generation *gen,
     }
 
     checkLargeObjects(gen->large_objects);
+    checkCompactObjects(gen->compact_objects);
 }
 
 /* Full heap sanity check. */
@@ -743,6 +767,14 @@ void checkSanity (rtsBool after_gc, rtsBool major_gc)
     }
 }
 
+static void
+markCompactBlocks(bdescr *bd)
+{
+    for (; bd != NULL; bd = bd->link) {
+        compactMarkKnown(((StgCompactNFDataBlock*)bd->start)->owner);
+    }
+}
+
 // If memInventory() calculates that we have a memory leak, this
 // function will try to find the block(s) that are leaking by marking
 // all the ones that we know about, and search through memory to find
@@ -763,6 +795,7 @@ findMemoryLeak (void)
         }
         markBlocks(generations[g].blocks);
         markBlocks(generations[g].large_objects);
+        markCompactBlocks(generations[g].compact_objects);
     }
 
     for (i = 0; i < n_nurseries; i++) {
@@ -796,12 +829,14 @@ checkRunQueue(Capability *cap)
 {
     StgTSO *prev, *tso;
     prev = END_TSO_QUEUE;
-    for (tso = cap->run_queue_hd; tso != END_TSO_QUEUE;
-         prev = tso, tso = tso->_link) {
+    uint32_t n;
+    for (n = 0, tso = cap->run_queue_hd; tso != END_TSO_QUEUE;
+         prev = tso, tso = tso->_link, n++) {
         ASSERT(prev == END_TSO_QUEUE || prev->_link == tso);
         ASSERT(tso->block_info.prev == prev);
     }
     ASSERT(cap->run_queue_tl == prev);
+    ASSERT(cap->n_run_queue == n);
 }
 
 /* -----------------------------------------------------------------------------
@@ -832,8 +867,11 @@ genBlocks (generation *gen)
 {
     ASSERT(countBlocks(gen->blocks) == gen->n_blocks);
     ASSERT(countBlocks(gen->large_objects) == gen->n_large_blocks);
+    ASSERT(countCompactBlocks(gen->compact_objects) == gen->n_compact_blocks);
+    ASSERT(countCompactBlocks(gen->compact_blocks_in_import) == gen->n_compact_blocks_in_import);
     return gen->n_blocks + gen->n_old_blocks +
-            countAllocdBlocks(gen->large_objects);
+        countAllocdBlocks(gen->large_objects) +
+        gen->n_compact_blocks + gen->n_compact_blocks_in_import;
 }
 
 void