summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorPatrick Palka <patrick@parcs.ath.cx>2013-08-21 15:25:18 -0400
committerPatrick Palka <patrick@parcs.ath.cx>2013-08-26 22:21:16 -0400
commit036910ad0d01cfd23fa53930fca2dd880faa6536 (patch)
tree069d6bff28cde8dd1b09835972e299966f16fd3d /compiler
parent776cfe28cf089c24a56a288f2f0c49494f7d9e47 (diff)
downloadhaskell-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.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/basicTypes/UniqSupply.lhs5
-rw-r--r--compiler/cbits/genSym.c6
-rw-r--r--compiler/ghc.mk6
3 files changed, 14 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