X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRetainerProfile.c;h=c5c3de53145779684aefcc7f6de0ccc590019fdd;hb=e20b29d0c1ebd529cc147e9fa507540e3e57917c;hp=074c256992e20e42c9af240c2d26964c5bb72ac8;hpb=f3c86836dc41e82a46db44c4817152020fa7ed7f;p=ghc-hetmet.git

diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c
index 074c256..c5c3de5 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:
@@ -521,7 +522,8 @@ 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,
@@ -588,6 +590,21 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 	if (*first_child == NULL)
 	    return;     // no child
 	break;
+	
+    case TVAR_WAIT_QUEUE:
+	*first_child = (StgClosure *)((StgTVarWaitQueue *)c)->waiting_tso;
+	se.info.next.step = 2;            // 2 = second
+	break;
+    case TVAR:
+	*first_child = (StgClosure *)((StgTVar *)c)->current_value;
+	break;
+    case TREC_HEADER:
+	*first_child = (StgClosure *)((StgTRecHeader *)c)->enclosing_trec;
+	break;
+    case TREC_CHUNK:
+	*first_child = (StgClosure *)((StgTRecChunk *)c)->prev_chunk;
+	se.info.next.step = 0;  // entry no.
+	break;
 
 	// cannot appear
     case PAP:
@@ -815,12 +832,67 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
 	    *r = se->c_child_r;
 	    return;
 
+	case TVAR_WAIT_QUEUE:
+	    if (se->info.next.step == 2) {
+		*c = (StgClosure *)((StgTVarWaitQueue *)se->c)->next_queue_entry;
+		se->info.next.step++;             // move to the next step
+		// no popOff
+	    } else {
+		*c = (StgClosure *)((StgTVarWaitQueue *)se->c)->prev_queue_entry;
+		popOff();
+	    }
+	    *cp = se->c;
+	    *r = se->c_child_r;
+	    return;
+
+	case TVAR:
+	    *c = (StgClosure *)((StgTVar *)se->c)->first_wait_queue_entry;
+	    *cp = se->c;
+	    *r = se->c_child_r;
+	    popOff();
+	    return;
+
+	case TREC_HEADER:
+	    *c = (StgClosure *)((StgTRecHeader *)se->c)->current_chunk;
+	    *cp = se->c;
+	    *r = se->c_child_r;
+	    popOff();
+	    return;
+
+	case TREC_CHUNK: {
+	    // These are pretty complicated: we have N entries, each
+	    // of which contains 3 fields that we want to follow.  So
+	    // we divide the step counter: the 2 low bits indicate
+	    // which field, and the rest of the bits indicate the
+	    // entry number (starting from zero).
+	    nat entry_no = se->info.next.step >> 2;
+	    nat field_no = se->info.next.step & 3;
+	    if (entry_no == ((StgTRecChunk *)se->c)->next_entry_idx) {
+		*c = NULL;
+		popOff();
+		return;
+	    }
+	    TRecEntry *entry = &((StgTRecChunk *)se->c)->entries[entry_no];
+	    if (field_no == 0) {
+		*c = (StgClosure *)entry->tvar;
+	    } else if (field_no == 1) {
+		*c = entry->expected_value;
+	    } else {
+		*c = entry->new_value;
+	    }
+	    *cp = se->c;
+	    *r = se->c_child_r;
+	    se->info.next.step++;
+	    return;
+	}
+
 	case CONSTR:
 	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);
@@ -889,7 +961,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,8 +1062,10 @@ 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:
 
@@ -1011,6 +1086,10 @@ isRetainer( StgClosure *c )
 	// WEAK objects are roots; there is separate code in which traversing
 	// begins from WEAK objects.
     case WEAK:
+
+	// Since the other mutvar-type things are retainers, seems
+	// like the right thing to do:
+    case TVAR:
 	return rtsTrue;
 
 	//
@@ -1049,6 +1128,10 @@ isRetainer( StgClosure *c )
     case STABLE_NAME:
     case BCO:
     case ARR_WORDS:
+	// STM
+    case TVAR_WAIT_QUEUE:
+    case TREC_HEADER:
+    case TREC_CHUNK:
 	return rtsFalse;
 
 	//
@@ -1302,6 +1385,9 @@ retainStack( StgClosure *c, retainer c_child_r,
 
 	case STOP_FRAME:
 	case CATCH_FRAME:
+	case CATCH_STM_FRAME:
+	case CATCH_RETRY_FRAME:
+	case ATOMICALLY_FRAME:
 	case RET_SMALL:
 	case RET_VEC_SMALL:
 	    bitmap = BITMAP_BITS(info->i.layout.bitmap);
@@ -1728,7 +1814,7 @@ retainRoot( StgClosure **tl )
     ASSERT(isEmptyRetainerStack());
     currentStackBoundary = stackTop;
 
-    if (isRetainer(*tl)) {
+    if (*tl != &stg_END_TSO_QUEUE_closure && isRetainer(*tl)) {
 	retainClosure(*tl, *tl, getRetainerFrom(*tl));
     } else {
 	retainClosure(*tl, *tl, CCS_SYSTEM);
@@ -1772,7 +1858,8 @@ computeRetainerSet( void )
     // object (computing sumOfNewCostExtra and updating costArray[] when
     // debugging retainer profiler).
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-        ASSERT(g != 0 || (generations[g].mut_list == NULL));
+	// NOT TRUE: even G0 has a block on its mutable list
+        // ASSERT(g != 0 || (generations[g].mut_list == NULL));
 
 	// Traversing through mut_list is necessary
 	// because we can find MUT_VAR objects which have not been
@@ -2056,97 +2143,7 @@ sanityCheckHeapClosure( StgClosure *c )
 	// debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
     }
 
-    info = get_itbl(c);
-    switch (info->type) {
-    case TSO:
-	return tso_sizeW((StgTSO *)c);
-
-    case THUNK:
-    case THUNK_1_0:
-    case THUNK_0_1:
-    case THUNK_2_0:
-    case THUNK_1_1:
-    case THUNK_0_2:
-	return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
-
-    case MVAR:
-	return sizeofW(StgMVar);
-
-    case MUT_ARR_PTRS:
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-	return mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
-
-    case AP:
-    case PAP:
-	return pap_sizeW((StgPAP *)c);
-
-    case AP:
-	return ap_stack_sizeW((StgAP_STACK *)c);
-
-    case ARR_WORDS:
-	return arr_words_sizeW((StgArrWords *)c);
-
-    case CONSTR:
-    case CONSTR_1_0:
-    case CONSTR_0_1:
-    case CONSTR_2_0:
-    case CONSTR_1_1:
-    case CONSTR_0_2:
-    case FUN:
-    case FUN_1_0:
-    case FUN_0_1:
-    case FUN_2_0:
-    case FUN_1_1:
-    case FUN_0_2:
-    case WEAK:
-    case MUT_VAR:
-    case CAF_BLACKHOLE:
-    case BLACKHOLE:
-    case SE_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case IND_PERM:
-    case IND_OLDGEN:
-    case IND_OLDGEN_PERM:
-    case BCO:
-    case STABLE_NAME:
-	return sizeW_fromITBL(info);
-
-    case THUNK_SELECTOR:
-	return sizeofW(StgHeader) + MIN_UPD_SIZE;
-
-	/*
-	  Error case
-	*/
-    case IND_STATIC:
-    case CONSTR_STATIC:
-    case FUN_STATIC:
-    case THUNK_STATIC:
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-    case CONSTR_NOCAF_STATIC:
-    case UPDATE_FRAME:
-    case CATCH_FRAME:
-    case STOP_FRAME:
-    case RET_DYN:
-    case RET_BCO:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-    case RET_BIG:
-    case RET_VEC_BIG:
-    case IND:
-    case BLOCKED_FETCH:
-    case FETCH_ME:
-    case FETCH_ME_BQ:
-    case RBH:
-    case REMOTE_REF:
-    case EVACUATED:
-    case INVALID_OBJECT:
-    default:
-	barf("Invalid object in sanityCheckHeapClosure(): %d",
-	     get_itbl(c)->type);
-	return 0;
-    }
+    return closure_sizeW(c);
 }
 
 static nat