Add erf, erfc, erfff, erfcf (#3536)
[ghc-hetmet.git] / rts / sm / Scav.c
index 732ad15..4c75ed2 100644 (file)
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #include "Rts.h"
-#include "RtsFlags.h"
+
 #include "Storage.h"
-#include "MBlock.h"
 #include "GC.h"
 #include "GCThread.h"
 #include "GCUtils.h"
@@ -23,9 +23,9 @@
 #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 +89,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 +335,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);
     
@@ -1360,23 +1361,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(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
-           break;
-       }
        evacuate(&((StgInd *)p)->indirectee);
-    }
 
 #if 0 && defined(DEBUG)
       if (RtsFlags.DebugFlags.gc) 
@@ -1466,7 +1458,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 +1907,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 +1918,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;