Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
69e0ab59 by Cheng Shao at 2026-01-06T19:37:56-05:00
compiler: add targetHasRTSWays function
This commit adds a `targetHasRTSWays` util function in
`GHC.Driver.Session` to query if the target RTS has a given Ways (e.g.
WayThreaded).
- - - - -
25a0ab94 by Cheng Shao at 2026-01-06T19:37:56-05:00
compiler: link on-demand external interpreter with threaded RTS
This commit makes the compiler link the on-demand external interpreter
program with threaded RTS if it is available in the target RTS ways.
This is a better default than the previous single-threaded RTS, and it
enables the external interpreter to benefit from parallelism when
deserializing CreateBCOs messages.
- - - - -
92404a2b by Cheng Shao at 2026-01-06T19:37:56-05:00
hadrian: link iserv with threaded RTS
This commit makes hadrian link iserv with threaded RTS if it's
available in the RTS ways. Also cleans up the iserv main C program
which can be replaced by the `-fkeep-cafs` link-time option.
- - - - -
8 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Runtime/Interpreter/C.hs
- compiler/GHC/Runtime/Interpreter/Init.hs
- hadrian/src/Packages.hs
- hadrian/src/Settings/Packages.hs
- − utils/iserv/cbits/iservmain.c
- utils/iserv/iserv.cabal.in
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -719,7 +719,7 @@ setTopSessionDynFlags dflags = do
{ interpCreateProcess = createIservProcessHook (hsc_hooks hsc_env)
}
- interp <- liftIO $ initInterpreter tmpfs logger platform finder_cache unit_env interp_opts
+ interp <- liftIO $ initInterpreter dflags tmpfs logger platform finder_cache unit_env interp_opts
modifySession $ \h -> hscSetFlags dflags
h{ hsc_IC = (hsc_IC h){ ic_dflags = dflags }
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -197,6 +197,8 @@ module GHC.Driver.Session (
-- * Compiler configuration suitable for display to the user
compilerInfo,
+ targetHasRTSWays,
+
wordAlignment,
setUnsafeGlobalDynFlags,
@@ -3635,6 +3637,15 @@ compilerInfo dflags
queryCmdMaybe p f = expandDirectories (query (maybe "" (prgPath . p) . f))
queryFlagsMaybe p f = query (maybe "" (unwords . map escapeArg . prgFlags . p) . f)
+-- | Query if the target RTS has the given 'Ways'. It's computed from
+-- the @"RTS ways"@ field in the settings file.
+targetHasRTSWays :: DynFlags -> Ways -> Bool
+targetHasRTSWays dflags ways
+ | Just ws <- lookup "RTS ways" $ compilerInfo dflags =
+ waysTag ways
+ `elem` words ws
+ | otherwise = panic "RTS ways not found in settings"
+
-- Note [Special unit-ids]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- Certain units are special to the compiler:
=====================================
compiler/GHC/Runtime/Interpreter/C.hs
=====================================
@@ -8,7 +8,9 @@ where
import GHC.Prelude
import GHC.Platform
+import GHC.Platform.Ways
import GHC.Data.FastString
+import GHC.Driver.Session
import GHC.Utils.Logger
import GHC.Utils.TmpFs
import GHC.Unit.Types
@@ -18,11 +20,10 @@ import GHC.Unit.State
import GHC.Utils.Panic.Plain
import GHC.Linker.Executable
import GHC.Linker.Config
-import GHC.Utils.CliOption
-- | Generate iserv program for the target
-generateIservC :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO FilePath
-generateIservC logger tmpfs opts unit_env = do
+generateIservC :: DynFlags -> Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO FilePath
+generateIservC dflags logger tmpfs opts unit_env = do
-- get the unit-id of the ghci package. We need this to load the
-- interpreter code.
let unit_state = ue_homeUnitState unit_env
@@ -60,6 +61,12 @@ generateIservC logger tmpfs opts unit_env = do
-- must retain CAFs for running interpreted code.
, leKeepCafs = True
+ -- link with -threaded if target has threaded RTS
+ , leWays =
+ let ways = leWays opts
+ ways' = addWay WayThreaded ways
+ in if targetHasRTSWays dflags ways' then ways' else ways
+
-- enable all rts options
, leRtsOptsEnabled = RtsOptsAll
=====================================
compiler/GHC/Runtime/Interpreter/Init.hs
=====================================
@@ -9,6 +9,7 @@ where
import GHC.Prelude
+import GHC.Driver.DynFlags
import GHC.Platform
import GHC.Platform.Ways
import GHC.Settings
@@ -57,14 +58,15 @@ data InterpOpts = InterpOpts
-- | Initialize code interpreter
initInterpreter
- :: TmpFs
+ :: DynFlags
+ -> TmpFs
-> Logger
-> Platform
-> FinderCache
-> UnitEnv
-> InterpOpts
-> IO (Maybe Interp)
-initInterpreter tmpfs logger platform finder_cache unit_env opts = do
+initInterpreter dflags tmpfs logger platform finder_cache unit_env opts = do
lookup_cache <- liftIO $ mkInterpSymbolCache
@@ -125,7 +127,7 @@ initInterpreter tmpfs logger platform finder_cache unit_env opts = do
dynamic = interpWays opts `hasWay` WayDyn
prog <- case interpProg opts of
-- build iserv program if none specified
- "" -> generateIservC logger tmpfs (interpExecutableLinkOpts opts) unit_env
+ "" -> generateIservC dflags logger tmpfs (interpExecutableLinkOpts opts) unit_env
_ -> pure (interpProg opts ++ flavour)
where
flavour
=====================================
hadrian/src/Packages.hs
=====================================
@@ -217,7 +217,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe
-- TODO: Can we extract this information from Cabal files?
-- | Some program packages should not be linked with Haskell main function.
nonHsMainPackage :: Package -> Bool
-nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper])
+nonHsMainPackage = (`elem` [hp2ps, unlit, ghciWrapper])
{-
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -41,6 +41,8 @@ packageArgs = do
libzstdLibraryDir <- getSetting LibZstdLibDir
stageVersion <- readVersion <$> (expr $ ghcVersionStage stage)
+ rtsWays <- getRtsWays
+
mconcat
--------------------------------- base ---------------------------------
[ package base ? mconcat
@@ -185,11 +187,15 @@ packageArgs = do
--
-- The Solaris linker does not support --export-dynamic option. It also
-- does not need it since it exports all dynamic symbols by default
- , package iserv
- ? expr isElfTarget
+ , package iserv ? mconcat [
+ expr isElfTarget
? notM (expr $ anyTargetOs [OSFreeBSD, OSSolaris2])? mconcat
[ builder (Ghc LinkHs) ? arg "-optl-Wl,--export-dynamic" ]
+ -- Link iserv with -threaded if possible
+ , builder (Cabal Flags) ? any (wayUnit Threaded) rtsWays `cabalFlag` "threaded"
+ ]
+
-------------------------------- haddock -------------------------------
, package haddockApi ?
builder (Cabal Flags) ? arg "in-ghc-tree"
=====================================
utils/iserv/cbits/iservmain.c deleted
=====================================
@@ -1,18 +0,0 @@
-#include