X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRetainerProfile.c;h=2f93cbf29abe98e7032e92c5d502dc92883ef157;hb=91b07216be1cb09230b7d1b417899ddea8620ff3;hp=bf52fcee720fa8affb1b58914275eb5aa7af5695;hpb=68ded3edcf684c139629d1aa2a6a3faa7f0440ba;p=ghc-hetmet.git

diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c
index bf52fce..2f93cbf 100644
--- a/ghc/rts/RetainerProfile.c
+++ b/ghc/rts/RetainerProfile.c
@@ -463,7 +463,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 	return;
 
 	// one child (fixed), no SRT
-    case MUT_VAR:
+    case MUT_VAR_CLEAN:
+    case MUT_VAR_DIRTY:
 	*first_child = ((StgMutVar *)c)->var;
 	return;
     case THUNK_SELECTOR:
@@ -510,7 +511,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
 	// layout.payload.ptrs, no SRT
     case CONSTR:
-    case FOREIGN:
     case STABLE_NAME:
     case BCO:
     case CONSTR_STATIC:
@@ -522,8 +522,10 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 	break;
 
 	// StgMutArrPtr.ptrs, no SRT
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
+    case MUT_ARR_PTRS_FROZEN0:
 	init_ptrs(&se.info, ((StgMutArrPtrs *)c)->ptrs,
 		  (StgPtr)(((StgMutArrPtrs *)c)->payload));
 	*first_child = find_ptrs(&se.info);
@@ -816,13 +818,14 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
 	    return;
 
 	case CONSTR:
-	case FOREIGN:
 	case STABLE_NAME:
 	case BCO:
 	case CONSTR_STATIC:
 	    // StgMutArrPtr.ptrs, no SRT
-	case MUT_ARR_PTRS:
+	case MUT_ARR_PTRS_CLEAN:
+	case MUT_ARR_PTRS_DIRTY:
 	case MUT_ARR_PTRS_FROZEN:
+	case MUT_ARR_PTRS_FROZEN0:
 	    *c = find_ptrs(&se->info);
 	    if (*c == NULL) {
 		popOff();
@@ -889,7 +892,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
 	case SE_CAF_BLACKHOLE:
 	case ARR_WORDS:
 	    // one child (fixed), no SRT
-	case MUT_VAR:
+	case MUT_VAR_CLEAN:
+	case MUT_VAR_DIRTY:
 	case THUNK_SELECTOR:
 	case IND_PERM:
 	case IND_OLDGEN_PERM:
@@ -989,9 +993,12 @@ isRetainer( StgClosure *c )
 
 	// mutable objects
     case MVAR:
-    case MUT_VAR:
-    case MUT_ARR_PTRS:
+    case MUT_VAR_CLEAN:
+    case MUT_VAR_DIRTY:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
+    case MUT_ARR_PTRS_FROZEN0:
 
 	// thunks are retainers.
     case THUNK:
@@ -1045,7 +1052,6 @@ isRetainer( StgClosure *c )
     case CONSTR_STATIC:
     case FUN_STATIC:
 	// misc
-    case FOREIGN:
     case STABLE_NAME:
     case BCO:
     case ARR_WORDS:
@@ -1780,8 +1786,8 @@ computeRetainerSet( void )
 	for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
 	    for (ml = bd->start; ml < bd->free; ml++) {
 
-		maybeInitRetainerSet((StgClosure *)ml);
-		rtl = retainerSetOf((StgClosure *)ml);
+		maybeInitRetainerSet((StgClosure *)*ml);
+		rtl = retainerSetOf((StgClosure *)*ml);
 
 #ifdef DEBUG_RETAINER
 		if (rtl == NULL) {
@@ -2027,7 +2033,7 @@ retainerProfile(void)
 #ifdef DEBUG_RETAINER
 
 #define LOOKS_LIKE_PTR(r) ((LOOKS_LIKE_STATIC_CLOSURE(r) || \
-        ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1))) && \
+        ((HEAP_ALLOCED(r) && ((Bdescr((P_)r)->flags & BF_FREE) == 0)))) && \
         ((StgWord)(*(StgPtr)r)!=0xaaaaaaaa))
 
 static nat
@@ -2072,8 +2078,10 @@ sanityCheckHeapClosure( StgClosure *c )
     case MVAR:
 	return sizeofW(StgMVar);
 
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
+    case MUT_ARR_PTRS_FROZEN0:
 	return mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
 
     case AP:
@@ -2099,7 +2107,8 @@ sanityCheckHeapClosure( StgClosure *c )
     case FUN_1_1:
     case FUN_0_2:
     case WEAK:
-    case MUT_VAR:
+    case MUT_VAR_CLEAN:
+    case MUT_VAR_DIRTY:
     case CAF_BLACKHOLE:
     case BLACKHOLE:
     case SE_BLACKHOLE:
@@ -2107,7 +2116,6 @@ sanityCheckHeapClosure( StgClosure *c )
     case IND_PERM:
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
-    case FOREIGN:
     case BCO:
     case STABLE_NAME:
 	return sizeW_fromITBL(info);