projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Mostly fix Trac #2431: make empty case acceptable to (most of) GHC
[ghc-hetmet.git]
/
rts
/
Sparks.c
diff --git
a/rts/Sparks.c
b/rts/Sparks.c
index
0f429e2
..
1a839ab
100644
(file)
--- a/
rts/Sparks.c
+++ b/
rts/Sparks.c
@@
-171,7
+171,7
@@
newSpark (StgRegTable *reg, StgClosure *p)
void
markSparkQueue (evac_fn evac, void *user, Capability *cap)
{
void
markSparkQueue (evac_fn evac, void *user, Capability *cap)
{
- StgClosure **sparkp, **to_sparkp;
+ StgClosure *spark, **sparkp, **to_sparkp;
nat n, pruned_sparks; // stats only
StgSparkPool *pool;
nat n, pruned_sparks; // stats only
StgSparkPool *pool;
@@
-184,27
+184,22
@@
markSparkQueue (evac_fn evac, void *user, Capability *cap)
ASSERT_SPARK_POOL_INVARIANTS(pool);
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(*sparkp!=NULL);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgClosure *)*sparkp)));
// ToDo?: statistics gathering here (also for GUM!)
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!)
- if (closure_SHOULD_SPARK(*sparkp)) {
- evac(user, sparkp);
- *to_sparkp++ = *sparkp;
+ 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++;
if (to_sparkp == pool->lim) {
to_sparkp = pool->base;
}
n++;
- } else {
- pruned_sparks++;
}
sparkp++;
if (sparkp == pool->lim) {
}
sparkp++;
if (sparkp == pool->lim) {
@@
-215,21
+210,32
@@
markSparkQueue (evac_fn evac, void *user, Capability *cap)
PAR_TICKY_MARK_SPARK_QUEUE_END(n);
PAR_TICKY_MARK_SPARK_QUEUE_END(n);
-#if defined(PARALLEL_HASKELL)
- debugTrace(DEBUG_sched,
- "marked %d sparks and pruned %d sparks on [%x]",
- n, pruned_sparks, mytid);
-#else
debugTrace(DEBUG_sched,
debugTrace(DEBUG_sched,
- "marked %d sparks and pruned %d sparks",
+ "marked %d sparks, pruned %d sparks",
n, pruned_sparks);
n, pruned_sparks);
-#endif
debugTrace(DEBUG_sched,
debugTrace(DEBUG_sched,
- "new spark queue len=%d; (hd=%p; tl=%p)\n",
+ "new spark queue len=%d; (hd=%p; tl=%p)",
sparkPoolSize(pool), pool->hd, pool->tl);
}
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
#else
StgInt