Fix CNF handling in compacting GC

Fixes #17937 Previously compacting GC simply ignored CNFs. This is mostly fine as most (see "What about small compacts?" below) CNF objects don't have outgoing pointers, and are "large" (allocated in large blocks) and large objects are not moved or compacted. However if we do GC *during* sharing-preserving compaction then the CNF will have a hash table mapping objects that have been moved to the CNF to their location in the CNF, to be able to preserve sharing. This case is handled in the copying collector, in `scavenge_compact`, where we evacuate hash table entries and then rehash the table. Compacting GC ignored this case. We now visit CNFs in all generations when threading pointers to the compacted heap and thread hash table keys. A visited CNF is added to the list `nfdata_chain`. After compaction is done, we re-visit the CNFs in that list and rehash the tables. The overhead is minimal: the list is static in `Compact.c`, and link field is added to `StgCompactNFData` closure. Programs that don't use CNFs should not be affected. To test this CNF tests are now also run in a new way 'compacting_gc', which just passes `-c` to the RTS, enabling compacting GC for the oldest generation. Before this patch the result would be: Unexpected failures: compact_gc.run compact_gc [bad exit code (139)] (compacting_gc) compact_huge_array.run compact_huge_array [bad exit code (1)] (compacting_gc) With this patch all tests pass. I can also pass `-c -DS` without any failures. What about small compacts? Small CNFs are still not handled by the compacting GC. However so far I'm unable to write a test that triggers a runtime panic ("update_fwd: unknown/strange object") by allocating a small CNF in a compated heap. It's possible that I'm missing something and it's not possible to have a small CNF. NoFib Results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS +0.1% 0.0% 0.0% +0.0% +0.0% CSD +0.1% 0.0% 0.0% 0.0% 0.0% FS +0.1% 0.0% 0.0% 0.0% 0.0% S +0.1% 0.0% 0.0% 0.0% 0.0% VS +0.1% 0.0% 0.0% 0.0% 0.0% VSD +0.1% 0.0% +0.0% +0.0% -0.0% VSM +0.1% 0.0% +0.0% -0.0% 0.0% anna +0.0% 0.0% -0.0% -0.0% -0.0% ansi +0.1% 0.0% +0.0% +0.0% +0.0% atom +0.1% 0.0% +0.0% +0.0% +0.0% awards +0.1% 0.0% +0.0% +0.0% +0.0% banner +0.1% 0.0% +0.0% +0.0% +0.0% bernouilli +0.1% 0.0% 0.0% -0.0% +0.0% binary-trees +0.1% 0.0% -0.0% -0.0% 0.0% boyer +0.1% 0.0% +0.0% +0.0% +0.0% boyer2 +0.1% 0.0% +0.0% +0.0% +0.0% bspt +0.1% 0.0% -0.0% -0.0% -0.0% cacheprof +0.1% 0.0% -0.0% -0.0% -0.0% calendar +0.1% 0.0% +0.0% +0.0% +0.0% cichelli +0.1% 0.0% +0.0% +0.0% +0.0% circsim +0.1% 0.0% +0.0% +0.0% +0.0% clausify +0.1% 0.0% -0.0% +0.0% +0.0% comp_lab_zift +0.1% 0.0% +0.0% +0.0% +0.0% compress +0.1% 0.0% +0.0% +0.0% 0.0% compress2 +0.1% 0.0% -0.0% 0.0% 0.0% constraints +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm1 +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm2 +0.1% 0.0% +0.0% +0.0% +0.0% cse +0.1% 0.0% +0.0% +0.0% +0.0% digits-of-e1 +0.1% 0.0% +0.0% -0.0% -0.0% digits-of-e2 +0.1% 0.0% -0.0% -0.0% -0.0% dom-lt +0.1% 0.0% +0.0% +0.0% +0.0% eliza +0.1% 0.0% +0.0% +0.0% +0.0% event +0.1% 0.0% +0.0% +0.0% +0.0% exact-reals +0.1% 0.0% +0.0% +0.0% +0.0% exp3_8 +0.1% 0.0% +0.0% -0.0% 0.0% expert +0.1% 0.0% +0.0% +0.0% +0.0% fannkuch-redux +0.1% 0.0% -0.0% 0.0% 0.0% fasta +0.1% 0.0% -0.0% +0.0% +0.0% fem +0.1% 0.0% -0.0% +0.0% 0.0% fft +0.1% 0.0% -0.0% +0.0% +0.0% fft2 +0.1% 0.0% +0.0% +0.0% +0.0% fibheaps +0.1% 0.0% +0.0% +0.0% +0.0% fish +0.1% 0.0% +0.0% +0.0% +0.0% fluid +0.0% 0.0% +0.0% +0.0% +0.0% fulsom +0.1% 0.0% -0.0% +0.0% 0.0% gamteb +0.1% 0.0% +0.0% +0.0% 0.0% gcd +0.1% 0.0% +0.0% +0.0% +0.0% gen_regexps +0.1% 0.0% -0.0% +0.0% 0.0% genfft +0.1% 0.0% +0.0% +0.0% +0.0% gg +0.1% 0.0% 0.0% +0.0% +0.0% grep +0.1% 0.0% -0.0% +0.0% +0.0% hidden +0.1% 0.0% +0.0% -0.0% 0.0% hpg +0.1% 0.0% -0.0% -0.0% -0.0% ida +0.1% 0.0% +0.0% +0.0% +0.0% infer +0.1% 0.0% +0.0% 0.0% -0.0% integer +0.1% 0.0% +0.0% +0.0% +0.0% integrate +0.1% 0.0% -0.0% -0.0% -0.0% k-nucleotide +0.1% 0.0% +0.0% +0.0% 0.0% kahan +0.1% 0.0% +0.0% +0.0% +0.0% knights +0.1% 0.0% -0.0% -0.0% -0.0% lambda +0.1% 0.0% +0.0% +0.0% -0.0% last-piece +0.1% 0.0% +0.0% 0.0% 0.0% lcss +0.1% 0.0% +0.0% +0.0% 0.0% life +0.1% 0.0% -0.0% +0.0% +0.0% lift +0.1% 0.0% +0.0% +0.0% +0.0% linear +0.1% 0.0% -0.0% +0.0% 0.0% listcompr +0.1% 0.0% +0.0% +0.0% +0.0% listcopy +0.1% 0.0% +0.0% +0.0% +0.0% maillist +0.1% 0.0% +0.0% -0.0% -0.0% mandel +0.1% 0.0% +0.0% +0.0% 0.0% mandel2 +0.1% 0.0% +0.0% +0.0% +0.0% mate +0.1% 0.0% +0.0% 0.0% +0.0% minimax +0.1% 0.0% -0.0% 0.0% -0.0% mkhprog +0.1% 0.0% +0.0% +0.0% +0.0% multiplier +0.1% 0.0% +0.0% 0.0% 0.0% n-body +0.1% 0.0% +0.0% +0.0% +0.0% nucleic2 +0.1% 0.0% +0.0% +0.0% +0.0% para +0.1% 0.0% 0.0% +0.0% +0.0% paraffins +0.1% 0.0% +0.0% -0.0% 0.0% parser +0.1% 0.0% -0.0% -0.0% -0.0% parstof +0.1% 0.0% +0.0% +0.0% +0.0% pic +0.1% 0.0% -0.0% -0.0% 0.0% pidigits +0.1% 0.0% +0.0% -0.0% -0.0% power +0.1% 0.0% +0.0% +0.0% +0.0% pretty +0.1% 0.0% -0.0% -0.0% -0.1% primes +0.1% 0.0% -0.0% -0.0% -0.0% primetest +0.1% 0.0% -0.0% -0.0% -0.0% prolog +0.1% 0.0% -0.0% -0.0% -0.0% puzzle +0.1% 0.0% -0.0% -0.0% -0.0% queens +0.1% 0.0% +0.0% +0.0% +0.0% reptile +0.1% 0.0% -0.0% -0.0% +0.0% reverse-complem +0.1% 0.0% +0.0% 0.0% -0.0% rewrite +0.1% 0.0% -0.0% -0.0% -0.0% rfib +0.1% 0.0% +0.0% +0.0% +0.0% rsa +0.1% 0.0% -0.0% +0.0% -0.0% scc +0.1% 0.0% -0.0% -0.0% -0.1% sched +0.1% 0.0% +0.0% +0.0% +0.0% scs +0.1% 0.0% +0.0% +0.0% +0.0% simple +0.1% 0.0% -0.0% -0.0% -0.0% solid +0.1% 0.0% +0.0% +0.0% +0.0% sorting +0.1% 0.0% -0.0% -0.0% -0.0% spectral-norm +0.1% 0.0% +0.0% +0.0% +0.0% sphere +0.1% 0.0% -0.0% -0.0% -0.0% symalg +0.1% 0.0% -0.0% -0.0% -0.0% tak +0.1% 0.0% +0.0% +0.0% +0.0% transform +0.1% 0.0% +0.0% +0.0% +0.0% treejoin +0.1% 0.0% +0.0% -0.0% -0.0% typecheck +0.1% 0.0% +0.0% +0.0% +0.0% veritas +0.0% 0.0% +0.0% +0.0% +0.0% wang +0.1% 0.0% 0.0% +0.0% +0.0% wave4main +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve1 +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve2 +0.1% 0.0% +0.0% +0.0% +0.0% x2n1 +0.1% 0.0% +0.0% +0.0% +0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -0.0% -0.1% Max +0.1% 0.0% +0.0% +0.0% +0.0% Geometric Mean +0.1% -0.0% -0.0% -0.0% -0.0% Bumping numbers of nonsensical perf tests: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 It's simply not possible for this patch to increase allocations, and I've wasted enough time on these test in the past (see #17686). I think these tests should not be perf tests, but for now I'll bump the numbers.
author: Ömer Sinan Ağacan <omeragacan@gmail.com> 2020-04-03 18:17:56 +0300
committer: Marge Bot <ben+marge-bot@smart-cactus.org> 2020-04-09 16:18:00 -0400
commit: 390751768104cd3d2cb57e2037062916476ebd10 (patch)
tree: 5ae1356a7c1f9bafc65e3cfca349bbd8187f5f59
parent: fa66f143a61f2285618c611a27c23815ca588299 (diff)
download: haskell-390751768104cd3d2cb57e2037062916476ebd10.tar.gz
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
author	Ömer Sinan Ağacan <omeragacan@gmail.com>	2020-04-03 18:17:56 +0300
committer	Marge Bot <ben+marge-bot@smart-cactus.org>	2020-04-09 16:18:00 -0400
commit	390751768104cd3d2cb57e2037062916476ebd10 (patch)
tree	5ae1356a7c1f9bafc65e3cfca349bbd8187f5f59
parent	fa66f143a61f2285618c611a27c23815ca588299 (diff)
download	haskell-390751768104cd3d2cb57e2037062916476ebd10.tar.gz