X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FScav.c;h=ea39ebdff6fe652fb12ba4bafcc9ac54e9644ad6;hb=a370654a872838c43e63bdd6cc279c0ee9913cdf;hp=00faff1d84cf88d36e1c752bcae89d6892eaa678;hpb=006a18ea83799c0d4255071a2f8c08d3e9c7d84f;p=ghc-hetmet.git

diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 00faff1..ea39ebd 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team 1998-2006
+ * (c) The GHC Team 1998-2008
  *
  * Generational garbage collector: scavenging functions
  *
@@ -12,15 +12,19 @@
  * ---------------------------------------------------------------------------*/
 
 #include "Rts.h"
+#include "RtsFlags.h"
 #include "Storage.h"
 #include "MBlock.h"
 #include "GC.h"
+#include "GCThread.h"
+#include "GCUtils.h"
 #include "Compact.h"
 #include "Evac.h"
 #include "Scav.h"
 #include "Apply.h"
 #include "Trace.h"
 #include "LdvProfile.h"
+#include "Sanity.h"
 
 static void scavenge_stack (StgPtr p, StgPtr stack_end);
 
@@ -28,6 +32,7 @@ static void scavenge_large_bitmap (StgPtr p,
 				   StgLargeBitmap *large_bitmap, 
 				   nat size );
 
+
 /* Similar to scavenge_large_bitmap(), but we don't write back the
  * pointers we get back from evacuate().
  */
@@ -44,7 +49,7 @@ scavenge_large_srt_bitmap( StgLargeSRT *large_srt )
     p      = (StgClosure **)large_srt->srt;
     for (i = 0; i < size; ) {
 	if ((bitmap & 1) != 0) {
-	    evacuate(*p);
+	    evacuate(p);
 	}
 	i++;
 	p++;
@@ -87,12 +92,12 @@ scavenge_srt (StgClosure **srt, nat srt_bitmap)
 	  // If the SRT entry hasn't got bit 0 set, the SRT entry points to a
 	  // closure that's fixed at link-time, and no extra magic is required.
 	  if ( (unsigned long)(*srt) & 0x1 ) {
-	      evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
+	      evacuate(stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
 	  } else {
-	      evacuate(*p);
+	      evacuate(p);
 	  }
 #else
-	  evacuate(*p);
+	  evacuate(p);
 #endif
       }
       p++;
@@ -130,27 +135,47 @@ scavenge_fun_srt(const StgInfoTable *info)
 static void
 scavengeTSO (StgTSO *tso)
 {
+    rtsBool saved_eager;
+
+    if (tso->what_next == ThreadRelocated) {
+        // the only way this can happen is if the old TSO was on the
+        // mutable list.  We might have other links to this defunct
+        // TSO, so we must update its link field.
+        evacuate((StgClosure**)&tso->_link);
+        return;
+    }
+
+    saved_eager = gct->eager_promotion;
+    gct->eager_promotion = rtsFalse;
+
     if (   tso->why_blocked == BlockedOnMVar
 	|| tso->why_blocked == BlockedOnBlackHole
 	|| tso->why_blocked == BlockedOnException
 	) {
-	tso->block_info.closure = evacuate(tso->block_info.closure);
+	evacuate(&tso->block_info.closure);
     }
-    tso->blocked_exceptions = 
-	(StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
+    evacuate((StgClosure **)&tso->blocked_exceptions);
     
     // We don't always chase the link field: TSOs on the blackhole
     // queue are not automatically alive, so the link field is a
     // "weak" pointer in that case.
     if (tso->why_blocked != BlockedOnBlackHole) {
-	tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
+	evacuate((StgClosure **)&tso->link);
     }
 
     // scavange current transaction record
-    tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec);
+    evacuate((StgClosure **)&tso->trec);
     
     // scavenge this thread's stack 
     scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
+
+    if (gct->failed_to_evac) {
+        tso->flags |= TSO_DIRTY;
+    } else {
+        tso->flags &= ~TSO_DIRTY;
+    }
+
+    gct->eager_promotion = saved_eager;
 }
 
 /* -----------------------------------------------------------------------------
@@ -182,7 +207,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
     small_bitmap:
 	while (size > 0) {
 	    if ((bitmap & 1) == 0) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+		evacuate((StgClosure **)p);
 	    }
 	    p++;
 	    bitmap = bitmap >> 1;
@@ -221,7 +246,7 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
     small_bitmap:
 	while (size > 0) {
 	    if ((bitmap & 1) == 0) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+		evacuate((StgClosure **)p);
 	    }
 	    p++;
 	    bitmap = bitmap >> 1;
@@ -235,440 +260,18 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
 STATIC_INLINE StgPtr
 scavenge_PAP (StgPAP *pap)
 {
-    pap->fun = evacuate(pap->fun);
+    evacuate(&pap->fun);
     return scavenge_PAP_payload (pap->fun, pap->payload, pap->n_args);
 }
 
 STATIC_INLINE StgPtr
 scavenge_AP (StgAP *ap)
 {
-    ap->fun = evacuate(ap->fun);
+    evacuate(&ap->fun);
     return scavenge_PAP_payload (ap->fun, ap->payload, ap->n_args);
 }
 
 /* -----------------------------------------------------------------------------
-   Scavenge a given step until there are no more objects in this step
-   to scavenge.
-
-   evac_gen is set by the caller to be either zero (for a step in a
-   generation < N) or G where G is the generation of the step being
-   scavenged.  
-
-   We sometimes temporarily change evac_gen back to zero if we're
-   scavenging a mutable object where early promotion isn't such a good
-   idea.  
-   -------------------------------------------------------------------------- */
-
-void
-scavenge(step *stp)
-{
-  StgPtr p, q;
-  StgInfoTable *info;
-  bdescr *bd;
-  nat saved_evac_gen = evac_gen;
-
-  p = stp->scan;
-  bd = stp->scan_bd;
-
-  failed_to_evac = rtsFalse;
-
-  /* scavenge phase - standard breadth-first scavenging of the
-   * evacuated objects 
-   */
-
-  while (bd != stp->hp_bd || p < stp->hp) {
-
-    // If we're at the end of this block, move on to the next block 
-    if (bd != stp->hp_bd && p == bd->free) {
-      bd = bd->link;
-      p = bd->start;
-      continue;
-    }
-
-    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-    info = get_itbl((StgClosure *)p);
-    
-    ASSERT(thunk_selector_depth == 0);
-
-    q = p;
-    switch (info->type) {
-
-    case MVAR:
-    { 
-	StgMVar *mvar = ((StgMVar *)p);
-	evac_gen = 0;
-	mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
-	mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
-	mvar->value = evacuate((StgClosure *)mvar->value);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable.
-	p += sizeofW(StgMVar);
-	break;
-    }
-
-    case FUN_2_0:
-	scavenge_fun_srt(info);
-	((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
-	((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 2;
-	break;
-
-    case THUNK_2_0:
-	scavenge_thunk_srt(info);
-	((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]);
-	((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
-	p += sizeofW(StgThunk) + 2;
-	break;
-
-    case CONSTR_2_0:
-	((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
-	((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 2;
-	break;
-	
-    case THUNK_1_0:
-	scavenge_thunk_srt(info);
-	((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
-	p += sizeofW(StgThunk) + 1;
-	break;
-	
-    case FUN_1_0:
-	scavenge_fun_srt(info);
-    case CONSTR_1_0:
-	((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 1;
-	break;
-	
-    case THUNK_0_1:
-	scavenge_thunk_srt(info);
-	p += sizeofW(StgThunk) + 1;
-	break;
-	
-    case FUN_0_1:
-	scavenge_fun_srt(info);
-    case CONSTR_0_1:
-	p += sizeofW(StgHeader) + 1;
-	break;
-	
-    case THUNK_0_2:
-	scavenge_thunk_srt(info);
-	p += sizeofW(StgThunk) + 2;
-	break;
-	
-    case FUN_0_2:
-	scavenge_fun_srt(info);
-    case CONSTR_0_2:
-	p += sizeofW(StgHeader) + 2;
-	break;
-	
-    case THUNK_1_1:
-	scavenge_thunk_srt(info);
-	((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
-	p += sizeofW(StgThunk) + 2;
-	break;
-
-    case FUN_1_1:
-	scavenge_fun_srt(info);
-    case CONSTR_1_1:
-	((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 2;
-	break;
-	
-    case FUN:
-	scavenge_fun_srt(info);
-	goto gen_obj;
-
-    case THUNK:
-    {
-	StgPtr end;
-
-	scavenge_thunk_srt(info);
-	end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
-	for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-	p += info->layout.payload.nptrs;
-	break;
-    }
-	
-    gen_obj:
-    case CONSTR:
-    case WEAK:
-    case STABLE_NAME:
-    {
-	StgPtr end;
-
-	end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
-	for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-	p += info->layout.payload.nptrs;
-	break;
-    }
-
-    case BCO: {
-	StgBCO *bco = (StgBCO *)p;
-	bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
-	bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
-	bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
-	p += bco_sizeW(bco);
-	break;
-    }
-
-    case IND_PERM:
-      if (stp->gen->no != 0) {
-#ifdef PROFILING
-        // @LDV profiling
-        // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an 
-        // IND_OLDGEN_PERM closure is larger than an IND_PERM closure.
-        LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
-#endif        
-        // 
-        // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
-        //
-	SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
-
-        // We pretend that p has just been created.
-        LDV_RECORD_CREATE((StgClosure *)p);
-      }
-	// fall through 
-    case IND_OLDGEN_PERM:
-	((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee);
-	p += sizeofW(StgInd);
-	break;
-
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY: {
-	rtsBool saved_eager_promotion = eager_promotion;
-
-	eager_promotion = rtsFalse;
-	((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
-	eager_promotion = saved_eager_promotion;
-
-	if (failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
-	}
-	p += sizeofW(StgMutVar);
-	break;
-    }
-
-    case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
-    case BLACKHOLE:
-	p += BLACKHOLE_sizeW();
-	break;
-
-    case THUNK_SELECTOR:
-    { 
-	StgSelector *s = (StgSelector *)p;
-	s->selectee = evacuate(s->selectee);
-	p += THUNK_SELECTOR_sizeW();
-	break;
-    }
-
-    // A chunk of stack saved in a heap object
-    case AP_STACK:
-    {
-	StgAP_STACK *ap = (StgAP_STACK *)p;
-
-	ap->fun = evacuate(ap->fun);
-	scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
-	p = (StgPtr)ap->payload + ap->size;
-	break;
-    }
-
-    case PAP:
-	p = scavenge_PAP((StgPAP *)p);
-	break;
-
-    case AP:
-	p = scavenge_AP((StgAP *)p);
-	break;
-
-    case ARR_WORDS:
-	// nothing to follow 
-	p += arr_words_sizeW((StgArrWords *)p);
-	break;
-
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-	// follow everything 
-    {
-	StgPtr next;
-	rtsBool saved_eager;
-
-	// We don't eagerly promote objects pointed to by a mutable
-	// array, but if we find the array only points to objects in
-	// the same or an older generation, we mark it "clean" and
-	// avoid traversing it during minor GCs.
-	saved_eager = eager_promotion;
-	eager_promotion = rtsFalse;
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-	eager_promotion = saved_eager;
-
-	if (failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
-	}
-
-	failed_to_evac = rtsTrue; // always put it on the mutable list.
-	break;
-    }
-
-    case MUT_ARR_PTRS_FROZEN:
-    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++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-
-	// If we're going to put this object on the mutable list, then
-	// set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
-	if (failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
-	}
-	break;
-    }
-
-    case TSO:
-    { 
-	StgTSO *tso = (StgTSO *)p;
-	rtsBool saved_eager = eager_promotion;
-
-	eager_promotion = rtsFalse;
-	scavengeTSO(tso);
-	eager_promotion = saved_eager;
-
-	if (failed_to_evac) {
-	    tso->flags |= TSO_DIRTY;
-	} else {
-	    tso->flags &= ~TSO_DIRTY;
-	}
-
-	failed_to_evac = rtsTrue; // always on the mutable list
-	p += tso_sizeW(tso);
-	break;
-    }
-
-    case TVAR_WATCH_QUEUE:
-      {
-	StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
-	evac_gen = 0;
-	wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure);
-	wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry);
-	wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTVarWatchQueue);
-	break;
-      }
-
-    case TVAR:
-      {
-	StgTVar *tvar = ((StgTVar *) p);
-	evac_gen = 0;
-	tvar->current_value = evacuate((StgClosure*)tvar->current_value);
-	tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTVar);
-	break;
-      }
-
-    case TREC_HEADER:
-      {
-        StgTRecHeader *trec = ((StgTRecHeader *) p);
-        evac_gen = 0;
-	trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
-	trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
-	trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTRecHeader);
-        break;
-      }
-
-    case TREC_CHUNK:
-      {
-	StgWord i;
-	StgTRecChunk *tc = ((StgTRecChunk *) p);
-	TRecEntry *e = &(tc -> entries[0]);
-	evac_gen = 0;
-	tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
-	for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
-	  e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
-	  e->expected_value = evacuate((StgClosure*)e->expected_value);
-	  e->new_value = evacuate((StgClosure*)e->new_value);
-	}
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTRecChunk);
-	break;
-      }
-
-    case ATOMIC_INVARIANT:
-      {
-        StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
-        evac_gen = 0;
-	invariant->code = (StgClosure *)evacuate(invariant->code);
-	invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgAtomicInvariant);
-        break;
-      }
-
-    case INVARIANT_CHECK_QUEUE:
-      {
-        StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
-        evac_gen = 0;
-	queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant);
-	queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution);
-	queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgInvariantCheckQueue);
-        break;
-      }
-
-    default:
-	barf("scavenge: unimplemented/strange closure type %d @ %p", 
-	     info->type, p);
-    }
-
-    /*
-     * We need to record the current object on the mutable list if
-     *  (a) It is actually mutable, or 
-     *  (b) It contains pointers to a younger generation.
-     * Case (b) arises if we didn't manage to promote everything that
-     * the current object points to into the current generation.
-     */
-    if (failed_to_evac) {
-	failed_to_evac = rtsFalse;
-	if (stp->gen_no > 0) {
-	    recordMutableGen((StgClosure *)q, stp->gen);
-	}
-    }
-  }
-
-  stp->scan_bd = bd;
-  stp->scan = p;
-}    
-
-/* -----------------------------------------------------------------------------
    Scavenge everything on the mark stack.
 
    This is slightly different from scavenge():
@@ -676,15 +279,15 @@ scavenge(step *stp)
         doesn't need to advance the pointer on to the next object.
    -------------------------------------------------------------------------- */
 
-void
+static void
 scavenge_mark_stack(void)
 {
     StgPtr p, q;
     StgInfoTable *info;
-    nat saved_evac_gen;
+    step *saved_evac_step;
 
-    evac_gen = oldest_gen->no;
-    saved_evac_gen = evac_gen;
+    gct->evac_step = &oldest_gen->steps[0];
+    saved_evac_step = gct->evac_step;
 
 linear_scan:
     while (!mark_stack_empty()) {
@@ -694,52 +297,60 @@ linear_scan:
 	info = get_itbl((StgClosure *)p);
 	
 	q = p;
-	switch (info->type) {
+        switch (((volatile StgWord *)info)[1] & 0xffff) {
 	    
-	case MVAR:
-	{
-	    StgMVar *mvar = ((StgMVar *)p);
-	    evac_gen = 0;
-	    mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
-	    mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
-	    mvar->value = evacuate((StgClosure *)mvar->value);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable.
-	    break;
-	}
+        case MVAR_CLEAN:
+        case MVAR_DIRTY:
+        { 
+            rtsBool saved_eager_promotion = gct->eager_promotion;
+            
+            StgMVar *mvar = ((StgMVar *)p);
+            gct->eager_promotion = rtsFalse;
+            evacuate((StgClosure **)&mvar->head);
+            evacuate((StgClosure **)&mvar->tail);
+            evacuate((StgClosure **)&mvar->value);
+            gct->eager_promotion = saved_eager_promotion;
+            
+            if (gct->failed_to_evac) {
+                mvar->header.info = &stg_MVAR_DIRTY_info;
+            } else {
+                mvar->header.info = &stg_MVAR_CLEAN_info;
+            }
+            break;
+        }
 
 	case FUN_2_0:
 	    scavenge_fun_srt(info);
-	    ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
-	    ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
+	    evacuate(&((StgClosure *)p)->payload[1]);
+	    evacuate(&((StgClosure *)p)->payload[0]);
 	    break;
 
 	case THUNK_2_0:
 	    scavenge_thunk_srt(info);
-	    ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]);
-	    ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
+	    evacuate(&((StgThunk *)p)->payload[1]);
+	    evacuate(&((StgThunk *)p)->payload[0]);
 	    break;
 
 	case CONSTR_2_0:
-	    ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
-	    ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
+	    evacuate(&((StgClosure *)p)->payload[1]);
+	    evacuate(&((StgClosure *)p)->payload[0]);
 	    break;
 	
 	case FUN_1_0:
 	case FUN_1_1:
 	    scavenge_fun_srt(info);
-	    ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
+	    evacuate(&((StgClosure *)p)->payload[0]);
 	    break;
 
 	case THUNK_1_0:
 	case THUNK_1_1:
 	    scavenge_thunk_srt(info);
-	    ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
+	    evacuate(&((StgThunk *)p)->payload[0]);
 	    break;
 
 	case CONSTR_1_0:
 	case CONSTR_1_1:
-	    ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
+	    evacuate(&((StgClosure *)p)->payload[0]);
 	    break;
 	
 	case FUN_0_1:
@@ -767,7 +378,7 @@ linear_scan:
 	    scavenge_thunk_srt(info);
 	    end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
 	    for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+		evacuate((StgClosure **)p);
 	    }
 	    break;
 	}
@@ -781,16 +392,16 @@ linear_scan:
 	    
 	    end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
 	    for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+		evacuate((StgClosure **)p);
 	    }
 	    break;
 	}
 
 	case BCO: {
 	    StgBCO *bco = (StgBCO *)p;
-	    bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
-	    bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
-	    bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
+	    evacuate((StgClosure **)&bco->instrs);
+	    evacuate((StgClosure **)&bco->literals);
+	    evacuate((StgClosure **)&bco->ptrs);
 	    break;
 	}
 
@@ -802,19 +413,18 @@ linear_scan:
 
 	case IND_OLDGEN:
 	case IND_OLDGEN_PERM:
-	    ((StgInd *)p)->indirectee = 
-		evacuate(((StgInd *)p)->indirectee);
+	    evacuate(&((StgInd *)p)->indirectee);
 	    break;
 
 	case MUT_VAR_CLEAN:
 	case MUT_VAR_DIRTY: {
-	    rtsBool saved_eager_promotion = eager_promotion;
+	    rtsBool saved_eager_promotion = gct->eager_promotion;
 	    
-	    eager_promotion = rtsFalse;
-	    ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
-	    eager_promotion = saved_eager_promotion;
+	    gct->eager_promotion = rtsFalse;
+	    evacuate(&((StgMutVar *)p)->var);
+	    gct->eager_promotion = saved_eager_promotion;
 	    
-	    if (failed_to_evac) {
+	    if (gct->failed_to_evac) {
 		((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
 	    } else {
 		((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
@@ -832,7 +442,7 @@ linear_scan:
 	case THUNK_SELECTOR:
 	{ 
 	    StgSelector *s = (StgSelector *)p;
-	    s->selectee = evacuate(s->selectee);
+	    evacuate(&s->selectee);
 	    break;
 	}
 
@@ -841,7 +451,7 @@ linear_scan:
 	{
 	    StgAP_STACK *ap = (StgAP_STACK *)p;
 	    
-	    ap->fun = evacuate(ap->fun);
+	    evacuate(&ap->fun);
 	    scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
 	    break;
 	}
@@ -865,21 +475,21 @@ linear_scan:
 	    // array, but if we find the array only points to objects in
 	    // the same or an older generation, we mark it "clean" and
 	    // avoid traversing it during minor GCs.
-	    saved_eager = eager_promotion;
-	    eager_promotion = rtsFalse;
+	    saved_eager = gct->eager_promotion;
+	    gct->eager_promotion = rtsFalse;
 	    next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 	    for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+		evacuate((StgClosure **)p);
 	    }
-	    eager_promotion = saved_eager;
+	    gct->eager_promotion = saved_eager;
 
-	    if (failed_to_evac) {
+	    if (gct->failed_to_evac) {
 		((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
 	    } else {
 		((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
 	    }
 
-	    failed_to_evac = rtsTrue; // mutable anyhow.
+	    gct->failed_to_evac = rtsTrue; // mutable anyhow.
 	    break;
 	}
 
@@ -891,12 +501,12 @@ linear_scan:
 	    
 	    next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 	    for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+		evacuate((StgClosure **)p);
 	    }
 
 	    // If we're going to put this object on the mutable list, then
 	    // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
-	    if (failed_to_evac) {
+	    if (gct->failed_to_evac) {
 		((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
 	    } else {
 		((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
@@ -906,43 +516,31 @@ linear_scan:
 
 	case TSO:
 	{ 
-	    StgTSO *tso = (StgTSO *)p;
-	    rtsBool saved_eager = eager_promotion;
-
-	    eager_promotion = rtsFalse;
-	    scavengeTSO(tso);
-	    eager_promotion = saved_eager;
-	    
-	    if (failed_to_evac) {
-		tso->flags |= TSO_DIRTY;
-	    } else {
-		tso->flags &= ~TSO_DIRTY;
-	    }
-	    
-	    failed_to_evac = rtsTrue; // always on the mutable list
+            scavengeTSO((StgTSO*)p);
+	    gct->failed_to_evac = rtsTrue; // always on the mutable list
 	    break;
 	}
 
 	case TVAR_WATCH_QUEUE:
 	  {
 	    StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
-	    evac_gen = 0;
-            wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure);
-	    wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry);
-	    wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
+	    gct->evac_step = 0;
+            evacuate((StgClosure **)&wq->closure);
+	    evacuate((StgClosure **)&wq->next_queue_entry);
+	    evacuate((StgClosure **)&wq->prev_queue_entry);
+	    gct->evac_step = saved_evac_step;
+	    gct->failed_to_evac = rtsTrue; // mutable
 	    break;
 	  }
 	  
 	case TVAR:
 	  {
 	    StgTVar *tvar = ((StgTVar *) p);
-	    evac_gen = 0;
-	    tvar->current_value = evacuate((StgClosure*)tvar->current_value);
-	    tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
+	    gct->evac_step = 0;
+	    evacuate((StgClosure **)&tvar->current_value);
+	    evacuate((StgClosure **)&tvar->first_watch_queue_entry);
+	    gct->evac_step = saved_evac_step;
+	    gct->failed_to_evac = rtsTrue; // mutable
 	    break;
 	  }
 	  
@@ -951,50 +549,50 @@ linear_scan:
 	    StgWord i;
 	    StgTRecChunk *tc = ((StgTRecChunk *) p);
 	    TRecEntry *e = &(tc -> entries[0]);
-	    evac_gen = 0;
-	    tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+	    gct->evac_step = 0;
+	    evacuate((StgClosure **)&tc->prev_chunk);
 	    for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
-	      e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
-	      e->expected_value = evacuate((StgClosure*)e->expected_value);
-	      e->new_value = evacuate((StgClosure*)e->new_value);
+	      evacuate((StgClosure **)&e->tvar);
+	      evacuate((StgClosure **)&e->expected_value);
+	      evacuate((StgClosure **)&e->new_value);
 	    }
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
+	    gct->evac_step = saved_evac_step;
+	    gct->failed_to_evac = rtsTrue; // mutable
 	    break;
 	  }
 
 	case TREC_HEADER:
 	  {
 	    StgTRecHeader *trec = ((StgTRecHeader *) p);
-	    evac_gen = 0;
-	    trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
-	    trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
-  	    trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
+	    gct->evac_step = 0;
+	    evacuate((StgClosure **)&trec->enclosing_trec);
+	    evacuate((StgClosure **)&trec->current_chunk);
+  	    evacuate((StgClosure **)&trec->invariants_to_check);
+	    gct->evac_step = saved_evac_step;
+	    gct->failed_to_evac = rtsTrue; // mutable
 	    break;
 	  }
 
         case ATOMIC_INVARIANT:
           {
             StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
-            evac_gen = 0;
-	    invariant->code = (StgClosure *)evacuate(invariant->code);
-    	    invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
+            gct->evac_step = 0;
+	    evacuate(&invariant->code);
+    	    evacuate((StgClosure **)&invariant->last_execution);
+	    gct->evac_step = saved_evac_step;
+	    gct->failed_to_evac = rtsTrue; // mutable
             break;
           }
 
         case INVARIANT_CHECK_QUEUE:
           {
             StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
-            evac_gen = 0;
-    	    queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant);
-	    queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution);
-            queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
+            gct->evac_step = 0;
+    	    evacuate((StgClosure **)&queue->invariant);
+	    evacuate((StgClosure **)&queue->my_execution);
+            evacuate((StgClosure **)&queue->next_queue_entry);
+	    gct->evac_step = saved_evac_step;
+	    gct->failed_to_evac = rtsTrue; // mutable
             break;
           }
 
@@ -1003,10 +601,10 @@ linear_scan:
 		 info->type, p);
 	}
 
-	if (failed_to_evac) {
-	    failed_to_evac = rtsFalse;
-	    if (evac_gen > 0) {
-		recordMutableGen((StgClosure *)q, &generations[evac_gen]);
+	if (gct->failed_to_evac) {
+	    gct->failed_to_evac = rtsFalse;
+	    if (gct->evac_step) {
+		recordMutableGen_GC((StgClosure *)q, gct->evac_step->gen);
 	    }
 	}
 	
@@ -1066,7 +664,7 @@ static rtsBool
 scavenge_one(StgPtr p)
 {
     const StgInfoTable *info;
-    nat saved_evac_gen = evac_gen;
+    step *saved_evac_step = gct->evac_step;
     rtsBool no_luck;
     
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
@@ -1074,15 +672,23 @@ scavenge_one(StgPtr p)
     
     switch (info->type) {
 	
-    case MVAR:
+    case MVAR_CLEAN:
+    case MVAR_DIRTY:
     { 
+	rtsBool saved_eager_promotion = gct->eager_promotion;
+
 	StgMVar *mvar = ((StgMVar *)p);
-	evac_gen = 0;
-	mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
-	mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
-	mvar->value = evacuate((StgClosure *)mvar->value);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable.
+	gct->eager_promotion = rtsFalse;
+	evacuate((StgClosure **)&mvar->head);
+	evacuate((StgClosure **)&mvar->tail);
+	evacuate((StgClosure **)&mvar->value);
+	gct->eager_promotion = saved_eager_promotion;
+
+	if (gct->failed_to_evac) {
+	    mvar->header.info = &stg_MVAR_DIRTY_info;
+	} else {
+	    mvar->header.info = &stg_MVAR_CLEAN_info;
+	}
 	break;
     }
 
@@ -1097,7 +703,7 @@ scavenge_one(StgPtr p)
 	
 	end = (StgPtr)((StgThunk *)p)->payload + info->layout.payload.ptrs;
 	for (q = (StgPtr)((StgThunk *)p)->payload; q < end; q++) {
-	    *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
+	    evacuate((StgClosure **)q);
 	}
 	break;
     }
@@ -1121,7 +727,7 @@ scavenge_one(StgPtr p)
 	
 	end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
 	for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) {
-	    *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
+	    evacuate((StgClosure **)q);
 	}
 	break;
     }
@@ -1129,13 +735,13 @@ scavenge_one(StgPtr p)
     case MUT_VAR_CLEAN:
     case MUT_VAR_DIRTY: {
 	StgPtr q = p;
-	rtsBool saved_eager_promotion = eager_promotion;
+	rtsBool saved_eager_promotion = gct->eager_promotion;
 
-	eager_promotion = rtsFalse;
-	((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
-	eager_promotion = saved_eager_promotion;
+	gct->eager_promotion = rtsFalse;
+	evacuate(&((StgMutVar *)p)->var);
+	gct->eager_promotion = saved_eager_promotion;
 
-	if (failed_to_evac) {
+	if (gct->failed_to_evac) {
 	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
 	} else {
 	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
@@ -1152,7 +758,7 @@ scavenge_one(StgPtr p)
     case THUNK_SELECTOR:
     { 
 	StgSelector *s = (StgSelector *)p;
-	s->selectee = evacuate(s->selectee);
+	evacuate(&s->selectee);
 	break;
     }
     
@@ -1160,7 +766,7 @@ scavenge_one(StgPtr p)
     {
 	StgAP_STACK *ap = (StgAP_STACK *)p;
 
-	ap->fun = evacuate(ap->fun);
+	evacuate(&ap->fun);
 	scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
 	p = (StgPtr)ap->payload + ap->size;
 	break;
@@ -1188,22 +794,22 @@ scavenge_one(StgPtr p)
 	// array, but if we find the array only points to objects in
 	// the same or an older generation, we mark it "clean" and
 	// avoid traversing it during minor GCs.
-	saved_eager = eager_promotion;
-	eager_promotion = rtsFalse;
+	saved_eager = gct->eager_promotion;
+	gct->eager_promotion = rtsFalse;
 	q = p;
 	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+	    evacuate((StgClosure **)p);
 	}
-	eager_promotion = saved_eager;
+	gct->eager_promotion = saved_eager;
 
-	if (failed_to_evac) {
+	if (gct->failed_to_evac) {
 	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
 	} else {
 	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
 	}
 
-	failed_to_evac = rtsTrue;
+	gct->failed_to_evac = rtsTrue;
 	break;
     }
 
@@ -1215,12 +821,12 @@ scavenge_one(StgPtr p)
       
 	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+	    evacuate((StgClosure **)p);
 	}
 
 	// If we're going to put this object on the mutable list, then
 	// set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
-	if (failed_to_evac) {
+	if (gct->failed_to_evac) {
 	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
 	} else {
 	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
@@ -1230,55 +836,43 @@ scavenge_one(StgPtr p)
 
     case TSO:
     {
-	StgTSO *tso = (StgTSO *)p;
-	rtsBool saved_eager = eager_promotion;
-
-	eager_promotion = rtsFalse;
-	scavengeTSO(tso);
-	eager_promotion = saved_eager;
-
-	if (failed_to_evac) {
-	    tso->flags |= TSO_DIRTY;
-	} else {
-	    tso->flags &= ~TSO_DIRTY;
-	}
-
-	failed_to_evac = rtsTrue; // always on the mutable list
+	scavengeTSO((StgTSO*)p);
+	gct->failed_to_evac = rtsTrue; // always on the mutable list
 	break;
     }
   
     case TVAR_WATCH_QUEUE:
       {
 	StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p);
-	evac_gen = 0;
-        wq->closure = (StgClosure*)evacuate((StgClosure*)wq->closure);
-        wq->next_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->next_queue_entry);
-        wq->prev_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
+	gct->evac_step = 0;
+        evacuate((StgClosure **)&wq->closure);
+        evacuate((StgClosure **)&wq->next_queue_entry);
+        evacuate((StgClosure **)&wq->prev_queue_entry);
+	gct->evac_step = saved_evac_step;
+	gct->failed_to_evac = rtsTrue; // mutable
 	break;
       }
 
     case TVAR:
       {
 	StgTVar *tvar = ((StgTVar *) p);
-	evac_gen = 0;
-	tvar->current_value = evacuate((StgClosure*)tvar->current_value);
-        tvar->first_watch_queue_entry = (StgTVarWatchQueue *)evacuate((StgClosure*)tvar->first_watch_queue_entry);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
+	gct->evac_step = 0;
+	evacuate((StgClosure **)&tvar->current_value);
+        evacuate((StgClosure **)&tvar->first_watch_queue_entry);
+	gct->evac_step = saved_evac_step;
+	gct->failed_to_evac = rtsTrue; // mutable
 	break;
       }
 
     case TREC_HEADER:
       {
         StgTRecHeader *trec = ((StgTRecHeader *) p);
-        evac_gen = 0;
-	trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
-	trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
-        trec->invariants_to_check = (StgInvariantCheckQueue *)evacuate((StgClosure*)trec->invariants_to_check);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
+        gct->evac_step = 0;
+	evacuate((StgClosure **)&trec->enclosing_trec);
+	evacuate((StgClosure **)&trec->current_chunk);
+        evacuate((StgClosure **)&trec->invariants_to_check);
+	gct->evac_step = saved_evac_step;
+	gct->failed_to_evac = rtsTrue; // mutable
         break;
       }
 
@@ -1287,38 +881,38 @@ scavenge_one(StgPtr p)
 	StgWord i;
 	StgTRecChunk *tc = ((StgTRecChunk *) p);
 	TRecEntry *e = &(tc -> entries[0]);
-	evac_gen = 0;
-	tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+	gct->evac_step = 0;
+	evacuate((StgClosure **)&tc->prev_chunk);
 	for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
-	  e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
-	  e->expected_value = evacuate((StgClosure*)e->expected_value);
-	  e->new_value = evacuate((StgClosure*)e->new_value);
+	  evacuate((StgClosure **)&e->tvar);
+	  evacuate((StgClosure **)&e->expected_value);
+	  evacuate((StgClosure **)&e->new_value);
 	}
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
+	gct->evac_step = saved_evac_step;
+	gct->failed_to_evac = rtsTrue; // mutable
 	break;
       }
 
     case ATOMIC_INVARIANT:
     {
       StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p);
-      evac_gen = 0;
-      invariant->code = (StgClosure *)evacuate(invariant->code);
-      invariant->last_execution = (StgTRecHeader *)evacuate((StgClosure*)invariant->last_execution);
-      evac_gen = saved_evac_gen;
-      failed_to_evac = rtsTrue; // mutable
+      gct->evac_step = 0;
+      evacuate(&invariant->code);
+      evacuate((StgClosure **)&invariant->last_execution);
+      gct->evac_step = saved_evac_step;
+      gct->failed_to_evac = rtsTrue; // mutable
       break;
     }
 
     case INVARIANT_CHECK_QUEUE:
     {
       StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p);
-      evac_gen = 0;
-      queue->invariant = (StgAtomicInvariant *)evacuate((StgClosure*)queue->invariant);
-      queue->my_execution = (StgTRecHeader *)evacuate((StgClosure*)queue->my_execution);
-      queue->next_queue_entry = (StgInvariantCheckQueue *)evacuate((StgClosure*)queue->next_queue_entry);
-      evac_gen = saved_evac_gen;
-      failed_to_evac = rtsTrue; // mutable
+      gct->evac_step = 0;
+      evacuate((StgClosure **)&queue->invariant);
+      evacuate((StgClosure **)&queue->my_execution);
+      evacuate((StgClosure **)&queue->next_queue_entry);
+      gct->evac_step = saved_evac_step;
+      gct->failed_to_evac = rtsTrue; // mutable
       break;
     }
 
@@ -1337,7 +931,7 @@ scavenge_one(StgPtr p)
 	if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
 	    break;
 	}
-	((StgInd *)p)->indirectee = evacuate(q);
+	evacuate(&((StgInd *)p)->indirectee);
     }
 
 #if 0 && defined(DEBUG)
@@ -1371,8 +965,8 @@ scavenge_one(StgPtr p)
 	barf("scavenge_one: strange object %d", (int)(info->type));
     }    
 
-    no_luck = failed_to_evac;
-    failed_to_evac = rtsFalse;
+    no_luck = gct->failed_to_evac;
+    gct->failed_to_evac = rtsFalse;
     return (no_luck);
 }
 
@@ -1392,7 +986,7 @@ scavenge_mutable_list(generation *gen)
 
     bd = gen->saved_mut_list;
 
-    evac_gen = gen->no;
+    gct->evac_step = &gen->steps[0];
     for (; bd != NULL; bd = bd->link) {
 	for (q = bd->start; q < bd->free; q++) {
 	    p = (StgPtr)*q;
@@ -1409,6 +1003,10 @@ scavenge_mutable_list(generation *gen)
 	    case MUT_ARR_PTRS_FROZEN:
 	    case MUT_ARR_PTRS_FROZEN0:
 		mutlist_MUTARRS++; break;
+	    case MVAR_CLEAN:
+		barf("MVAR_CLEAN on mutable list");
+	    case MVAR_DIRTY:
+		mutlist_MVARS++; break;
 	    default:
 		mutlist_OTHERS++; break;
 	    }
@@ -1423,7 +1021,7 @@ scavenge_mutable_list(generation *gen)
 	    //
 	    switch (get_itbl((StgClosure *)p)->type) {
 	    case MUT_ARR_PTRS_CLEAN:
-		recordMutableGen((StgClosure *)p,gen);
+		recordMutableGen_GC((StgClosure *)p,gen);
 		continue;
 	    case TSO: {
 		StgTSO *tso = (StgTSO *)p;
@@ -1433,9 +1031,9 @@ scavenge_mutable_list(generation *gen)
 		    // we don't want to have to mark a TSO dirty just
 		    // because we put it on a different queue.
 		    if (tso->why_blocked != BlockedOnBlackHole) {
-			tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
+			evacuate((StgClosure **)&tso->link);
 		    }
-		    recordMutableGen((StgClosure *)p,gen);
+		    recordMutableGen_GC((StgClosure *)p,gen);
 		    continue;
 		}
 	    }
@@ -1446,13 +1044,13 @@ scavenge_mutable_list(generation *gen)
 	    if (scavenge_one(p)) {
 		// didn't manage to promote everything, so put the
 		// object back on the list.
-		recordMutableGen((StgClosure *)p,gen);
+		recordMutableGen_GC((StgClosure *)p,gen);
 	    }
 	}
     }
 
     // free the old mut_list
-    freeChain(gen->saved_mut_list);
+    freeChain_sync(gen->saved_mut_list);
     gen->saved_mut_list = NULL;
 }
 
@@ -1464,50 +1062,62 @@ scavenge_mutable_list(generation *gen)
    remove non-mutable objects from the mutable list at this point.
    -------------------------------------------------------------------------- */
 
-void
+static void
 scavenge_static(void)
 {
-  StgClosure* p = static_objects;
+  StgClosure* p;
   const StgInfoTable *info;
 
+  debugTrace(DEBUG_gc, "scavenging static objects");
+
   /* Always evacuate straight to the oldest generation for static
    * objects */
-  evac_gen = oldest_gen->no;
+  gct->evac_step = &oldest_gen->steps[0];
 
   /* keep going until we've scavenged all the objects on the linked
      list... */
-  while (p != END_OF_STATIC_LIST) {
 
+  while (1) {
+      
+    /* get the next static object from the list.  Remember, there might
+     * be more stuff on this list after each evacuation...
+     * (static_objects is a global)
+     */
+    p = gct->static_objects;
+    if (p == END_OF_STATIC_LIST) {
+    	  break;
+    }
+    
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
     info = get_itbl(p);
     /*
-    if (info->type==RBH)
-      info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure
+    	if (info->type==RBH)
+    	info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure
     */
     // make sure the info pointer is into text space 
     
     /* Take this object *off* the static_objects list,
      * and put it on the scavenged_static_objects list.
      */
-    static_objects = *STATIC_LINK(info,p);
-    *STATIC_LINK(info,p) = scavenged_static_objects;
-    scavenged_static_objects = p;
+    gct->static_objects = *STATIC_LINK(info,p);
+    *STATIC_LINK(info,p) = gct->scavenged_static_objects;
+    gct->scavenged_static_objects = p;
     
     switch (info -> type) {
       
     case IND_STATIC:
       {
 	StgInd *ind = (StgInd *)p;
-	ind->indirectee = evacuate(ind->indirectee);
+	evacuate(&ind->indirectee);
 
 	/* might fail to evacuate it, in which case we have to pop it
 	 * back on the mutable list of the oldest generation.  We
 	 * leave it *on* the scavenged_static_objects list, though,
 	 * in case we visit this object again.
 	 */
-	if (failed_to_evac) {
-	  failed_to_evac = rtsFalse;
-	  recordMutableGen((StgClosure *)p,oldest_gen);
+	if (gct->failed_to_evac) {
+	  gct->failed_to_evac = rtsFalse;
+	  recordMutableGen_GC((StgClosure *)p,oldest_gen);
 	}
 	break;
       }
@@ -1527,7 +1137,7 @@ scavenge_static(void)
 	next = (P_)p->payload + info->layout.payload.ptrs;
 	// evacuate the pointers 
 	for (q = (P_)p->payload; q < next; q++) {
-	    *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
+	    evacuate((StgClosure **)q);
 	}
 	break;
       }
@@ -1536,13 +1146,7 @@ scavenge_static(void)
       barf("scavenge_static: strange closure %d", (int)(info->type));
     }
 
-    ASSERT(failed_to_evac == rtsFalse);
-
-    /* get the next static object from the list.  Remember, there might
-     * be more stuff on this list now that we've done some evacuating!
-     * (static_objects is a global)
-     */
-    p = static_objects;
+    ASSERT(gct->failed_to_evac == rtsFalse);
   }
 }
 
@@ -1560,7 +1164,7 @@ scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
     bitmap = large_bitmap->bitmap[b];
     for (i = 0; i < size; ) {
 	if ((bitmap & 1) == 0) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+	    evacuate((StgClosure **)p);
 	}
 	i++;
 	p++;
@@ -1578,7 +1182,7 @@ scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
 {
     while (size > 0) {
 	if ((bitmap & 1) == 0) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+	    evacuate((StgClosure **)p);
 	}
 	p++;
 	bitmap = bitmap >> 1;
@@ -1633,14 +1237,20 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 	// the indirection into an IND_PERM, so that evacuate will
 	// copy the indirection into the old generation instead of
 	// discarding it.
-	if (get_itbl(((StgUpdateFrame *)p)->updatee)->type == IND) {
+    {
+        nat type;
+        type = get_itbl(((StgUpdateFrame *)p)->updatee)->type;
+	if (type == IND) {
 	    ((StgUpdateFrame *)p)->updatee->header.info = 
 		(StgInfoTable *)&stg_IND_PERM_info;
-	}
-	((StgUpdateFrame *)p)->updatee 
-	    = evacuate(((StgUpdateFrame *)p)->updatee);
+	} else if (type == IND_OLDGEN) {
+	    ((StgUpdateFrame *)p)->updatee->header.info = 
+		(StgInfoTable *)&stg_IND_OLDGEN_PERM_info;
+        }            
+	evacuate(&((StgUpdateFrame *)p)->updatee);
 	p += sizeofW(StgUpdateFrame);
 	continue;
+    }
 
       // small bitmap (< 32 entries, or 64 on a 64-bit machine) 
     case CATCH_STM_FRAME:
@@ -1666,7 +1276,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 	nat size;
 
 	p++;
-	*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+	evacuate((StgClosure **)p);
 	bco = (StgBCO *)*p;
 	p++;
 	size = BCO_BITMAP_SIZE(bco);
@@ -1708,7 +1318,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 	
 	// follow the ptr words
 	for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+	    evacuate((StgClosure **)p);
 	    p++;
 	}
 	continue;
@@ -1719,7 +1329,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 	StgRetFun *ret_fun = (StgRetFun *)p;
 	StgFunInfoTable *fun_info;
 
-	ret_fun->fun = evacuate(ret_fun->fun);
+	evacuate(&ret_fun->fun);
  	fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
 	p = scavenge_arg_block(fun_info, ret_fun->payload);
 	goto follow_srt;
@@ -1734,39 +1344,201 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 /*-----------------------------------------------------------------------------
   scavenge the large object list.
 
-  evac_gen set by caller; similar games played with evac_gen as with
+  evac_step set by caller; similar games played with evac_step as with
   scavenge() - see comment at the top of scavenge().  Most large
-  objects are (repeatedly) mutable, so most of the time evac_gen will
+  objects are (repeatedly) mutable, so most of the time evac_step will
   be zero.
   --------------------------------------------------------------------------- */
 
-void
-scavenge_large(step *stp)
+static void
+scavenge_large (step_workspace *ws)
 {
-  bdescr *bd;
-  StgPtr p;
+    bdescr *bd;
+    StgPtr p;
 
-  bd = stp->new_large_objects;
+    gct->evac_step = ws->step;
 
-  for (; bd != NULL; bd = stp->new_large_objects) {
+    bd = ws->todo_large_objects;
+    
+    for (; bd != NULL; bd = ws->todo_large_objects) {
+	
+	// take this object *off* the large objects list and put it on
+	// the scavenged large objects list.  This is so that we can
+	// treat new_large_objects as a stack and push new objects on
+	// the front when evacuating.
+	ws->todo_large_objects = bd->link;
+	
+	ACQUIRE_SPIN_LOCK(&ws->step->sync_large_objects);
+	dbl_link_onto(bd, &ws->step->scavenged_large_objects);
+	ws->step->n_scavenged_large_blocks += bd->blocks;
+	RELEASE_SPIN_LOCK(&ws->step->sync_large_objects);
+	
+	p = bd->start;
+	if (scavenge_one(p)) {
+	    if (ws->step->gen_no > 0) {
+		recordMutableGen_GC((StgClosure *)p, ws->step->gen);
+	    }
+	}
 
-    /* take this object *off* the large objects list and put it on
-     * the scavenged large objects list.  This is so that we can
-     * treat new_large_objects as a stack and push new objects on
-     * the front when evacuating.
-     */
-    stp->new_large_objects = bd->link;
-    dbl_link_onto(bd, &stp->scavenged_large_objects);
+        // stats
+        gct->scanned += closure_sizeW((StgClosure*)p);
+    }
+}
 
-    // update the block count in this step.
-    stp->n_scavenged_large_blocks += bd->blocks;
+/* ----------------------------------------------------------------------------
+   Scavenge a block
+   ------------------------------------------------------------------------- */
 
-    p = bd->start;
-    if (scavenge_one(p)) {
-	if (stp->gen_no > 0) {
-	    recordMutableGen((StgClosure *)p, stp->gen);
-	}
+#define PARALLEL_GC
+#include "Scav.c-inc"
+#undef PARALLEL_GC
+#include "Scav.c-inc"
+
+/* ----------------------------------------------------------------------------
+   Look for work to do.
+
+   We look for the oldest step that has either a todo block that can
+   be scanned, or a block of work on the global queue that we can
+   scan.
+
+   It is important to take work from the *oldest* generation that we
+   has work available, because that minimizes the likelihood of
+   evacuating objects into a young generation when they should have
+   been eagerly promoted.  This really does make a difference (the
+   cacheprof benchmark is one that is affected).
+
+   We also want to scan the todo block if possible before grabbing
+   work from the global queue, the reason being that we don't want to
+   steal work from the global queue and starve other threads if there
+   is other work we can usefully be doing.
+   ------------------------------------------------------------------------- */
+
+static rtsBool
+scavenge_find_work (void)
+{
+    int s;
+    step_workspace *ws;
+    rtsBool did_something, did_anything;
+    bdescr *bd;
+
+    gct->scav_find_work++;
+
+    did_anything = rtsFalse;
+
+loop:
+    did_something = rtsFalse;
+    for (s = total_steps-1; s >= 0; s--) {
+        if (s == 0 && RtsFlags.GcFlags.generations > 1) { 
+            continue; 
+        }
+        ws = &gct->steps[s];
+        
+        gct->scan_bd = NULL;
+
+        // If we have a scan block with some work to do,
+        // scavenge everything up to the free pointer.
+        if (ws->todo_bd->u.scan < ws->todo_free)
+        {
+            if (n_gc_threads == 1) {
+                scavenge_block1(ws->todo_bd);
+            } else {
+                scavenge_block(ws->todo_bd);
+            }
+            did_something = rtsTrue;
+            break;
+        }
+
+        // If we have any large objects to scavenge, do them now.
+        if (ws->todo_large_objects) {
+            scavenge_large(ws);
+            did_something = rtsTrue;
+            break;
+        }
+
+        if ((bd = grab_todo_block(ws)) != NULL) {
+            if (n_gc_threads == 1) {
+                scavenge_block1(bd);
+            } else {
+                scavenge_block(bd);
+            }
+            did_something = rtsTrue;
+            break;
+        }
     }
-  }
+
+    if (did_something) {
+        did_anything = rtsTrue;
+        goto loop;
+    }
+    // only return when there is no more work to do
+
+    return did_anything;
+}
+
+/* ----------------------------------------------------------------------------
+   Scavenge until we can't find anything more to scavenge.
+   ------------------------------------------------------------------------- */
+
+void
+scavenge_loop(void)
+{
+    rtsBool work_to_do;
+
+loop:
+    work_to_do = rtsFalse;
+
+    // scavenge static objects 
+    if (major_gc && gct->static_objects != END_OF_STATIC_LIST) {
+	IF_DEBUG(sanity, checkStaticObjects(gct->static_objects));
+	scavenge_static();
+    }
+    
+    // scavenge objects in compacted generation
+    if (mark_stack_overflowed || oldgen_scan_bd != NULL ||
+	(mark_stack_bdescr != NULL && !mark_stack_empty())) {
+	scavenge_mark_stack();
+	work_to_do = rtsTrue;
+    }
+    
+    // Order is important here: we want to deal in full blocks as
+    // much as possible, so go for global work in preference to
+    // local work.  Only if all the global work has been exhausted
+    // do we start scavenging the fragments of blocks in the local
+    // workspaces.
+    if (scavenge_find_work()) goto loop;
+    
+    if (work_to_do) goto loop;
 }
 
+rtsBool
+any_work (void)
+{
+    int s;
+    step_workspace *ws;
+
+    gct->any_work++;
+
+    write_barrier();
+
+    // scavenge objects in compacted generation
+    if (mark_stack_overflowed || oldgen_scan_bd != NULL ||
+	(mark_stack_bdescr != NULL && !mark_stack_empty())) {
+	return rtsTrue;
+    }
+    
+    // Check for global work in any step.  We don't need to check for
+    // local work, because we have already exited scavenge_loop(),
+    // which means there is no local work for this thread.
+    for (s = total_steps-1; s >= 0; s--) {
+        if (s == 0 && RtsFlags.GcFlags.generations > 1) { 
+            continue; 
+        }
+        ws = &gct->steps[s];
+        if (ws->todo_large_objects) return rtsTrue;
+        if (ws->step->todos) return rtsTrue;
+    }
+
+    gct->no_work++;
+
+    return rtsFalse;
+}