GitLab

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

 -#include <ghcversion.h>
 -#  include <rts/PosixSource.h>
 -#include <Rts.h>
+-
 -#include <HsFFI.h>
+-
 -int main (int argc, char *argv[])
 -{
 -    RtsConfig conf = defaultRtsConfig;
+-
 -    // We never know what symbols GHC will look up in the future, so
 -    // we must retain CAFs for running interpreted code.
 -    conf.keep_cafs = 1;
+-
 -    conf.rts_opts_enabled = RtsOptsAll;
 -    extern StgClosure ZCMain_main_closure;
 -    hs_main(argc, argv, &ZCMain_main_closure, conf);
 -}

utils/iserv/iserv.cabal.in

@@ -23,11 +23,17 @@ Category: Development
  build-type: Simple
  cabal-version: >=1.10
 +Flag threaded
 +    Description: Link the iserv executable against the threaded RTS
 +    Default: True
 +    Manual: True
++
  Executable iserv
      Default-Language: Haskell2010
 -    ghc-options: -no-hs-main
 +    ghc-options: -fkeep-cafs -rtsopts
 +    if flag(threaded)
 +      ghc-options: -threaded
      Main-Is: Main.hs
 -    C-Sources: cbits/iservmain.c
      Hs-Source-Dirs: src
      include-dirs: .
      Build-Depends: