summaryrefslogtreecommitdiff
path: root/hadrian
diff options
context:
space:
mode:
authorTravis Whitaker <pi.boy.travis@gmail.com>2020-05-06 04:14:47 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-05-29 13:34:48 -0400
commit67738db10010fd28a8e997b5c8f83ea591b88a0e (patch)
tree92e283a33006eca3888019c744f5d1b5ed34cddb /hadrian
parentf9a513e064bd8a33ad6f8aa5fb8673931507eca1 (diff)
downloadhaskell-67738db10010fd28a8e997b5c8f83ea591b88a0e.tar.gz
Build a threaded stage 1 if the bootstrapping GHC supports it.
Diffstat (limited to 'hadrian')
-rw-r--r--hadrian/cfg/system.config.in2
-rw-r--r--hadrian/src/Expression.hs26
-rw-r--r--hadrian/src/Oracles/Flag.hs28
-rw-r--r--hadrian/src/Settings/Packages.hs30
4 files changed, 66 insertions, 20 deletions
diff --git a/hadrian/cfg/system.config.in b/hadrian/cfg/system.config.in
index 016b5bc7bb..810b290d1b 100644
--- a/hadrian/cfg/system.config.in
+++ b/hadrian/cfg/system.config.in
@@ -79,6 +79,8 @@ ghc-major-version = @GhcMajVersion@
ghc-minor-version = @GhcMinVersion@
ghc-patch-level = @GhcPatchLevel@
+bootstrap-threaded-rts = @GhcThreadedRts@
+
supports-this-unit-id = @SUPPORTS_THIS_UNIT_ID@
project-name = @ProjectName@
diff --git a/hadrian/src/Expression.hs b/hadrian/src/Expression.hs
index 197827a5f0..d0b166fdaa 100644
--- a/hadrian/src/Expression.hs
+++ b/hadrian/src/Expression.hs
@@ -6,8 +6,9 @@ module Expression (
expr, exprIO, arg, remove,
-- ** Predicates
- (?), stage, stage0, stage1, stage2, notStage0, package, notPackage,
- packageOneOf, libraryPackage, builder, way, input, inputs, output, outputs,
+ (?), stage, stage0, stage1, stage2, notStage0, threadedBootstrapper,
+ package, notPackage, packageOneOf, libraryPackage, builder, way, input,
+ inputs, output, outputs,
-- ** Evaluation
interpret, interpretInContext,
@@ -26,6 +27,7 @@ import Base
import Builder
import Context hiding (stage, package, way)
import Expression.Type
+import Oracles.Flag
import Hadrian.Expression hiding (Expr, Predicate, Args)
import Hadrian.Haskell.Cabal.Type
import Hadrian.Oracles.Cabal
@@ -86,6 +88,19 @@ instance BuilderPredicate a => BuilderPredicate (FilePath -> a) where
way :: Way -> Predicate
way w = (w ==) <$> getWay
+{-
+Note [Stage Names]
+~~~~~~~~~~~~~~~~~~
+
+Code referring to specific stages can be a bit tricky. In Hadrian, the stages
+have the same names they carried in the autoconf build system, but they are
+often referred to by the stage used to construct them. For example, the stage 1
+artifacts will be placed in _build/stage0, because they are constructed by the
+stage 0 compiler. The stage predicates in this module behave the same way,
+'stage0' will return 'True' while stage 0 is being used to build the stage 1
+compiler.
+-}
+
-- | Is the build currently in stage 0?
stage0 :: Predicate
stage0 = stage Stage0
@@ -102,6 +117,13 @@ stage2 = stage Stage2
notStage0 :: Predicate
notStage0 = notM stage0
+-- | Whether or not the bootstrapping compiler provides a threaded RTS. We need
+-- to know this when building stage 1, since stage 1 links against the
+-- compiler's RTS ways. See Note [Linking ghc-bin against threaded stage0 RTS]
+-- in Settings.Packages for details.
+threadedBootstrapper :: Predicate
+threadedBootstrapper = expr (flag BootstrapThreadedRts)
+
-- | Is a certain package /not/ built right now?
notPackage :: Package -> Predicate
notPackage = notM . package
diff --git a/hadrian/src/Oracles/Flag.hs b/hadrian/src/Oracles/Flag.hs
index 34713faae1..2de81cfdd6 100644
--- a/hadrian/src/Oracles/Flag.hs
+++ b/hadrian/src/Oracles/Flag.hs
@@ -24,25 +24,27 @@ data Flag = ArSupportsAtFile
| WithLibnuma
| HaveLibMingwEx
| UseSystemFfi
+ | BootstrapThreadedRts
-- Note, if a flag is set to empty string we treat it as set to NO. This seems
-- fragile, but some flags do behave like this.
flag :: Flag -> Action Bool
flag f = do
let key = case f of
- ArSupportsAtFile -> "ar-supports-at-file"
- CrossCompiling -> "cross-compiling"
- CcLlvmBackend -> "cc-llvm-backend"
- GhcUnregisterised -> "ghc-unregisterised"
- TablesNextToCode -> "tables-next-to-code"
- GmpInTree -> "intree-gmp"
- GmpFrameworkPref -> "gmp-framework-preferred"
- LeadingUnderscore -> "leading-underscore"
- SolarisBrokenShld -> "solaris-broken-shld"
- WithLibdw -> "with-libdw"
- WithLibnuma -> "with-libnuma"
- HaveLibMingwEx -> "have-lib-mingw-ex"
- UseSystemFfi -> "use-system-ffi"
+ ArSupportsAtFile -> "ar-supports-at-file"
+ CrossCompiling -> "cross-compiling"
+ CcLlvmBackend -> "cc-llvm-backend"
+ GhcUnregisterised -> "ghc-unregisterised"
+ TablesNextToCode -> "tables-next-to-code"
+ GmpInTree -> "intree-gmp"
+ GmpFrameworkPref -> "gmp-framework-preferred"
+ LeadingUnderscore -> "leading-underscore"
+ SolarisBrokenShld -> "solaris-broken-shld"
+ WithLibdw -> "with-libdw"
+ WithLibnuma -> "with-libnuma"
+ HaveLibMingwEx -> "have-lib-mingw-ex"
+ UseSystemFfi -> "use-system-ffi"
+ BootstrapThreadedRts -> "bootstrap-threaded-rts"
value <- lookupValueOrError configFile key
when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag "
++ quote (key ++ " = " ++ value) ++ " cannot be parsed."
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index eb911ef6f2..210f1c829c 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -64,8 +64,13 @@ packageArgs = do
, flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
, notM targetSupportsSMP ? arg "--ghc-option=-DNOSMP"
, notM targetSupportsSMP ? arg "--ghc-option=-optc-DNOSMP"
+ -- When building stage 1 or later, use thread-safe RTS functions if
+ -- the configuration calls for a threaded GHC.
, (any (wayUnit Threaded) rtsWays) ?
notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
+ -- When building stage 1, use thread-safe RTS functions if the
+ -- bootstrapping (stage 0) compiler provides a threaded RTS way.
+ , stage0 ? threadedBootstrapper ? arg "--ghc-option=-optc-DTHREADED_RTS"
, ghcWithInterpreter ?
ghciWithDebugger <$> flavour ?
notStage0 ? arg "--ghc-option=-DDEBUGGER"
@@ -90,11 +95,26 @@ packageArgs = do
, builder (Cabal Flags) ? mconcat
[ ghcWithInterpreter ? notStage0 ? arg "ghci"
, cross ? arg "-terminfo"
- -- the 'threaded' flag is True by default, but
- -- let's record explicitly that we link all ghc
- -- executables with the threaded runtime.
- , stage0 ? arg "-threaded"
- , notStage0 ? ifM (ghcThreaded <$> expr flavour) (arg "threaded") (arg "-threaded") ]
+ -- Note [Linking ghc-bin against threaded stage0 RTS]
+ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ -- We must maintain the invariant that GHCs linked with '-threaded'
+ -- are built with '-optc=-DTHREADED_RTS', otherwise we'll end up
+ -- with a GHC that can use the threaded runtime, but contains some
+ -- non-thread-safe functions. See
+ -- https://gitlab.haskell.org/ghc/ghc/issues/18024 for an example of
+ -- the sort of issues this can cause.
+ , ifM stage0
+ -- We build a threaded stage 1 if the bootstrapping compiler
+ -- supports it.
+ (ifM threadedBootstrapper
+ (arg "threaded")
+ (arg "-threaded"))
+ -- We build a threaded stage N, N>1 if the configuration calls
+ -- for it.
+ (ifM (ghcThreaded <$> expr flavour)
+ (arg "threaded")
+ (arg "-threaded"))
+ ]
]
-------------------------------- ghcPkg --------------------------------