RTS tidyup sweep, first phase
[ghc-hetmet.git] / rts / sm / Scav.c
index 71c2be7..9ebd4c5 100644 (file)
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team 1998-2006
+ * (c) The GHC Team 1998-2008
  *
  * Generational garbage collector: scavenging functions
  *
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #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"
+#include "Capability.h"
 
 static void scavenge_stack (StgPtr p, StgPtr stack_end);
 
@@ -31,111 +32,47 @@ static void scavenge_large_bitmap (StgPtr p,
                                   StgLargeBitmap *large_bitmap, 
                                   nat size );
 
-static void scavenge_block (bdescr *bd, StgPtr scan);
-
-
-/* Similar to scavenge_large_bitmap(), but we don't write back the
- * pointers we get back from evacuate().
- */
-static void
-scavenge_large_srt_bitmap( StgLargeSRT *large_srt )
-{
-    nat i, b, size;
-    StgWord bitmap;
-    StgClosure **p;
-    
-    b = 0;
-    bitmap = large_srt->l.bitmap[b];
-    size   = (nat)large_srt->l.size;
-    p      = (StgClosure **)large_srt->srt;
-    for (i = 0; i < size; ) {
-       if ((bitmap & 1) != 0) {
-           evacuate(p);
-       }
-       i++;
-       p++;
-       if (i % BITS_IN(W_) == 0) {
-           b++;
-           bitmap = large_srt->l.bitmap[b];
-       } else {
-           bitmap = bitmap >> 1;
-       }
-    }
-}
-
-/* evacuate the SRT.  If srt_bitmap is zero, then there isn't an
- * srt field in the info table.  That's ok, because we'll
- * never dereference it.
- */
-STATIC_INLINE void
-scavenge_srt (StgClosure **srt, nat srt_bitmap)
-{
-  nat bitmap;
-  StgClosure **p;
-
-  bitmap = srt_bitmap;
-  p = srt;
-
-  if (bitmap == (StgHalfWord)(-1)) {  
-      scavenge_large_srt_bitmap( (StgLargeSRT *)srt );
-      return;
-  }
-
-  while (bitmap != 0) {
-      if ((bitmap & 1) != 0) {
-#if defined(__PIC__) && defined(mingw32_TARGET_OS)
-         // Special-case to handle references to closures hiding out in DLLs, since
-         // double indirections required to get at those. The code generator knows
-         // which is which when generating the SRT, so it stores the (indirect)
-         // reference to the DLL closure in the table by first adding one to it.
-         // We check for this here, and undo the addition before evacuating it.
-         // 
-         // 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)));
-         } else {
-             evacuate(p);
-         }
-#else
-         evacuate(p);
+#if defined(THREADED_RTS) && !defined(PARALLEL_GC)
+# define evacuate(a) evacuate1(a)
+# define recordMutableGen_GC(a,b) recordMutableGen(a,b)
+# define scavenge_loop(a) scavenge_loop1(a)
+# define scavenge_mutable_list(bd,g) scavenge_mutable_list1(bd,g)
+# define scavenge_capability_mut_lists(cap) scavenge_capability_mut_Lists1(cap)
 #endif
-      }
-      p++;
-      bitmap = bitmap >> 1;
-  }
-}
 
+/* -----------------------------------------------------------------------------
+   Scavenge a TSO.
+   -------------------------------------------------------------------------- */
 
 STATIC_INLINE void
-scavenge_thunk_srt(const StgInfoTable *info)
+scavenge_TSO_link (StgTSO *tso)
 {
-    StgThunkInfoTable *thunk_info;
-
-    if (!major_gc) return;
-
-    thunk_info = itbl_to_thunk_itbl(info);
-    scavenge_srt((StgClosure **)GET_SRT(thunk_info), thunk_info->i.srt_bitmap);
+    // 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) {
+        evacuate((StgClosure **)&tso->_link);
+    }
 }
 
-STATIC_INLINE void
-scavenge_fun_srt(const StgInfoTable *info)
+static void
+scavengeTSO (StgTSO *tso)
 {
-    StgFunInfoTable *fun_info;
+    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;
+    }
 
-    if (!major_gc) return;
-  
-    fun_info = itbl_to_fun_itbl(info);
-    scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap);
-}
+    debugTrace(DEBUG_gc,"scavenging thread %d",(int)tso->id);
 
-/* -----------------------------------------------------------------------------
-   Scavenge a TSO.
-   -------------------------------------------------------------------------- */
+    saved_eager = gct->eager_promotion;
+    gct->eager_promotion = rtsFalse;
 
-static void
-scavengeTSO (StgTSO *tso)
-{
     if (   tso->why_blocked == BlockedOnMVar
        || tso->why_blocked == BlockedOnBlackHole
        || tso->why_blocked == BlockedOnException
@@ -144,18 +81,26 @@ scavengeTSO (StgTSO *tso)
     }
     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) {
-       evacuate((StgClosure **)&tso->link);
-    }
-
     // scavange current transaction record
     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;
+        scavenge_TSO_link(tso);
+    } else {
+        tso->flags &= ~TSO_DIRTY;
+        scavenge_TSO_link(tso);
+        if (gct->failed_to_evac) {
+            tso->flags |= TSO_LINK_DIRTY;
+        } else {
+            tso->flags &= ~TSO_LINK_DIRTY;
+        }
+    }
+
+    gct->eager_promotion = saved_eager;
 }
 
 /* -----------------------------------------------------------------------------
@@ -198,7 +143,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
     return p;
 }
 
-STATIC_INLINE StgPtr
+STATIC_INLINE GNUC_ATTR_HOT StgPtr
 scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
 {
     StgPtr p;
@@ -237,7 +182,7 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
     return p;
 }
 
-STATIC_INLINE StgPtr
+STATIC_INLINE GNUC_ATTR_HOT StgPtr
 scavenge_PAP (StgPAP *pap)
 {
     evacuate(&pap->fun);
@@ -252,6 +197,105 @@ scavenge_AP (StgAP *ap)
 }
 
 /* -----------------------------------------------------------------------------
+   Scavenge SRTs
+   -------------------------------------------------------------------------- */
+
+/* Similar to scavenge_large_bitmap(), but we don't write back the
+ * pointers we get back from evacuate().
+ */
+static void
+scavenge_large_srt_bitmap( StgLargeSRT *large_srt )
+{
+    nat i, b, size;
+    StgWord bitmap;
+    StgClosure **p;
+    
+    b = 0;
+    bitmap = large_srt->l.bitmap[b];
+    size   = (nat)large_srt->l.size;
+    p      = (StgClosure **)large_srt->srt;
+    for (i = 0; i < size; ) {
+       if ((bitmap & 1) != 0) {
+           evacuate(p);
+       }
+       i++;
+       p++;
+       if (i % BITS_IN(W_) == 0) {
+           b++;
+           bitmap = large_srt->l.bitmap[b];
+       } else {
+           bitmap = bitmap >> 1;
+       }
+    }
+}
+
+/* evacuate the SRT.  If srt_bitmap is zero, then there isn't an
+ * srt field in the info table.  That's ok, because we'll
+ * never dereference it.
+ */
+STATIC_INLINE GNUC_ATTR_HOT void
+scavenge_srt (StgClosure **srt, nat srt_bitmap)
+{
+  nat bitmap;
+  StgClosure **p;
+
+  bitmap = srt_bitmap;
+  p = srt;
+
+  if (bitmap == (StgHalfWord)(-1)) {  
+      scavenge_large_srt_bitmap( (StgLargeSRT *)srt );
+      return;
+  }
+
+  while (bitmap != 0) {
+      if ((bitmap & 1) != 0) {
+#if defined(__PIC__) && defined(mingw32_TARGET_OS)
+         // Special-case to handle references to closures hiding out in DLLs, since
+         // double indirections required to get at those. The code generator knows
+         // which is which when generating the SRT, so it stores the (indirect)
+         // reference to the DLL closure in the table by first adding one to it.
+         // We check for this here, and undo the addition before evacuating it.
+         // 
+         // 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)));
+         } else {
+             evacuate(p);
+         }
+#else
+         evacuate(p);
+#endif
+      }
+      p++;
+      bitmap = bitmap >> 1;
+  }
+}
+
+
+STATIC_INLINE GNUC_ATTR_HOT void
+scavenge_thunk_srt(const StgInfoTable *info)
+{
+    StgThunkInfoTable *thunk_info;
+
+    if (!major_gc) return;
+
+    thunk_info = itbl_to_thunk_itbl(info);
+    scavenge_srt((StgClosure **)GET_SRT(thunk_info), thunk_info->i.srt_bitmap);
+}
+
+STATIC_INLINE GNUC_ATTR_HOT void
+scavenge_fun_srt(const StgInfoTable *info)
+{
+    StgFunInfoTable *fun_info;
+
+    if (!major_gc) return;
+  
+    fun_info = itbl_to_fun_itbl(info);
+    scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap);
+}
+
+/* -----------------------------------------------------------------------------
    Scavenge a block from the given scan pointer up to bd->free.
 
    evac_step is set by the caller to be either zero (for a step in a
@@ -263,27 +307,34 @@ scavenge_AP (StgAP *ap)
    idea.  
    -------------------------------------------------------------------------- */
 
-static void
-scavenge_block (bdescr *bd, StgPtr scan)
+static GNUC_ATTR_HOT void
+scavenge_block (bdescr *bd)
 {
   StgPtr p, q;
   StgInfoTable *info;
   step *saved_evac_step;
+  rtsBool saved_eager_promotion;
+  step_workspace *ws;
 
-  p = scan;
-  
   debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p",
-            bd->start, bd->gen_no, bd->step->no, scan);
+            bd->start, bd->gen_no, bd->step->no, bd->u.scan);
 
+  gct->scan_bd = bd;
   gct->evac_step = bd->step;
   saved_evac_step = gct->evac_step;
+  saved_eager_promotion = gct->eager_promotion;
   gct->failed_to_evac = rtsFalse;
 
+  ws = &gct->steps[bd->step->abs_no];
+
+  p = bd->u.scan;
+  
   // we might be evacuating into the very object that we're
   // scavenging, so we have to check the real bd->free pointer each
   // time around the loop.
-  while (p < bd->free) {
+  while (p < bd->free || (bd == ws->todo_bd && p < ws->todo_free)) {
 
+      ASSERT(bd->link == NULL);
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
     info = get_itbl((StgClosure *)p);
     
@@ -295,8 +346,6 @@ scavenge_block (bdescr *bd, StgPtr scan)
     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);
@@ -445,9 +494,7 @@ scavenge_block (bdescr *bd, StgPtr scan)
        break;
 
     case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY: {
-       rtsBool saved_eager_promotion = gct->eager_promotion;
-
+    case MUT_VAR_DIRTY:
        gct->eager_promotion = rtsFalse;
        evacuate(&((StgMutVar *)p)->var);
        gct->eager_promotion = saved_eager_promotion;
@@ -459,11 +506,8 @@ scavenge_block (bdescr *bd, StgPtr scan)
        }
        p += sizeofW(StgMutVar);
        break;
-    }
 
     case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
     case BLACKHOLE:
        p += BLACKHOLE_sizeW();
        break;
@@ -505,19 +549,17 @@ scavenge_block (bdescr *bd, StgPtr scan)
        // 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 = gct->eager_promotion;
        gct->eager_promotion = rtsFalse;
        next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
        for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
            evacuate((StgClosure **)p);
        }
-       gct->eager_promotion = saved_eager;
+       gct->eager_promotion = saved_eager_promotion;
 
        if (gct->failed_to_evac) {
            ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
@@ -553,19 +595,7 @@ scavenge_block (bdescr *bd, StgPtr scan)
     case TSO:
     { 
        StgTSO *tso = (StgTSO *)p;
-       rtsBool saved_eager = gct->eager_promotion;
-
-       gct->eager_promotion = rtsFalse;
-       scavengeTSO(tso);
-       gct->eager_promotion = saved_eager;
-
-       if (gct->failed_to_evac) {
-           tso->flags |= TSO_DIRTY;
-       } else {
-           tso->flags &= ~TSO_DIRTY;
-       }
-
-       gct->failed_to_evac = rtsTrue; // always on the mutable list
+        scavengeTSO(tso);
        p += tso_sizeW(tso);
        break;
     }
@@ -666,14 +696,31 @@ scavenge_block (bdescr *bd, StgPtr scan)
     if (gct->failed_to_evac) {
        gct->failed_to_evac = rtsFalse;
        if (bd->gen_no > 0) {
-           recordMutableGen_GC((StgClosure *)q, &generations[bd->gen_no]);
+           recordMutableGen_GC((StgClosure *)q, bd->gen_no);
        }
     }
   }
 
-  debugTrace(DEBUG_gc, "   scavenged %ld bytes", (bd->free - scan) * sizeof(W_));
-}    
+  if (p > bd->free)  {
+      gct->copied += ws->todo_free - bd->free;
+      bd->free = p;
+  }
+
+  debugTrace(DEBUG_gc, "   scavenged %ld bytes",
+             (unsigned long)((bd->free - bd->u.scan) * sizeof(W_)));
+
+  // update stats: this is a block that has been scavenged
+  gct->scanned += bd->free - bd->u.scan;
+  bd->u.scan = bd->free;
+
+  if (bd != ws->todo_bd) {
+      // we're not going to evac any more objects into
+      // this block, so push it now.
+      push_scanned_block(bd, ws);
+  }
 
+  gct->scan_bd = NULL;
+}
 /* -----------------------------------------------------------------------------
    Scavenge everything on the mark stack.
 
@@ -700,7 +747,7 @@ linear_scan:
        info = get_itbl((StgClosure *)p);
        
        q = p;
-       switch (info->type) {
+        switch (info->type) {
            
         case MVAR_CLEAN:
         case MVAR_DIRTY:
@@ -836,8 +883,6 @@ linear_scan:
        }
 
        case CAF_BLACKHOLE:
-       case SE_CAF_BLACKHOLE:
-       case SE_BLACKHOLE:
        case BLACKHOLE:
        case ARR_WORDS:
            break;
@@ -919,20 +964,7 @@ linear_scan:
 
        case TSO:
        { 
-           StgTSO *tso = (StgTSO *)p;
-           rtsBool saved_eager = gct->eager_promotion;
-
-           gct->eager_promotion = rtsFalse;
-           scavengeTSO(tso);
-           gct->eager_promotion = saved_eager;
-           
-           if (gct->failed_to_evac) {
-               tso->flags |= TSO_DIRTY;
-           } else {
-               tso->flags &= ~TSO_DIRTY;
-           }
-           
-           gct->failed_to_evac = rtsTrue; // always on the mutable list
+            scavengeTSO((StgTSO*)p);
            break;
        }
 
@@ -1019,7 +1051,7 @@ linear_scan:
        if (gct->failed_to_evac) {
            gct->failed_to_evac = rtsFalse;
            if (gct->evac_step) {
-               recordMutableGen_GC((StgClosure *)q, gct->evac_step->gen);
+               recordMutableGen_GC((StgClosure *)q, gct->evac_step->gen_no);
            }
        }
        
@@ -1165,8 +1197,6 @@ scavenge_one(StgPtr p)
     }
 
     case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
     case BLACKHOLE:
        break;
        
@@ -1251,20 +1281,7 @@ scavenge_one(StgPtr p)
 
     case TSO:
     {
-       StgTSO *tso = (StgTSO *)p;
-       rtsBool saved_eager = gct->eager_promotion;
-
-       gct->eager_promotion = rtsFalse;
-       scavengeTSO(tso);
-       gct->eager_promotion = saved_eager;
-
-       if (gct->failed_to_evac) {
-           tso->flags |= TSO_DIRTY;
-       } else {
-           tso->flags &= ~TSO_DIRTY;
-       }
-
-       gct->failed_to_evac = rtsTrue; // always on the mutable list
+       scavengeTSO((StgTSO*)p);
        break;
     }
   
@@ -1346,20 +1363,7 @@ scavenge_one(StgPtr p)
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
     case IND_STATIC:
-    {
-       /* Careful here: a THUNK can be on the mutable list because
-        * it contains pointers to young gen objects.  If such a thunk
-        * is updated, the IND_OLDGEN will be added to the mutable
-        * list again, and we'll scavenge it twice.  evacuate()
-        * doesn't check whether the object has already been
-        * evacuated, so we perform that check here.
-        */
-       StgClosure *q = ((StgInd *)p)->indirectee;
-       if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
-           break;
-       }
        evacuate(&((StgInd *)p)->indirectee);
-    }
 
 #if 0 && defined(DEBUG)
       if (RtsFlags.DebugFlags.gc) 
@@ -1406,13 +1410,10 @@ scavenge_one(StgPtr p)
    -------------------------------------------------------------------------- */
 
 void
-scavenge_mutable_list(generation *gen)
+scavenge_mutable_list(bdescr *bd, generation *gen)
 {
-    bdescr *bd;
     StgPtr p, q;
 
-    bd = gen->saved_mut_list;
-
     gct->evac_step = &gen->steps[0];
     for (; bd != NULL; bd = bd->link) {
        for (q = bd->start; q < bd->free; q++) {
@@ -1443,24 +1444,27 @@ scavenge_mutable_list(generation *gen)
            // definitely doesn't point into a young generation.
            // Clean objects don't need to be scavenged.  Some clean
            // objects (MUT_VAR_CLEAN) are not kept on the mutable
-           // list at all; others, such as MUT_ARR_PTRS_CLEAN and
-           // TSO, are always on the mutable list.
+           // list at all; others, such as MUT_ARR_PTRS_CLEAN
+           // are always on the mutable list.
            //
            switch (get_itbl((StgClosure *)p)->type) {
            case MUT_ARR_PTRS_CLEAN:
-               recordMutableGen_GC((StgClosure *)p,gen);
+               recordMutableGen_GC((StgClosure *)p,gen->no);
                continue;
            case TSO: {
                StgTSO *tso = (StgTSO *)p;
                if ((tso->flags & TSO_DIRTY) == 0) {
-                   // A clean TSO: we don't have to traverse its
-                   // stack.  However, we *do* follow the link field:
-                   // 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) {
-                       evacuate((StgClosure **)&tso->link);
-                   }
-                   recordMutableGen_GC((StgClosure *)p,gen);
+                    // Must be on the mutable list because its link
+                    // field is dirty.
+                    ASSERT(tso->flags & TSO_LINK_DIRTY);
+
+                    scavenge_TSO_link(tso);
+                    if (gct->failed_to_evac) {
+                        recordMutableGen_GC((StgClosure *)p,gen->no);
+                        gct->failed_to_evac = rtsFalse;
+                    } else {
+                        tso->flags &= ~TSO_LINK_DIRTY;
+                    }
                    continue;
                }
            }
@@ -1471,14 +1475,28 @@ scavenge_mutable_list(generation *gen)
            if (scavenge_one(p)) {
                // didn't manage to promote everything, so put the
                // object back on the list.
-               recordMutableGen_GC((StgClosure *)p,gen);
+               recordMutableGen_GC((StgClosure *)p,gen->no);
            }
        }
     }
+}
 
-    // free the old mut_list
-    freeChain(gen->saved_mut_list);
-    gen->saved_mut_list = NULL;
+void
+scavenge_capability_mut_lists (Capability *cap)
+{
+    nat g;
+
+    /* Mutable lists from each generation > N
+     * we want to *scavenge* these roots, not evacuate them: they're not
+     * going to move in this GC.
+     * Also do them in reverse generation order, for the usual reason:
+     * namely to reduce the likelihood of spurious old->new pointers.
+     */
+    for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
+        scavenge_mutable_list(cap->saved_mut_lists[g], &generations[g]);
+        freeChain_sync(cap->saved_mut_lists[g]);
+        cap->saved_mut_lists[g] = NULL;
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -1495,6 +1513,8 @@ scavenge_static(void)
   StgClosure* p;
   const StgInfoTable *info;
 
+  debugTrace(DEBUG_gc, "scavenging static objects");
+
   /* Always evacuate straight to the oldest generation for static
    * objects */
   gct->evac_step = &oldest_gen->steps[0];
@@ -1504,15 +1524,12 @@ scavenge_static(void)
 
   while (1) {
       
-    ACQUIRE_SPIN_LOCK(&static_objects_sync);
-    
     /* 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 = static_objects;
+    p = gct->static_objects;
     if (p == END_OF_STATIC_LIST) {
-         RELEASE_SPIN_LOCK(&static_objects_sync);
          break;
     }
     
@@ -1527,11 +1544,9 @@ scavenge_static(void)
     /* 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;
-    
-    RELEASE_SPIN_LOCK(&static_objects_sync);
+    gct->static_objects = *STATIC_LINK(info,p);
+    *STATIC_LINK(info,p) = gct->scavenged_static_objects;
+    gct->scavenged_static_objects = p;
     
     switch (info -> type) {
       
@@ -1547,7 +1562,7 @@ scavenge_static(void)
         */
        if (gct->failed_to_evac) {
          gct->failed_to_evac = rtsFalse;
-         recordMutableGen_GC((StgClosure *)p,oldest_gen);
+         recordMutableGen_GC((StgClosure *)p,oldest_gen->no);
        }
        break;
       }
@@ -1667,19 +1682,34 @@ 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.
+        //
+        // Note [upd-black-hole]
+        // One slight hiccup is that the THUNK_SELECTOR machinery can
+        // overwrite the updatee with an IND.  In parallel GC, this
+        // could even be happening concurrently, so we can't check for
+        // the IND.  Fortunately if we assume that blackholing is
+        // happening (either lazy or eager), then we can be sure that
+        // the updatee is never a THUNK_SELECTOR and we're ok.
+        // NB. this is a new invariant: blackholing is not optional.
     {
         nat type;
-        type = get_itbl(((StgUpdateFrame *)p)->updatee)->type;
-       if (type == IND) {
-           ((StgUpdateFrame *)p)->updatee->header.info = 
-               (StgInfoTable *)&stg_IND_PERM_info;
-       } else if (type == IND_OLDGEN) {
-           ((StgUpdateFrame *)p)->updatee->header.info = 
-               (StgInfoTable *)&stg_IND_OLDGEN_PERM_info;
-        }            
-       evacuate(&((StgUpdateFrame *)p)->updatee);
-       p += sizeofW(StgUpdateFrame);
-       continue;
+        const StgInfoTable *i;
+        StgClosure *updatee;
+
+        updatee = ((StgUpdateFrame *)p)->updatee;
+        i = updatee->header.info;
+        if (!IS_FORWARDING_PTR(i)) {
+            type = get_itbl(updatee)->type;
+            if (type == IND) {
+                updatee->header.info = &stg_IND_PERM_info;
+            } else if (type == IND_OLDGEN) {
+                updatee->header.info = &stg_IND_OLDGEN_PERM_info;
+            }            
+        }
+        evacuate(&((StgUpdateFrame *)p)->updatee);
+        ASSERT(GET_CLOSURE_TAG(((StgUpdateFrame *)p)->updatee) == 0);
+        p += sizeofW(StgUpdateFrame);
+        continue;
     }
 
       // small bitmap (< 32 entries, or 64 on a 64-bit machine) 
@@ -1786,7 +1816,7 @@ scavenge_large (step_workspace *ws)
     bdescr *bd;
     StgPtr p;
 
-    gct->evac_step = ws->stp;
+    gct->evac_step = ws->step;
 
     bd = ws->todo_large_objects;
     
@@ -1798,124 +1828,116 @@ scavenge_large (step_workspace *ws)
        // the front when evacuating.
        ws->todo_large_objects = bd->link;
        
-       ACQUIRE_SPIN_LOCK(&ws->stp->sync_large_objects);
-       dbl_link_onto(bd, &ws->stp->scavenged_large_objects);
-       ws->stp->n_scavenged_large_blocks += bd->blocks;
-       RELEASE_SPIN_LOCK(&ws->stp->sync_large_objects);
+       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->stp->gen_no > 0) {
-               recordMutableGen_GC((StgClosure *)p, ws->stp->gen);
+           if (ws->step->gen_no > 0) {
+               recordMutableGen_GC((StgClosure *)p, ws->step->gen_no);
            }
        }
+
+        // stats
+        gct->scanned += closure_sizeW((StgClosure*)p);
     }
 }
 
 /* ----------------------------------------------------------------------------
-   Find the oldest full block to scavenge, and scavenge it.
+   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_global_work (void)
+scavenge_find_work (void)
 {
-    bdescr *bd;
-    int g, s;
-    rtsBool flag;
+    int s;
     step_workspace *ws;
+    rtsBool did_something, did_anything;
+    bdescr *bd;
 
-    flag = rtsFalse;
-    for (g = RtsFlags.GcFlags.generations; --g >= 0; ) {
-       for (s = generations[g].n_steps; --s >= 0; ) {
-           if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { 
-               continue; 
-           }
-           ws = &gct->steps[g][s];
-
-           // If we have any large objects to scavenge, do them now.
-           if (ws->todo_large_objects) {
-               scavenge_large(ws);
-               flag = rtsTrue;
-           }
-
-           if ((bd = grab_todo_block(ws)) != NULL) {
-               // no need to assign this to ws->scan_bd, we're going
-               // to scavenge the whole thing and then push it on
-               // our scavd list.  This saves pushing out the
-               // scan_bd block, which might be partial.
-               scavenge_block(bd, bd->start);
-               push_scan_block(bd, ws);
-               return rtsTrue;
-           }
-
-           if (flag) return rtsTrue;
-       }
-    }
-    return rtsFalse;
-}
+    gct->scav_find_work++;
 
-/* ----------------------------------------------------------------------------
-   Look for local work to do.
+    did_anything = rtsFalse;
 
-   We can have outstanding scavenging to do if, for any of the workspaces,
+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)
+        {
+            scavenge_block(ws->todo_bd);
+            did_something = rtsTrue;
+            break;
+        }
 
-     - the scan block is the same as the todo block, and new objects
-       have been evacuated to the todo block.
+        // If we have any large objects to scavenge, do them now.
+        if (ws->todo_large_objects) {
+            scavenge_large(ws);
+            did_something = rtsTrue;
+            break;
+        }
 
-     - the scan block *was* the same as the todo block, but the todo
-       block filled up and a new one has been allocated.
-   ------------------------------------------------------------------------- */
+        if ((bd = grab_local_todo_block(ws)) != NULL) {
+            scavenge_block(bd);
+            did_something = rtsTrue;
+            break;
+        }
+    }
 
-static rtsBool
-scavenge_find_local_work (void)
-{
-    int g, s;
-    step_workspace *ws;
-    rtsBool flag;
+    if (did_something) {
+        did_anything = rtsTrue;
+        goto loop;
+    }
 
-    flag = rtsFalse;
-    for (g = RtsFlags.GcFlags.generations; --g >= 0; ) {
-       for (s = generations[g].n_steps; --s >= 0; ) {
-           if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { 
-               continue; 
-           }
-           ws = &gct->steps[g][s];
-
-           // If we have a todo block and no scan block, start
-           // scanning the todo block.
-           if (ws->scan_bd == NULL && ws->todo_bd != NULL)
-           {
-               ws->scan_bd = ws->todo_bd;
-               ws->scan = ws->scan_bd->start;
-           }
+#if defined(THREADED_RTS)
+    if (work_stealing) {
+        // look for work to steal
+        for (s = total_steps-1; s >= 0; s--) {
+            if (s == 0 && RtsFlags.GcFlags.generations > 1) { 
+                continue; 
+            }
+            if ((bd = steal_todo_block(s)) != NULL) {
+                scavenge_block(bd);
+                did_something = rtsTrue;
+                break;
+            }
+        }
 
-           // If we have a scan block with some work to do,
-           // scavenge everything up to the free pointer.
-           if (ws->scan != NULL && ws->scan < ws->scan_bd->free)
-           {
-               scavenge_block(ws->scan_bd, ws->scan);
-               ws->scan = ws->scan_bd->free;
-               flag = rtsTrue;
-           }
+        if (did_something) {
+            did_anything = rtsTrue;
+            goto loop;
+        }
+    }
+#endif
 
-           if (ws->scan_bd != NULL && ws->scan == ws->scan_bd->free
-               && ws->scan_bd != ws->todo_bd)
-           {
-               // we're not going to evac any more objects into
-               // this block, so push it now.
-               push_scan_block(ws->scan_bd, ws);
-               ws->scan_bd = NULL;
-               ws->scan = NULL;
-                // we might be able to scan the todo block now.  But
-                // don't do it right away: there might be full blocks
-               // waiting to be scanned as a result of scavenge_block above.
-               flag = rtsTrue; 
-           }
+    // only return when there is no more work to do
 
-           if (flag) return rtsTrue;
-       }
-    }
-    return rtsFalse;
+    return did_anything;
 }
 
 /* ----------------------------------------------------------------------------
@@ -1931,8 +1953,8 @@ loop:
     work_to_do = rtsFalse;
 
     // scavenge static objects 
-    if (major_gc && static_objects != END_OF_STATIC_LIST) {
-       IF_DEBUG(sanity, checkStaticObjects(static_objects));
+    if (major_gc && gct->static_objects != END_OF_STATIC_LIST) {
+       IF_DEBUG(sanity, checkStaticObjects(gct->static_objects));
        scavenge_static();
     }
     
@@ -1948,44 +1970,8 @@ loop:
     // 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_global_work()) goto loop;
-    if (scavenge_find_local_work())  goto loop;
+    if (scavenge_find_work()) goto loop;
     
     if (work_to_do) goto loop;
 }
 
-rtsBool
-any_work (void)
-{
-    int g, s;
-    step_workspace *ws;
-
-    write_barrier();
-
-    // scavenge static objects 
-    if (major_gc && static_objects != END_OF_STATIC_LIST) {
-       return rtsTrue;
-    }
-    
-    // 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 (g = RtsFlags.GcFlags.generations; --g >= 0; ) {
-       for (s = generations[g].n_steps; --s >= 0; ) {
-           if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { 
-               continue; 
-           }
-           ws = &gct->steps[g][s];
-           if (ws->todo_large_objects) return rtsTrue;
-           if (ws->stp->todos) return rtsTrue;
-       }
-    }
-
-    return rtsFalse;
-}