X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=rts%2Fsm%2FCompact.c;h=892364dfa500b68db5c4b51173da2a5bdbeba190;hb=a2a67cd520b9841114d69a87a423dabcb3b4368e;hp=d70f05955036ac70579093258ddafab0d645fcd7;hpb=a370654a872838c43e63bdd6cc279c0ee9913cdf;p=ghc-hetmet.git

diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index d70f059..892364d 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -13,16 +13,18 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
+
+#include "Storage.h"
 #include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "OSThreads.h"
 #include "BlockAlloc.h"
-#include "MBlock.h"
 #include "GC.h"
 #include "Compact.h"
 #include "Schedule.h"
 #include "Apply.h"
 #include "Trace.h"
+#include "Weak.h"
+#include "MarkWeak.h"
+#include "Stable.h"
 
 // Turn off inlining when debugging - it obfuscates things
 #ifdef DEBUG
@@ -83,11 +85,8 @@ thread (StgClosure **p)
     
     if (HEAP_ALLOCED(q)) {
 	bd = Bdescr(q); 
-	// a handy way to discover whether the ptr is into the
-	// compacted area of the old gen, is that the EVACUATED flag
-	// is zero (it's non-zero for all the other areas of live
-	// memory).
-	if ((bd->flags & BF_EVACUATED) == 0)
+
+	if (bd->flags & BF_MARKED)
         {
             iptr = *q;
             switch (GET_CLOSURE_TAG((StgClosure *)iptr))
@@ -169,7 +168,7 @@ loop:
     case 1:
     {
         StgWord r = *(StgPtr)(q-1);
-        ASSERT(LOOKS_LIKE_INFO_PTR(UNTAG_CLOSURE((StgClosure *)r)));
+        ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)UNTAG_CLOSURE((StgClosure *)r)));
         return r;
     }
     case 2:
@@ -467,7 +466,7 @@ thread_AP_STACK (StgAP_STACK *ap)
 static StgPtr
 thread_TSO (StgTSO *tso)
 {
-    thread_(&tso->link);
+    thread_(&tso->_link);
     thread_(&tso->global_link);
 
     if (   tso->why_blocked == BlockedOnMVar
@@ -493,6 +492,10 @@ update_fwd_large( bdescr *bd )
 
   for (; bd != NULL; bd = bd->link) {
 
+    // nothing to do in a pinned block; it might not even have an object
+    // at the beginning.
+    if (bd->flags & BF_PINNED) continue;
+
     p = bd->start;
     info  = get_itbl((StgClosure *)p);
 
@@ -624,8 +627,6 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY:
     case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
     case BLACKHOLE:
     {
 	StgPtr end;
@@ -641,6 +642,7 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case WEAK:
     {
 	StgWeak *w = (StgWeak *)p;
+	thread(&w->cfinalizer);
 	thread(&w->key);
 	thread(&w->value);
 	thread(&w->finalizer);
@@ -929,7 +931,7 @@ update_bkwd_compact( step *stp )
 
             iptr = get_threaded_info(p);
 	    unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
-	    ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
+	    ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)((StgClosure *)p)->header.info));
 	    info = get_itbl((StgClosure *)p);
 	    size = closure_sizeW_((StgClosure *)p,info);
 
@@ -981,19 +983,33 @@ compact(StgClosure *static_objects)
     for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
 	bdescr *bd;
 	StgPtr p;
+        nat n;
 	for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
 	    for (p = bd->start; p < bd->free; p++) {
 		thread((StgClosure **)p);
 	    }
 	}
+        for (n = 0; n < n_capabilities; n++) {
+            for (bd = capabilities[n].mut_lists[g]; 
+                 bd != NULL; bd = bd->link) {
+                for (p = bd->start; p < bd->free; p++) {
+                    thread((StgClosure **)p);
+                }
+            }
+        }
     }
 
     // the global thread list
-    thread((void *)&all_threads);
+    for (s = 0; s < total_steps; s++) {
+        thread((void *)&all_steps[s].threads);
+    }
 
     // any threads resurrected during this GC
     thread((void *)&resurrected_threads);
 
+    // the blackhole queue
+    thread((void *)&blackhole_queue);
+
     // the task list
     {
 	Task *task;