From 5d9e686c30a00be08a04d9fd1c860994153a1f7a Mon Sep 17 00:00:00 2001
From: Ian Lynagh <ian@well-typed.com>
Date: Sat, 15 Jun 2013 13:19:21 +0100
Subject: Optimization for takeMVar/putMVar when MVar left empty; fixes #7923

We only need to apply the write barrier to an MVar when it acquires
a reference to live data; when the MVar is left empty in the case
of a takeMVar/putMVar, we can save a memory reference.

Patch from Edward Z. Yang.
---
 rts/PrimOps.cmm | 49 +++++++++++++++++++++++++++++--------------------
 1 file changed, 29 insertions(+), 20 deletions(-)

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 230b9292f8..01339b2a36 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1197,14 +1197,13 @@ stg_takeMVarzh ( P_ mvar /* :: MVar a */ )
     info = GET_INFO(mvar);
 #endif
 
-    if (info == stg_MVAR_CLEAN_info) {
-        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
-    }
-
     /* If the MVar is empty, put ourselves on its blocking queue,
      * and wait until we're woken up.
      */
     if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
+        if (info == stg_MVAR_CLEAN_info) {
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        }
 
         // We want to put the heap check down here in the slow path,
         // but be careful to unlock the closure before returning to
@@ -1243,7 +1242,9 @@ loop:
     if (q == stg_END_TSO_QUEUE_closure) {
         /* No further putMVars, MVar is now empty */
         StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-        unlockClosure(mvar, stg_MVAR_DIRTY_info);
+        // If the MVar is not already dirty, then we don't need to make
+        // it dirty, as it is empty with nothing blocking on it.
+        unlockClosure(mvar, info);
         return (val);
     }
     if (StgHeader_info(q) == stg_IND_info ||
@@ -1254,6 +1255,10 @@ loop:
 
     // There are putMVar(s) waiting... wake up the first thread on the queue
 
+    if (info == stg_MVAR_CLEAN_info) {
+        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+    }
+
     tso = StgMVarTSOQueue_tso(q);
     StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
     if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
@@ -1300,10 +1305,6 @@ stg_tryTakeMVarzh ( P_ mvar /* :: MVar a */ )
         return (0, stg_NO_FINALIZER_closure);
     }
 
-    if (info == stg_MVAR_CLEAN_info) {
-        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
-    }
-
     /* we got the value... */
     val = StgMVar_value(mvar);
 
@@ -1312,9 +1313,10 @@ loop:
     if (q == stg_END_TSO_QUEUE_closure) {
         /* No further putMVars, MVar is now empty */
         StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-        unlockClosure(mvar, stg_MVAR_DIRTY_info);
+        unlockClosure(mvar, info);
         return (1, val);
     }
+
     if (StgHeader_info(q) == stg_IND_info ||
         StgHeader_info(q) == stg_MSG_NULL_info) {
         q = StgInd_indirectee(q);
@@ -1323,6 +1325,10 @@ loop:
 
     // There are putMVar(s) waiting... wake up the first thread on the queue
 
+    if (info == stg_MVAR_CLEAN_info) {
+        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+    }
+
     tso = StgMVarTSOQueue_tso(q);
     StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
     if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
@@ -1359,12 +1365,12 @@ stg_putMVarzh ( P_ mvar, /* :: MVar a */
     info = GET_INFO(mvar);
 #endif
 
-    if (info == stg_MVAR_CLEAN_info) {
-        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
-    }
-
     if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
 
+        if (info == stg_MVAR_CLEAN_info) {
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        }
+
         // We want to put the heap check down here in the slow path,
         // but be careful to unlock the closure before returning to
         // the RTS if the check fails.
@@ -1398,6 +1404,9 @@ stg_putMVarzh ( P_ mvar, /* :: MVar a */
 loop:
     if (q == stg_END_TSO_QUEUE_closure) {
         /* No further takes, the MVar is now full. */
+        if (info == stg_MVAR_CLEAN_info) {
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        }
         StgMVar_value(mvar) = val;
         unlockClosure(mvar, stg_MVAR_DIRTY_info);
         return ();
@@ -1433,7 +1442,7 @@ loop:
 
     ccall tryWakeupThread(MyCapability() "ptr", tso);
 
-    unlockClosure(mvar, stg_MVAR_DIRTY_info);
+    unlockClosure(mvar, info);
     return ();
 }
 
@@ -1456,14 +1465,14 @@ stg_tryPutMVarzh ( P_ mvar, /* :: MVar a */
         return (0);
     }
 
-    if (info == stg_MVAR_CLEAN_info) {
-        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
-    }
-
     q = StgMVar_head(mvar);
 loop:
     if (q == stg_END_TSO_QUEUE_closure) {
         /* No further takes, the MVar is now full. */
+        if (info == stg_MVAR_CLEAN_info) {
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        }
+
         StgMVar_value(mvar) = val;
         unlockClosure(mvar, stg_MVAR_DIRTY_info);
         return (1);
@@ -1499,7 +1508,7 @@ loop:
 
     ccall tryWakeupThread(MyCapability() "ptr", tso);
 
-    unlockClosure(mvar, stg_MVAR_DIRTY_info);
+    unlockClosure(mvar, info);
     return (1);
 }
 
-- 
cgit v1.2.1