summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--includes/rts/storage/Closures.h3
-rw-r--r--libraries/ghc-compact/tests/all.T2
-rw-r--r--libraries/ghc-compact/tests/compact_gc.hs4
-rw-r--r--rts/Hash.c29
-rw-r--r--rts/Hash.h2
-rw-r--r--rts/StgMiscClosures.cmm4
-rw-r--r--rts/sm/CNF.c1
-rw-r--r--rts/sm/Compact.c67
-rw-r--r--testsuite/config/ghc6
9 files changed, 105 insertions, 13 deletions
diff --git a/includes/rts/storage/Closures.h b/includes/rts/storage/Closures.h
index 81b6fd1fe1..3196efd3de 100644
--- a/includes/rts/storage/Closures.h
+++ b/includes/rts/storage/Closures.h
@@ -486,4 +486,7 @@ typedef struct StgCompactNFData_ {
StgClosure *result;
// Used temporarily to store the result of compaction. Doesn't need to be
// a GC root.
+ struct StgCompactNFData_ *link;
+ // Used by compacting GC for linking CNFs with threaded hash tables. See
+ // Note [CNFs in compacting GC] in Compact.c for details.
} StgCompactNFData;
diff --git a/libraries/ghc-compact/tests/all.T b/libraries/ghc-compact/tests/all.T
index 4a1bab9336..24f5d6d2b4 100644
--- a/libraries/ghc-compact/tests/all.T
+++ b/libraries/ghc-compact/tests/all.T
@@ -1,4 +1,4 @@
-setTestOpts(extra_ways(['sanity']))
+setTestOpts(extra_ways(['sanity', 'compacting_gc']))
test('compact_simple', normal, compile_and_run, [''])
test('compact_loop', normal, compile_and_run, [''])
diff --git a/libraries/ghc-compact/tests/compact_gc.hs b/libraries/ghc-compact/tests/compact_gc.hs
index 2e13bafdbe..f5df01fd5e 100644
--- a/libraries/ghc-compact/tests/compact_gc.hs
+++ b/libraries/ghc-compact/tests/compact_gc.hs
@@ -6,6 +6,8 @@ main = do
let m = Map.fromList [(x,show x) | x <- [1..(10000::Int)]]
c <- compactWithSharing m
print =<< compactSize c
- c <- foldM (\c _ -> do c <- compactWithSharing (getCompact c); print =<< compactSize c; return c) c [1..10]
+ c <- foldM (\c _ -> do c <- compactWithSharing (getCompact c)
+ print =<< compactSize c
+ return c) c [1..10]
print (length (show (getCompact c)))
print =<< compactSize c
diff --git a/rts/Hash.c b/rts/Hash.c
index 4e11228961..d5fda056bd 100644
--- a/rts/Hash.c
+++ b/rts/Hash.c
@@ -444,17 +444,13 @@ freeHashTable(HashTable *table, void (*freeDataFun)(void *) )
void
mapHashTable(HashTable *table, void *data, MapHashFn fn)
{
- long segment;
- long index;
- HashList *hl;
-
/* The last bucket with something in it is table->max + table->split - 1 */
- segment = (table->max + table->split - 1) / HSEGSIZE;
- index = (table->max + table->split - 1) % HSEGSIZE;
+ long segment = (table->max + table->split - 1) / HSEGSIZE;
+ long index = (table->max + table->split - 1) % HSEGSIZE;
while (segment >= 0) {
while (index >= 0) {
- for (hl = table->dir[segment][index]; hl != NULL; hl = hl->next) {
+ for (HashList *hl = table->dir[segment][index]; hl != NULL; hl = hl->next) {
fn(data, hl->key, hl->data);
}
index--;
@@ -464,6 +460,25 @@ mapHashTable(HashTable *table, void *data, MapHashFn fn)
}
}
+void
+mapHashTableKeys(HashTable *table, void *data, MapHashFnKeys fn)
+{
+ /* The last bucket with something in it is table->max + table->split - 1 */
+ long segment = (table->max + table->split - 1) / HSEGSIZE;
+ long index = (table->max + table->split - 1) % HSEGSIZE;
+
+ while (segment >= 0) {
+ while (index >= 0) {
+ for (HashList *hl = table->dir[segment][index]; hl != NULL; hl = hl->next) {
+ fn(data, &hl->key, hl->data);
+ }
+ index--;
+ }
+ segment--;
+ index = HSEGSIZE - 1;
+ }
+}
+
/* -----------------------------------------------------------------------------
* When we initialize a hash table, we set up the first segment as well,
* initializing all of the first segment's hash buckets to NULL.
diff --git a/rts/Hash.h b/rts/Hash.h
index 59e2e22a09..8a605d11de 100644
--- a/rts/Hash.h
+++ b/rts/Hash.h
@@ -34,8 +34,10 @@ int keyCountHashTable (HashTable *table);
int keysHashTable(HashTable *table, StgWord keys[], int szKeys);
typedef void (*MapHashFn)(void *data, StgWord key, const void *value);
+typedef void (*MapHashFnKeys)(void *data, StgWord *key, const void *value);
void mapHashTable(HashTable *table, void *data, MapHashFn fn);
+void mapHashTableKeys(HashTable *table, void *data, MapHashFnKeys fn);
/* Hash table access where the keys are C strings (the strings are
* assumed to be allocated by the caller, and mustn't be deallocated
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 44ff9db6ce..5af3a06b89 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -686,11 +686,11 @@ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE
compaction is in progress and the hash table needs to be scanned by the GC.
------------------------------------------------------------------------- */
-INFO_TABLE( stg_COMPACT_NFDATA_CLEAN, 0, 8, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA")
+INFO_TABLE( stg_COMPACT_NFDATA_CLEAN, 0, 9, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA")
()
{ foreign "C" barf("COMPACT_NFDATA_CLEAN object (%p) entered!", R1) never returns; }
-INFO_TABLE( stg_COMPACT_NFDATA_DIRTY, 0, 8, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA")
+INFO_TABLE( stg_COMPACT_NFDATA_DIRTY, 0, 9, COMPACT_NFDATA, "COMPACT_NFDATA", "COMPACT_NFDATA")
()
{ foreign "C" barf("COMPACT_NFDATA_DIRTY object (%p) entered!", R1) never returns; }
diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c
index 87d1d84f50..43a090fd42 100644
--- a/rts/sm/CNF.c
+++ b/rts/sm/CNF.c
@@ -381,6 +381,7 @@ compactNew (Capability *cap, StgWord size)
self->nursery = block;
self->last = block;
self->hash = NULL;
+ self->link = NULL;
block->owner = self;
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index fee9cf02fa..d8b21b83c6 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -473,6 +473,67 @@ thread_TSO (StgTSO *tso)
return (P_)tso + sizeofW(StgTSO);
}
+/* ----------------------------------------------------------------------------
+ Note [CNFs in compacting GC]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+ CNF hash table keys point outside of the CNF so those need to be threaded
+ and updated during compaction. After compaction we need to re-visit those
+ hash tables for re-hashing. The list `nfdata_chain` is used for that
+ purpose. When we thread keys of a CNF we add the CNF to the list. After
+ compacting is done we re-visit the CNFs in the list and re-hash their
+ tables. See also #17937 for more details.
+ ------------------------------------------------------------------------- */
+
+static StgCompactNFData *nfdata_chain = NULL;
+
+static void
+thread_nfdata_hash_key(void *data STG_UNUSED, StgWord *key, const void *value STG_UNUSED)
+{
+ thread_((void *)key);
+}
+
+static void
+add_hash_entry(void *data, StgWord key, const void *value)
+{
+ HashTable *new_hash = (HashTable *)data;
+ insertHashTable(new_hash, key, value);
+}
+
+static void
+rehash_CNFs(void)
+{
+ while (nfdata_chain != NULL) {
+ StgCompactNFData *str = nfdata_chain;
+ nfdata_chain = str->link;
+ str->link = NULL;
+
+ HashTable *new_hash = allocHashTable();
+ mapHashTable(str->hash, (void*)new_hash, add_hash_entry);
+ freeHashTable(str->hash, NULL);
+ str->hash = new_hash;
+ }
+}
+
+static void
+update_fwd_cnf( bdescr *bd )
+{
+ while (bd) {
+ ASSERT(bd->flags & BF_COMPACT);
+ StgCompactNFData *str = ((StgCompactNFDataBlock*)bd->start)->owner;
+
+ // Thread hash table keys. Values won't be moved as those are inside the
+ // CNF, and the CNF is a large object and so won't ever move.
+ if (str->hash) {
+ mapHashTableKeys(str->hash, NULL, thread_nfdata_hash_key);
+ ASSERT(str->link == NULL);
+ str->link = nfdata_chain;
+ nfdata_chain = str;
+ }
+
+ bd = bd->link;
+ }
+}
static void
update_fwd_large( bdescr *bd )
@@ -489,7 +550,6 @@ update_fwd_large( bdescr *bd )
switch (info->type) {
case ARR_WORDS:
- case COMPACT_NFDATA:
// nothing to follow
continue;
@@ -968,6 +1028,7 @@ compact(StgClosure *static_objects,
update_fwd(gc_threads[n]->gens[g].part_list);
}
update_fwd_large(gen->scavenged_large_objects);
+ update_fwd_cnf(gen->live_compact_objects);
if (g == RtsFlags.GcFlags.generations-1 && gen->old_blocks != NULL) {
debugTrace(DEBUG_gc, "update_fwd: %d (compact)", g);
update_fwd_compact(gen->old_blocks);
@@ -983,4 +1044,8 @@ compact(StgClosure *static_objects,
gen->no, gen->n_old_blocks, blocks);
gen->n_old_blocks = blocks;
}
+
+ // 4. Re-hash hash tables of threaded CNFs.
+ // See Note [CNFs in compacting GC] above.
+ rehash_CNFs();
}
diff --git a/testsuite/config/ghc b/testsuite/config/ghc
index 884cb1e953..b561fc806e 100644
--- a/testsuite/config/ghc
+++ b/testsuite/config/ghc
@@ -29,7 +29,9 @@ config.other_ways = ['prof', 'normal_h',
'ext-interp',
'nonmoving',
'nonmoving_thr',
- 'nonmoving_thr_ghc']
+ 'nonmoving_thr_ghc',
+ 'compacting_gc',
+ ]
if ghc_with_native_codegen:
config.compile_ways.append('optasm')
@@ -105,6 +107,7 @@ config.way_flags = {
'nonmoving' : [],
'nonmoving_thr': ['-threaded'],
'nonmoving_thr_ghc': ['+RTS', '-xn', '-N2', '-RTS', '-threaded'],
+ 'compacting_gc': [],
}
config.way_rts_flags = {
@@ -146,6 +149,7 @@ config.way_rts_flags = {
'nonmoving' : ['-xn'],
'nonmoving_thr' : ['-xn', '-N2'],
'nonmoving_thr_ghc': ['-xn', '-N2'],
+ 'compacting_gc': ['-c'],
}
# Useful classes of ways that can be used with only_ways(), omit_ways() and
View Lorry Controller Status