#include "PosixSource.h"
#include "Rts.h"
+#include "Storage.h"
#include "Schedule.h"
#include "SchedAPI.h"
-#include "Storage.h"
#include "RtsFlags.h"
#include "RtsUtils.h"
#include "ParTicky.h"
# include "GranSimRts.h"
# endif
#include "Sparks.h"
+#include "Trace.h"
#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL)
#endif
}
+void
+freeSparkPool(StgSparkPool *pool) {
+ stgFree(pool->base);
+}
+
/* -----------------------------------------------------------------------------
*
* findSpark: find a spark on the current Capability that we can fork
}
/* -----------------------------------------------------------------------------
- * 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)
-{
- StgClosure **sparkp, **to_sparkp;
- nat i, n, pruned_sparks; // stats only
- StgSparkPool *pool;
- Capability *cap;
-
- PAR_TICKY_MARK_SPARK_QUEUE_START();
-
- n = 0;
- pruned_sparks = 0;
- for (i = 0; i < n_capabilities; i++) {
- cap = &capabilities[i];
- pool = &(cap->r.rSparks);
-
- ASSERT_SPARK_POOL_INVARIANTS(pool);
-
-#if defined(PARALLEL_HASKELL)
- // stats only
- n = 0;
- pruned_sparks = 0;
-#endif
-
- sparkp = pool->hd;
- to_sparkp = pool->hd;
- while (sparkp != pool->tl) {
- ASSERT(to_sparkp<=sparkp);
- ASSERT(*sparkp!=NULL);
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgClosure *)*sparkp)));
- // ToDo?: statistics gathering here (also for GUM!)
- if (closure_SHOULD_SPARK(*sparkp)) {
- evac(sparkp);
- *to_sparkp++ = *sparkp;
- n++;
- } else {
- pruned_sparks++;
- }
- sparkp++;
- if (sparkp == pool->lim) {
- sparkp = pool->base;
- }
- }
- pool->tl = to_sparkp;
-
- PAR_TICKY_MARK_SPARK_QUEUE_END(n);
-
-#if defined(PARALLEL_HASKELL)
- IF_DEBUG(scheduler,
- debugBelch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
- n, pruned_sparks, mytid));
-#else
- IF_DEBUG(scheduler,
- debugBelch("markSparkQueue: marked %d sparks and pruned %d sparks\n",
- n, pruned_sparks));
-#endif
-
- IF_DEBUG(scheduler,
- debugBelch("markSparkQueue: new spark queue len=%d; (hd=%p; tl=%p)\n",
- sparkPoolSize(pool), pool->hd, pool->tl));
-
- }
-}
-
-/* -----------------------------------------------------------------------------
*
* Turn a spark into a real thread
*
{
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)) {
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, void *user, 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!)
+ 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++;
+ }
+ sparkp++;
+ if (sparkp == pool->lim) {
+ sparkp = pool->base;
+ }
+ }
+ pool->tl = to_sparkp;
+
+ PAR_TICKY_MARK_SPARK_QUEUE_END(n);
+
+ debugTrace(DEBUG_sched,
+ "marked %d sparks, pruned %d sparks",
+ n, pruned_sparks);
+
+ debugTrace(DEBUG_sched,
+ "new spark queue len=%d; (hd=%p; tl=%p)",
+ sparkPoolSize(pool), pool->hd, pool->tl);
+}
+
+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(sparkp, user);
+ sparkp++;
+ if (sparkp == pool->lim) {
+ sparkp = pool->base;
+ }
+ }
+}
+
#else
StgInt
return 1;
}
+
#endif /* PARALLEL_HASKELL || THREADED_RTS */
// ToDo?: statistics gathering here (also for GUM!)
sp->node = (StgClosure *)MarkRoot(sp->node);
}
+
IF_DEBUG(gc,
- debugBelch("@@ markSparkQueue: spark statistics at start of GC:");
+ debugBelch("markSparkQueue: spark statistics at start of GC:");
print_sparkq_stats());
}