X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FSanity.c;h=89c1a7ea0ea8c409b69e2977f02beea1b8c98a58;hb=4ab216140652b1ebdc011bba06f77cd05c614b91;hp=f1d43bdad3d8c973a91d841fbc14972f248366aa;hpb=153b9cb9b11e05c4edb1b6bc0a7b972660e41f70;p=ghc-hetmet.git

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index f1d43bd..89c1a7e 100644
--- 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,
@@ -202,6 +202,40 @@ checkStackChunk( StgPtr sp, StgPtr stack_end )
     // ASSERT( p == stack_end ); -- HWL
 }
 
+static void
+checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args)
+{ 
+    StgClosure *p;
+    StgFunInfoTable *fun_info;
+    
+    ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun));
+    fun_info = get_fun_itbl(fun);
+    
+    p = (StgClosure *)payload;
+    switch (fun_info->f.fun_type) {
+    case ARG_GEN:
+	checkSmallBitmap( (StgPtr)payload, 
+			  BITMAP_BITS(fun_info->f.b.bitmap), n_args );
+	break;
+    case ARG_GEN_BIG:
+	checkLargeBitmap( (StgPtr)payload, 
+			  GET_FUN_LARGE_BITMAP(fun_info), 
+			  n_args );
+	break;
+    case ARG_BCO:
+	checkLargeBitmap( (StgPtr)payload, 
+			  BCO_BITMAP(fun), 
+			  n_args );
+	break;
+    default:
+	checkSmallBitmap( (StgPtr)payload, 
+			  BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
+			  n_args );
+	break;
+    }
+}
+
+
 StgOffset 
 checkClosure( StgClosure* p )
 {
@@ -244,14 +278,11 @@ checkClosure( StgClosure* p )
       {
 	nat i;
 	for (i = 0; i < info->layout.payload.ptrs; i++) {
-	  ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i]));
+	  ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgThunk *)p)->payload[i]));
 	}
-	return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
+	return stg_max(thunk_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 +307,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 +350,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:
 	{ 
@@ -349,39 +379,19 @@ checkClosure( StgClosure* p )
     case CATCH_STM_FRAME:
 	    barf("checkClosure: stack frame");
 
-    case AP: /* we can treat this as being the same as a PAP */
+    case AP:
+    {
+	StgAP* ap = (StgAP *)p;
+	checkPAP (ap->fun, ap->payload, ap->n_args);
+	return ap_sizeW(ap);
+    }
+
     case PAP:
-	{ 
-	    StgFunInfoTable *fun_info;
-	    StgPAP* pap = (StgPAP *)p;
-
-	    ASSERT(LOOKS_LIKE_CLOSURE_PTR(pap->fun));
-	    fun_info = get_fun_itbl(pap->fun);
-
-	    p = (StgClosure *)pap->payload;
-	    switch (fun_info->f.fun_type) {
-	    case ARG_GEN:
-		checkSmallBitmap( (StgPtr)pap->payload, 
-				  BITMAP_BITS(fun_info->f.bitmap), pap->n_args );
-		break;
-	    case ARG_GEN_BIG:
-		checkLargeBitmap( (StgPtr)pap->payload, 
-				  GET_FUN_LARGE_BITMAP(fun_info), 
-				  pap->n_args );
-		break;
-	    case ARG_BCO:
-		checkLargeBitmap( (StgPtr)pap->payload, 
-				  BCO_BITMAP(pap->fun), 
-				  pap->n_args );
-		break;
-	    default:
-		checkSmallBitmap( (StgPtr)pap->payload, 
-				  BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
-				  pap->n_args );
-		break;
-	    }
-	    return pap_sizeW(pap);
-	}
+    {
+	StgPAP* pap = (StgPAP *)p;
+	checkPAP (pap->fun, pap->payload, pap->n_args);
+	return pap_sizeW(pap);
+    }
 
     case AP_STACK:
     { 
@@ -396,6 +406,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 +430,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,8 +656,7 @@ 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:
@@ -762,41 +772,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);
 	}
     }
 }
@@ -820,20 +805,20 @@ checkStaticObjects ( StgClosure* static_objects )
 
 	ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee));
 	ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info));
-	p = IND_STATIC_LINK((StgClosure *)p);
+	p = *IND_STATIC_LINK((StgClosure *)p);
 	break;
       }
 
     case THUNK_STATIC:
-      p = THUNK_STATIC_LINK((StgClosure *)p);
+      p = *THUNK_STATIC_LINK((StgClosure *)p);
       break;
 
     case FUN_STATIC:
-      p = FUN_STATIC_LINK((StgClosure *)p);
+      p = *FUN_STATIC_LINK((StgClosure *)p);
       break;
 
     case CONSTR_STATIC:
-      p = STATIC_LINK(info,(StgClosure *)p);
+      p = *STATIC_LINK(info,(StgClosure *)p);
       break;
 
     default:
@@ -856,8 +841,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 +870,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 +894,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) {