Undo fix for #2185: sparks really should be treated as roots

Unless sparks are roots, strategies don't work at all: all the sparks
get GC'd.  We need to think about this some more.

5 files changed, 13 insertions, 26 deletions

diff --git a/rts/Capability.c b/rts/Capability.c
index fa7f63069f..444532480d 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -791,8 +791,12 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta)
 		       "evac'ing suspended TSO %lu", (unsigned long)task->suspended_tso->id);
 	    evac(user, (StgClosure **)(void *)&task->suspended_tso);
 	}
+
+#if defined(THREADED_RTS)
+        markSparkQueue (evac, user, cap);
+#endif
     }
-    
+
 #if !defined(THREADED_RTS)
     evac(user, (StgClosure **)(void *)&blocked_queue_hd);
     evac(user, (StgClosure **)(void *)&blocked_queue_tl);
@@ -800,20 +804,6 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta)
 #endif 
 }
 
-// Sparks are not roots for GC, so we don't mark them in
-// markSomeCapabilities().  Instead, we traverse the spark queues
-// after GC and throw away any that are unreachable.
-void
-updateCapabilitiesPostGC (void)
-{
-#if defined(THREADED_RTS)
-    nat i;
-    for (i = 0; i < n_capabilities; i++) {
-        updateSparkQueue (&capabilities[i]);
-    }
-#endif // THREADED_RTS
-}
-
 // This function is used by the compacting GC to thread all the
 // pointers from spark queues.
 void
diff --git a/rts/Capability.h b/rts/Capability.h
index f8fb7beceb..959ab50b3e 100644
--- a/rts/Capability.h
+++ b/rts/Capability.h
@@ -238,7 +238,6 @@ void freeCapability (Capability *cap);
 // FOr the GC:
 void markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta);
 void markCapabilities (evac_fn evac, void *user);
-void updateCapabilitiesPostGC (void);
 void traverseSparkQueues (evac_fn evac, void *user);
 
 /* -----------------------------------------------------------------------------
diff --git a/rts/Sparks.c b/rts/Sparks.c
index 49f319c28b..1a839ab315 100644
--- a/rts/Sparks.c
+++ b/rts/Sparks.c
@@ -169,7 +169,7 @@ newSpark (StgRegTable *reg, StgClosure *p)
  * -------------------------------------------------------------------------- */
 
 void
-updateSparkQueue (Capability *cap)
+markSparkQueue (evac_fn evac, void *user, Capability *cap)
 { 
     StgClosure *spark, **sparkp, **to_sparkp;
     nat n, pruned_sparks; // stats only
@@ -190,15 +190,16 @@ updateSparkQueue (Capability *cap)
         ASSERT(*sparkp!=NULL);
         ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgClosure *)*sparkp)));
         // ToDo?: statistics gathering here (also for GUM!)
-        spark = isAlive(*sparkp);
-        if (spark != NULL && closure_SHOULD_SPARK(spark)) {
+        evac(user,sparkp);
+        spark = *sparkp;
+        if (!closure_SHOULD_SPARK(spark)) {
+            pruned_sparks++;
+        } else{
             *to_sparkp++ = spark;
             if (to_sparkp == pool->lim) {
                 to_sparkp = pool->base;
             }
             n++;
-        } else {
-            pruned_sparks++;
         }
         sparkp++;
         if (sparkp == pool->lim) {
@@ -210,7 +211,7 @@ updateSparkQueue (Capability *cap)
     PAR_TICKY_MARK_SPARK_QUEUE_END(n);
 	
     debugTrace(DEBUG_sched, 
-               "updated %d sparks and pruned %d sparks",
+               "marked %d sparks, pruned %d sparks",
                n, pruned_sparks);
     
     debugTrace(DEBUG_sched,
diff --git a/rts/Sparks.h b/rts/Sparks.h
index bf10a59d57..1b9784668e 100644
--- a/rts/Sparks.h
+++ b/rts/Sparks.h
@@ -14,7 +14,7 @@ StgClosure * findSpark         (Capability *cap);
 void         initSparkPools    (void);
 void         freeSparkPool     (StgSparkPool *pool);
 void         createSparkThread (Capability *cap, StgClosure *p);
-void         updateSparkQueue  (Capability *cap);
+void         markSparkQueue    (evac_fn evac, void *user, Capability *cap);
 void         traverseSparkQueue(evac_fn evac, void *user, Capability *cap);
 
 INLINE_HEADER void     discardSparks  (StgSparkPool *pool);
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index e0792d970d..c254fcb54f 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -381,9 +381,6 @@ GarbageCollect ( rtsBool force_major_gc )
   // Update pointers from the Task list
   update_task_list();
 
-  // Update pointers from capabilities (probably just the spark queues)
-  updateCapabilitiesPostGC();
-
   // Now see which stable names are still alive.
   gcStablePtrTable();