Separate pruning from marking of spark pools

Fixes crash when using compacting GC in parallel programs

4 files changed, 19 insertions, 11 deletions

diff --git a/rts/Sparks.c b/rts/Sparks.c
index 1a839ab315..2e9e61ca62 100644
--- a/rts/Sparks.c
+++ b/rts/Sparks.c
@@ -168,8 +168,8 @@ newSpark (StgRegTable *reg, StgClosure *p)
  * spark pool and the spark pool only contains sparkable closures 
  * -------------------------------------------------------------------------- */
 
-void
-markSparkQueue (evac_fn evac, void *user, Capability *cap)
+static void
+pruneSparkQueue (Capability *cap)
 { 
     StgClosure *spark, **sparkp, **to_sparkp;
     nat n, pruned_sparks; // stats only
@@ -190,7 +190,6 @@ markSparkQueue (evac_fn evac, void *user, Capability *cap)
         ASSERT(*sparkp!=NULL);
         ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgClosure *)*sparkp)));
         // ToDo?: statistics gathering here (also for GUM!)
-        evac(user,sparkp);
         spark = *sparkp;
         if (!closure_SHOULD_SPARK(spark)) {
             pruned_sparks++;
@@ -210,9 +209,7 @@ markSparkQueue (evac_fn evac, void *user, Capability *cap)
 	
     PAR_TICKY_MARK_SPARK_QUEUE_END(n);
 	
-    debugTrace(DEBUG_sched, 
-               "marked %d sparks, pruned %d sparks",
-               n, pruned_sparks);
+    debugTrace(DEBUG_sched, "pruned %d sparks", pruned_sparks);
     
     debugTrace(DEBUG_sched,
                "new spark queue len=%d; (hd=%p; tl=%p)",
@@ -220,6 +217,15 @@ markSparkQueue (evac_fn evac, void *user, Capability *cap)
 }
 
 void
+pruneSparkQueues (void)
+{
+    nat i;
+    for (i = 0; i < n_capabilities; i++) {
+        pruneSparkQueue(&capabilities[i]);
+    }
+}
+
+void
 traverseSparkQueue (evac_fn evac, void *user, Capability *cap)
 {
     StgClosure **sparkp;
@@ -228,7 +234,7 @@ traverseSparkQueue (evac_fn evac, void *user, Capability *cap)
     pool = &(cap->r.rSparks);
     sparkp = pool->hd;
     while (sparkp != pool->tl) {
-        evac(sparkp, user);
+        evac(user, sparkp);
         sparkp++;
         if (sparkp == pool->lim) {
             sparkp = pool->base;
diff --git a/rts/Sparks.h b/rts/Sparks.h
index 1b9784668e..8e0ba90f3d 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         markSparkQueue    (evac_fn evac, void *user, Capability *cap);
+void         pruneSparkQueues  (void);
 void         traverseSparkQueue(evac_fn evac, void *user, Capability *cap);
 
 INLINE_HEADER void     discardSparks  (StgSparkPool *pool);
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index 7f3bb29580..b43c0ea532 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -966,9 +966,6 @@ compact(StgClosure *static_objects)
     // 1. thread the roots
     markCapabilities((evac_fn)thread_root, NULL);
 
-    // spark queues
-    traverseSparkQueues((evac_fn)thread_root, NULL);
-
     // the weak pointer lists...
     if (weak_ptr_list != NULL) {
 	thread((void *)&weak_ptr_list);
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index ef0c79a6ea..84a15fbaf7 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -724,6 +724,11 @@ GarbageCollect ( rtsBool force_major_gc )
   // Update the stable pointer hash table.
   updateStablePtrTable(major_gc);
 
+  // Remove useless sparks from the spark pools
+#ifdef THREADED_RTS
+  pruneSparkQueues();
+#endif
+
   // check sanity after GC 
   IF_DEBUG(sanity, checkSanity());