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

diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 48473d2..4bfda6f 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -1684,6 +1684,23 @@ inner_loop:
                     ((StgStack *)c)->stack + ((StgStack *)c)->stack_size);
 	goto loop;
 
+    case TSO:
+    {
+        StgTSO *tso = (StgTSO *)c;
+
+        retainClosure(tso->stackobj,           c, c_child_r);
+        retainClosure(tso->blocked_exceptions, c, c_child_r);
+        retainClosure(tso->bq,                 c, c_child_r);
+        retainClosure(tso->trec,               c, c_child_r);
+        if (   tso->why_blocked == BlockedOnMVar
+               || tso->why_blocked == BlockedOnBlackHole
+               || tso->why_blocked == BlockedOnMsgThrowTo
+            ) {
+            retainClosure(tso->block_info.closure, c, c_child_r);
+        }
+        goto loop;
+    }
+
     case PAP:
     {
 	StgPAP *pap = (StgPAP *)c;
@@ -1756,7 +1773,7 @@ computeRetainerSet( void )
 {
     StgWeak *weak;
     RetainerSet *rtl;
-    nat g;
+    nat g, n;
     StgPtr ml;
     bdescr *bd;
 #ifdef DEBUG_RETAINER
@@ -1787,7 +1804,8 @@ computeRetainerSet( void )
 	// Traversing through mut_list is necessary
 	// because we can find MUT_VAR objects which have not been
 	// visited during retainer profiling.
-	for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
+        for (n = 0; n < n_capabilities; n++) {
+          for (bd = capabilities[n].mut_lists[g]; bd != NULL; bd = bd->link) {
 	    for (ml = bd->start; ml < bd->free; ml++) {
 
 		maybeInitRetainerSet((StgClosure *)*ml);
@@ -1818,7 +1836,8 @@ computeRetainerSet( void )
 		}
 #endif
 	    }
-	}
+          }
+        }
     }
 }