X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRetainerProfile.c;fp=rts%2FRetainerProfile.c;h=48473d24809ca529e643dd75850d3d87be3e8612;hp=c5a7bf78977fb13e7dff87f5f066be9b2ae79345;hb=f30d527344db528618f64a25250a3be557d9f287;hpb=99b6e6ac44c6c610b0d60e3b70a2341c83d23106

diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index c5a7bf7..48473d2 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -597,11 +597,13 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
     case AP:
     case AP_STACK:
     case TSO:
+    case STACK:
     case IND_STATIC:
     case CONSTR_NOCAF_STATIC:
 	// stack objects
     case UPDATE_FRAME:
     case CATCH_FRAME:
+    case UNDERFLOW_FRAME:
     case STOP_FRAME:
     case RET_DYN:
     case RET_BCO:
@@ -925,13 +927,15 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
 	case AP:
 	case AP_STACK:
 	case TSO:
-	case IND_STATIC:
+        case STACK:
+        case IND_STATIC:
 	case CONSTR_NOCAF_STATIC:
 	    // stack objects
 	case RET_DYN:
 	case UPDATE_FRAME:
 	case CATCH_FRAME:
-	case STOP_FRAME:
+        case UNDERFLOW_FRAME:
+        case STOP_FRAME:
 	case RET_BCO:
 	case RET_SMALL:
 	case RET_BIG:
@@ -1001,6 +1005,7 @@ isRetainer( StgClosure *c )
 	//
 	// TSOs MUST be retainers: they constitute the set of roots.
     case TSO:
+    case STACK:
 
 	// mutable objects
     case MUT_PRIM:
@@ -1080,6 +1085,7 @@ isRetainer( StgClosure *c )
 	// legal objects during retainer profiling.
     case UPDATE_FRAME:
     case CATCH_FRAME:
+    case UNDERFLOW_FRAME:
     case STOP_FRAME:
     case RET_DYN:
     case RET_BCO:
@@ -1257,8 +1263,8 @@ retainSRT (StgClosure **srt, nat srt_bitmap, StgClosure *c, retainer c_child_r)
  *    RSET(c) and RSET(c_child_r) are valid, i.e., their
  *    interpretation conforms to the current value of flip (even when they
  *    are interpreted to be NULL).
- *    If *c is TSO, its state is not any of ThreadRelocated, ThreadComplete,
- *    or ThreadKilled, which means that its stack is ready to process.
+ *    If *c is TSO, its state is not ThreadComplete,or ThreadKilled, 
+ *    which means that its stack is ready to process.
  *  Note:
  *    This code was almost plagiarzied from GC.c! For each pointer,
  *    retainClosure() is invoked instead of evacuate().
@@ -1291,11 +1297,8 @@ retainStack( StgClosure *c, retainer c_child_r,
     // debugBelch("retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary);
 #endif
 
-    ASSERT(get_itbl(c)->type != TSO || 
-	   (((StgTSO *)c)->what_next != ThreadRelocated &&
-	    ((StgTSO *)c)->what_next != ThreadComplete &&
-	    ((StgTSO *)c)->what_next != ThreadKilled));
-    
+    ASSERT(get_itbl(c)->type == STACK);
+
     p = stackStart;
     while (p < stackEnd) {
 	info = get_ret_itbl((StgClosure *)p);
@@ -1307,7 +1310,8 @@ retainStack( StgClosure *c, retainer c_child_r,
 	    p += sizeofW(StgUpdateFrame);
 	    continue;
 
-	case STOP_FRAME:
+        case UNDERFLOW_FRAME:
+        case STOP_FRAME:
 	case CATCH_FRAME:
 	case CATCH_STM_FRAME:
 	case CATCH_RETRY_FRAME:
@@ -1560,14 +1564,7 @@ inner_loop:
 #endif
 	    goto loop;
 	}
-	if (((StgTSO *)c)->what_next == ThreadRelocated) {
-#ifdef DEBUG_RETAINER
-	    debugBelch("ThreadRelocated encountered in retainClosure()\n");
-#endif
-	    c = (StgClosure *)((StgTSO *)c)->_link;
-	    goto inner_loop;
-	}
-	break;
+        break;
 
     case IND_STATIC:
 	// We just skip IND_STATIC, so its retainer set is never computed.
@@ -1681,10 +1678,10 @@ inner_loop:
     // than attempting to save the current position, because doing so
     // would be hard.
     switch (typeOfc) {
-    case TSO:
+    case STACK:
 	retainStack(c, c_child_r,
-		    ((StgTSO *)c)->sp,
-		    ((StgTSO *)c)->stack + ((StgTSO *)c)->stack_size);
+                    ((StgStack *)c)->sp,
+                    ((StgStack *)c)->stack + ((StgStack *)c)->stack_size);
 	goto loop;
 
     case PAP: