[project @ 2005-04-13 15:07:20 by simonmar]

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

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index 5941329..410df74 100644 (file)
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -169,7 +169,7 @@ checkStackFrame( StgPtr c )
        switch (fun_info->f.fun_type) {
        case ARG_GEN:
            checkSmallBitmap((StgPtr)ret_fun->payload, 
-                            BITMAP_BITS(fun_info->f.bitmap), size);
+                            BITMAP_BITS(fun_info->f.b.bitmap), size);
            break;
        case ARG_GEN_BIG:
            checkLargeBitmap((StgPtr)ret_fun->payload,
@@ -249,9 +249,6 @@ checkClosure( StgClosure* p )
        return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
       }
 
-    case BLACKHOLE_BQ:
-      checkBQ(((StgBlockingQueue *)p)->blocking_queue, p);
-      /* fall through to basic ptr check */
     case FUN:
     case FUN_1_0:
     case FUN_0_1:
@@ -276,7 +273,6 @@ checkClosure( StgClosure* p )
     case FOREIGN:
     case STABLE_NAME:
     case MUT_VAR:
-    case MUT_CONS:
     case CONSTR_INTLIKE:
     case CONSTR_CHARLIKE:
     case CONSTR_STATIC:
@@ -320,7 +316,7 @@ checkClosure( StgClosure* p )
 
     case THUNK_SELECTOR:
            ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgSelector *)p)->selectee));
-           return sizeofW(StgHeader) + MIN_UPD_SIZE;
+           return THUNK_SELECTOR_sizeW();
 
     case IND:
        { 
@@ -362,7 +358,7 @@ checkClosure( StgClosure* p )
            switch (fun_info->f.fun_type) {
            case ARG_GEN:
                checkSmallBitmap( (StgPtr)pap->payload, 
-                                 BITMAP_BITS(fun_info->f.bitmap), pap->n_args );
+                                 BITMAP_BITS(fun_info->f.b.bitmap), pap->n_args );
                break;
            case ARG_GEN_BIG:
                checkLargeBitmap( (StgPtr)pap->payload, 
@@ -396,6 +392,7 @@ checkClosure( StgClosure* p )
 
     case MUT_ARR_PTRS:
     case MUT_ARR_PTRS_FROZEN:
+    case MUT_ARR_PTRS_FROZEN0:
        {
            StgMutArrPtrs* a = (StgMutArrPtrs *)p;
            nat i;
@@ -419,7 +416,7 @@ checkClosure( StgClosure* p )
 #ifdef DIST
     case REMOTE_REF:
       return sizeofW(StgFetchMe); 
-#endif //DIST
+#endif /*DIST */
       
     case FETCH_ME:
       ASSERT(LOOKS_LIKE_GA(((StgFetchMe *)p)->ga));
@@ -645,14 +642,13 @@ checkTSO(StgTSO *tso)
       break;
     case BlockedOnBlackHole: 
       checkClosureShallow(tso->block_info.closure);
-      ASSERT(/* Can't be a BLACKHOLE because *this* closure is on its BQ */
-            get_itbl(tso->block_info.closure)->type==BLACKHOLE_BQ ||
+      ASSERT(get_itbl(tso->block_info.closure)->type==BLACKHOLE ||
              get_itbl(tso->block_info.closure)->type==RBH);
       break;
     case BlockedOnRead:
     case BlockedOnWrite:
     case BlockedOnDelay:
-#if defined(mingw32_TARGET_OS)
+#if defined(mingw32_HOST_OS)
     case BlockedOnDoProc:
 #endif
       /* isOnBQ(blocked_queue) */
@@ -762,41 +758,16 @@ checkGlobalTSOList (rtsBool checkTSOs)
    -------------------------------------------------------------------------- */
 
 void
-checkMutableList( StgMutClosure *p, nat gen )
+checkMutableList( bdescr *mut_bd, nat gen )
 {
     bdescr *bd;
+    StgPtr q;
+    StgClosure *p;
 
-    for (; p != END_MUT_LIST; p = p->mut_link) {
-       bd = Bdescr((P_)p);
-       ASSERT(closure_MUTABLE(p));
-       ASSERT(bd->gen_no == gen);
-       ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->mut_link));
-    }
-}
-
-void
-checkMutOnceList( StgMutClosure *p, nat gen )
-{
-    bdescr *bd;
-    StgInfoTable *info;
-
-    for (; p != END_MUT_LIST; p = p->mut_link) {
-       bd = Bdescr((P_)p);
-       info = get_itbl(p);
-
-       ASSERT(!closure_MUTABLE(p));
-       ASSERT(ip_STATIC(info) || bd->gen_no == gen);
-       ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->mut_link));
-
-       switch (info->type) {
-       case IND_STATIC:
-       case IND_OLDGEN:
-       case IND_OLDGEN_PERM:
-       case MUT_CONS:
-           break;
-       default:
-           barf("checkMutOnceList: strange closure %p (%s)", 
-                p, info_type((StgClosure *)p));
+    for (bd = mut_bd; bd != NULL; bd = bd->link) {
+       for (q = bd->start; q < bd->free; q++) {
+           p = (StgClosure *)*q;
+           ASSERT(!HEAP_ALLOCED(p) || Bdescr((P_)p)->gen_no == gen);
        }
     }
 }
@@ -856,8 +827,7 @@ checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure)
   rtsBool end = rtsFalse;
   StgInfoTable *info = get_itbl(closure);
 
-  ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR
-        || info->type == FETCH_ME_BQ || info->type == RBH);
+  ASSERT(info->type == MVAR || info->type == FETCH_ME_BQ || info->type == RBH);
 
   do {
     switch (get_itbl(bqe)->type) {
@@ -886,7 +856,7 @@ checkBQ (StgTSO *bqe, StgClosure *closure)
   rtsBool end = rtsFalse;
   StgInfoTable *info = get_itbl(closure);
 
-  ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR);
+  ASSERT(info->type == MVAR);
 
   do {
     switch (get_itbl(bqe)->type) {
@@ -910,7 +880,7 @@ checkBQ (StgTSO *bqe, StgClosure *closure)
   rtsBool end = rtsFalse;
   StgInfoTable *info = get_itbl(closure);
 
-  ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR);
+  ASSERT(info->type == MVAR);
 
   do {
     switch (get_itbl(bqe)->type) {