[commit: ghc] master: Fix #7970, #2161, unfix #551 (1ae72ac)

[Simon Marlow]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/1ae72ac45e51e63cbf6f3d627d77acc6a36aa0f9

>---------------------------------------------------------------

commit 1ae72ac45e51e63cbf6f3d627d77acc6a36aa0f9
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Tue Jul 2 12:10:53 2013 +0100

    Fix #7970, #2161, unfix #551
    
    Establish the reachability of threads before weak pointers.  Hence a
    deadlocked thread can keep a weak pointer alive and prevent it from
    being finalized early.  However, an reference from the finalizer of a
    weak pointer will no longer prevent a thread from being considered
    deadlocked (#551).  To keep the thread alive in that situation you
    need to use a StablePtr.
    
    See comments on #7970 and in the code for more details.

>---------------------------------------------------------------

 rts/sm/MarkWeak.c | 92 +++++++++++++++++++++++++++++--------------------------
 1 file changed, 48 insertions(+), 44 deletions(-)

diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index 5313eec..f0ab5d1 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -81,10 +81,10 @@ StgWeak *dead_weak_ptr_list;
 // List of threads found to be unreachable
 StgTSO *resurrected_threads;
 
-static void collectDeadWeakPtrs (generation *gen);
+static void    collectDeadWeakPtrs (generation *gen);
 static rtsBool tidyWeakList (generation *gen);
-static void resurrectUnreachableThreads (generation *gen);
-static rtsBool tidyThreadList (generation *gen);
+static rtsBool resurrectUnreachableThreads (generation *gen);
+static void    tidyThreadList (generation *gen);
 
 void
 initWeakForGC(void)
@@ -97,7 +97,7 @@ initWeakForGC(void)
         gen->weak_ptr_list = NULL;
     }
 
-    weak_stage = WeakPtrs;
+    weak_stage = WeakThreads;
     dead_weak_ptr_list = NULL;
     resurrected_threads = END_TSO_QUEUE;
 }
@@ -112,68 +112,72 @@ traverseWeakPtrList(void)
   case WeakDone:
       return rtsFalse;
 
-  case WeakPtrs:
+  case WeakThreads:
+      /* Now deal with the gen->threads lists, which behave somewhat like
+       * the weak ptr list.  If we discover any threads that are about to
+       * become garbage, we wake them up and administer an exception.
+       */
   {
       nat g;
 	  
       for (g = 0; g <= N; g++) {
+          tidyThreadList(&generations[g]);
+      }
+
+      // Use weak pointer relationships (value is reachable if
+      // key is reachable):
+      for (g = 0; g <= N; g++) {
           if (tidyWeakList(&generations[g])) {
               flag = rtsTrue;
           }
       }
       
-      /* If we didn't make any changes, then we can go round and kill all
-       * the dead weak pointers.  The dead_weak_ptr list is used as a list
-       * of pending finalizers later on.
-       */
-      if (flag == rtsFalse) {
-          for (g = 0; g <= N; g++) {
-              collectDeadWeakPtrs(&generations[g]);
-          }
+      // if we evacuated anything new, we must scavenge thoroughly
+      // before we can determine which threads are unreachable.
+      if (flag) return rtsTrue;
 
-	  // Next, move to the WeakThreads stage after fully
-	  // scavenging the finalizers we've just evacuated.
-	  weak_stage = WeakThreads;
+      // Resurrect any threads which were unreachable
+      for (g = 0; g <= N; g++) {
+          if (resurrectUnreachableThreads(&generations[g])) {
+              flag = rtsTrue;
+          }
       }
 
-      return rtsTrue;
+      // Next, move to the WeakPtrs stage after fully
+      // scavenging the finalizers we've just evacuated.
+      weak_stage = WeakPtrs;
+
+      // if we evacuated anything new, we must scavenge thoroughly
+      // before entering the WeakPtrs stage.
+      if (flag) return rtsTrue;
+
+      // otherwise, fall through...
   }
 
-  case WeakThreads:
-      /* Now deal with the step->threads lists, which behave somewhat like
-       * the weak ptr list.  If we discover any threads that are about to
-       * become garbage, we wake them up and administer an exception.
-       */
+  case WeakPtrs:
   {
       nat g;
 
-      // Traverse thread lists for generations we collected...
-//      ToDo when we have one gen per capability:
-//      for (n = 0; n < n_capabilities; n++) {
-//          if (tidyThreadList(&nurseries[n])) {
-//              flag = rtsTrue;
-//          }
-//      }              
+      // resurrecting threads might have made more weak pointers
+      // alive, so traverse those lists again:
       for (g = 0; g <= N; g++) {
-          if (tidyThreadList(&generations[g])) {
+          if (tidyWeakList(&generations[g])) {
               flag = rtsTrue;
           }
       }
       
-      /* If we evacuated any threads, we need to go back to the scavenger.
-       */
-      if (flag) return rtsTrue;
-
-      /* And resurrect any threads which were about to become garbage.
+      /* If we didn't make any changes, then we can go round and kill all
+       * the dead weak pointers.  The dead_weak_ptr list is used as a list
+       * of pending finalizers later on.
        */
-      {
-          nat g;
+      if (flag == rtsFalse) {
           for (g = 0; g <= N; g++) {
-              resurrectUnreachableThreads(&generations[g]);
+              collectDeadWeakPtrs(&generations[g]);
           }
+
+          weak_stage = WeakDone;  // *now* we're done,
       }
 
-      weak_stage = WeakDone;  // *now* we're done,
       return rtsTrue;         // but one more round of scavenging, please
   }
 
@@ -194,9 +198,10 @@ static void collectDeadWeakPtrs (generation *gen)
     }
 }
 
-  static void resurrectUnreachableThreads (generation *gen)
+static rtsBool resurrectUnreachableThreads (generation *gen)
 {
     StgTSO *t, *tmp, *next;
+    rtsBool flag = rtsFalse;
 
     for (t = gen->old_threads; t != END_TSO_QUEUE; t = next) {
         next = t->global_link;
@@ -214,8 +219,10 @@ static void collectDeadWeakPtrs (generation *gen)
             evacuate((StgClosure **)&tmp);
             tmp->global_link = resurrected_threads;
             resurrected_threads = tmp;
+            flag = rtsTrue;
         }
     }
+    return flag;
 }
 
 static rtsBool tidyWeakList(generation *gen)
@@ -292,10 +299,9 @@ static rtsBool tidyWeakList(generation *gen)
     return flag;
 }
 
-static rtsBool tidyThreadList (generation *gen)
+static void tidyThreadList (generation *gen)
 {
     StgTSO *t, *tmp, *next, **prev;
-    rtsBool flag = rtsFalse;
 
     prev = &gen->old_threads;
 
@@ -335,8 +341,6 @@ static rtsBool tidyThreadList (generation *gen)
             new_gen->threads  = t;
         }
     }
-
-    return flag;
 }
 
 /* -----------------------------------------------------------------------------