X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2Fsm%2FCompact.c;h=6de42efae482e7274cc70774490f276eddc8ab51;hp=bb4d8388c29e12a4e68939f0fbbe204728f1e99a;hb=5d52d9b64c21dcf77849866584744722f8121389;hpb=01ccdeea34b4853750326126f3bff9b2bdfa9a32

diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index bb4d838..6de42ef 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
@@ -84,7 +86,7 @@ thread (StgClosure **p)
     if (HEAP_ALLOCED(q)) {
 	bd = Bdescr(q); 
 
-	if (bd->flags & BF_COMPACTED)
+	if (bd->flags & BF_MARKED)
         {
             iptr = *q;
             switch (GET_CLOSURE_TAG((StgClosure *)iptr))
@@ -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:
@@ -469,7 +471,8 @@ thread_TSO (StgTSO *tso)
 
     if (   tso->why_blocked == BlockedOnMVar
 	|| tso->why_blocked == BlockedOnBlackHole
-	|| tso->why_blocked == BlockedOnException
+	|| tso->why_blocked == BlockedOnMsgThrowTo
+	|| tso->why_blocked == BlockedOnMsgWakeup
 	) {
 	thread_(&tso->block_info.closure);
     }
@@ -490,6 +493,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);
 
@@ -505,13 +512,13 @@ update_fwd_large( bdescr *bd )
     case MUT_ARR_PTRS_FROZEN0:
       // follow everything 
       {
-	StgPtr next;
+          StgMutArrPtrs *a;
 
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    thread((StgClosure **)p);
-	}
-	continue;
+          a = (StgMutArrPtrs*)p;
+          for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
+              thread((StgClosure **)p);
+          }
+          continue;
       }
 
     case TSO:
@@ -616,14 +623,13 @@ thread_obj (StgInfoTable *info, StgPtr p)
 
     case FUN:
     case CONSTR:
-    case STABLE_NAME:
+    case PRIM:
+    case MUT_PRIM:
     case IND_PERM:
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY:
-    case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
     case BLACKHOLE:
+    case BLOCKING_QUEUE:
     {
 	StgPtr end;
 	
@@ -638,6 +644,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);
@@ -687,44 +694,19 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case MUT_ARR_PTRS_FROZEN0:
 	// follow everything 
     {
-	StgPtr next;
-	
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
+        StgMutArrPtrs *a;
+
+        a = (StgMutArrPtrs *)p;
+	for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
 	    thread((StgClosure **)p);
 	}
-	return p;
+
+	return (StgPtr)a + mut_arr_ptrs_sizeW(a);
     }
     
     case TSO:
 	return thread_TSO((StgTSO *)p);
     
-    case TVAR_WATCH_QUEUE:
-    {
-        StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
-	thread_(&wq->closure);
-	thread_(&wq->next_queue_entry);
-	thread_(&wq->prev_queue_entry);
-	return p + sizeofW(StgTVarWatchQueue);
-    }
-    
-    case TVAR:
-    {
-        StgTVar *tvar = (StgTVar *)p;
-	thread((void *)&tvar->current_value);
-	thread((void *)&tvar->first_watch_queue_entry);
-	return p + sizeofW(StgTVar);
-    }
-    
-    case TREC_HEADER:
-    {
-        StgTRecHeader *trec = (StgTRecHeader *)p;
-	thread_(&trec->enclosing_trec);
-	thread_(&trec->current_chunk);
-	thread_(&trec->invariants_to_check);
-	return p + sizeofW(StgTRecHeader);
-    }
-
     case TREC_CHUNK:
     {
         StgWord i;
@@ -739,23 +721,6 @@ thread_obj (StgInfoTable *info, StgPtr p)
 	return p + sizeofW(StgTRecChunk);
     }
 
-    case ATOMIC_INVARIANT:
-    {
-        StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
-	thread_(&invariant->code);
-	thread_(&invariant->last_execution);
-	return p + sizeofW(StgAtomicInvariant);
-    }
-
-    case INVARIANT_CHECK_QUEUE:
-    {
-        StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
-	thread_(&queue->invariant);
-	thread_(&queue->my_execution);
-	thread_(&queue->next_queue_entry);
-	return p + sizeofW(StgInvariantCheckQueue);
-    }
-
     default:
 	barf("update_fwd: unknown/strange object  %d", (int)(info->type));
 	return NULL;
@@ -849,15 +814,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));
@@ -870,7 +835,7 @@ update_fwd_compact( bdescr *blocks )
 }
 
 static nat
-update_bkwd_compact( step *stp )
+update_bkwd_compact( generation *gen )
 {
     StgPtr p, free;
 #if 0
@@ -881,7 +846,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;
 
@@ -916,7 +881,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;
@@ -926,7 +891,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);
 
@@ -960,15 +925,12 @@ 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);
 
-    // spark queues
-    traverseSparkQueues((evac_fn)thread_root, NULL);
-
     // the weak pointer lists...
     if (weak_ptr_list != NULL) {
 	thread((void *)&weak_ptr_list);
@@ -981,16 +943,25 @@ 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
-    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
@@ -999,10 +970,14 @@ compact(StgClosure *static_objects)
     // the task list
     {
 	Task *task;
+        InCall *incall;
 	for (task = all_tasks; task != NULL; task = task->all_link) {
-	    if (task->tso) {
-		thread_(&task->tso);
-	    }
+            for (incall = task->incall; incall != NULL; 
+                 incall = incall->prev_stack) {
+                if (incall->tso) {
+                    thread_(&incall->tso);
+                }
+            }
 	}
     }
 
@@ -1017,30 +992,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;
     }
 }