From f9ce05ef56187d981b5d1af51e3f53fc6f202d5b Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Tue, 25 May 2010 15:04:35 +0000
Subject: [PATCH] Make sparks into weak pointers (#2185) The new strategies
 library (parallel-2.0+, preferably 2.2+) is now required
 for parallel programming, otherwise parallelism will be
 lost.

---
 rts/Capability.c |    6 ++----
 rts/Capability.h |    2 +-
 rts/Sparks.c     |   12 ++++++++----
 rts/Sparks.h     |    2 +-
 rts/sm/GC.c      |   20 ++++++++++++++++++++
 5 files changed, 32 insertions(+), 10 deletions(-)

diff --git a/rts/Capability.c b/rts/Capability.c
index f5e77a9..2fcd72c 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -819,7 +819,7 @@ freeCapabilities (void)
 
 void
 markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta, 
-                      rtsBool prune_sparks USED_IF_THREADS)
+                      rtsBool no_mark_sparks USED_IF_THREADS)
 {
     nat i;
     Capability *cap;
@@ -843,9 +843,7 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta,
 	}
 
 #if defined(THREADED_RTS)
-        if (prune_sparks) {
-            pruneSparkQueue (evac, user, cap);
-        } else {
+        if (!no_mark_sparks) {
             traverseSparkQueue (evac, user, cap);
         }
 #endif
diff --git a/rts/Capability.h b/rts/Capability.h
index 4b85a13..59da4a8 100644
--- a/rts/Capability.h
+++ b/rts/Capability.h
@@ -276,7 +276,7 @@ void freeCapabilities (void);
 
 // For the GC:
 void markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta, 
-                           rtsBool prune_sparks);
+                           rtsBool no_mark_sparks);
 void markCapabilities (evac_fn evac, void *user);
 void traverseSparkQueues (evac_fn evac, void *user);
 
diff --git a/rts/Sparks.c b/rts/Sparks.c
index 3911ae9..93f6417 100644
--- a/rts/Sparks.c
+++ b/rts/Sparks.c
@@ -112,7 +112,7 @@ tryStealSpark (Capability *cap)
  * -------------------------------------------------------------------------- */
 
 void
-pruneSparkQueue (evac_fn evac, void *user, Capability *cap)
+pruneSparkQueue (Capability *cap)
 { 
     SparkPool *pool;
     StgClosurePtr spark, tmp, *elements;
@@ -208,17 +208,21 @@ pruneSparkQueue (evac_fn evac, void *user, Capability *cap)
               pruned_sparks++; // discard spark
               cap->sparks_pruned++;
           }
-      } else {
-          if (!(closure_flags[INFO_PTR_TO_STRUCT(info)->type] & _NS)) {
+      } else if (HEAP_ALLOCED(spark) && 
+                 (Bdescr(spark)->flags & BF_EVACUATED)) {
+          if (closure_SHOULD_SPARK(spark)) {
               elements[botInd] = spark; // keep entry (new address)
-              evac (user, &elements[botInd]);
               botInd++;
               n++;
           } else {
               pruned_sparks++; // discard spark
               cap->sparks_pruned++;
           }
+      } else {
+          pruned_sparks++; // discard spark
+          cap->sparks_pruned++;
       }
+
       currInd++;
 
       // in the loop, we may reach the bounds, and instantly wrap around
diff --git a/rts/Sparks.h b/rts/Sparks.h
index 33aa818..71fac6c 100644
--- a/rts/Sparks.h
+++ b/rts/Sparks.h
@@ -34,7 +34,7 @@ StgClosure * tryStealSpark     (Capability *cap);
 void         freeSparkPool     (SparkPool *pool);
 void         createSparkThread (Capability *cap);
 void         traverseSparkQueue(evac_fn evac, void *user, Capability *cap);
-void         pruneSparkQueue   (evac_fn evac, void *user, Capability *cap);
+void         pruneSparkQueue   (Capability *cap);
 
 INLINE_HEADER void discardSparks  (SparkPool *pool);
 INLINE_HEADER long sparkPoolSize  (SparkPool *pool);
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 4d63724..e7166a2 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -411,6 +411,16 @@ SET_GCT(gc_threads[0]);
   // Now see which stable names are still alive.
   gcStablePtrTable();
 
+#ifdef THREADED_RTS
+  if (n_gc_threads == 1) {
+      for (n = 0; n < n_capabilities; n++) {
+          pruneSparkQueue(&capabilities[n]);
+      }
+  } else {
+      pruneSparkQueue(&capabilities[gct->thread_index]);
+  }
+#endif
+
 #ifdef PROFILING
   // We call processHeapClosureForDead() on every closure destroyed during
   // the current garbage collection, so we invoke LdvCensusForDead().
@@ -1072,6 +1082,16 @@ gcWorkerThread (Capability *cap)
 
     scavenge_until_all_done();
     
+#ifdef THREADED_RTS
+    // Now that the whole heap is marked, we discard any sparks that
+    // were found to be unreachable.  The main GC thread is currently
+    // marking heap reachable via weak pointers, so it is
+    // non-deterministic whether a spark will be retained if it is
+    // only reachable via weak pointers.  To fix this problem would
+    // require another GC barrier, which is too high a price.
+    pruneSparkQueue(cap);
+#endif
+
 #ifdef USE_PAPI
     // count events in this thread towards the GC totals
     papi_thread_stop_gc1_count(gct->papi_events);
-- 
1.7.10.4