diff options
| author | Patrick Palka <patrick@parcs.ath.cx> | 2013-08-21 15:25:18 -0400 |
|---|---|---|
| committer | Patrick Palka <patrick@parcs.ath.cx> | 2013-08-26 22:21:16 -0400 |
| commit | 036910ad0d01cfd23fa53930fca2dd880faa6536 (patch) | |
| tree | 069d6bff28cde8dd1b09835972e299966f16fd3d | |
| parent | 776cfe28cf089c24a56a288f2f0c49494f7d9e47 (diff) | |
| download | haskell-036910ad0d01cfd23fa53930fca2dd880faa6536.tar.gz | |
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.
| -rw-r--r-- | compiler/basicTypes/UniqSupply.lhs | 5 | ||||
| -rw-r--r-- | compiler/cbits/genSym.c | 6 | ||||
| -rw-r--r-- | compiler/ghc.mk | 6 | ||||
| -rw-r--r-- | rts/PrimOps.cmm | 5 |
4 files changed, 19 insertions, 3 deletions
diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs index 0c6007a4f7..fea1489efb 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 2d9779b898..8614e97e75 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 2a7a8c4b87..af289d436c 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 ced15eec99..d8acaef77b 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 |