X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FMarkWeak.c;h=78c84ed77aaa8da0a4a13c15f7e5cdf66c855064;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hp=078919dae7ba5c6c46c21b1383e1540e6c164af0;hpb=200c73fdfea734765c48309cc8dcbcf44b69c8c5;p=ghc-hetmet.git

diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index 078919d..78c84ed 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -74,10 +74,12 @@ static WeakStage weak_stage;
  */
 StgWeak *old_weak_ptr_list; // also pending finaliser list
 
-/* List of all threads during GC
- */
+// List of threads found to be unreachable
 StgTSO *resurrected_threads;
 
+// List of blocked threads found to have pending throwTos
+StgTSO *exception_threads;
+
 void
 initWeakForGC(void)
 {
@@ -85,6 +87,7 @@ initWeakForGC(void)
     weak_ptr_list = NULL;
     weak_stage = WeakPtrs;
     resurrected_threads = END_TSO_QUEUE;
+    exception_threads = END_TSO_QUEUE;
 }
 
 rtsBool 
@@ -93,6 +96,7 @@ traverseWeakPtrList(void)
   StgWeak *w, **last_w, *next_w;
   StgClosure *new;
   rtsBool flag = rtsFalse;
+  const StgInfoTable *info;
 
   switch (weak_stage) {
 
@@ -117,12 +121,14 @@ traverseWeakPtrList(void)
 	      continue;
 	  }
 	  
-	  switch (get_itbl(w)->type) {
-
-	  case EVACUATED:
-	      next_w = (StgWeak *)((StgEvacuated *)w)->evacuee;
+          info = w->header.info;
+          if (IS_FORWARDING_PTR(info)) {
+	      next_w = (StgWeak *)UN_FORWARDING_PTR(info);
 	      *last_w = next_w;
 	      continue;
+          }
+
+	  switch (INFO_PTR_TO_STRUCT(info)->type) {
 
 	  case WEAK:
 	      /* Now, check whether the key is reachable.
@@ -199,40 +205,58 @@ traverseWeakPtrList(void)
                       }
 
                       ASSERT(get_itbl(t)->type == TSO);
-                      switch (t->what_next) {
-                      case ThreadRelocated:
+                      if (t->what_next == ThreadRelocated) {
                           next = t->_link;
                           *prev = next;
                           continue;
-                      case ThreadKilled:
-                      case ThreadComplete:
-                          // finshed or died.  The thread might still
-                          // be alive, but we don't keep it on the
-                          // all_threads list.  Don't forget to
-                          // stub out its global_link field.
-                          next = t->global_link;
-                          t->global_link = END_TSO_QUEUE;
+                      }
+
+                      next = t->global_link;
+
+                      // This is a good place to check for blocked
+                      // exceptions.  It might be the case that a thread is
+                      // blocked on delivering an exception to a thread that
+                      // is also blocked - we try to ensure that this
+                      // doesn't happen in throwTo(), but it's too hard (or
+                      // impossible) to close all the race holes, so we
+                      // accept that some might get through and deal with
+                      // them here.  A GC will always happen at some point,
+                      // even if the system is otherwise deadlocked.
+                      //
+                      // If an unreachable thread has blocked
+                      // exceptions, we really want to perform the
+                      // blocked exceptions rather than throwing
+                      // BlockedIndefinitely exceptions.  This is the
+                      // only place we can discover such threads.
+                      // The target thread might even be
+                      // ThreadFinished or ThreadKilled.  Bugs here
+                      // will only be seen when running on a
+                      // multiprocessor.
+                      if (t->blocked_exceptions != END_TSO_QUEUE) {
+                          if (tmp == NULL) {
+                              evacuate((StgClosure **)&t);
+                              flag = rtsTrue;
+                          }
+                          t->global_link = exception_threads;
+                          exception_threads = t;
                           *prev = next;
                           continue;
-                      default:
-                          ;
                       }
-	      
+
                       if (tmp == NULL) {
                           // not alive (yet): leave this thread on the
                           // old_all_threads list.
                           prev = &(t->global_link);
-                          next = t->global_link;
                       } 
                       else {
+                          // alive
+                          *prev = next;
+
+                          // move this thread onto the correct threads list.
                           step *new_step;
-                          // alive: move this thread onto the correct
-                          // threads list.
-                          next = t->global_link;
                           new_step = Bdescr((P_)t)->step;
                           t->global_link = new_step->threads;
                           new_step->threads  = t;
-                          *prev = next;
                       }
                   }
               }
@@ -256,10 +280,21 @@ traverseWeakPtrList(void)
 
                   for (t = stp->old_threads; t != END_TSO_QUEUE; t = next) {
                       next = t->global_link;
-                      tmp = t;
-                      evacuate((StgClosure **)&tmp);
-                      tmp->global_link = resurrected_threads;
-                      resurrected_threads = tmp;
+
+                      // ThreadFinished and ThreadComplete: we have to keep
+                      // these on the all_threads list until they
+                      // become garbage, because they might get
+                      // pending exceptions.
+                      switch (t->what_next) {
+                      case ThreadKilled:
+                      case ThreadComplete:
+                          continue;
+                      default:
+                          tmp = t;
+                          evacuate((StgClosure **)&tmp);
+                          tmp->global_link = resurrected_threads;
+                          resurrected_threads = tmp;
+                      }
                   }
               }
           }
@@ -320,7 +355,11 @@ traverseBlackholeQueue (void)
                 }
             }
             evacuate((StgClosure **)&t);
-            if (prev) prev->_link = t;
+            if (prev) {
+                prev->_link = t;
+            } else {
+                blackhole_queue = t;
+            }
                  // no write barrier when on the blackhole queue,
                  // because we traverse the whole queue on every GC.
             flag = rtsTrue;
@@ -349,8 +388,9 @@ markWeakPtrList ( void )
   last_w = &weak_ptr_list;
   for (w = weak_ptr_list; w; w = w->link) {
       // w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here
-      ASSERT(w->header.info == &stg_DEAD_WEAK_info 
-	     || get_itbl(w)->type == WEAK || get_itbl(w)->type == EVACUATED);
+      ASSERT(IS_FORWARDING_PTR(w->header.info)
+             || w->header.info == &stg_DEAD_WEAK_info 
+	     || get_itbl(w)->type == WEAK);
       tmp = w;
       evacuate((StgClosure **)&tmp);
       *last_w = w;