UniqSupply: make mkSplitUniqSupply thread-safe
authorPatrick Palka <patrick@parcs.ath.cx>
Wed, 21 Aug 2013 19:25:18 +0000 (15:25 -0400)
committerPatrick Palka <patrick@parcs.ath.cx>
Tue, 27 Aug 2013 02:21:16 +0000 (22:21 -0400)
unsafeInterleaveIO is used instead of unsafeDupableInterleaveIO because
a mk_supply thunk that is simultaneously entered by two threads should
evaluate to the same UniqSupply.

The UniqSupply counter is now incremented atomically using the RTS's
atomic_inc().

To mitigate the extra overhead of unsafeInterleaveIO in the
single-threaded compiler, noDuplicate# is changed to exit early when
n_capabilities == 1.

compiler/basicTypes/UniqSupply.lhs
compiler/cbits/genSym.c
compiler/ghc.mk
rts/PrimOps.cmm

index 0c6007a..fea1489 100644 (file)
@@ -29,7 +29,7 @@ module UniqSupply (
 import Unique
 import FastTypes
 
-import GHC.IO (unsafeDupableInterleaveIO)
+import GHC.IO
 
 import MonadUtils
 import Control.Monad
@@ -80,7 +80,8 @@ mkSplitUniqSupply c
 
         -- This is one of the most hammered bits in the whole compiler
         mk_supply
-          = unsafeDupableInterleaveIO (
+          -- NB: Use unsafeInterleaveIO for thread-safety.
+          = unsafeInterleaveIO (
                 genSym      >>= \ u_ -> case iUnbox u_ of { u -> (
                 mk_supply   >>= \ s1 ->
                 mk_supply   >>= \ s2 ->
index 2d9779b..8614e97 100644 (file)
@@ -4,6 +4,10 @@
 static HsInt GenSymCounter = 0;
 
 HsInt genSym(void) {
-    return GenSymCounter++;
+    if (n_capabilities == 1) {
+        return GenSymCounter++;
+    } else {
+        return atomic_inc((StgWord *)&GenSymCounter);
+    }
 }
 
index 2a7a8c4..af289d4 100644 (file)
@@ -309,6 +309,12 @@ compiler_stage1_CONFIGURE_OPTS += --flags=stage1
 compiler_stage2_CONFIGURE_OPTS += --flags=stage2
 compiler_stage3_CONFIGURE_OPTS += --flags=stage3
 
+ifeq "$(GhcThreaded)" "YES"
+# We pass THREADED_RTS to the stage2 C files so that cbits/genSym.c will bring
+# the threaded version of atomic_inc() into scope.
+compiler_stage2_CONFIGURE_OPTS += --ghc-option=-optc-DTHREADED_RTS
+endif
+
 ifeq "$(GhcWithNativeCodeGen)" "YES"
 compiler_stage1_CONFIGURE_OPTS += --flags=ncg
 compiler_stage2_CONFIGURE_OPTS += --flags=ncg
index ced15ee..d8acaef 100644 (file)
@@ -2008,6 +2008,11 @@ INFO_TABLE_RET(stg_noDuplicate, RET_SMALL, W_ info_ptr)
 
 stg_noDuplicatezh /* no arg list: explicit stack layout */
 {
+    // With a single capability there's no chance of work duplication.
+    if (CInt[n_capabilities] == 1 :: CInt) {
+        jump %ENTRY_CODE(Sp(0)) [];
+    }
+
     STK_CHK(WDS(1), stg_noDuplicatezh);
 
     // leave noDuplicate frame in case the current