[commit: ghc] master: storageAddCapabilities: fix bug in updating nursery pointers (4cb5595)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/4cb5595e5e800818721a623a5419cad29a528000/ghc

>---------------------------------------------------------------

commit 4cb5595e5e800818721a623a5419cad29a528000
Author: Simon Marlow <smarlow at fb.com>
Date:   Fri Apr 27 11:31:19 2018 -0700

    storageAddCapabilities: fix bug in updating nursery pointers
    
    Summary:
    We were unconditionally updating the nursery pointers to be
    `nurseries[cap->no]`, but when using nursery chunks this might be
    wrong. This manifested as a later assertion failure in allocate().
    
    Test Plan: new test case
    
    Reviewers: bgamari, niteria, erikd
    
    Subscribers: thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D4649


>---------------------------------------------------------------

4cb5595e5e800818721a623a5419cad29a528000
 rts/sm/Storage.c                       |  7 +++++--
 testsuite/tests/rts/all.T              |  7 +++++++
 testsuite/tests/rts/nursery-chunks1.hs | 12 ++++++++++++
 3 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 9174646..52dab73 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -220,6 +220,7 @@ initStorage (void)
 void storageAddCapabilities (uint32_t from, uint32_t to)
 {
     uint32_t n, g, i, new_n_nurseries;
+    nursery *old_nurseries;
 
     if (RtsFlags.GcFlags.nurseryChunkSize == 0) {
         new_n_nurseries = to;
@@ -229,6 +230,7 @@ void storageAddCapabilities (uint32_t from, uint32_t to)
             stg_max(to, total_alloc / RtsFlags.GcFlags.nurseryChunkSize);
     }
 
+    old_nurseries = nurseries;
     if (from > 0) {
         nurseries = stgReallocBytes(nurseries,
                                     new_n_nurseries * sizeof(struct nursery_),
@@ -240,8 +242,9 @@ void storageAddCapabilities (uint32_t from, uint32_t to)
 
     // we've moved the nurseries, so we have to update the rNursery
     // pointers from the Capabilities.
-    for (i = 0; i < to; i++) {
-        capabilities[i]->r.rNursery = &nurseries[i];
+    for (i = 0; i < from; i++) {
+        uint32_t index = capabilities[i]->r.rNursery - old_nurseries;
+        capabilities[i]->r.rNursery = &nurseries[index];
     }
 
     /* The allocation area.  Policy: keep the allocation area
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index a278388..8fa2257 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -402,3 +402,10 @@ test('alloccounter1', normal, compile_and_run,
     # allocation and messes up the results:
     '-with-rtsopts=-k1m'
   ])
+
+test('nursery-chunks1',
+  [ extra_run_opts('4 100 +RTS -n32k -A1m -RTS')
+  , only_ways(['threaded1','threaded2'])
+  ],
+  compile_and_run,
+  [''])
diff --git a/testsuite/tests/rts/nursery-chunks1.hs b/testsuite/tests/rts/nursery-chunks1.hs
new file mode 100644
index 0000000..f8f9f6a
--- /dev/null
+++ b/testsuite/tests/rts/nursery-chunks1.hs
@@ -0,0 +1,12 @@
+-- Test for a bug that provoked the following assertion failure:
+-- nursery-chunks1: internal error: ASSERTION FAILED: file rts/sm/Sanity.c, line 903
+module Main (main) where
+
+import Control.Monad
+import System.Environment
+import GHC.Conc
+
+main = do
+  [n,m] <- fmap read <$> getArgs
+  forM_ [1..n] $ \n' ->
+    when (sum [1.. m::Integer] > 0) $ setNumCapabilities (fromIntegral n')