X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSparks.c;h=2e9e61ca622c2a11a7d01cb4049319ce52815afb;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hp=9a843fab417fcf5cd29b90533c59e694dfd57880;hpb=d07d5ed880e6f4529c2331a5d5a963505d884dd9;p=ghc-hetmet.git

diff --git a/rts/Sparks.c b/rts/Sparks.c
index 9a843fa..2e9e61c 100644
--- a/rts/Sparks.c
+++ b/rts/Sparks.c
@@ -162,6 +162,86 @@ newSpark (StgRegTable *reg, StgClosure *p)
     return 1;
 }
 
+/* -----------------------------------------------------------------------------
+ * Mark all nodes pointed to by sparks in the spark queues (for GC) Does an
+ * implicit slide i.e. after marking all sparks are at the beginning of the
+ * spark pool and the spark pool only contains sparkable closures 
+ * -------------------------------------------------------------------------- */
+
+static void
+pruneSparkQueue (Capability *cap)
+{ 
+    StgClosure *spark, **sparkp, **to_sparkp;
+    nat n, pruned_sparks; // stats only
+    StgSparkPool *pool;
+    
+    PAR_TICKY_MARK_SPARK_QUEUE_START();
+    
+    n = 0;
+    pruned_sparks = 0;
+    
+    pool = &(cap->r.rSparks);
+    
+    ASSERT_SPARK_POOL_INVARIANTS(pool);
+    
+    sparkp = pool->hd;
+    to_sparkp = pool->hd;
+    while (sparkp != pool->tl) {
+        ASSERT(*sparkp!=NULL);
+        ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgClosure *)*sparkp)));
+        // ToDo?: statistics gathering here (also for GUM!)
+        spark = *sparkp;
+        if (!closure_SHOULD_SPARK(spark)) {
+            pruned_sparks++;
+        } else{
+            *to_sparkp++ = spark;
+            if (to_sparkp == pool->lim) {
+                to_sparkp = pool->base;
+            }
+            n++;
+        }
+        sparkp++;
+        if (sparkp == pool->lim) {
+            sparkp = pool->base;
+        }
+    }
+    pool->tl = to_sparkp;
+	
+    PAR_TICKY_MARK_SPARK_QUEUE_END(n);
+	
+    debugTrace(DEBUG_sched, "pruned %d sparks", pruned_sparks);
+    
+    debugTrace(DEBUG_sched,
+               "new spark queue len=%d; (hd=%p; tl=%p)",
+               sparkPoolSize(pool), pool->hd, pool->tl);
+}
+
+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;
+    StgSparkPool *pool;
+    
+    pool = &(cap->r.rSparks);
+    sparkp = pool->hd;
+    while (sparkp != pool->tl) {
+        evac(user, sparkp);
+        sparkp++;
+        if (sparkp == pool->lim) {
+            sparkp = pool->base;
+        }
+    }
+}
+
 #else
 
 StgInt
@@ -171,6 +251,7 @@ newSpark (StgRegTable *reg STG_UNUSED, StgClosure *p STG_UNUSED)
     return 1;
 }
 
+
 #endif /* PARALLEL_HASKELL || THREADED_RTS */