Wrap gcc on Windows, to provide the -B flags

[ghc-hetmet.git] / rts / sm / Scav.c

diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 34096d4..5e38777 100644 (file)
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -11,21 +11,22 @@
  *
  * ---------------------------------------------------------------------------*/
 
+#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 "MarkStack.h"
 #include "Evac.h"
 #include "Scav.h"
 #include "Apply.h"
 #include "Trace.h"
-#include "LdvProfile.h"
 #include "Sanity.h"
 #include "Capability.h"
+#include "LdvProfile.h"
 
 static void scavenge_stack (StgPtr p, StgPtr stack_end);
 
@@ -89,10 +90,10 @@ scavengeTSO (StgTSO *tso)
     scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
 
     if (gct->failed_to_evac) {
-        tso->flags |= TSO_DIRTY;
+        tso->dirty = 1;
         scavenge_TSO_link(tso);
     } else {
-        tso->flags &= ~TSO_DIRTY;
+        tso->dirty = 0;
         scavenge_TSO_link(tso);
         if (gct->failed_to_evac) {
             tso->flags |= TSO_LINK_DIRTY;
@@ -335,6 +336,7 @@ scavenge_block (bdescr *bd)
   // time around the loop.
   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);
     
@@ -739,9 +741,7 @@ scavenge_mark_stack(void)
     gct->evac_step = &oldest_gen->steps[0];
     saved_evac_step = gct->evac_step;
 
-linear_scan:
-    while (!mark_stack_empty()) {
-       p = pop_mark_stack();
+    while ((p = pop_mark_stack())) {
 
        ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
        info = get_itbl((StgClosure *)p);
@@ -1054,49 +1054,7 @@ linear_scan:
                recordMutableGen_GC((StgClosure *)q, gct->evac_step->gen_no);
            }
        }
-       
-       // mark the next bit to indicate "scavenged"
-       mark(q+1, Bdescr(q));
-
-    } // while (!mark_stack_empty())
-
-    // start a new linear scan if the mark stack overflowed at some point
-    if (mark_stack_overflowed && oldgen_scan_bd == NULL) {
-       debugTrace(DEBUG_gc, "scavenge_mark_stack: starting linear scan");
-       mark_stack_overflowed = rtsFalse;
-       oldgen_scan_bd = oldest_gen->steps[0].old_blocks;
-       oldgen_scan = oldgen_scan_bd->start;
-    }
-
-    if (oldgen_scan_bd) {
-       // push a new thing on the mark stack
-    loop:
-       // find a closure that is marked but not scavenged, and start
-       // from there.
-       while (oldgen_scan < oldgen_scan_bd->free 
-              && !is_marked(oldgen_scan,oldgen_scan_bd)) {
-           oldgen_scan++;
-       }
-
-       if (oldgen_scan < oldgen_scan_bd->free) {
-
-           // already scavenged?
-           if (is_marked(oldgen_scan+1,oldgen_scan_bd)) {
-               oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE;
-               goto loop;
-           }
-           push_mark_stack(oldgen_scan);
-           // ToDo: bump the linear scan by the actual size of the object
-           oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE;
-           goto linear_scan;
-       }
-
-       oldgen_scan_bd = oldgen_scan_bd->link;
-       if (oldgen_scan_bd != NULL) {
-           oldgen_scan = oldgen_scan_bd->start;
-           goto loop;
-       }
-    }
+    } // while (p = pop_mark_stack())
 }
 
 /* -----------------------------------------------------------------------------
@@ -1360,23 +1318,14 @@ scavenge_one(StgPtr p)
       break;
     }
 
+    case IND:
+        // IND can happen, for example, when the interpreter allocates
+        // a gigantic AP closure (more than one block), which ends up
+        // on the large-object list and then gets updated.  See #3424.
     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_GC(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
-           break;
-       }
        evacuate(&((StgInd *)p)->indirectee);
-    }
 
 #if 0 && defined(DEBUG)
       if (RtsFlags.DebugFlags.gc) 
@@ -1466,7 +1415,7 @@ scavenge_mutable_list(bdescr *bd, generation *gen)
                continue;
            case TSO: {
                StgTSO *tso = (StgTSO *)p;
-               if ((tso->flags & TSO_DIRTY) == 0) {
+               if (tso->dirty == 0) {
                     // Must be on the mutable list because its link
                     // field is dirty.
                     ASSERT(tso->flags & TSO_LINK_DIRTY);
@@ -1915,7 +1864,7 @@ loop:
             break;
         }
 
-        if ((bd = grab_todo_block(ws)) != NULL) {
+        if ((bd = grab_local_todo_block(ws)) != NULL) {
             scavenge_block(bd);
             did_something = rtsTrue;
             break;
@@ -1926,6 +1875,28 @@ loop:
         did_anything = rtsTrue;
         goto loop;
     }
+
+#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 (did_something) {
+            did_anything = rtsTrue;
+            goto loop;
+        }
+    }
+#endif
+
     // only return when there is no more work to do
 
     return did_anything;
@@ -1950,8 +1921,7 @@ loop:
     }
     
     // scavenge objects in compacted generation
-    if (mark_stack_overflowed || oldgen_scan_bd != NULL ||
-       (mark_stack_bdescr != NULL && !mark_stack_empty())) {
+    if (mark_stack_bd != NULL && !mark_stack_empty()) {
        scavenge_mark_stack();
        work_to_do = rtsTrue;
     }