[commit: ghc] ghc-8.6: Optimise wakeups for STM (c15ba1f)

[git at git.haskell.org]

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

On branch  : ghc-8.6
Link       : http://ghc.haskell.org/trac/ghc/changeset/c15ba1fb83575081bb6a1d4955f9e13626ef8d51/ghc

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

commit c15ba1fb83575081bb6a1d4955f9e13626ef8d51
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Sat Jul 14 20:02:03 2018 -0400

    Optimise wakeups for STM
    
    Avoids repeated wakeup messages being sent when a TVar is written to
    multiple times. See comments for details.
    
    Test Plan:
    * Test from #15136 (will be added to stm shortly)
    * existing stm tests
    
    Reviewers: bgamari, osa1, erikd
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #15136
    
    Differential Revision: https://phabricator.haskell.org/D4961
    
    (cherry picked from commit 502640c90c3d0fbb6c46257be14fdc7e3c694c6c)


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

c15ba1fb83575081bb6a1d4955f9e13626ef8d51
 rts/STM.c | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

diff --git a/rts/STM.c b/rts/STM.c
index abb4417..976ad87 100644
--- a/rts/STM.c
+++ b/rts/STM.c
@@ -332,7 +332,29 @@ static void unpark_tso(Capability *cap, StgTSO *tso) {
     // queues: it's up to the thread itself to remove it from the wait queues
     // if it decides to do so when it is scheduled.
 
-    tryWakeupThread(cap,tso);
+    // Only the capability that owns this TSO may unblock it. We can
+    // call tryWakeupThread() which will either unblock it directly if
+    // it belongs to this cap, or send a message to the owning cap
+    // otherwise.
+
+    // But we don't really want to send multiple messages if we write
+    // to the same TVar multiple times, and the owning cap hasn't yet
+    // woken up the thread and removed it from the TVar's watch list.
+    // So, we use the tso->block_info as a flag to indicate whether
+    // we've already done tryWakeupThread() for this thread.
+
+    // Safety Note: we hold the TVar lock at this point, so we know
+    // that this thread is definitely still blocked, since the first
+    // thing a thread will do when it runs is remove itself from the
+    // TVar watch queues, and to do that it would need to lock the
+    // TVar.
+
+    if (tso->block_info.closure != &stg_STM_AWOKEN_closure) {
+        // safe to do a non-atomic test-and-set here, because it's
+        // fine if we do multiple tryWakeupThread()s.
+        tso->block_info.closure = &stg_STM_AWOKEN_closure;
+        tryWakeupThread(cap,tso);
+    }
 }
 
 static void unpark_waiters_on(Capability *cap, StgTVar *s) {