Don't call DEAD_WEAK finalizer again on shutdown (#7170)
[ghc.git] / rts / sm / MarkWeak.c
index eca5c54..60ac53f 100644 (file)
@@ -1,23 +1,31 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team 1998-2006
+ * (c) The GHC Team 1998-2008
  *
  * Weak pointers and weak-like things in the GC
  *
  * Documentation on the architecture of the Garbage Collector can be
  * found in the online commentary:
- * 
- *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
+ *
+ *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #include "Rts.h"
-#include "Storage.h"
+
 #include "MarkWeak.h"
 #include "GC.h"
+#include "GCThread.h"
+#include "GCTDecl.h"
 #include "Evac.h"
 #include "Trace.h"
 #include "Schedule.h"
+#include "Weak.h"
+#include "Storage.h"
+#include "Threads.h"
+
+#include "sm/Sanity.h"
 
 /* -----------------------------------------------------------------------------
    Weak Pointers
    new live weak pointers, then all the currently unreachable ones are
    dead.
 
-   For generational GC: we just don't try to finalize weak pointers in
-   older generations than the one we're collecting.  This could
-   probably be optimised by keeping per-generation lists of weak
-   pointers, but for a few weak pointers this scheme will work.
+   For generational GC: we don't try to finalize weak pointers in
+   older generations than the one we're collecting.
 
    There are three distinct stages to processing weak pointers:
 
@@ -54,7 +60,7 @@
      threads from the all_threads and main thread lists are the
      weakest of all: a pointers from the finalizer of a dead weak
      pointer can keep a thread alive.  Any threads found to be unreachable
-     are evacuated and placed on the resurrected_threads list so we 
+     are evacuated and placed on the resurrected_threads list so we
      can send them a signal later.
 
    - weak_stage == WeakDone
 typedef enum { WeakPtrs, WeakThreads, WeakDone } WeakStage;
 static WeakStage weak_stage;
 
-/* Weak pointers
- */
-StgWeak *old_weak_ptr_list; // also pending finaliser list
+// List of weak pointers whose key is dead
+StgWeak *dead_weak_ptr_list;
 
-/* List of all threads during GC
- */
+// List of threads found to be unreachable
 StgTSO *resurrected_threads;
-static StgTSO *old_all_threads;
+
+static void    collectDeadWeakPtrs (generation *gen);
+static rtsBool tidyWeakList (generation *gen);
+static rtsBool resurrectUnreachableThreads (generation *gen);
+static void    tidyThreadList (generation *gen);
 
 void
 initWeakForGC(void)
 {
-    old_weak_ptr_list = weak_ptr_list;
-    weak_ptr_list = NULL;
-    weak_stage = WeakPtrs;
-
-    /* The all_threads list is like the weak_ptr_list.  
-     * See traverseWeakPtrList() for the details.
-     */
-    old_all_threads = all_threads;
-    all_threads = END_TSO_QUEUE;
+    nat g;
+
+    for (g = 0; g <= N; g++) {
+        generation *gen = &generations[g];
+        gen->old_weak_ptr_list = gen->weak_ptr_list;
+        gen->weak_ptr_list = NULL;
+    }
+
+    weak_stage = WeakThreads;
+    dead_weak_ptr_list = NULL;
     resurrected_threads = END_TSO_QUEUE;
 }
 
-rtsBool 
+rtsBool
 traverseWeakPtrList(void)
 {
-  StgWeak *w, **last_w, *next_w;
-  StgClosure *new;
   rtsBool flag = rtsFalse;
 
   switch (weak_stage) {
@@ -105,238 +112,308 @@ traverseWeakPtrList(void)
   case WeakDone:
       return rtsFalse;
 
-  case WeakPtrs:
-      /* doesn't matter where we evacuate values/finalizers to, since
-       * these pointers are treated as roots (iff the keys are alive).
+  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.
        */
-      gct->evac_step = 0;
-      
-      last_w = &old_weak_ptr_list;
-      for (w = old_weak_ptr_list; w != NULL; w = next_w) {
-         
-         /* There might be a DEAD_WEAK on the list if finalizeWeak# was
-          * called on a live weak pointer object.  Just remove it.
-          */
-         if (w->header.info == &stg_DEAD_WEAK_info) {
-             next_w = ((StgDeadWeak *)w)->link;
-             *last_w = next_w;
-             continue;
-         }
-         
-         switch (get_itbl(w)->type) {
-
-         case EVACUATED:
-             next_w = (StgWeak *)((StgEvacuated *)w)->evacuee;
-             *last_w = next_w;
-             continue;
-
-         case WEAK:
-             /* Now, check whether the key is reachable.
-              */
-             new = isAlive(w->key);
-             if (new != NULL) {
-                 w->key = new;
-                 // evacuate the value and finalizer 
-                 evacuate(&w->value);
-                 evacuate(&w->finalizer);
-                 // remove this weak ptr from the old_weak_ptr list 
-                 *last_w = w->link;
-                 // and put it on the new weak ptr list 
-                 next_w  = w->link;
-                 w->link = weak_ptr_list;
-                 weak_ptr_list = w;
-                 flag = rtsTrue;
-
-                 debugTrace(DEBUG_weak, 
-                            "weak pointer still alive at %p -> %p",
-                            w, w->key);
-                 continue;
-             }
-             else {
-                 last_w = &(w->link);
-                 next_w = w->link;
-                 continue;
-             }
-
-         default:
-             barf("traverseWeakPtrList: not WEAK");
-         }
+  {
+      nat g;
+
+      for (g = 0; g <= N; g++) {
+          tidyThreadList(&generations[g]);
       }
-      
-      /* If we didn't make any changes, then we can go round and kill all
-       * the dead weak pointers.  The old_weak_ptr list is used as a list
-       * of pending finalizers later on.
-       */
-      if (flag == rtsFalse) {
-         for (w = old_weak_ptr_list; w; w = w->link) {
-             evacuate(&w->finalizer);
-         }
 
-         // Next, move to the WeakThreads stage after fully
-         // scavenging the finalizers we've just evacuated.
-         weak_stage = WeakThreads;
+      // Use weak pointer relationships (value is reachable if
+      // key is reachable):
+      for (g = 0; g <= N; g++) {
+          if (tidyWeakList(&generations[g])) {
+              flag = rtsTrue;
+          }
       }
 
-      return rtsTrue;
+      // if we evacuated anything new, we must scavenge thoroughly
+      // before we can determine which threads are unreachable.
+      if (flag) return rtsTrue;
 
-  case WeakThreads:
-      /* Now deal with the all_threads list, which behaves 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.
-       */
-      {
-         StgTSO *t, *tmp, *next, **prev;
-         
-         prev = &old_all_threads;
-         for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
-             
-             tmp = (StgTSO *)isAlive((StgClosure *)t);
-             
-             if (tmp != NULL) {
-                 t = tmp;
-             }
-             
-             ASSERT(get_itbl(t)->type == TSO);
-             switch (t->what_next) {
-             case 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;
-                 *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: move this thread onto the all_threads list.
-                 next = t->global_link;
-                 t->global_link = all_threads;
-                 all_threads  = t;
-                 *prev = next;
-             }
-         }
+      // Resurrect any threads which were unreachable
+      for (g = 0; g <= N; g++) {
+          if (resurrectUnreachableThreads(&generations[g])) {
+              flag = rtsTrue;
+          }
       }
-      
-      /* If we evacuated any threads, we need to go back to the scavenger.
-       */
+
+      // 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;
 
-      /* And resurrect any threads which were about to become garbage.
-       */
-      {
-         StgTSO *t, *tmp, *next;
-         for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
-             next = t->global_link;
-             tmp = t;
-             evacuate((StgClosure **)&tmp);
-             tmp->global_link = resurrected_threads;
-             resurrected_threads = tmp;
-         }
+      // otherwise, fall through...
+  }
+
+  case WeakPtrs:
+  {
+      nat g;
+
+      // resurrecting threads might have made more weak pointers
+      // alive, so traverse those lists again:
+      for (g = 0; g <= N; g++) {
+          if (tidyWeakList(&generations[g])) {
+              flag = rtsTrue;
+          }
       }
-      
-      /* Finally, we can update the blackhole_queue.  This queue
-       * simply strings together TSOs blocked on black holes, it is
-       * not intended to keep anything alive.  Hence, we do not follow
-       * pointers on the blackhole_queue until now, when we have
-       * determined which TSOs are otherwise reachable.  We know at
-       * this point that all TSOs have been evacuated, however.
+
+      /* 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.
        */
-      { 
-         StgTSO **pt;
-         for (pt = &blackhole_queue; *pt != END_TSO_QUEUE; pt = &((*pt)->link)) {
-             *pt = (StgTSO *)isAlive((StgClosure *)*pt);
-             ASSERT(*pt != NULL);
-         }
+      if (flag == rtsFalse) {
+          for (g = 0; g <= N; 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
+  }
 
   default:
       barf("traverse_weak_ptr_list");
       return rtsTrue;
   }
+}
 
+static void collectDeadWeakPtrs (generation *gen)
+{
+    StgWeak *w, *next_w;
+    for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) {
+        evacuate(&w->finalizer);
+        next_w = w->link;
+        w->link = dead_weak_ptr_list;
+        dead_weak_ptr_list = w;
+    }
 }
 
-/* -----------------------------------------------------------------------------
-   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.
-   -------------------------------------------------------------------------- */
-rtsBool
-traverseBlackholeQueue (void)
+static rtsBool resurrectUnreachableThreads (generation *gen)
 {
-    StgTSO *prev, *t, *tmp;
-    rtsBool flag;
-    nat type;
-
-    flag = rtsFalse;
-    prev = NULL;
-
-    for (t = blackhole_queue; t != END_TSO_QUEUE; prev=t, t = t->link) {
-        // if the thread is not yet alive...
-       if (! (tmp = (StgTSO *)isAlive((StgClosure*)t))) {
-            // if the closure it is blocked on is either (a) a
-            // reachable BLAKCHOLE or (b) not a BLACKHOLE, then we
-            // make the thread alive.
-           if (!isAlive(t->block_info.closure)) {
-                type = get_itbl(t->block_info.closure)->type;
-                if (type == BLACKHOLE || type == CAF_BLACKHOLE) {
-                    continue;
-                }
-            }
+    StgTSO *t, *tmp, *next;
+    rtsBool flag = rtsFalse;
+
+    for (t = gen->old_threads; t != END_TSO_QUEUE; t = next) {
+        next = t->global_link;
+
+        // 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);
-            if (prev) prev->link = t;
+            tmp->global_link = resurrected_threads;
+            resurrected_threads = tmp;
             flag = rtsTrue;
-       }
+        }
+    }
+    return flag;
+}
+
+static rtsBool tidyWeakList(generation *gen)
+{
+    StgWeak *w, **last_w, *next_w;
+    const StgInfoTable *info;
+    StgClosure *new;
+    rtsBool flag = rtsFalse;
+    last_w = &gen->old_weak_ptr_list;
+    for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) {
+
+        /* There might be a DEAD_WEAK on the list if finalizeWeak# was
+         * called on a live weak pointer object.  Just remove it.
+         */
+        if (w->header.info == &stg_DEAD_WEAK_info) {
+            next_w = w->link;
+            *last_w = next_w;
+            continue;
+        }
+
+        info = get_itbl((StgClosure *)w);
+        switch (info->type) {
+
+        case WEAK:
+            /* Now, check whether the key is reachable.
+             */
+            new = isAlive(w->key);
+            if (new != NULL) {
+                generation *new_gen;
+
+                w->key = new;
+
+                // Find out which generation this weak ptr is in, and
+                // move it onto the weak ptr list of that generation.
+
+                new_gen = Bdescr((P_)w)->gen;
+                gct->evac_gen_no = new_gen->no;
+
+                // evacuate the value and finalizer
+                evacuate(&w->value);
+                evacuate(&w->finalizer);
+                // remove this weak ptr from the old_weak_ptr list
+                *last_w = w->link;
+                next_w  = w->link;
+
+                // and put it on the correct weak ptr list.
+                w->link = new_gen->weak_ptr_list;
+                new_gen->weak_ptr_list = w;
+                flag = rtsTrue;
+
+                if (gen->no != new_gen->no) {
+                    debugTrace(DEBUG_weak,
+                      "moving weak pointer %p from %d to %d",
+                      w, gen->no, new_gen->no);
+                }
+
+
+                debugTrace(DEBUG_weak,
+                           "weak pointer still alive at %p -> %p",
+                           w, w->key);
+                continue;
+            }
+            else {
+                last_w = &(w->link);
+                next_w = w->link;
+                continue;
+            }
+
+        default:
+            barf("tidyWeakList: not WEAK: %d, %p", info->type, w);
+        }
     }
+
     return flag;
 }
 
+static void tidyThreadList (generation *gen)
+{
+    StgTSO *t, *tmp, *next, **prev;
+
+    prev = &gen->old_threads;
+
+    for (t = gen->old_threads; t != END_TSO_QUEUE; t = next) {
+
+        tmp = (StgTSO *)isAlive((StgClosure *)t);
+
+        if (tmp != NULL) {
+            t = tmp;
+        }
+
+        ASSERT(get_itbl((StgClosure *)t)->type == TSO);
+        next = t->global_link;
+
+        // if the thread is not masking exceptions but there are
+        // pending exceptions on its queue, then something has gone
+        // wrong.  However, pending exceptions are OK if there is an
+        // FFI call.
+        ASSERT(t->blocked_exceptions == END_BLOCKED_EXCEPTIONS_QUEUE
+               || t->why_blocked == BlockedOnCCall
+               || t->why_blocked == BlockedOnCCall_Interruptible
+               || (t->flags & TSO_BLOCKEX));
+
+        if (tmp == NULL) {
+            // not alive (yet): leave this thread on the
+            // old_all_threads list.
+            prev = &(t->global_link);
+        }
+        else {
+            // alive
+            *prev = next;
+
+            // move this thread onto the correct threads list.
+            generation *new_gen;
+            new_gen = Bdescr((P_)t)->gen;
+            t->global_link = new_gen->threads;
+            new_gen->threads  = t;
+        }
+    }
+}
+
+#ifdef DEBUG
+static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl)
+{
+    StgWeak *w, *prev;
+    for (w = hd; w != NULL; prev = w, w = w->link) {
+        ASSERT(INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure*)w)->header.info)->type == WEAK
+            || UNTAG_CLOSURE((StgClosure*)w)->header.info == &stg_DEAD_WEAK_info);
+        checkClosure((StgClosure*)w);
+    }
+    if (tl != NULL) {
+        ASSERT(prev == tl);
+    }
+}
+#endif
+
+void collectFreshWeakPtrs()
+{
+    nat i;
+    generation *gen = &generations[0];
+    // move recently allocated weak_ptr_list to the old list as well
+    for (i = 0; i < n_capabilities; i++) {
+        Capability *cap = capabilities[i];
+        if (cap->weak_ptr_list_tl != NULL) {
+            IF_DEBUG(sanity, checkWeakPtrSanity(cap->weak_ptr_list_hd, cap->weak_ptr_list_tl));
+            cap->weak_ptr_list_tl->link = gen->weak_ptr_list;
+            gen->weak_ptr_list = cap->weak_ptr_list_hd;
+            cap->weak_ptr_list_tl = NULL;
+            cap->weak_ptr_list_hd = NULL;
+        } else {
+            ASSERT(cap->weak_ptr_list_hd == NULL);
+        }
+    }
+}
+
 /* -----------------------------------------------------------------------------
-   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
-   pointers here.
-
-   Also, we don't consider weak pointer objects to be reachable, but
-   we must nevertheless consider them to be "live" and retain them.
-   Therefore any weak pointer objects which haven't as yet been
-   evacuated need to be evacuated now.
+   Evacuate every weak pointer object on the weak_ptr_list, and update
+   the link fields.
    -------------------------------------------------------------------------- */
 
 void
 markWeakPtrList ( void )
 {
-  StgWeak *w, **last_w, *tmp;
-
-  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);
-      tmp = w;
-      evacuate((StgClosure **)&tmp);
-      *last_w = w;
-      last_w = &(w->link);
-  }
+    nat g;
+
+    for (g = 0; g <= N; g++) {
+        generation *gen = &generations[g];
+        StgWeak *w, **last_w;
+
+        last_w = &gen->weak_ptr_list;
+        for (w = gen->weak_ptr_list; w != NULL; w = w->link) {
+            // w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here
+
+#ifdef DEBUG
+            {   // careful to do this assertion only reading the info ptr
+                // once, because during parallel GC it might change under our feet.
+                const StgInfoTable *info;
+                info = w->header.info;
+                ASSERT(IS_FORWARDING_PTR(info)
+                       || info == &stg_DEAD_WEAK_info
+                       || INFO_PTR_TO_STRUCT(info)->type == WEAK);
+            }
+#endif
+
+            evacuate((StgClosure **)last_w);
+            w = *last_w;
+            if (w->header.info == &stg_DEAD_WEAK_info) {
+                last_w = &(w->link);
+            } else {
+                last_w = &(w->link);
+            }
+        }
+    }
 }