[commit: ghc] master: Per-capability nursery weak pointer lists, fixes #9075 (723095b)
git at git.haskell.org
git at git.haskell.org
Fri May 30 03:09:20 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/723095b0e4c5838c7eefd757af56ab2a7c614801/ghc
>---------------------------------------------------------------
commit 723095b0e4c5838c7eefd757af56ab2a7c614801
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date: Thu May 29 20:05:51 2014 -0700
Per-capability nursery weak pointer lists, fixes #9075
Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>
>---------------------------------------------------------------
723095b0e4c5838c7eefd757af56ab2a7c614801
rts/Capability.c | 2 ++
rts/Capability.h | 5 +++++
rts/PrimOps.cmm | 9 ++++----
rts/RetainerProfile.c | 6 ++++++
rts/RtsStartup.c | 5 ++++-
rts/sm/GC.c | 3 +++
rts/sm/MarkWeak.c | 35 ++++++++++++++++++++++++++++++++
rts/sm/MarkWeak.h | 1 +
utils/deriveConstants/DeriveConstants.hs | 2 ++
9 files changed, 63 insertions(+), 5 deletions(-)
diff --git a/rts/Capability.c b/rts/Capability.c
index 16b71b7..805a35b 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -273,6 +273,8 @@ initCapability( Capability *cap, nat i )
cap->mut_lists[g] = NULL;
}
+ cap->weak_ptr_list_hd = NULL;
+ cap->weak_ptr_list_tl = NULL;
cap->free_tvar_watch_queues = END_STM_WATCH_QUEUE;
cap->free_invariant_check_queues = END_INVARIANT_CHECK_QUEUE;
cap->free_trec_chunks = END_STM_CHUNK_LIST;
diff --git a/rts/Capability.h b/rts/Capability.h
index f342d92..d36d502 100644
--- a/rts/Capability.h
+++ b/rts/Capability.h
@@ -79,6 +79,11 @@ struct Capability_ {
// full pinned object blocks allocated since the last GC
bdescr *pinned_object_blocks;
+ // per-capability weak pointer list associated with nursery (older
+ // lists stored in generation object)
+ StgWeak *weak_ptr_list_hd;
+ StgWeak *weak_ptr_list_tl;
+
// Context switch flag. When non-zero, this means: stop running
// Haskell code, and switch threads.
int context_switch;
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 1dc232d..84bcea5 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -577,10 +577,11 @@ stg_mkWeakzh ( gcptr key,
StgWeak_finalizer(w) = finalizer;
StgWeak_cfinalizers(w) = stg_NO_FINALIZER_closure;
- ACQUIRE_LOCK(sm_mutex);
- StgWeak_link(w) = generation_weak_ptr_list(W_[g0]);
- generation_weak_ptr_list(W_[g0]) = w;
- RELEASE_LOCK(sm_mutex);
+ StgWeak_link(w) = Capability_weak_ptr_list_hd(MyCapability());
+ Capability_weak_ptr_list_hd(MyCapability()) = w;
+ if (Capability_weak_ptr_list_tl(MyCapability()) == NULL) {
+ Capability_weak_ptr_list_tl(MyCapability()) = w;
+ }
IF_DEBUG(weak, ccall debugBelch(stg_weak_msg,w));
diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index bdfc831..bfc9624 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -1781,6 +1781,12 @@ computeRetainerSet( void )
//
// The following code assumes that WEAK objects are considered to be roots
// for retainer profilng.
+ for (n = 0; n < n_capabilities; n++) {
+ // NB: after a GC, all nursery weak_ptr_lists have been migrated
+ // to the global lists living in the generations
+ ASSERT(capabilities[n]->weak_ptr_list_hd == NULL);
+ ASSERT(capabilities[n]->weak_ptr_list_tl == NULL);
+ }
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
for (weak = generations[g].weak_ptr_list; weak != NULL; weak = weak->link) {
// retainRoot((StgClosure *)weak);
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 15e48a6..06e888c 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -304,7 +304,7 @@ hs_add_root(void (*init_root)(void) STG_UNUSED)
static void
hs_exit_(rtsBool wait_foreign)
{
- nat g;
+ nat g, i;
if (hs_init_count <= 0) {
errorBelch("warning: too many hs_exit()s");
@@ -336,6 +336,9 @@ hs_exit_(rtsBool wait_foreign)
exitScheduler(wait_foreign);
/* run C finalizers for all active weak pointers */
+ for (i = 0; i < n_capabilities; i++) {
+ runAllCFinalizers(capabilities[i]->weak_ptr_list_hd);
+ }
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
runAllCFinalizers(generations[g].weak_ptr_list);
}
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index d22a31e..61432ea 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -286,6 +286,9 @@ GarbageCollect (nat collect_gen,
memInventory(DEBUG_gc);
#endif
+ // do this *before* we start scavenging
+ collectFreshWeakPtrs();
+
// check sanity *before* GC
IF_DEBUG(sanity, checkSanity(rtsFalse /* before GC */, major_gc));
diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index af953cd..0324f3b 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -25,6 +25,8 @@
#include "Storage.h"
#include "Threads.h"
+#include "sm/Sanity.h"
+
/* -----------------------------------------------------------------------------
Weak Pointers
@@ -341,6 +343,39 @@ static void tidyThreadList (generation *gen)
}
}
+#ifdef DEBUG
+static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl)
+{
+ StgWeak *w, *prev;
+ for (w = hd; w != NULL; prev = w, w = w->link) {
+ ASSERT(INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure*)w)->header.info)->type == WEAK);
+ checkClosure((StgClosure*)w);
+ }
+ if (tl != NULL) {
+ ASSERT(prev == tl);
+ }
+}
+#endif
+
+void collectFreshWeakPtrs()
+{
+ nat i;
+ generation *gen = &generations[0];
+ // move recently allocated weak_ptr_list to the old list as well
+ for (i = 0; i < n_capabilities; i++) {
+ Capability *cap = capabilities[i];
+ if (cap->weak_ptr_list_tl != NULL) {
+ IF_DEBUG(sanity, checkWeakPtrSanity(cap->weak_ptr_list_hd, cap->weak_ptr_list_tl));
+ cap->weak_ptr_list_tl->link = gen->weak_ptr_list;
+ gen->weak_ptr_list = cap->weak_ptr_list_hd;
+ cap->weak_ptr_list_tl = NULL;
+ cap->weak_ptr_list_hd = NULL;
+ } else {
+ ASSERT(cap->weak_ptr_list_hd == NULL);
+ }
+ }
+}
+
/* -----------------------------------------------------------------------------
Evacuate every weak pointer object on the weak_ptr_list, and update
the link fields.
diff --git a/rts/sm/MarkWeak.h b/rts/sm/MarkWeak.h
index f9bacfa..bd0231d 100644
--- a/rts/sm/MarkWeak.h
+++ b/rts/sm/MarkWeak.h
@@ -20,6 +20,7 @@ extern StgWeak *old_weak_ptr_list;
extern StgTSO *resurrected_threads;
extern StgTSO *exception_threads;
+void collectFreshWeakPtrs ( void );
void initWeakForGC ( void );
rtsBool traverseWeakPtrList ( void );
void markWeakPtrList ( void );
diff --git a/utils/deriveConstants/DeriveConstants.hs b/utils/deriveConstants/DeriveConstants.hs
index d15f619..9bf2160 100644
--- a/utils/deriveConstants/DeriveConstants.hs
+++ b/utils/deriveConstants/DeriveConstants.hs
@@ -349,6 +349,8 @@ wanteds = concat
,structField C "Capability" "context_switch"
,structField C "Capability" "interrupt"
,structField C "Capability" "sparks"
+ ,structField C "Capability" "weak_ptr_list_hd"
+ ,structField C "Capability" "weak_ptr_list_tl"
,structField Both "bdescr" "start"
,structField Both "bdescr" "free"
More information about the ghc-commits
mailing list