From 35a5207e8277800b77af90d74cdd235d29a901e6 Mon Sep 17 00:00:00 2001
From: GHC GitLab CI <ghc-ci@gitlab-haskell.org>
Date: Thu, 26 Nov 2020 00:10:26 +0000
Subject: rts/Messages: Add missing write barrier in THROWTO message update

After a THROWTO message has been handle the message closure is
overwritten by a NULL message. We must ensure that the original
closure's pointers continue to be visible to the nonmoving GC.
---
 rts/Messages.c   |  2 +-
 rts/Messages.h   | 10 +++++++++-
 rts/RaiseAsync.c |  8 ++++----
 3 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/rts/Messages.c b/rts/Messages.c
index 285ca5be63..8cd0a5570f 100644
--- a/rts/Messages.c
+++ b/rts/Messages.c
@@ -97,7 +97,7 @@ loop:
         case THROWTO_SUCCESS: {
             // this message is done
             StgTSO *source = t->source;
-            doneWithMsgThrowTo(t);
+            doneWithMsgThrowTo(cap, t);
             tryWakeupThread(cap, source);
             break;
         }
diff --git a/rts/Messages.h b/rts/Messages.h
index 18371564c4..561eb449d2 100644
--- a/rts/Messages.h
+++ b/rts/Messages.h
@@ -23,8 +23,16 @@ void sendMessage    (Capability *from_cap, Capability *to_cap, Message *msg);
 #include "SMPClosureOps.h"
 
 INLINE_HEADER void
-doneWithMsgThrowTo (MessageThrowTo *m)
+doneWithMsgThrowTo (Capability *cap, MessageThrowTo *m)
 {
+    // The message better be locked
+    ASSERT(m->header.info == &stg_WHITEHOLE_info);
+    IF_NONMOVING_WRITE_BARRIER_ENABLED {
+      updateRemembSetPushClosure(cap, (StgClosure *) m->link);
+      updateRemembSetPushClosure(cap, (StgClosure *) m->source);
+      updateRemembSetPushClosure(cap, (StgClosure *) m->target);
+      updateRemembSetPushClosure(cap, (StgClosure *) m->exception);
+    }
     OVERWRITING_CLOSURE((StgClosure*)m);
     unlockClosure((StgClosure*)m, &stg_MSG_NULL_info);
     LDV_RECORD_CREATE(m);
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index a3593fe7a6..c73f2b1161 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -336,7 +336,7 @@ check_target:
         }
 
         // nobody else can wake up this TSO after we claim the message
-        doneWithMsgThrowTo(m);
+        doneWithMsgThrowTo(cap, m);
 
         raiseAsync(cap, target, msg->exception, false, NULL);
         return THROWTO_SUCCESS;
@@ -580,7 +580,7 @@ maybePerformBlockedException (Capability *cap, StgTSO *tso)
 
         throwToSingleThreaded(cap, msg->target, msg->exception);
         source = msg->source;
-        doneWithMsgThrowTo(msg);
+        doneWithMsgThrowTo(cap, msg);
         tryWakeupThread(cap, source);
         return 1;
     }
@@ -602,7 +602,7 @@ awakenBlockedExceptionQueue (Capability *cap, StgTSO *tso)
         i = lockClosure((StgClosure *)msg);
         if (i != &stg_MSG_NULL_info) {
             source = msg->source;
-            doneWithMsgThrowTo(msg);
+            doneWithMsgThrowTo(cap, msg);
             tryWakeupThread(cap, source);
         } else {
             unlockClosure((StgClosure *)msg,i);
@@ -700,7 +700,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
       // ASSERT(m->header.info == &stg_WHITEHOLE_info);
 
       // unlock and revoke it at the same time
-      doneWithMsgThrowTo(m);
+      doneWithMsgThrowTo(cap, m);
       break;
   }
 
-- 
cgit v1.2.1