Build a threaded stage 1 if the bootstrapping GHC supports it.

8 files changed, 98 insertions, 21 deletions

diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 6a2dadc820..6e86b73e8d 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -194,6 +194,12 @@ ifeq "$(GhcThreaded)" "YES"
 compiler_stage2_CONFIGURE_OPTS += --ghc-option=-optc-DTHREADED_RTS
 endif
 
+# If the bootstrapping GHC supplies the threaded RTS, then we can have a
+# threaded stage 1 too.
+ifeq "$(GhcThreadedRts)" "YES"
+compiler_stage1_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/configure.ac b/configure.ac
index a621814700..bac2cfde5e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -124,6 +124,9 @@ AC_ARG_VAR(CC_STAGE0, [C compiler command (bootstrap)])
 AC_ARG_VAR(LD_STAGE0, [Linker command (bootstrap)])
 AC_ARG_VAR(AR_STAGE0, [Archive command (bootstrap)])
 
+dnl RTS ways supplied by the bootstrapping compiler.
+AC_ARG_VAR(RTS_WAYS_STAGE0, [RTS ways])
+
 if test "$WithGhc" != ""; then
   FPTOOLS_GHC_VERSION([GhcVersion], [GhcMajVersion], [GhcMinVersion], [GhcPatchLevel])dnl
 
@@ -151,6 +154,17 @@ if test "$WithGhc" != ""; then
   fi
   BOOTSTRAPPING_GHC_INFO_FIELD([AR_OPTS_STAGE0],[ar flags])
   BOOTSTRAPPING_GHC_INFO_FIELD([ArSupportsAtFile_STAGE0],[ar supports at file])
+  BOOTSTRAPPING_GHC_INFO_FIELD([RTS_WAYS_STAGE0],[RTS ways])
+
+  dnl Check whether or not the bootstrapping GHC has a threaded RTS. This
+  dnl determines whether or not we can have a threaded stage 1.
+  dnl See Note [Linking ghc-bin against threaded stage0 RTS] in
+  dnl hadrian/src/Settings/Packages.hs for details.
+  if echo ${RTS_WAYS_STAGE0} | grep '.*thr.*' 2>&1 >/dev/null; then
+      AC_SUBST(GhcThreadedRts, YES)
+  else
+      AC_SUBST(GhcThreadedRts, NO)
+  fi
 fi
 
 dnl ** Must have GHC to build GHC
@@ -1454,6 +1468,7 @@ Configure completed successfully.
 echo "\
    Bootstrapping using   : $WithGhc
       which is version   : $GhcVersion
+      with threaded RTS? : $GhcThreadedRts
 "
 
 if test "x$CcLlvmBackend" = "xYES"; then
diff --git a/ghc/ghc.mk b/ghc/ghc.mk
index 8c112a054f..5512d50710 100644
--- a/ghc/ghc.mk
+++ b/ghc/ghc.mk
@@ -66,8 +66,15 @@ else
 ghc_stage2_CONFIGURE_OPTS += -f-threaded
 ghc_stage3_CONFIGURE_OPTS += -f-threaded
 endif
-# Stage-0 compiler isn't guaranteed to have a threaded RTS.
+
+# If stage 0 supplies a threaded RTS, we can use it for stage 1.
+# See Note [Linking ghc-bin against threaded stage0 RTS] in
+# hadrian/src/Settings/Packages.hs for details.
+ifeq "$(GhcThreadedRts)" "YES"
+ghc_stage1_MORE_HC_OPTS += -threaded
+else
 ghc_stage1_CONFIGURE_OPTS += -f-threaded
+endif
 
 ifeq "$(GhcProfiled)" "YES"
 ghc_stage2_PROGRAM_WAY = p
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 --------------------------------
diff --git a/mk/config.mk.in b/mk/config.mk.in
index 791dc5acc0..250d41ebe6 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -199,6 +199,9 @@ endif
 # `GhcUnregisterised` mode doesn't allow that.
 GhcWithSMP := $(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),YES,NO))
 
+# Whether or not the bootstrapping GHC supplies a threaded RTS.
+GhcThreadedRts = @GhcThreadedRts@
+
 # Whether to include GHCi in the compiler.  Depends on whether the RTS linker
 # has support for this OS/ARCH combination.