X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FGC.c;h=b75c54948059e76367cf41945e983ef1b13f6db1;hb=47936fa626f195b057de16b35c0e6ca40666fc62;hp=a13cd33afadd346ed79e20ac72235ea4e62887eb;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/rts/GC.c b/rts/GC.c
index a13cd33..b75c549 100644
--- a/rts/GC.c
+++ b/rts/GC.c
@@ -172,6 +172,7 @@ static void         zero_static_object_list ( StgClosure* first_static );
 
 static rtsBool      traverse_weak_ptr_list  ( void );
 static void         mark_weak_ptr_list      ( StgWeak **list );
+static rtsBool      traverse_blackhole_queue ( void );
 
 static StgClosure * eval_thunk_selector     ( nat field, StgSelector * p );
 
@@ -665,6 +666,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
    */
   markStablePtrTable(mark_root);
 
+  /* Mark the root pointer table.
+   */
+  markRootPtrTable(mark_root);
+
   /* -------------------------------------------------------------------------
    * Repeatedly scavenge all the areas we know about until there's no
    * more scavenging to be done.
@@ -723,6 +728,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       }
     }
 
+    // if any blackholes are alive, make the threads that wait on
+    // them alive too.
+    if (traverse_blackhole_queue())
+	flag = rtsTrue;
+
     if (flag) { goto loop; }
 
     // must be last...  invariant is that everything is fully
@@ -1366,16 +1376,6 @@ traverse_weak_ptr_list(void)
 		  ;
 	      }
 	      
-	      // Threads blocked on black holes: if the black hole
-	      // is alive, then the thread is alive too.
-	      if (tmp == NULL && t->why_blocked == BlockedOnBlackHole) {
-		  if (isAlive(t->block_info.closure)) {
-		      t = (StgTSO *)evacuate((StgClosure *)t);
-		      tmp = t;
-		      flag = rtsTrue;
-		  }
-	      }
-
 	      if (tmp == NULL) {
 		  // not alive (yet): leave this thread on the
 		  // old_all_threads list.
@@ -1434,6 +1434,34 @@ traverse_weak_ptr_list(void)
 }
 
 /* -----------------------------------------------------------------------------
+   The blackhole queue
+   
+   Threads on this list behave like weak pointers during the normal
+   phase of garbage collection: if the blackhole is reachable, then
+   the thread is reachable too.
+   -------------------------------------------------------------------------- */
+static rtsBool
+traverse_blackhole_queue (void)
+{
+    StgTSO *prev, *t, *tmp;
+    rtsBool flag;
+
+    flag = rtsFalse;
+    prev = NULL;
+
+    for (t = blackhole_queue; t != END_TSO_QUEUE; prev=t, t = t->link) {
+	if (! (tmp = (StgTSO *)isAlive((StgClosure*)t))) {
+	    if (isAlive(t->block_info.closure)) {
+		t = (StgTSO *)evacuate((StgClosure *)t);
+		if (prev) prev->link = t;
+		flag = rtsTrue;
+	    }
+	}
+    }
+    return flag;
+}
+
+/* -----------------------------------------------------------------------------
    After GC, the live weak pointer list may have forwarding pointers
    on it, because a weak pointer object was evacuated after being
    moved to the live weak pointer list.  We remove those forwarding