From 01ccdeea34b4853750326126f3bff9b2bdfa9a32 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 24 Apr 2008 20:58:13 +0000 Subject: [PATCH] FIX #2185: sparks should not be treated as roots by the GC --- rts/Capability.c | 32 ++++++++++++++++++++++++++++---- rts/Capability.h | 2 ++ rts/Sparks.c | 41 +++++++++++++++++++++++------------------ rts/Sparks.h | 29 +++-------------------------- rts/sm/Compact.c | 3 +++ rts/sm/GC.c | 4 +++- 6 files changed, 62 insertions(+), 49 deletions(-) diff --git a/rts/Capability.c b/rts/Capability.c index 4950df6..fa7f630 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -791,10 +791,6 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta) "evac'ing suspended TSO %lu", (unsigned long)task->suspended_tso->id); evac(user, (StgClosure **)(void *)&task->suspended_tso); } - -#if defined(THREADED_RTS) - markSparkQueue (evac, user, cap); -#endif } #if !defined(THREADED_RTS) @@ -804,6 +800,34 @@ markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta) #endif } +// Sparks are not roots for GC, so we don't mark them in +// markSomeCapabilities(). Instead, we traverse the spark queues +// after GC and throw away any that are unreachable. +void +updateCapabilitiesPostGC (void) +{ +#if defined(THREADED_RTS) + nat i; + for (i = 0; i < n_capabilities; i++) { + updateSparkQueue (&capabilities[i]); + } +#endif // THREADED_RTS +} + +// This function is used by the compacting GC to thread all the +// pointers from spark queues. +void +traverseSparkQueues (evac_fn evac USED_IF_THREADS, void *user USED_IF_THREADS) +{ +#if defined(THREADED_RTS) + nat i; + for (i = 0; i < n_capabilities; i++) { + traverseSparkQueue (evac, user, &capabilities[i]); + } +#endif // THREADED_RTS + +} + void markCapabilities (evac_fn evac, void *user) { diff --git a/rts/Capability.h b/rts/Capability.h index 71c0ff6..f8fb7be 100644 --- a/rts/Capability.h +++ b/rts/Capability.h @@ -238,6 +238,8 @@ void freeCapability (Capability *cap); // FOr the GC: void markSomeCapabilities (evac_fn evac, void *user, nat i0, nat delta); void markCapabilities (evac_fn evac, void *user); +void updateCapabilitiesPostGC (void); +void traverseSparkQueues (evac_fn evac, void *user); /* ----------------------------------------------------------------------------- * INLINE functions... private below here diff --git a/rts/Sparks.c b/rts/Sparks.c index 0f429e2..5ea296d 100644 --- a/rts/Sparks.c +++ b/rts/Sparks.c @@ -169,9 +169,9 @@ newSpark (StgRegTable *reg, StgClosure *p) * -------------------------------------------------------------------------- */ void -markSparkQueue (evac_fn evac, void *user, Capability *cap) +updateSparkQueue (Capability *cap) { - StgClosure **sparkp, **to_sparkp; + StgClosure *spark, **sparkp, **to_sparkp; nat n, pruned_sparks; // stats only StgSparkPool *pool; @@ -184,21 +184,15 @@ markSparkQueue (evac_fn evac, void *user, Capability *cap) 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!) - if (closure_SHOULD_SPARK(*sparkp)) { - evac(user, sparkp); - *to_sparkp++ = *sparkp; + spark = isAlive(*sparkp); + if (spark != NULL && closure_SHOULD_SPARK(spark)) { + *to_sparkp++ = spark; if (to_sparkp == pool->lim) { to_sparkp = pool->base; } @@ -215,21 +209,32 @@ markSparkQueue (evac_fn evac, void *user, Capability *cap) 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, - "marked %d sparks and pruned %d sparks", + "updated %d sparks and pruned %d sparks", n, pruned_sparks); -#endif debugTrace(DEBUG_sched, "new spark queue len=%d; (hd=%p; tl=%p)\n", 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 diff --git a/rts/Sparks.h b/rts/Sparks.h index 57c02e6..f617558 100644 --- a/rts/Sparks.h +++ b/rts/Sparks.h @@ -9,12 +9,13 @@ #ifndef SPARKS_H #define SPARKS_H -#if defined(PARALLEL_HASKELL) || defined(THREADED_RTS) +#if defined(THREADED_RTS) StgClosure * findSpark (Capability *cap); void initSparkPools (void); void freeSparkPool (StgSparkPool *pool); void createSparkThread (Capability *cap, StgClosure *p); -void markSparkQueue (evac_fn evac, void *user, Capability *cap); +void updateSparkQueue (Capability *cap); +void traverseSparkQueue(evac_fn evac, void *user, Capability *cap); INLINE_HEADER void discardSparks (StgSparkPool *pool); INLINE_HEADER nat sparkPoolSize (StgSparkPool *pool); @@ -25,30 +26,6 @@ INLINE_HEADER nat sparkPoolSizeCap (Capability *cap); INLINE_HEADER rtsBool emptySparkPoolCap (Capability *cap); #endif -#if defined(PARALLEL_HASKELL) -StgTSO *activateSpark (rtsSpark spark) ; -rtsBool add_to_spark_queue( StgClosure *closure, StgSparkPool *pool ); -void markSparkQueue( void ); -nat spark_queue_len( StgSparkPool *pool ); -void disposeSpark( StgClosure *spark ); -#endif - -#if defined(GRAN) -void findLocalSpark (rtsEvent *event, rtsBool *found_res, rtsSparkQ *spark_res); -rtsBool activateSpark (rtsEvent *event, rtsSparkQ spark); -rtsSpark *newSpark(StgClosure *node, nat name, nat gran_info, - nat size_info, nat par_info, nat local); -void add_to_spark_queue(rtsSpark *spark); -rtsSpark *delete_from_sparkq (rtsSpark *spark, PEs p, rtsBool dispose_too); -void disposeSpark(rtsSpark *spark); -void disposeSparkQ(rtsSparkQ spark); -void print_spark(rtsSpark *spark); -void print_sparkq(PEs proc); -void print_sparkq_stats(void); -nat spark_queue_len(PEs proc); -void markSparkQueue(void); -#endif - /* ----------------------------------------------------------------------------- * PRIVATE below here * -------------------------------------------------------------------------- */ diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c index c5f0c37..bb4d838 100644 --- a/rts/sm/Compact.c +++ b/rts/sm/Compact.c @@ -966,6 +966,9 @@ compact(StgClosure *static_objects) // 1. thread the roots markCapabilities((evac_fn)thread_root, NULL); + // spark queues + traverseSparkQueues((evac_fn)thread_root, NULL); + // the weak pointer lists... if (weak_ptr_list != NULL) { thread((void *)&weak_ptr_list); diff --git a/rts/sm/GC.c b/rts/sm/GC.c index a8c637d..6225478 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -39,7 +39,6 @@ #include "Trace.h" #include "RetainerProfile.h" #include "RaiseAsync.h" -#include "Sparks.h" #include "Papi.h" #include "GC.h" @@ -377,6 +376,9 @@ GarbageCollect ( rtsBool force_major_gc ) // Update pointers from the Task list update_task_list(); + // Update pointers from capabilities (probably just the spark queues) + updateCapabilitiesPostGC(); + // Now see which stable names are still alive. gcStablePtrTable(); -- 1.7.10.4