Don't look at all the threads before each GC.
[ghc-hetmet.git] / rts / sm / Scav.c
index 0eb4b11..b969de3 100644 (file)
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team 1998-2006
+ * (c) The GHC Team 1998-2008
  *
  * Generational garbage collector: scavenging functions
  *
@@ -16,6 +16,7 @@
 #include "Storage.h"
 #include "MBlock.h"
 #include "GC.h"
+#include "GCThread.h"
 #include "GCUtils.h"
 #include "Compact.h"
 #include "Evac.h"
@@ -131,6 +132,17 @@ scavenge_fun_srt(const StgInfoTable *info)
    Scavenge a TSO.
    -------------------------------------------------------------------------- */
 
+STATIC_INLINE void
+scavenge_TSO_link (StgTSO *tso)
+{
+    // 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 void
 scavengeTSO (StgTSO *tso)
 {
@@ -155,13 +167,6 @@ 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);
     
@@ -170,8 +175,15 @@ scavengeTSO (StgTSO *tso)
 
     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;
@@ -516,7 +528,6 @@ linear_scan:
        case TSO:
        { 
             scavengeTSO((StgTSO*)p);
-           gct->failed_to_evac = rtsTrue; // always on the mutable list
            break;
        }
 
@@ -836,7 +847,6 @@ scavenge_one(StgPtr p)
     case TSO:
     {
        scavengeTSO((StgTSO*)p);
-       gct->failed_to_evac = rtsTrue; // always on the mutable list
        break;
     }
   
@@ -1025,14 +1035,17 @@ scavenge_mutable_list(generation *gen)
            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);
+                        gct->failed_to_evac = rtsFalse;
+                    } else {
+                        tso->flags &= ~TSO_LINK_DIRTY;
+                    }
                    continue;
                }
            }
@@ -1432,44 +1445,20 @@ loop:
         }
         ws = &gct->steps[s];
         
-        if (ws->todo_bd != NULL)
-        {
-            bd = ws->todo_bd;
-            gct->copied += ws->todo_free - bd->free;
-            bd->free = ws->todo_free;
-        }
+        gct->scan_bd = NULL;
 
-        // 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;
-        }
-        
         // If we have a scan block with some work to do,
         // scavenge everything up to the free pointer.
-        if (ws->scan_bd != NULL && ws->scan_bd->u.scan < ws->scan_bd->free)
+        if (ws->todo_bd->u.scan < ws->todo_free)
         {
             if (n_gc_threads == 1) {
-                scavenge_block1(ws->scan_bd);
+                scavenge_block1(ws->todo_bd);
             } else {
-                scavenge_block(ws->scan_bd);
+                scavenge_block(ws->todo_bd);
             }
             did_something = rtsTrue;
+            break;
         }
-        
-        if (ws->scan_bd != NULL && ws->scan_bd != ws->todo_bd)
-        {
-            ASSERT(ws->scan_bd->u.scan == ws->scan_bd->free);
-            // we're not going to evac any more objects into
-            // this block, so push it now.
-            push_scanned_block(ws->scan_bd, ws);
-            ws->scan_bd = NULL;
-            // we might be able to scan the todo block now.
-            did_something = rtsTrue; 
-        }
-
-        if (did_something) break;
 
         // If we have any large objects to scavenge, do them now.
         if (ws->todo_large_objects) {
@@ -1479,16 +1468,11 @@ loop:
         }
 
         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.
             if (n_gc_threads == 1) {
                 scavenge_block1(bd);
             } else {
                 scavenge_block(bd);
             }
-            push_scanned_block(bd, ws);
             did_something = rtsTrue;
             break;
         }