Fix a bug related to threads blocked on blackholes

[ghc-hetmet.git] / rts / GC.c

diff --git a/rts/GC.c b/rts/GC.c
index a13cd33..d71eaee 100644 (file)
--- 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_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 );
 
 
 static StgClosure * eval_thunk_selector     ( nat field, StgSelector * p );
 

@@ -723,6 +724,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
     if (flag) { goto loop; }
 
     // must be last...  invariant is that everything is fully

@@ -1366,16 +1372,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.
              if (tmp == NULL) {
                  // not alive (yet): leave this thread on the
                  // old_all_threads list.

@@ -1434,6 +1430,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
    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