From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 7 Jan 2009 11:20:26 +0000 (+0000)
Subject: putMVar and takeMVar: add write_barrier() to fix race with throwTo
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=8a317b223ac681f99e75f9a4a89380c92d283049

putMVar and takeMVar: add write_barrier() to fix race with throwTo
---

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 40948a3..dc60ff2 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1651,8 +1651,11 @@ takeMVarzh_fast
                                    CurrentTSO) [];
 	}
 	StgTSO__link(CurrentTSO)       = stg_END_TSO_QUEUE_closure;
-	StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
 	StgTSO_block_info(CurrentTSO)  = mvar;
+        // write barrier for throwTo(), which looks at block_info
+        // if why_blocked==BlockedOnMVar.
+        prim %write_barrier() [];
+	StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
 	StgMVar_tail(mvar) = CurrentTSO;
 	
         R1 = mvar;
@@ -1808,8 +1811,11 @@ putMVarzh_fast
                                    CurrentTSO) [];
 	}
 	StgTSO__link(CurrentTSO)       = stg_END_TSO_QUEUE_closure;
-	StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
 	StgTSO_block_info(CurrentTSO)  = mvar;
+        // write barrier for throwTo(), which looks at block_info
+        // if why_blocked==BlockedOnMVar.
+        prim %write_barrier() [];
+	StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
 	StgMVar_tail(mvar) = CurrentTSO;
 	
         R1 = mvar;