Reorganisation to fix problems related to the gct register variable

[ghc-hetmet.git] / rts / Sparks.c

diff --git a/rts/Sparks.c b/rts/Sparks.c
index 2ebe5f6..0f429e2 100644 (file)
--- a/rts/Sparks.c
+++ b/rts/Sparks.c
@@ -102,13 +102,74 @@ findSpark (Capability *cap)
 }
 
 /* -----------------------------------------------------------------------------
+ * 
+ * Turn a spark into a real thread
+ *
+ * -------------------------------------------------------------------------- */
+
+void
+createSparkThread (Capability *cap, StgClosure *p)
+{
+    StgTSO *tso;
+
+    tso = createGenThread (cap, RtsFlags.GcFlags.initialStkSize, p);
+    appendToRunQueue(cap,tso);
+}
+
+/* -----------------------------------------------------------------------------
+ * 
+ * Create a new spark
+ *
+ * -------------------------------------------------------------------------- */
+
+#define DISCARD_NEW
+
+StgInt
+newSpark (StgRegTable *reg, StgClosure *p)
+{
+    StgSparkPool *pool = &(reg->rSparks);
+
+    /* I am not sure whether this is the right thing to do.
+     * Maybe it is better to exploit the tag information
+     * instead of throwing it away?
+     */
+    p = UNTAG_CLOSURE(p);
+
+    ASSERT_SPARK_POOL_INVARIANTS(pool);
+
+    if (closure_SHOULD_SPARK(p)) {
+#ifdef DISCARD_NEW
+       StgClosure **new_tl;
+       new_tl = pool->tl + 1;
+       if (new_tl == pool->lim) { new_tl = pool->base; }
+       if (new_tl != pool->hd) {
+           *pool->tl = p;
+           pool->tl = new_tl;
+       } else if (!closure_SHOULD_SPARK(*pool->hd)) {
+           // if the old closure is not sparkable, discard it and
+           // keep the new one.  Otherwise, keep the old one.
+           *pool->tl = p;
+           bump_hd(pool);
+       }
+#else  /* DISCARD OLD */
+       *pool->tl = p;
+       bump_tl(pool);
+       if (pool->tl == pool->hd) { bump_hd(pool); }
+#endif
+    }  
+
+    ASSERT_SPARK_POOL_INVARIANTS(pool);
+    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 
  * -------------------------------------------------------------------------- */
 
 void
-markSparkQueue (evac_fn evac, Capability *cap)
+markSparkQueue (evac_fn evac, void *user, Capability *cap)
 { 
     StgClosure **sparkp, **to_sparkp;
     nat n, pruned_sparks; // stats only
@@ -136,7 +197,7 @@ markSparkQueue (evac_fn evac, Capability *cap)
         ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgClosure *)*sparkp)));
         // ToDo?: statistics gathering here (also for GUM!)
         if (closure_SHOULD_SPARK(*sparkp)) {
-            evac(sparkp);
+            evac(user, sparkp);
             *to_sparkp++ = *sparkp;
             if (to_sparkp == pool->lim) {
                 to_sparkp = pool->base;
@@ -169,67 +230,6 @@ markSparkQueue (evac_fn evac, Capability *cap)
                sparkPoolSize(pool), pool->hd, pool->tl);
 }
 
-/* -----------------------------------------------------------------------------
- * 
- * Turn a spark into a real thread
- *
- * -------------------------------------------------------------------------- */
-
-void
-createSparkThread (Capability *cap, StgClosure *p)
-{
-    StgTSO *tso;
-
-    tso = createGenThread (cap, RtsFlags.GcFlags.initialStkSize, p);
-    appendToRunQueue(cap,tso);
-}
-
-/* -----------------------------------------------------------------------------
- * 
- * Create a new spark
- *
- * -------------------------------------------------------------------------- */
-
-#define DISCARD_NEW
-
-StgInt
-newSpark (StgRegTable *reg, StgClosure *p)
-{
-    StgSparkPool *pool = &(reg->rSparks);
-
-    /* I am not sure whether this is the right thing to do.
-     * Maybe it is better to exploit the tag information
-     * instead of throwing it away?
-     */
-    p = UNTAG_CLOSURE(p);
-
-    ASSERT_SPARK_POOL_INVARIANTS(pool);
-
-    if (closure_SHOULD_SPARK(p)) {
-#ifdef DISCARD_NEW
-       StgClosure **new_tl;
-       new_tl = pool->tl + 1;
-       if (new_tl == pool->lim) { new_tl = pool->base; }
-       if (new_tl != pool->hd) {
-           *pool->tl = p;
-           pool->tl = new_tl;
-       } else if (!closure_SHOULD_SPARK(*pool->hd)) {
-           // if the old closure is not sparkable, discard it and
-           // keep the new one.  Otherwise, keep the old one.
-           *pool->tl = p;
-           bump_hd(pool);
-       }
-#else  /* DISCARD OLD */
-       *pool->tl = p;
-       bump_tl(pool);
-       if (pool->tl == pool->hd) { bump_hd(pool); }
-#endif
-    }  
-
-    ASSERT_SPARK_POOL_INVARIANTS(pool);
-    return 1;
-}
-
 #else
 
 StgInt
@@ -239,6 +239,7 @@ newSpark (StgRegTable *reg STG_UNUSED, StgClosure *p STG_UNUSED)
     return 1;
 }
 
+
 #endif /* PARALLEL_HASKELL || THREADED_RTS */