[commit: ghc] ghc-parmake-gsoc: UniqSupply: make mkSplitUniqSupply thread-safe (036910a)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-parmake-gsoc
Link       : http://ghc.haskell.org/trac/ghc/changeset/036910ad0d01cfd23fa53930fca2dd880faa6536/ghc

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

commit 036910ad0d01cfd23fa53930fca2dd880faa6536
Author: Patrick Palka <patrick at parcs.ath.cx>
Date:   Wed Aug 21 15:25:18 2013 -0400

    UniqSupply: make mkSplitUniqSupply thread-safe
    
    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.


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

036910ad0d01cfd23fa53930fca2dd880faa6536
 compiler/basicTypes/UniqSupply.lhs |    5 +++--
 compiler/cbits/genSym.c            |    6 +++++-
 compiler/ghc.mk                    |    6 ++++++
 rts/PrimOps.cmm                    |    5 +++++
 4 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs
index 0c6007a..fea1489 100644
--- a/compiler/basicTypes/UniqSupply.lhs
+++ b/compiler/basicTypes/UniqSupply.lhs
@@ -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 ->
diff --git a/compiler/cbits/genSym.c b/compiler/cbits/genSym.c
index 2d9779b..8614e97 100644
--- a/compiler/cbits/genSym.c
+++ b/compiler/cbits/genSym.c
@@ -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);
+    }
 }
 
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 2a7a8c4..af289d4 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -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
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index ced15ee..d8acaef 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -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