[commit: ghc] master: Optimise lockClosure when n_capabilities == 1; fixes #693 (75947bb)

[Ian Lynagh]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/75947bb63794cae5950f679c8df86441b736b3fa

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

commit 75947bb63794cae5950f679c8df86441b736b3fa
Author: Ian Lynagh <ian at well-typed.com>
Date:   Sat Jun 15 19:07:58 2013 +0100

    Optimise lockClosure when n_capabilities == 1; fixes #693
    
    Based on a patch from Yuras Shumovich.

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

 includes/Rts.h                       |  2 +-
 includes/rts/storage/SMPClosureOps.h | 28 ++++++++++++++++++++++------
 rts/PrimOps.cmm                      | 28 ++++++++++++++++++++++++----
 3 files changed, 47 insertions(+), 11 deletions(-)

diff --git a/includes/Rts.h b/includes/Rts.h
index bea4c47..122637c 100644
--- a/includes/Rts.h
+++ b/includes/Rts.h
@@ -203,6 +203,7 @@ INLINE_HEADER Time fsecondsToTime (double t)
 #include "rts/SpinLock.h"
 
 #include "rts/Messages.h"
+#include "rts/Threads.h"
 
 /* Storage format definitions */
 #include "rts/storage/FunTypes.h"
@@ -230,7 +231,6 @@ INLINE_HEADER Time fsecondsToTime (double t)
 #include "rts/Globals.h"
 #include "rts/IOManager.h"
 #include "rts/Linker.h"
-#include "rts/Threads.h"
 #include "rts/Ticky.h"
 #include "rts/Timer.h"
 #include "rts/Stable.h"
diff --git a/includes/rts/storage/SMPClosureOps.h b/includes/rts/storage/SMPClosureOps.h
index e2b01d7..ffa2fe8 100644
--- a/includes/rts/storage/SMPClosureOps.h
+++ b/includes/rts/storage/SMPClosureOps.h
@@ -18,6 +18,7 @@
 #else
 
 EXTERN_INLINE StgInfoTable *lockClosure(StgClosure *p);
+EXTERN_INLINE StgInfoTable *reallyLockClosure(StgClosure *p);
 EXTERN_INLINE StgInfoTable *tryLockClosure(StgClosure *p);
 EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info);
 
@@ -31,7 +32,7 @@ EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info);
 
 // We want a callable copy of lockClosure() so that we can refer to it
 // from .cmm files compiled using the native codegen.
-EXTERN_INLINE StgInfoTable *lockClosure(StgClosure *p)
+EXTERN_INLINE StgInfoTable *reallyLockClosure(StgClosure *p)
 {
     StgWord info;
     do {
@@ -44,14 +45,29 @@ EXTERN_INLINE StgInfoTable *lockClosure(StgClosure *p)
     } while (1);
 }
 
+EXTERN_INLINE StgInfoTable *lockClosure(StgClosure *p)
+{
+    if (n_capabilities == 1) {
+        return (StgInfoTable *)p->header.info;
+    }
+    else {
+        return reallyLockClosure(p);
+    }
+}
+
 EXTERN_INLINE StgInfoTable *tryLockClosure(StgClosure *p)
 {
     StgWord info;
-    info = xchg((P_)(void *)&p->header.info, (W_)&stg_WHITEHOLE_info);
-    if (info != (W_)&stg_WHITEHOLE_info) {
-        return (StgInfoTable *)info;
-    } else {
-        return NULL;
+    if (n_capabilities == 1) {
+        return (StgInfoTable *)p->header.info;
+    }
+    else {
+        info = xchg((P_)(void *)&p->header.info, (W_)&stg_WHITEHOLE_info);
+        if (info != (W_)&stg_WHITEHOLE_info) {
+            return (StgInfoTable *)info;
+        } else {
+            return NULL;
+        }
     }
 }
 
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index c12c6d8..a227e77 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1193,7 +1193,12 @@ stg_takeMVarzh ( P_ mvar /* :: MVar a */ )
     W_ val, info, tso, q;
 
 #if defined(THREADED_RTS)
-    ("ptr" info) = ccall lockClosure(mvar "ptr");
+    if (CInt[n_capabilities] == 1 :: CInt) {
+        info = GET_INFO(mvar);
+    }
+    else {
+        ("ptr" info) = ccall reallyLockClosure(mvar "ptr");
+    }
 #else
     info = GET_INFO(mvar);
 #endif
@@ -1290,7 +1295,12 @@ stg_tryTakeMVarzh ( P_ mvar /* :: MVar a */ )
     W_ val, info, tso, q;
 
 #if defined(THREADED_RTS)
-    ("ptr" info) = ccall lockClosure(mvar "ptr");
+    if (CInt[n_capabilities] == 1 :: CInt) {
+        info = GET_INFO(mvar);
+    }
+    else {
+        ("ptr" info) = ccall reallyLockClosure(mvar "ptr");
+    }
 #else
     info = GET_INFO(mvar);
 #endif
@@ -1361,7 +1371,12 @@ stg_putMVarzh ( P_ mvar, /* :: MVar a */
     W_ info, tso, q;
 
 #if defined(THREADED_RTS)
-    ("ptr" info) = ccall lockClosure(mvar "ptr");
+    if (CInt[n_capabilities] == 1 :: CInt) {
+        info = GET_INFO(mvar);
+    }
+    else {
+        ("ptr" info) = ccall reallyLockClosure(mvar "ptr");
+    }
 #else
     info = GET_INFO(mvar);
 #endif
@@ -1454,7 +1469,12 @@ stg_tryPutMVarzh ( P_ mvar, /* :: MVar a */
     W_ info, tso, q;
 
 #if defined(THREADED_RTS)
-    ("ptr" info) = ccall lockClosure(mvar "ptr");
+    if (CInt[n_capabilities] == 1 :: CInt) {
+        info = GET_INFO(mvar);
+    }
+    else {
+        ("ptr" info) = ccall reallyLockClosure(mvar "ptr");
+    }
 #else
     info = GET_INFO(mvar);
 #endif