X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FMarkWeak.c;h=ce88466fdf90bbc07fb6400f7618ccf6f1d91e00;hb=122ff64971cbef8260221840caefc1a3411f41b5;hp=0042dbdeabbb79e4bb1e8956f314cbf92b082b89;hpb=ab0e778ccfde61aed4c22679b24d175fc6cc9bf3;p=ghc-hetmet.git

diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index 0042dbd..ce88466 100644
--- 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);
   }