summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/codeGen/StgCmmHeap.hs5
-rw-r--r--rts/CheckUnload.c6
-rw-r--r--rts/RetainerProfile.c2
-rw-r--r--rts/sm/Compact.c4
-rw-r--r--rts/sm/Evac.c95
-rw-r--r--rts/sm/GC.c48
-rw-r--r--rts/sm/GCAux.c10
-rw-r--r--rts/sm/GCThread.h7
-rw-r--r--rts/sm/Sanity.c3
-rw-r--r--rts/sm/Scav.c11
-rw-r--r--rts/sm/Storage.c10
-rw-r--r--rts/sm/Storage.h57
12 files changed, 137 insertions, 121 deletions
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 0e9eb6d658..4b2bd96b52 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -212,8 +212,9 @@ mkStaticClosureFields dflags info_tbl ccs caf_refs payload
-- collector will ignore it.
static_link_value
| mayHaveCafRefs caf_refs = mkIntCLit dflags 0
- | otherwise = mkIntCLit dflags 1 -- No CAF refs
-
+ | otherwise = mkIntCLit dflags 3 -- No CAF refs
+ -- See Note [STATIC_LINK fields]
+ -- in rts/sm/Storage.h
mkStaticClosure :: DynFlags -> CLabel -> CostCentreStack -> [CmmLit]
-> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
diff --git a/rts/CheckUnload.c b/rts/CheckUnload.c
index 2c01113f63..34f976db4d 100644
--- a/rts/CheckUnload.c
+++ b/rts/CheckUnload.c
@@ -271,7 +271,8 @@ void checkUnload (StgClosure *static_objects)
addrs = allocHashTable();
- for (p = static_objects; p != END_OF_STATIC_LIST; p = link) {
+ for (p = static_objects; p != END_OF_STATIC_OBJECT_LIST; p = link) {
+ p = UNTAG_STATIC_LIST_PTR(p);
checkAddress(addrs, p);
info = get_itbl(p);
link = *STATIC_LINK(info, p);
@@ -279,8 +280,9 @@ void checkUnload (StgClosure *static_objects)
// CAFs on revertible_caf_list are not on static_objects
for (p = (StgClosure*)revertible_caf_list;
- p != END_OF_STATIC_LIST;
+ p != END_OF_CAF_LIST;
p = ((StgIndStatic *)p)->static_link) {
+ p = UNTAG_STATIC_LIST_PTR(p);
checkAddress(addrs, p);
}
diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 78daa892ad..8121defbf8 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -1881,7 +1881,7 @@ resetStaticObjectForRetainerProfiling( StgClosure *static_objects )
count = 0;
#endif
p = static_objects;
- while (p != END_OF_STATIC_LIST) {
+ while (p != END_OF_STATIC_OBJECT_LIST) {
#ifdef DEBUG_RETAINER
count++;
#endif
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index a053dc3b4e..4ee88da11c 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -197,8 +197,8 @@ thread_static( StgClosure* p )
// keep going until we've threaded all the objects on the linked
// list...
- while (p != END_OF_STATIC_LIST) {
-
+ while (p != END_OF_STATIC_OBJECT_LIST) {
+ p = UNTAG_STATIC_LIST_PTR(p);
info = get_itbl(p);
switch (info->type) {
diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index b0ef807768..bc8cb9ad13 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -324,6 +324,38 @@ evacuate_large(StgPtr p)
}
/* ----------------------------------------------------------------------------
+ Evacuate static objects
+
+ When a static object is visited for the first time in this GC, it
+ is chained on to the gct->static_objects list.
+
+ evacuate_static_object (link_field, q)
+ - link_field must be STATIC_LINK(q)
+ ------------------------------------------------------------------------- */
+
+STATIC_INLINE void
+evacuate_static_object (StgClosure **link_field, StgClosure *q)
+{
+ StgWord link = (StgWord)*link_field;
+
+ // See Note [STATIC_LINK fields] for how the link field bits work
+ if ((((StgWord)(link)&STATIC_BITS) | prev_static_flag) != 3) {
+ StgWord new_list_head = (StgWord)q | static_flag;
+#ifndef THREADED_RTS
+ *link_field = gct->static_objects;
+ gct->static_objects = (StgClosure *)new_list_head;
+#else
+ StgWord prev;
+ prev = cas((StgVolatilePtr)link_field, link,
+ (StgWord)gct->static_objects);
+ if (prev == link) {
+ gct->static_objects = (StgClosure *)new_list_head;
+ }
+#endif
+ }
+}
+
+/* ----------------------------------------------------------------------------
Evacuate
This is called (eventually) for every live object in the system.
@@ -392,38 +424,13 @@ loop:
case THUNK_STATIC:
if (info->srt_bitmap != 0) {
- if (*THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
-#ifndef THREADED_RTS
- *THUNK_STATIC_LINK((StgClosure *)q) = gct->static_objects;
- gct->static_objects = (StgClosure *)q;
-#else
- StgPtr link;
- link = (StgPtr)cas((StgPtr)THUNK_STATIC_LINK((StgClosure *)q),
- (StgWord)NULL,
- (StgWord)gct->static_objects);
- if (link == NULL) {
- gct->static_objects = (StgClosure *)q;
- }
-#endif
- }
+ evacuate_static_object(THUNK_STATIC_LINK((StgClosure *)q), q);
}
return;
case FUN_STATIC:
- if (info->srt_bitmap != 0 &&
- *FUN_STATIC_LINK((StgClosure *)q) == NULL) {
-#ifndef THREADED_RTS
- *FUN_STATIC_LINK((StgClosure *)q) = gct->static_objects;
- gct->static_objects = (StgClosure *)q;
-#else
- StgPtr link;
- link = (StgPtr)cas((StgPtr)FUN_STATIC_LINK((StgClosure *)q),
- (StgWord)NULL,
- (StgWord)gct->static_objects);
- if (link == NULL) {
- gct->static_objects = (StgClosure *)q;
- }
-#endif
+ if (info->srt_bitmap != 0) {
+ evacuate_static_object(FUN_STATIC_LINK((StgClosure *)q), q);
}
return;
@@ -432,39 +439,11 @@ loop:
* on the CAF list, so don't do anything with it here (we'll
* scavenge it later).
*/
- if (*IND_STATIC_LINK((StgClosure *)q) == NULL) {
-#ifndef THREADED_RTS
- *IND_STATIC_LINK((StgClosure *)q) = gct->static_objects;
- gct->static_objects = (StgClosure *)q;
-#else
- StgPtr link;
- link = (StgPtr)cas((StgPtr)IND_STATIC_LINK((StgClosure *)q),
- (StgWord)NULL,
- (StgWord)gct->static_objects);
- if (link == NULL) {
- gct->static_objects = (StgClosure *)q;
- }
-#endif
- }
+ evacuate_static_object(IND_STATIC_LINK((StgClosure *)q), q);
return;
case CONSTR_STATIC:
- if (*STATIC_LINK(info,(StgClosure *)q) == NULL) {
-#ifndef THREADED_RTS
- *STATIC_LINK(info,(StgClosure *)q) = gct->static_objects;
- gct->static_objects = (StgClosure *)q;
-#else
- StgPtr link;
- link = (StgPtr)cas((StgPtr)STATIC_LINK(info,(StgClosure *)q),
- (StgWord)NULL,
- (StgWord)gct->static_objects);
- if (link == NULL) {
- gct->static_objects = (StgClosure *)q;
- }
-#endif
- }
- /* I am assuming that static_objects pointers are not
- * written to other objects, and thus, no need to retag. */
+ evacuate_static_object(STATIC_LINK(info,(StgClosure *)q), q);
return;
case CONSTR_NOCAF_STATIC:
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 52d7f98fa0..e6a23395eb 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -134,6 +134,9 @@ long copied; // *words* copied & scavenged during this GC
rtsBool work_stealing;
+nat static_flag = STATIC_FLAG_B;
+nat prev_static_flag = STATIC_FLAG_A;
+
DECLARE_GCT
/* -----------------------------------------------------------------------------
@@ -141,7 +144,6 @@ DECLARE_GCT
-------------------------------------------------------------------------- */
static void mark_root (void *user, StgClosure **root);
-static void zero_static_object_list (StgClosure* first_static);
static void prepare_collected_gen (generation *gen);
static void prepare_uncollected_gen (generation *gen);
static void init_gc_thread (gc_thread *t);
@@ -246,6 +248,12 @@ GarbageCollect (nat collect_gen,
N = collect_gen;
major_gc = (N == RtsFlags.GcFlags.generations-1);
+ if (major_gc) {
+ prev_static_flag = static_flag;
+ static_flag =
+ static_flag == STATIC_FLAG_A ? STATIC_FLAG_B : STATIC_FLAG_A;
+ }
+
#if defined(THREADED_RTS)
work_stealing = RtsFlags.ParFlags.parGcLoadBalancingEnabled &&
N >= RtsFlags.ParFlags.parGcLoadBalancingGen;
@@ -672,20 +680,6 @@ GarbageCollect (nat collect_gen,
resetStaticObjectForRetainerProfiling(gct->scavenged_static_objects);
#endif
- // zero the scavenged static object list
- if (major_gc) {
- nat i;
- if (n_gc_threads == 1) {
- zero_static_object_list(gct->scavenged_static_objects);
- } else {
- for (i = 0; i < n_gc_threads; i++) {
- if (!gc_threads[i]->idle) {
- zero_static_object_list(gc_threads[i]->scavenged_static_objects);
- }
- }
- }
- }
-
// Start any pending finalizers. Must be after
// updateStableTables() and stableUnlock() (see #4221).
RELEASE_SM_LOCK;
@@ -1427,8 +1421,8 @@ collect_pinned_object_blocks (void)
static void
init_gc_thread (gc_thread *t)
{
- t->static_objects = END_OF_STATIC_LIST;
- t->scavenged_static_objects = END_OF_STATIC_LIST;
+ t->static_objects = END_OF_STATIC_OBJECT_LIST;
+ t->scavenged_static_objects = END_OF_STATIC_OBJECT_LIST;
t->scan_bd = NULL;
t->mut_lists = t->cap->mut_lists;
t->evac_gen_no = 0;
@@ -1465,24 +1459,6 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root)
SET_GCT(saved_gct);
}
-/* -----------------------------------------------------------------------------
- Initialising the static object & mutable lists
- -------------------------------------------------------------------------- */
-
-static void
-zero_static_object_list(StgClosure* first_static)
-{
- StgClosure* p;
- StgClosure* link;
- const StgInfoTable *info;
-
- for (p = first_static; p != END_OF_STATIC_LIST; p = link) {
- info = get_itbl(p);
- link = *STATIC_LINK(info, p);
- *STATIC_LINK(info,p) = NULL;
- }
-}
-
/* ----------------------------------------------------------------------------
Reset the sizes of the older generations when we do a major
collection.
@@ -1728,7 +1704,7 @@ static void gcCAFs(void)
p = debug_caf_list;
prev = NULL;
- for (p = debug_caf_list; p != (StgIndStatic*)END_OF_STATIC_LIST;
+ for (p = debug_caf_list; p != (StgIndStatic*)END_OF_CAF_LIST;
p = (StgIndStatic*)p->saved_info) {
info = get_itbl((StgClosure*)p);
diff --git a/rts/sm/GCAux.c b/rts/sm/GCAux.c
index 13316e4d29..d3cbdaefb4 100644
--- a/rts/sm/GCAux.c
+++ b/rts/sm/GCAux.c
@@ -118,14 +118,14 @@ revertCAFs( void )
StgIndStatic *c;
for (c = revertible_caf_list;
- c != (StgIndStatic *)END_OF_STATIC_LIST;
+ c != (StgIndStatic *)END_OF_CAF_LIST;
c = (StgIndStatic *)c->static_link)
{
SET_INFO((StgClosure *)c, c->saved_info);
c->saved_info = NULL;
// could, but not necessary: c->static_link = NULL;
}
- revertible_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
+ revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
}
void
@@ -134,15 +134,17 @@ markCAFs (evac_fn evac, void *user)
StgIndStatic *c;
for (c = dyn_caf_list;
- c != (StgIndStatic*)END_OF_STATIC_LIST;
+ c != (StgIndStatic*)END_OF_CAF_LIST;
c = (StgIndStatic *)c->static_link)
{
+ c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c);
evac(user, &c->indirectee);
}
for (c = revertible_caf_list;
- c != (StgIndStatic*)END_OF_STATIC_LIST;
+ c != (StgIndStatic*)END_OF_CAF_LIST;
c = (StgIndStatic *)c->static_link)
{
+ c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c);
evac(user, &c->indirectee);
}
}
diff --git a/rts/sm/GCThread.h b/rts/sm/GCThread.h
index cbe4346afe..d42b89f973 100644
--- a/rts/sm/GCThread.h
+++ b/rts/sm/GCThread.h
@@ -131,8 +131,11 @@ typedef struct gc_thread_ {
// during GC without accessing the block
// allocators spin lock.
- StgClosure* static_objects; // live static objects
- StgClosure* scavenged_static_objects; // static objects scavenged so far
+ // These two lists are chained through the STATIC_LINK() fields of static
+ // objects. Pointers are tagged with the current static_flag, so before
+ // following a pointer, untag it with UNTAG_STATIC_LIST_PTR().
+ StgClosure* static_objects; // live static objects
+ StgClosure* scavenged_static_objects; // static objects scavenged so far
W_ gc_count; // number of GCs this thread has done
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index c4a699e59a..e7a8401145 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -637,7 +637,8 @@ checkStaticObjects ( StgClosure* static_objects )
StgClosure *p = static_objects;
StgInfoTable *info;
- while (p != END_OF_STATIC_LIST) {
+ while (p != END_OF_STATIC_OBJECT_LIST) {
+ p = UNTAG_STATIC_LIST_PTR(p);
checkClosure(p);
info = get_itbl(p);
switch (info->type) {
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index a8f0ab037f..dfad0bef58 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -1672,7 +1672,7 @@ scavenge_capability_mut_lists (Capability *cap)
static void
scavenge_static(void)
{
- StgClosure* p;
+ StgClosure *flagged_p, *p;
const StgInfoTable *info;
debugTrace(DEBUG_gc, "scavenging static objects");
@@ -1690,10 +1690,11 @@ scavenge_static(void)
* be more stuff on this list after each evacuation...
* (static_objects is a global)
*/
- p = gct->static_objects;
- if (p == END_OF_STATIC_LIST) {
+ flagged_p = gct->static_objects;
+ if (flagged_p == END_OF_STATIC_OBJECT_LIST) {
break;
}
+ p = UNTAG_STATIC_LIST_PTR(flagged_p);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
info = get_itbl(p);
@@ -1708,7 +1709,7 @@ scavenge_static(void)
*/
gct->static_objects = *STATIC_LINK(info,p);
*STATIC_LINK(info,p) = gct->scavenged_static_objects;
- gct->scavenged_static_objects = p;
+ gct->scavenged_static_objects = flagged_p;
switch (info -> type) {
@@ -2066,7 +2067,7 @@ loop:
work_to_do = rtsFalse;
// scavenge static objects
- if (major_gc && gct->static_objects != END_OF_STATIC_LIST) {
+ if (major_gc && gct->static_objects != END_OF_STATIC_OBJECT_LIST) {
IF_DEBUG(sanity, checkStaticObjects(gct->static_objects));
scavenge_static();
}
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 6e9b0634b7..65f5b70c21 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -175,9 +175,9 @@ initStorage (void)
generations[0].max_blocks = 0;
- dyn_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
- debug_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
- revertible_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
+ dyn_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
+ debug_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
+ revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
/* initialise the allocate() interface */
large_alloc_lim = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W;
@@ -427,7 +427,7 @@ newCAF(StgRegTable *reg, StgIndStatic *caf)
ACQUIRE_SM_LOCK; // dyn_caf_list is global, locked by sm_mutex
caf->static_link = (StgClosure*)dyn_caf_list;
- dyn_caf_list = caf;
+ dyn_caf_list = (StgIndStatic*)((StgWord)caf | STATIC_FLAG_LIST);
RELEASE_SM_LOCK;
}
else
@@ -484,7 +484,7 @@ StgInd* newRetainedCAF (StgRegTable *reg, StgIndStatic *caf)
ACQUIRE_SM_LOCK;
caf->static_link = (StgClosure*)revertible_caf_list;
- revertible_caf_list = caf;
+ revertible_caf_list = (StgIndStatic*)((StgWord)caf | STATIC_FLAG_LIST);
RELEASE_SM_LOCK;
diff --git a/rts/sm/Storage.h b/rts/sm/Storage.h
index a4421db3f2..d0094b60fb 100644
--- a/rts/sm/Storage.h
+++ b/rts/sm/Storage.h
@@ -133,12 +133,59 @@ W_ calcLiveWords (void);
extern bdescr *exec_block;
-#define END_OF_STATIC_LIST ((StgClosure*)1)
-
void move_STACK (StgStack *src, StgStack *dest);
/* -----------------------------------------------------------------------------
- CAF lists
+ Note [STATIC_LINK fields]
+
+ The low 2 bits of the static link field have the following meaning:
+
+ 00 we haven't seen this static object before
+
+ 01/10 if it equals static_flag, then we saw it in this GC, otherwise
+ we saw it in the previous GC.
+
+ 11 ignore during GC. This value is used in two ways
+ - When we put CAFs on a list (see Note [CAF lists])
+ - a static constructor that was determined to have no CAF
+ references at compile time is given this value, so we
+ don't traverse it during GC
+
+ This choice of values is quite deliberate, because it means we can
+ decide whether a static object should be traversed during GC using a
+ single test:
+
+ bits = link_field & 3;
+ if ((bits | prev_static_flag) != 3) { ... }
+
+ -------------------------------------------------------------------------- */
+
+#define STATIC_BITS 3
+
+#define STATIC_FLAG_A 1
+#define STATIC_FLAG_B 2
+#define STATIC_FLAG_LIST 3
+
+#define END_OF_CAF_LIST ((StgClosure*)STATIC_FLAG_LIST)
+
+// The previous and current values of the static flag. These flip
+// between STATIC_FLAG_A and STATIC_FLAG_B at each major GC.
+extern nat prev_static_flag, static_flag;
+
+// In the chain of static objects built up during GC, all the link
+// fields are tagged with the current static_flag value. How to mark
+// the end of the chain? It must be a special value so that we can
+// tell it is the end of the chain, but note that we're going to store
+// this value in the link field of a static object, which means that
+// during the NEXT GC we should treat it like any other object that
+// has not been visited during this GC. Therefore, we use static_flag
+// as the sentinel value.
+#define END_OF_STATIC_OBJECT_LIST ((StgClosure*)(StgWord)static_flag)
+
+#define UNTAG_STATIC_LIST_PTR(p) ((StgClosure*)((StgWord)(p) & ~STATIC_BITS))
+
+/* -----------------------------------------------------------------------------
+ Note [CAF lists]
dyn_caf_list (CAFs chained through static_link)
This is a chain of all CAFs in the program, used for
@@ -154,6 +201,10 @@ void move_STACK (StgStack *src, StgStack *dest);
A chain of CAFs in object code loaded with the RTS linker.
These CAFs can be reverted to their unevaluated state using
revertCAFs.
+
+ Pointers in these lists are tagged with STATIC_FLAG_LIST, so when
+ traversing the list remember to untag each pointer with
+ UNTAG_STATIC_LIST_PTR().
--------------------------------------------------------------------------- */
extern StgIndStatic * dyn_caf_list;