diff options
author | Travis Whitaker <pi.boy.travis@gmail.com> | 2020-05-06 04:14:47 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-05-29 13:34:48 -0400 |
commit | 67738db10010fd28a8e997b5c8f83ea591b88a0e (patch) | |
tree | 92e283a33006eca3888019c744f5d1b5ed34cddb /hadrian | |
parent | f9a513e064bd8a33ad6f8aa5fb8673931507eca1 (diff) | |
download | haskell-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.in | 2 | ||||
-rw-r--r-- | hadrian/src/Expression.hs | 26 | ||||
-rw-r--r-- | hadrian/src/Oracles/Flag.hs | 28 | ||||
-rw-r--r-- | hadrian/src/Settings/Packages.hs | 30 |
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 -------------------------------- |