Optimise lockClosure when n_capabilities == 1; fixes #693

Based on a patch from Yuras Shumovich.

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"

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;
+        }
     }
 }
 

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