[commit: ghc] ghc-8.0: Fix failure in setnumcapabilities001 (#12728) (2722cd5)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/2722cd55431452ad7fc7fcae030b1587086dec8f/ghc

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

commit 2722cd55431452ad7fc7fcae030b1587086dec8f
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Fri Oct 21 12:02:57 2016 -0400

    Fix failure in setnumcapabilities001 (#12728)
    
    The value of enabled_capabilities can change across a call to
    requestSync(), and we were erroneously using an old value, causing
    things to go wrong later.  It manifested as an assertion failure, I'm
    not sure whether there are worse consequences or not, but we should
    get this fix into 8.0.2 anyway.
    
    The failure didn't happen for me because it only shows up on machines
    with fewer than 4 processors, due to the new logic to enable -qn
    automatically.  I've bumped the test parameter 8 to make it more
    likely to exercise that code.
    
    Test Plan: Ran setnumcapabilities001 many times
    
    Reviewers: niteria, austin, erikd, rwbarton, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2617
    
    GHC Trac Issues: #12728
    
    (cherry picked from commit acc98510c5e32474b0bba9fba54e78df2b11078c)


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

2722cd55431452ad7fc7fcae030b1587086dec8f
 rts/Schedule.c                              | 45 +++++++++++++++++------------
 testsuite/tests/concurrent/should_run/all.T |  2 +-
 2 files changed, 27 insertions(+), 20 deletions(-)

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 74859af..1f42e42 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1543,27 +1543,14 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS,
         gc_type = SYNC_GC_SEQ;
     }
 
-    if (gc_type == SYNC_GC_PAR && RtsFlags.ParFlags.parGcThreads > 0) {
-        need_idle = stg_max(0, enabled_capabilities -
-                            RtsFlags.ParFlags.parGcThreads);
-    } else {
-        need_idle = 0;
-    }
-
     // In order to GC, there must be no threads running Haskell code.
-    // Therefore, the GC thread needs to hold *all* the capabilities,
-    // and release them after the GC has completed.
+    // Therefore, for single-threaded GC, the GC thread needs to hold *all* the
+    // capabilities, and release them after the GC has completed.  For parallel
+    // GC, we synchronise all the running threads using requestSync().
     //
-    // This seems to be the simplest way: previous attempts involved
-    // making all the threads with capabilities give up their
-    // capabilities and sleep except for the *last* one, which
-    // actually did the GC.  But it's quite hard to arrange for all
-    // the other tasks to sleep and stay asleep.
-    //
-
-    /*  Other capabilities are prevented from running yet more Haskell
-        threads if pending_sync is set. Tested inside
-        yieldCapability() and releaseCapability() in Capability.c */
+    // Other capabilities are prevented from running yet more Haskell threads if
+    // pending_sync is set. Tested inside yieldCapability() and
+    // releaseCapability() in Capability.c
 
     PendingSync sync = {
         .type = gc_type,
@@ -1575,6 +1562,26 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS,
         SyncType prev_sync = 0;
         rtsBool was_syncing;
         do {
+            // If -qn is not set and we have more capabilities than cores, set
+            // the number of GC threads to #cores.  We do this here rather than
+            // in normaliseRtsOpts() because here it will work if the program
+            // calls setNumCapabilities.
+            //
+            n_gc_threads = RtsFlags.ParFlags.parGcThreads;
+            if (n_gc_threads == 0 &&
+                enabled_capabilities > getNumberOfProcessors()) {
+                n_gc_threads = getNumberOfProcessors();
+            }
+
+            // This calculation must be inside the loop because
+            // enabled_capabilities may change if requestSync() below fails and
+            // we retry.
+            if (gc_type == SYNC_GC_PAR && n_gc_threads > 0) {
+                need_idle = stg_max(0, enabled_capabilities - n_gc_threads);
+            } else {
+                need_idle = 0;
+            }
+
             // We need an array of size n_capabilities, but since this may
             // change each time around the loop we must allocate it afresh.
             idle_cap = (rtsBool *)stgMallocBytes(n_capabilities *
diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T
index 3d5e08b..e7537ec 100644
--- a/testsuite/tests/concurrent/should_run/all.T
+++ b/testsuite/tests/concurrent/should_run/all.T
@@ -246,7 +246,7 @@ test('conc068', [ omit_ways('threaded2'), exit_code(1) ], compile_and_run, [''])
 
 test('setnumcapabilities001',
      [ only_ways(['threaded1','threaded2']),
-       extra_run_opts('4 12 2000'),
+       extra_run_opts('8 12 2000'),
        req_smp ],
      compile_and_run, [''])