X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FCompact.c;h=0a695ca07871252dd80a9392aa70843d1bfaa858;hb=071f080ab938648063db1e3c9e0b4d01e9621b1f;hp=5f56c1e84b61a8622482ba73d8f574dc43465408;hpb=1b62aecee4a58f52999cfa53f1c6b7744b29b808;p=ghc-hetmet.git

diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index 5f56c1e..0a695ca 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
@@ -166,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:
@@ -640,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);
@@ -851,15 +854,15 @@ update_fwd_compact( bdescr *blocks )
 
 	    size = p - q;
 	    if (free + size > free_bd->start + BLOCK_SIZE_W) {
-		// unset the next bit in the bitmap to indicate that
+		// set the next bit in the bitmap to indicate that
 		// this object needs to be pushed into the next
 		// block.  This saves us having to run down the
 		// threaded info pointer list twice during the next pass.
-		unmark(q+1,bd);
+		mark(q+1,bd);
 		free_bd = free_bd->link;
 		free = free_bd->start;
 	    } else {
-		ASSERT(is_marked(q+1,bd));
+		ASSERT(!is_marked(q+1,bd));
 	    }
 
 	    unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
@@ -872,7 +875,7 @@ update_fwd_compact( bdescr *blocks )
 }
 
 static nat
-update_bkwd_compact( step *stp )
+update_bkwd_compact( generation *gen )
 {
     StgPtr p, free;
 #if 0
@@ -883,7 +886,7 @@ update_bkwd_compact( step *stp )
     nat size, free_blocks;
     StgWord iptr;
 
-    bd = free_bd = stp->old_blocks;
+    bd = free_bd = gen->old_blocks;
     free = free_bd->start;
     free_blocks = 1;
 
@@ -918,7 +921,7 @@ update_bkwd_compact( step *stp )
 	    }
 #endif
 
-	    if (!is_marked(p+1,bd)) {
+	    if (is_marked(p+1,bd)) {
 		// don't forget to update the free ptr in the block desc.
 		free_bd->free = free;
 		free_bd = free_bd->link;
@@ -928,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);
 
@@ -962,8 +965,8 @@ update_bkwd_compact( step *stp )
 void
 compact(StgClosure *static_objects)
 {
-    nat g, s, blocks;
-    step *stp;
+    nat g, blocks;
+    generation *gen;
 
     // 1. thread the roots
     markCapabilities((evac_fn)thread_root, NULL);
@@ -997,8 +1000,8 @@ compact(StgClosure *static_objects)
     }
 
     // the global thread list
-    for (s = 0; s < total_steps; s++) {
-        thread((void *)&all_steps[s].threads);
+    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+        thread((void *)&generations[g].threads);
     }
 
     // any threads resurrected during this GC
@@ -1028,30 +1031,24 @@ compact(StgClosure *static_objects)
 
     // 2. update forward ptrs
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	for (s = 0; s < generations[g].n_steps; s++) {
-	    if (g==0 && s ==0) continue;
-	    stp = &generations[g].steps[s];
-	    debugTrace(DEBUG_gc, "update_fwd:  %d.%d", 
-		       stp->gen->no, stp->no);
-
-	    update_fwd(stp->blocks);
-	    update_fwd_large(stp->scavenged_large_objects);
-	    if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
-		debugTrace(DEBUG_gc, "update_fwd:  %d.%d (compact)",
-			   stp->gen->no, stp->no);
-		update_fwd_compact(stp->old_blocks);
-	    }
+        gen = &generations[g];
+        debugTrace(DEBUG_gc, "update_fwd:  %d", g);
+
+        update_fwd(gen->blocks);
+        update_fwd_large(gen->scavenged_large_objects);
+        if (g == RtsFlags.GcFlags.generations-1 && gen->old_blocks != NULL) {
+            debugTrace(DEBUG_gc, "update_fwd:  %d (compact)", g);
+            update_fwd_compact(gen->old_blocks);
 	}
     }
 
     // 3. update backward ptrs
-    stp = &oldest_gen->steps[0];
-    if (stp->old_blocks != NULL) {
-	blocks = update_bkwd_compact(stp);
+    gen = oldest_gen;
+    if (gen->old_blocks != NULL) {
+	blocks = update_bkwd_compact(gen);
 	debugTrace(DEBUG_gc, 
-		   "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
-		   stp->gen->no, stp->no,
-		   stp->n_old_blocks, blocks);
-	stp->n_old_blocks = blocks;
+		   "update_bkwd: %d (compact, old: %d blocks, now %d blocks)",
+		   gen->no, gen->n_old_blocks, blocks);
+	gen->n_old_blocks = blocks;
     }
 }