bugfix for traverseBlackHoleQueue

[ghc-hetmet.git] / rts / sm / MarkWeak.c

diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index 0042dbd..ce88466 100644 (file)
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -1,15 +1,21 @@
 /* -----------------------------------------------------------------------------
  *
- * (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
+ *
  * ---------------------------------------------------------------------------*/
 
 #include "Rts.h"
 #include "Storage.h"
 #include "MarkWeak.h"
 #include "GC.h"
+#include "GCThread.h"
 #include "Evac.h"
 #include "Trace.h"
 #include "Schedule.h"
@@ -104,7 +110,7 @@ traverseWeakPtrList(void)
       /* doesn't matter where we evacuate values/finalizers to, since
        * these pointers are treated as roots (iff the keys are alive).
        */
-      evac_gen = 0;
+      gct->evac_step = 0;
       
       last_w = &old_weak_ptr_list;
       for (w = old_weak_ptr_list; w != NULL; w = next_w) {
@@ -132,8 +138,8 @@ traverseWeakPtrList(void)
              if (new != NULL) {
                  w->key = new;
                  // evacuate the value and finalizer 
-                 w->value = evacuate(w->value);
-                 w->finalizer = evacuate(w->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 
@@ -164,7 +170,7 @@ traverseWeakPtrList(void)
        */
       if (flag == rtsFalse) {
          for (w = old_weak_ptr_list; w; w = w->link) {
-             w->finalizer = evacuate(w->finalizer);
+             evacuate(&w->finalizer);
          }
 
          // Next, move to the WeakThreads stage after fully
@@ -194,7 +200,7 @@ traverseWeakPtrList(void)
              ASSERT(get_itbl(t)->type == TSO);
              switch (t->what_next) {
              case ThreadRelocated:
-                 next = t->link;
+                 next = t->_link;
                  *prev = next;
                  continue;
              case ThreadKilled:
@@ -236,7 +242,8 @@ traverseWeakPtrList(void)
          StgTSO *t, *tmp, *next;
          for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
              next = t->global_link;
-             tmp = (StgTSO *)evacuate((StgClosure *)t);
+             tmp = t;
+             evacuate((StgClosure **)&tmp);
              tmp->global_link = resurrected_threads;
              resurrected_threads = tmp;
          }
@@ -251,7 +258,7 @@ traverseWeakPtrList(void)
        */
       { 
          StgTSO **pt;
-         for (pt = &blackhole_queue; *pt != END_TSO_QUEUE; pt = &((*pt)->link)) {
+         for (pt = &blackhole_queue; *pt != END_TSO_QUEUE; pt = &((*pt)->_link)) {
              *pt = (StgTSO *)isAlive((StgClosure *)*pt);
              ASSERT(*pt != NULL);
          }
@@ -279,17 +286,28 @@ traverseBlackholeQueue (void)
 {
     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) {
+    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 (isAlive(t->block_info.closure)) {
-               t = (StgTSO *)evacuate((StgClosure *)t);
-               if (prev) prev->link = t;
-               flag = rtsTrue;
-           }
+            // 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;
+                }
+            }
+            evacuate((StgClosure **)&t);
+            if (prev) prev->_link = t;
+                 // no write barrier when on the blackhole queue,
+                 // because we traverse the whole queue on every GC.
+            flag = rtsTrue;
        }
     }
     return flag;
@@ -310,14 +328,15 @@ traverseBlackholeQueue (void)
 void
 markWeakPtrList ( void )
 {
-  StgWeak *w, **last_w;
+  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);
-      w = (StgWeak *)evacuate((StgClosure *)w);
+      tmp = w;
+      evacuate((StgClosure **)&tmp);
       *last_w = w;
       last_w = &(w->link);
   }