GitLab

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

55eab80d

by Sylvain Henry at 2025-11-20T17:33:13-05:00

Build external interpreter program on demand (#24731)

This patch teaches GHC how to build the external interpreter program
when it is missing. As long as we have the `ghci` library, doing this is
trivial so most of this patch is refactoring for doing it sanely.

21 changed files:

compiler/GHC.hs
+ compiler/GHC/Driver/Config/Interpreter.hs
compiler/GHC/Driver/Config/Linker.hs
compiler/GHC/Driver/DynFlags.hs
compiler/GHC/Driver/Pipeline.hs
compiler/GHC/Driver/Pipeline/Execute.hs
compiler/GHC/Linker/Config.hs
compiler/GHC/Linker/Dynamic.hs
+ compiler/GHC/Linker/Executable.hs
− compiler/GHC/Linker/ExtraObj.hs
compiler/GHC/Linker/Loader.hs
compiler/GHC/Linker/MacOS.hs
compiler/GHC/Linker/Static.hs
compiler/GHC/Linker/Windows.hs
+ compiler/GHC/Runtime/Interpreter/C.hs
+ compiler/GHC/Runtime/Interpreter/Init.hs
compiler/GHC/SysTools/Tasks.hs
compiler/ghc.cabal.in
+ testsuite/tests/driver/T24731.hs
testsuite/tests/driver/all.T
utils/iserv/iserv.cabal.in

Changes:

compiler/GHC.hs

@@ -337,7 +337,6 @@ module GHC (
  import GHC.Prelude hiding (init)
  import GHC.Platform
 -import GHC.Platform.Ways
  import GHC.Driver.Phases   ( Phase(..), isHaskellSrcFilename
                             , isSourceFilename, startPhase )
@@ -351,7 +350,6 @@ import GHC.Driver.Backend
  import GHC.Driver.Config.Finder (initFinderOpts)
  import GHC.Driver.Config.Parser (initParserOpts)
  import GHC.Driver.Config.Logger (initLogFlags)
 -import GHC.Driver.Config.StgToJS (initStgToJSConfig)
  import GHC.Driver.Config.Diagnostic
  import GHC.Driver.Main
  import GHC.Driver.Make
@@ -360,10 +358,11 @@ import GHC.Driver.Monad
  import GHC.Driver.Ppr
  import GHC.ByteCode.Types
 -import qualified GHC.Linker.Loader as Loader
  import GHC.Runtime.Loader
  import GHC.Runtime.Eval
  import GHC.Runtime.Interpreter
 +import GHC.Runtime.Interpreter.Init
 +import GHC.Driver.Config.Interpreter
  import GHC.Runtime.Context
  import GHCi.RemoteTypes
@@ -439,10 +438,8 @@ import GHC.Unit.Module.ModSummary
  import GHC.Unit.Module.Graph
  import GHC.Unit.Home.ModInfo
  import qualified GHC.Unit.Home.Graph as HUG
 -import GHC.Settings
  import Control.Applicative ((<|>))
 -import Control.Concurrent
  import Control.Monad
  import Control.Monad.Catch as MC
  import Data.Foldable
@@ -715,98 +712,16 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m ()
  setTopSessionDynFlags dflags = do
    hsc_env <- getSession
    logger  <- getLogger
 -  lookup_cache  <- liftIO $ mkInterpSymbolCache
+-
 -  -- see Note [Target code interpreter]
 -  interp <- if
 -#if !defined(wasm32_HOST_ARCH)
 -    -- Wasm dynamic linker
 -    | ArchWasm32 <- platformArch $ targetPlatform dflags
 -    -> do
 -        s <- liftIO $ newMVar InterpPending
 -        loader <- liftIO Loader.uninitializedLoader
 -        dyld <- liftIO $ makeAbsolute $ topDir dflags </> "dyld.mjs"
 -        libdir <- liftIO $ last <$> Loader.getGccSearchDirectory logger dflags "libraries"
 -        let profiled = ways dflags `hasWay` WayProf
 -            way_tag = if profiled then "_p" else ""
 -        let cfg =
 -              WasmInterpConfig
 -                { wasmInterpDyLD = dyld,
 -                  wasmInterpLibDir = libdir,
 -                  wasmInterpOpts = getOpts dflags opt_i,
 -                  wasmInterpBrowser = gopt Opt_GhciBrowser dflags,
 -                  wasmInterpBrowserHost = ghciBrowserHost dflags,
 -                  wasmInterpBrowserPort = ghciBrowserPort dflags,
 -                  wasmInterpBrowserRedirectWasiConsole = gopt Opt_GhciBrowserRedirectWasiConsole dflags,
 -                  wasmInterpBrowserPuppeteerLaunchOpts = ghciBrowserPuppeteerLaunchOpts dflags,
 -                  wasmInterpBrowserPlaywrightBrowserType = ghciBrowserPlaywrightBrowserType dflags,
 -                  wasmInterpBrowserPlaywrightLaunchOpts = ghciBrowserPlaywrightLaunchOpts dflags,
 -                  wasmInterpTargetPlatform = targetPlatform dflags,
 -                  wasmInterpProfiled = profiled,
 -                  wasmInterpHsSoSuffix = way_tag ++ dynLibSuffix (ghcNameVersion dflags),
 -                  wasmInterpUnitState = ue_homeUnitState $ hsc_unit_env hsc_env
 -                }
 -        pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache
 -#endif
+-
 -    -- JavaScript interpreter
 -    | ArchJavaScript <- platformArch (targetPlatform dflags)
 -    -> do
 -         s <- liftIO $ newMVar InterpPending
 -         loader <- liftIO Loader.uninitializedLoader
 -         let cfg = JSInterpConfig
 -              { jsInterpNodeConfig  = defaultNodeJsSettings
 -              , jsInterpScript      = topDir dflags </> "ghc-interp.js"
 -              , jsInterpTmpFs       = hsc_tmpfs hsc_env
 -              , jsInterpTmpDir      = tmpDir dflags
 -              , jsInterpLogger      = hsc_logger hsc_env
 -              , jsInterpCodegenCfg  = initStgToJSConfig dflags
 -              , jsInterpUnitEnv     = hsc_unit_env hsc_env
 -              , jsInterpFinderOpts  = initFinderOpts dflags
 -              , jsInterpFinderCache = hsc_FC hsc_env
 -              }
 -         return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache))
+-
 -    -- external interpreter
 -    | gopt Opt_ExternalInterpreter dflags
 -    -> do
 -         let
 -           prog = pgm_i dflags ++ flavour
 -           profiled = ways dflags `hasWay` WayProf
 -           dynamic  = ways dflags `hasWay` WayDyn
 -           flavour
 -             | profiled && dynamic = "-prof-dyn"
 -             | profiled  = "-prof"
 -             | dynamic   = "-dyn"
 -             | otherwise = ""
 -           msg = text "Starting " <> text prog
 -         tr <- if verbosity dflags >= 3
 -                then return (logInfo logger $ withPprStyle defaultDumpStyle msg)
 -                else return (pure ())
 -         let
 -          conf = IServConfig
 -            { iservConfProgram  = prog
 -            , iservConfOpts     = getOpts dflags opt_i
 -            , iservConfProfiled = profiled
 -            , iservConfDynamic  = dynamic
 -            , iservConfHook     = createIservProcessHook (hsc_hooks hsc_env)
 -            , iservConfTrace    = tr
 -            }
 -         s <- liftIO $ newMVar InterpPending
 -         loader <- liftIO Loader.uninitializedLoader
 -         return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache))
+-
 -    -- Internal interpreter
 -    | otherwise
 -    ->
 -#if defined(HAVE_INTERNAL_INTERPRETER)
 -     do
 -      loader <- liftIO Loader.uninitializedLoader
 -      return (Just (Interp InternalInterp loader lookup_cache))
 -#else
 -      return Nothing
 -#endif
+-
 +  let platform = targetPlatform dflags
 +  let unit_env = hsc_unit_env hsc_env
 +  let tmpfs = hsc_tmpfs hsc_env
 +  let finder_cache = hsc_FC hsc_env
 +  interp_opts' <- liftIO $ initInterpOpts dflags
 +  let interp_opts = interp_opts'
 +                      { interpCreateProcess = createIservProcessHook (hsc_hooks hsc_env)
 +                      }
++
 +  interp <- liftIO $ initInterpreter 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/Config/Interpreter.hs

 +module GHC.Driver.Config.Interpreter
 +  ( initInterpOpts
 +  )
 +where
++
 +import GHC.Prelude
 +import GHC.Runtime.Interpreter.Init
 +import GHC.Driver.DynFlags
 +import GHC.Driver.Session
 +import GHC.Driver.Config.Finder
 +import GHC.Driver.Config.StgToJS
 +import GHC.SysTools.Tasks
 +import GHC.Linker.Executable
++
 +import System.FilePath
 +import System.Directory
++
 +initInterpOpts :: DynFlags -> IO InterpOpts
 +initInterpOpts dflags = do
 +  wasm_dyld <- makeAbsolute $ topDir dflags </> "dyld.mjs"
 +  js_interp <- makeAbsolute $ topDir dflags </> "ghc-interp.js"
 +  pure $ InterpOpts
 +    { interpExternal = gopt Opt_ExternalInterpreter dflags
 +    , interpProg = pgm_i dflags
 +    , interpOpts = getOpts dflags opt_i
 +    , interpWays = ways dflags
 +    , interpNameVer = ghcNameVersion dflags
 +    , interpCreateProcess = Nothing
 +    , interpWasmDyld = wasm_dyld
 +    , interpBrowser = gopt Opt_GhciBrowser dflags
 +    , interpBrowserHost = ghciBrowserHost dflags
 +    , interpBrowserPort = ghciBrowserPort dflags
 +    , interpBrowserRedirectWasiConsole = gopt Opt_GhciBrowserRedirectWasiConsole dflags
 +    , interpBrowserPuppeteerLaunchOpts = ghciBrowserPuppeteerLaunchOpts dflags
 +    , interpBrowserPlaywrightBrowserType = ghciBrowserPlaywrightBrowserType dflags
 +    , interpBrowserPlaywrightLaunchOpts = ghciBrowserPlaywrightLaunchOpts dflags
 +    , interpJsInterp = js_interp
 +    , interpTmpDir = tmpDir dflags
 +    , interpJsCodegenCfg = initStgToJSConfig dflags
 +    , interpFinderOpts  = initFinderOpts dflags
 +    , interpVerbosity = verbosity dflags
 +    , interpLdConfig = configureLd dflags
 +    , interpCcConfig = configureCc dflags
 +    , interpExecutableLinkOpts = initExecutableLinkOpts dflags
 +    }
++

compiler/GHC/Driver/Config/Linker.hs

@@ -10,6 +10,7 @@ import GHC.Linker.Config
  import GHC.Driver.DynFlags
  import GHC.Driver.Session
 +import GHC.Settings
  import Data.List (isPrefixOf)
@@ -52,6 +53,8 @@ initLinkerConfig dflags =
      , linkerOptionsPost = post_args
      , linkerTempDir     = tmpDir dflags
      , linkerFilter      = ld_filter
 +    , linkerSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind (toolSettings dflags)
 +    , linkerIsGnuLd     = toolSettings_ldIsGnuLd (toolSettings dflags)
+     }
  {- Note [Solaris linker]

compiler/GHC/Driver/DynFlags.hs

@@ -28,7 +28,7 @@ module GHC.Driver.DynFlags (
          ParMakeCount(..),
          ways,
          HasDynFlags(..), ContainsDynFlags(..),
 -        RtsOptsEnabled(..),
 +        RtsOptsEnabled(..), haveRtsOptsFlags,
          GhcMode(..), isOneShot,
          GhcLink(..), isNoLink,
          PackageFlag(..), PackageArg(..), ModRenaming(..),
@@ -902,6 +902,13 @@ data RtsOptsEnabled
    | RtsOptsAll
    deriving (Show)
 +haveRtsOptsFlags :: DynFlags -> Bool
 +haveRtsOptsFlags dflags =
 +        isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of
 +                                       RtsOptsSafeOnly -> False
 +                                       _ -> True
++
++
  -- | Are we building with @-fPIE@ or @-fPIC@ enabled?
  positionIndependent :: DynFlags -> Bool
  positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags

compiler/GHC/Driver/Pipeline.hs

@@ -71,7 +71,7 @@ import GHC.SysTools
  import GHC.SysTools.Cpp
  import GHC.Utils.TmpFs
 -import GHC.Linker.ExtraObj
 +import GHC.Linker.Executable
  import GHC.Linker.Static
  import GHC.Linker.Static.Utils
  import GHC.Linker.Types
@@ -444,7 +444,9 @@ link' logger tmpfs fc dflags unit_env batch_attempt_linking mHscMessager hpt
          case ghcLink dflags of
            LinkBinary
              | backendUseJSLinker (backend dflags) -> linkJSBinary logger tmpfs fc dflags unit_env obj_files pkg_deps
 -            | otherwise -> linkBinary logger tmpfs dflags unit_env obj_files pkg_deps
 +            | otherwise -> do
 +              let opts = initExecutableLinkOpts dflags
 +              linkExecutable logger tmpfs opts unit_env obj_files pkg_deps
            LinkStaticLib -> linkStaticLib logger dflags unit_env obj_files pkg_deps
            LinkDynLib    -> linkDynLibCheck logger tmpfs dflags unit_env obj_files pkg_deps
            other         -> panicBadLink other
@@ -511,7 +513,8 @@ linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do
          if not (null lib_errs) || any (t <) lib_times
             then return $ needsRecompileBecause LibraryChanged
             else do
 -            res <- checkLinkInfo logger dflags unit_env pkg_deps exe_file
 +            let opts = initExecutableLinkOpts dflags
 +            res <- checkLinkInfo logger opts unit_env pkg_deps exe_file
              if res
                then return $ needsRecompileBecause FlagsChanged
                else return UpToDate
@@ -585,7 +588,9 @@ doLink hsc_env o_files = do
      LinkBinary
        | backendUseJSLinker (backend dflags)
                    -> linkJSBinary logger tmpfs fc dflags unit_env o_files []
 -      | otherwise -> linkBinary logger tmpfs dflags unit_env o_files []
 +      | otherwise -> do
 +          let opts = initExecutableLinkOpts dflags
 +          linkExecutable logger tmpfs opts unit_env o_files []
      LinkStaticLib -> linkStaticLib      logger       dflags unit_env o_files []
      LinkDynLib    -> linkDynLibCheck    logger tmpfs dflags unit_env o_files []
      LinkMergedObj

compiler/GHC/Driver/Pipeline/Execute.hs

@@ -15,6 +15,7 @@ import Control.Monad
  import Control.Monad.IO.Class
  import Control.Monad.Catch
  import GHC.Driver.Hooks
 +import GHC.Driver.DynFlags
  import Control.Monad.Trans.Reader
  import GHC.Driver.Pipeline.Monad
  import GHC.Driver.Pipeline.Phases
@@ -74,7 +75,6 @@ import GHC.CmmToLlvm.Version.Type (LlvmVersion (..))
  import {-# SOURCE #-} GHC.Driver.Pipeline (compileForeign, compileEmptyStub)
  import GHC.Settings
  import System.IO
 -import GHC.Linker.ExtraObj
  import GHC.Linker.Dynamic
  import GHC.Utils.Panic
  import GHC.Utils.Touch
@@ -416,6 +416,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
    let unit_env  = hsc_unit_env hsc_env
    let home_unit = hsc_home_unit_maybe hsc_env
    let tmpfs     = hsc_tmpfs hsc_env
 +  let tmpdir    = tmpDir dflags
    let platform  = ue_platform unit_env
    let hcc       = cc_phase `eqPhase` HCc
@@ -437,7 +438,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
    let include_paths = include_paths_quote ++ include_paths_global
    let gcc_extra_viac_flags = extraGccViaCFlags dflags
 -  let pic_c_flags = picCCOpts dflags
 +  let cc_config = configureCc dflags
    let verbFlags = getVerbFlags dflags
@@ -486,14 +487,14 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
    ghcVersionH <- getGhcVersionIncludeFlags dflags unit_env
    withAtomicRename output_fn $ \temp_outputFilename ->
 -    GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs dflags (
 +    GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs tmpdir cc_config (
                    [ GHC.SysTools.Option "-c"
                    , GHC.SysTools.FileOption "" input_fn
                    , GHC.SysTools.Option "-o"
                    , GHC.SysTools.FileOption "" temp_outputFilename
+                   ]
                   ++ map GHC.SysTools.Option (
 -                    pic_c_flags
 +                    (ccPicOpts cc_config)
                   -- See Note [Produce big objects on Windows]
                   ++ [ "-Wa,-mbig-obj"
@@ -1149,7 +1150,8 @@ joinObjectFiles hsc_env o_files output_fn
    | otherwise = do
    withAtomicRename output_fn $ \tmp_ar ->
 -      liftIO $ runAr logger dflags Nothing $ map Option $ ["qc" ++ dashL, tmp_ar] ++ o_files
 +      let ar_opts = configureAr dflags
 +      in liftIO $ runAr logger ar_opts Nothing $ map Option $ ["qc" ++ dashL, tmp_ar] ++ o_files
    where
      dashLSupported = sArSupportsDashL (settings dflags)
      dashL = if dashLSupported then "L" else ""

compiler/GHC/Linker/Config.hs

@@ -23,5 +23,7 @@ data LinkerConfig = LinkerConfig
    , linkerOptionsPost :: [Option]         -- ^ Linker options (after user options)
    , linkerTempDir     :: TempDir          -- ^ Temporary directory to use
    , linkerFilter      :: [String] -> [String] -- ^ Output filter
 +  , linkerSupportsCompactUnwind :: !Bool  -- ^ Does the linker support compact unwind
 +  , linkerIsGnuLd     :: !Bool            -- ^ Is it GNU LD (used for gc-sections support)
+   }

compiler/GHC/Linker/Dynamic.hs

@@ -12,6 +12,7 @@ import GHC.Prelude
  import GHC.Platform
  import GHC.Platform.Ways
  import GHC.Settings (ToolSettings(toolSettings_ldSupportsSingleModule))
 +import GHC.SysTools.Tasks
  import GHC.Driver.Config.Linker
  import GHC.Driver.Session
@@ -207,8 +208,10 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
                   ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ]
+               )
              -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
 -            when (gopt Opt_RPath dflags) $
 -              runInjectRPaths logger (toolSettings dflags) pkg_lib_paths output_fn
 +            when (gopt Opt_RPath dflags) $ do
 +              let otool_opts = configureOtool dflags
 +              let install_name_opts = configureInstallName dflags
 +              runInjectRPaths logger otool_opts install_name_opts pkg_lib_paths output_fn
          _ -> do
              -------------------------------------------------------------------
              -- Making a DSO

compiler/GHC/Linker/Executable.hs

 +-- | Linking executables
 +module GHC.Linker.Executable
 +   ( linkExecutable
 +   , ExecutableLinkOpts (..)
 +   , initExecutableLinkOpts
 +   -- RTS Opts
 +   , RtsOptsEnabled (..)
 +   -- * Link info
 +   , LinkInfo (..)
 +   , initLinkInfo
 +   , checkLinkInfo
 +   , ghcLinkInfoSectionName
 +   , ghcLinkInfoNoteName
 +   , platformSupportsSavingLinkOpts
 +   )
 +where
++
 +import GHC.Prelude
 +import GHC.Platform
 +import GHC.Platform.Ways
++
 +import GHC.Unit
 +import GHC.Unit.Env
++
 +import GHC.Utils.Asm
 +import GHC.Utils.Error
 +import GHC.Utils.Misc
 +import GHC.Utils.Outputable as Outputable
 +import GHC.Utils.Logger
 +import GHC.Utils.TmpFs
++
 +import GHC.Driver.Session
 +import GHC.Driver.Config.Linker
++
 +import qualified GHC.Data.ShortText as ST
++
 +import GHC.SysTools
 +import GHC.SysTools.Elf
 +import GHC.Linker.Config
 +import GHC.Linker.Unit
 +import GHC.Linker.MacOS
 +import GHC.Linker.Windows
 +import GHC.Linker.Dynamic (libmLinkOpts)
 +import GHC.Linker.External (runLink)
 +import GHC.Linker.Static.Utils (exeFileName)
++
 +import Control.Monad
 +import Data.Maybe
 +import System.FilePath
 +import System.Directory
++
 +data ExecutableLinkOpts = ExecutableLinkOpts
 +  { leOutputFile :: Maybe FilePath
 +  , leNameVersion :: GhcNameVersion
 +  , leWays :: Ways
 +  , leDynLibLoader :: DynLibLoader
 +  , leRelativeDynlibPaths :: !Bool
 +  , leUseXLinkerRPath :: !Bool
 +  , leSingleLibFolder :: !Bool
 +  , leWholeArchiveHsLibs :: !Bool
 +  , leGenManifest :: !Bool
 +  , leRPath :: !Bool
 +  , leCompactUnwind :: !Bool
 +  , leLibraryPaths :: [String]
 +  , leFrameworkOpts :: FrameworkOpts
 +  , leManifestOpts :: ManifestOpts
 +  , leLinkerConfig :: LinkerConfig
 +  , leOtoolConfig :: OtoolConfig
 +  , leCcConfig :: CcConfig
 +  , leInstallNameConfig :: InstallNameConfig
 +  , leInputs :: [Option]
 +  , lePieOpts :: [String]
 +  , leTempDir :: TempDir
 +  , leVerbFlags :: [String]
 +  , leNoHsMain :: !Bool
 +  , leMainSymbol :: String
 +  , leRtsOptsEnabled :: !RtsOptsEnabled
 +  , leRtsOptsSuggestions :: !Bool
 +  , leKeepCafs :: !Bool
 +  , leRtsOpts :: Maybe String
 +  }
++
 +initExecutableLinkOpts :: DynFlags -> ExecutableLinkOpts
 +initExecutableLinkOpts dflags =
 +  let
 +    platform = targetPlatform dflags
 +    os = platformOS platform
 +  in ExecutableLinkOpts
 +    { leOutputFile = outputFile_ dflags
 +    , leNameVersion = ghcNameVersion dflags
 +    , leWays = ways dflags
 +    , leDynLibLoader = dynLibLoader dflags
 +    , leRelativeDynlibPaths = gopt Opt_RelativeDynlibPaths dflags
 +    , leUseXLinkerRPath = useXLinkerRPath dflags os
 +    , leSingleLibFolder = gopt Opt_SingleLibFolder dflags
 +    , leWholeArchiveHsLibs = gopt Opt_WholeArchiveHsLibs dflags
 +    , leGenManifest = gopt Opt_GenManifest dflags
 +    , leRPath = gopt Opt_RPath dflags
 +    , leCompactUnwind = gopt Opt_CompactUnwind dflags
 +    , leLibraryPaths = libraryPaths dflags
 +    , leFrameworkOpts = initFrameworkOpts dflags
 +    , leManifestOpts = initManifestOpts dflags
 +    , leLinkerConfig = initLinkerConfig dflags
 +    , leCcConfig = configureCc dflags
 +    , leOtoolConfig = configureOtool dflags
 +    , leInstallNameConfig = configureInstallName dflags
 +    , leInputs = ldInputs dflags
 +    , lePieOpts = pieCCLDOpts dflags
 +    , leTempDir = tmpDir dflags
 +    , leVerbFlags = getVerbFlags dflags
 +    , leNoHsMain = gopt Opt_NoHsMain dflags
 +    , leMainSymbol = "ZCMain_main"
 +    , leRtsOptsEnabled = rtsOptsEnabled dflags
 +    , leRtsOptsSuggestions = rtsOptsSuggestions dflags
 +    , leKeepCafs = gopt Opt_KeepCAFs dflags
 +    , leRtsOpts = rtsOpts dflags
 +    }
++
 +leHaveRtsOptsFlags :: ExecutableLinkOpts -> Bool
 +leHaveRtsOptsFlags opts =
 +  isJust (leRtsOpts opts)
 +  || case leRtsOptsEnabled opts of
 +      RtsOptsSafeOnly -> False
 +      _ -> True
++
 +linkExecutable :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
 +linkExecutable logger tmpfs opts unit_env o_files dep_units = do
 +    let static_link = False
 +    let platform   = ue_platform unit_env
 +        unit_state = ue_homeUnitState unit_env
 +        verbFlags = leVerbFlags opts
 +        arch_os   = platformArchOS platform
 +        output_fn = exeFileName arch_os static_link (leOutputFile opts)
 +        namever   = leNameVersion opts
 +        -- For the wasm target, when ghc is invoked with -dynamic,
 +        -- when linking the final .wasm binary we must still ensure
 +        -- the static archives are selected. Otherwise wasm-ld would
 +        -- fail to find and link the .so library dependencies. wasm-ld
 +        -- can link PIC objects into static .wasm binaries fine, so we
 +        -- only adjust the ways in the final linking step, and only
 +        -- when linking .wasm binary (which is supposed to be fully
 +        -- static), not when linking .so shared libraries.
 +        ways_
 +          | ArchWasm32 <- platformArch platform = removeWay WayDyn $ leWays opts
 +          | otherwise = leWays opts
++
 +    full_output_fn <- if isAbsolute output_fn
 +                      then return output_fn
 +                      else do d <- getCurrentDirectory
 +                              return $ normalise (d </> output_fn)
++
 +    -- get the full list of packages to link with, by combining the
 +    -- explicit packages with the auto packages and all of their
 +    -- dependencies, and eliminating duplicates.
 +    pkgs <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
 +    let pkg_lib_paths     = collectLibraryDirs ways_ pkgs
 +    let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
 +        get_pkg_lib_path_opts l
 +         | osElfTarget (platformOS platform) &&
 +           leDynLibLoader opts == SystemDependent &&
 +           ways_ `hasWay` WayDyn
 +            = let libpath = if leRelativeDynlibPaths opts
 +                            then "$ORIGIN" </>
 +                                 (l `makeRelativeTo` full_output_fn)
 +                            else l
 +                  -- See Note [-Xlinker -rpath vs -Wl,-rpath]
 +                  rpath = if leUseXLinkerRPath opts
 +                          then ["-Xlinker", "-rpath", "-Xlinker", libpath]
 +                          else []
 +                  -- Solaris 11's linker does not support -rpath-link option. It silently
 +                  -- ignores it and then complains about next option which is -l<some
 +                  -- dir> as being a directory and not expected object file, E.g
 +                  -- ld: elf error: file
 +                  -- /tmp/ghc-src/libraries/base/dist-install/build:
 +                  -- elf_begin: I/O error: region read: Is a directory
 +                  rpathlink = if (platformOS platform) == OSSolaris2
 +                              then []
 +                              else ["-Xlinker", "-rpath-link", "-Xlinker", l]
 +              in ["-L" ++ l] ++ rpathlink ++ rpath
 +         | osMachOTarget (platformOS platform) &&
 +           leDynLibLoader opts == SystemDependent &&
 +           ways_ `hasWay` WayDyn &&
 +           leUseXLinkerRPath opts
 +            = let libpath = if leRelativeDynlibPaths opts
 +                            then "@loader_path" </>
 +                                 (l `makeRelativeTo` full_output_fn)
 +                            else l
 +              in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath]
 +         | otherwise = ["-L" ++ l]
++
 +    pkg_lib_path_opts <-
 +      if leSingleLibFolder opts
 +      then do
 +        libs <- getLibs namever ways_ unit_env dep_units
 +        tmpDir <- newTempSubDir logger tmpfs (leTempDir opts)
 +        sequence_ [ copyFile lib (tmpDir </> basename)
 +                  | (lib, basename) <- libs]
 +        return [ "-L" ++ tmpDir ]
 +      else pure pkg_lib_path_opts
++
 +    let
 +      dead_strip
 +        | leWholeArchiveHsLibs opts = []
 +        | otherwise = if osSubsectionsViaSymbols (platformOS platform)
 +                        then ["-Wl,-dead_strip"]
 +                        else []
 +    let lib_paths = leLibraryPaths opts
 +    let lib_path_opts = map ("-L"++) lib_paths
++
 +    extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger tmpfs opts unit_state
 +    noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger tmpfs opts unit_env dep_units
++
 +    let
 +      (pre_hs_libs, post_hs_libs)
 +        | leWholeArchiveHsLibs opts
 +        = if platformOS platform == OSDarwin
 +            then (["-Wl,-all_load"], [])
 +              -- OS X does not have a flag to turn off -all_load
 +            else (["-Wl,--whole-archive"], ["-Wl,--no-whole-archive"])
 +        | otherwise
 +        = ([],[])
++
 +    pkg_link_opts <- do
 +        unit_link_opts <- getUnitLinkOpts namever ways_ unit_env dep_units
 +        return $ otherFlags unit_link_opts ++ dead_strip
 +                  ++ pre_hs_libs ++ hsLibs unit_link_opts ++ post_hs_libs
 +                  ++ extraLibs unit_link_opts
 +                 -- -Wl,-u,<sym> contained in other_flags
 +                 -- needs to be put before -l<package>,
 +                 -- otherwise Solaris linker fails linking
 +                 -- a binary with unresolved symbols in RTS
 +                 -- which are defined in base package
 +                 -- the reason for this is a note in ld(1) about
 +                 -- '-u' option: "The placement of this option
 +                 -- on the command line is significant.
 +                 -- This option must be placed before the library
 +                 -- that defines the symbol."
++
 +    -- frameworks
 +    pkg_framework_opts <- getUnitFrameworkOpts unit_env dep_units
 +    let framework_opts = getFrameworkOpts (leFrameworkOpts opts) platform
++
 +        -- probably _stub.o files
 +    let extra_ld_inputs = leInputs opts
++
 +    rc_objs <- case platformOS platform of
 +      OSMinGW32 | leGenManifest opts -> maybeCreateManifest logger tmpfs (leManifestOpts opts) output_fn
 +      _                              -> return []
++
 +    let linker_config = leLinkerConfig opts
 +    let args = ( map GHC.SysTools.Option verbFlags
 +                 ++ [ GHC.SysTools.Option "-o"
 +                    , GHC.SysTools.FileOption "" output_fn
 +                    ]
 +                 ++ libmLinkOpts platform
 +                 ++ map GHC.SysTools.Option (
 +                    []
++
 +                 -- See Note [No PIE when linking]
 +                 ++ lePieOpts opts
++
 +                 -- Permit the linker to auto link _symbol to _imp_symbol.
 +                 -- This lets us link against DLLs without needing an "import library".
 +                 ++ (if platformOS platform == OSMinGW32
 +                     then ["-Wl,--enable-auto-import"]
 +                     else [])
++
 +                 -- '-no_compact_unwind'
 +                 -- C++/Objective-C exceptions cannot use optimised
 +                 -- stack unwinding code. The optimised form is the
 +                 -- default in Xcode 4 on at least x86_64, and
 +                 -- without this flag we're also seeing warnings
 +                 -- like
 +                 --     ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
 +                 -- on x86.
 +                 ++ (if not (leCompactUnwind opts) &&
 +                        linkerSupportsCompactUnwind (leLinkerConfig opts) &&
 +                        (platformOS platform == OSDarwin) &&
 +                        case platformArch platform of
 +                          ArchX86_64  -> True
 +                          ArchAArch64 -> True
 +                          _ -> False
 +                     then ["-Wl,-no_compact_unwind"]
 +                     else [])
++
 +                     -- We should rather be asking does it support --gc-sections?
 +                 ++ (if linkerIsGnuLd (leLinkerConfig opts) &&
 +                        not (leWholeArchiveHsLibs opts)
 +                     then ["-Wl,--gc-sections"]
 +                     else [])
++
 +                 ++ o_files
 +                 ++ lib_path_opts)
 +                 ++ extra_ld_inputs
 +                 ++ map GHC.SysTools.Option (
 +                    rc_objs
 +                 ++ framework_opts
 +                 ++ pkg_lib_path_opts
 +                 ++ extraLinkObj
 +                 ++ noteLinkObjs
 +                 -- See Note [RTS/ghc-internal interface]
 +                 -- (-u<sym> must come before -lghc-internal...!)
 +                 ++ (if ghcInternalUnitId `elem` map unitId pkgs
 +                     then [concat [ "-Wl,-u,"
 +                                  , ['_' | platformLeadingUnderscore platform]
 +                                  , "init_ghc_hs_iface" ]]
 +                     else [])
 +                 ++ pkg_link_opts
 +                 ++ pkg_framework_opts
 +                 ++ (if platformOS platform == OSDarwin
 +                     --  dead_strip_dylibs, will remove unused dylibs, and thus save
 +                     --  space in the load commands. The -headerpad is necessary so
 +                     --  that we can inject more @rpath's later for the left over
 +                     --  libraries during runInjectRpaths phase.
 +                     --
 +                     --  See Note [Dynamic linking on macOS].
 +                     then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ]
 +                     else [])
 +               ))
++
 +    runLink logger tmpfs linker_config args
++
 +    -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
 +    when (platformOS platform == OSDarwin && leRPath opts) $
 +      GHC.Linker.MacOS.runInjectRPaths logger (leOtoolConfig opts) (leInstallNameConfig opts) pkg_lib_paths output_fn
++
 +mkExtraObj :: Logger -> TmpFs -> TempDir -> CcConfig -> UnitState -> Suffix -> String -> IO FilePath
 +mkExtraObj logger tmpfs tmpdir cc_config unit_state extn xs
 + = do
 +      -- Pass a different set of options to the C compiler depending one whether
 +      -- we're compiling C or assembler. When compiling C, we pass the usual
 +      -- set of include directories and PIC flags.
 +      let cOpts = map Option (ccPicOpts cc_config)
 +                  ++ map (FileOption "-I" . ST.unpack)
 +                         (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit)
 +      cFile <- newTempName logger tmpfs tmpdir TFL_CurrentModule extn
 +      oFile <- newTempName logger tmpfs tmpdir TFL_GhcSession "o"
 +      writeFile cFile xs
 +      runCc Nothing logger tmpfs tmpdir cc_config
 +            ([Option        "-c",
 +              FileOption "" cFile,
 +              Option        "-o",
 +              FileOption "" oFile]
 +              ++ if extn /= "s"
 +                    then cOpts
 +                    else [])
 +      return oFile
++
 +-- | Create object containing main() entry point
 +--
 +-- When linking a binary, we need to create a C main() function that
 +-- starts everything off.  This used to be compiled statically as part
 +-- of the RTS, but that made it hard to change the -rtsopts setting,
 +-- so now we generate and compile a main() stub as part of every
 +-- binary and pass the -rtsopts setting directly to the RTS (#5373)
 +mkExtraObjToLinkIntoBinary :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitState -> IO (Maybe FilePath)
 +mkExtraObjToLinkIntoBinary logger tmpfs opts unit_state = do
 +  when (leNoHsMain opts && leHaveRtsOptsFlags opts) $
 +     logInfo logger $ withPprStyle defaultUserStyle
 +         (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
 +          text "    Call hs_init_ghc() from your main() function to set these options.")
++
 +  if leNoHsMain opts
 +    -- Don't try to build the extra object if it is not needed.  Compiling the
 +    -- extra object assumes the presence of the RTS in the unit database
 +    -- (because the extra object imports Rts.h) but GHC's build system may try
 +    -- to build some helper programs before building and registering the RTS!
 +    -- See #18938 for an example where hp2ps failed to build because of a failed
 +    -- (unsafe) lookup for the RTS in the unit db.
 +    then pure Nothing
 +    else mk_extra_obj exeMain
++
 +  where
 +    tmpdir = leTempDir opts
 +    cc_config = leCcConfig opts
 +    mk_extra_obj = fmap Just . mkExtraObj logger tmpfs tmpdir cc_config unit_state "c" . renderWithContext defaultSDocContext
++
 +    exeMain = vcat [
 +        text "#include <Rts.h>",
 +        text "extern StgClosure " <> text (leMainSymbol opts) <> text "_closure;",
 +        text "int main(int argc, char *argv[])",
 +        char '{',
 +        text " RtsConfig __conf = defaultRtsConfig;",
 +        text " __conf.rts_opts_enabled = "
 +            <> text (show (leRtsOptsEnabled opts)) <> semi,
 +        text " __conf.rts_opts_suggestions = "
 +            <> (if leRtsOptsSuggestions opts
 +                then text "true"
 +                else text "false") <> semi,
 +        text "__conf.keep_cafs = "
 +            <> (if leKeepCafs opts
 +                then text "true"
 +                else text "false") <> semi,
 +        case leRtsOpts opts of
 +            Nothing   -> Outputable.empty
 +            Just rts_opts -> text "    __conf.rts_opts= " <>
 +                          text (show rts_opts) <> semi,
 +        text " __conf.rts_hs_main = true;",
 +        text " return hs_main(argc,argv,&" <> text (leMainSymbol opts) <> text "_closure,__conf);",
 +        char '}',
 +        char '\n' -- final newline, to keep gcc happy
 +        ]
++
 +-- Write out the link info section into a new assembly file. Previously
 +-- this was included as inline assembly in the main.c file but this
 +-- is pretty fragile. gas gets upset trying to calculate relative offsets
 +-- that span the .note section (notably .text) when debug info is present
 +mkNoteObjsToLinkIntoBinary :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> [UnitId] -> IO [FilePath]
 +mkNoteObjsToLinkIntoBinary logger tmpfs opts unit_env dep_packages = do
 +   link_info <- initLinkInfo opts unit_env dep_packages
++
 +   if (platformSupportsSavingLinkOpts (platformOS platform ))
 +     then fmap (:[]) $ mkExtraObj logger tmpfs tmpdir cc_config unit_state "s" (renderWithContext defaultSDocContext (link_opts link_info))
 +     else return []
++
 +  where
 +    unit_state = ue_homeUnitState unit_env
 +    platform   = ue_platform unit_env
 +    tmpdir = leTempDir opts
 +    cc_config = leCcConfig opts
 +    link_opts info = hcat
 +        [ -- "link info" section (see Note [LinkInfo section])
 +          makeElfNote platform ghcLinkInfoSectionName ghcLinkInfoNoteName 0 (show info)
++
 +        -- ALL generated assembly must have this section to disable
 +        -- executable stacks.  See also
 +        -- "GHC.CmmToAsm" for another instance
 +        -- where we need to do this.
 +        , if platformHasGnuNonexecStack platform
 +            then text ".section .note.GNU-stack,\"\","
 +                 <> sectionType platform "progbits" <> char '\n'
 +            else Outputable.empty
 +        ]
++
 +data LinkInfo = LinkInfo
 +  { liPkgLinkOpts :: UnitLinkOpts
 +  , liPkgFrameworks :: [String]
 +  , liRtsOpts :: Maybe String
 +  , liRtsOptsEnabled :: !RtsOptsEnabled
 +  , liNoHsMain :: !Bool
 +  , liLdInputs :: [String]
 +  , liLdOpts :: [String]
 +  }
 +  deriving (Show)
++
++
 +-- | Return the "link info"
 +--
 +-- See Note [LinkInfo section]
 +initLinkInfo :: ExecutableLinkOpts -> UnitEnv -> [UnitId] -> IO LinkInfo
 +initLinkInfo opts unit_env dep_packages = do
 +    package_link_opts <- getUnitLinkOpts (leNameVersion opts) (leWays opts) unit_env dep_packages
 +    pkg_frameworks <- if not (platformUsesFrameworks (ue_platform unit_env))
 +      then return []
 +      else do
 +         ps <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_packages)
 +         return (collectFrameworks ps)
 +    pure $ LinkInfo
 +      { liPkgLinkOpts = package_link_opts
 +      , liPkgFrameworks = pkg_frameworks
 +      , liRtsOpts = leRtsOpts opts
 +      , liRtsOptsEnabled = leRtsOptsEnabled opts
 +      , liNoHsMain = leNoHsMain opts
 +      , liLdInputs = map showOpt (leInputs opts)
 +      , liLdOpts = map showOpt (linkerOptionsPost (leLinkerConfig opts))
 +      }
++
 +platformSupportsSavingLinkOpts :: OS -> Bool
 +platformSupportsSavingLinkOpts os
 + | os == OSSolaris2 = False -- see #5382
 + | otherwise        = osElfTarget os
++
 +-- See Note [LinkInfo section]
 +ghcLinkInfoSectionName :: String
 +ghcLinkInfoSectionName = ".debug-ghc-link-info"
 +  -- if we use the ".debug" prefix, then strip will strip it by default
++
 +-- Identifier for the note (see Note [LinkInfo section])
 +ghcLinkInfoNoteName :: String
 +ghcLinkInfoNoteName = "GHC link info"
++
 +-- Returns 'False' if it was, and we can avoid linking, because the
 +-- previous binary was linked with "the same options".
 +checkLinkInfo :: Logger -> ExecutableLinkOpts -> UnitEnv -> [UnitId] -> FilePath -> IO Bool
 +checkLinkInfo logger opts unit_env pkg_deps exe_file
 + | not (platformSupportsSavingLinkOpts (platformOS (ue_platform unit_env)))
 + -- ToDo: Windows and OS X do not use the ELF binary format, so
 + -- readelf does not work there.  We need to find another way to do
 + -- this.
 + = return False -- conservatively we should return True, but not
 +                -- linking in this case was the behaviour for a long
 +                -- time so we leave it as-is.
 + | otherwise
 + = do
 +   link_info <- initLinkInfo opts unit_env pkg_deps
 +   debugTraceMsg logger 3 $ text ("Link info: " ++ show link_info)
 +   m_exe_link_info <- readElfNoteAsString logger exe_file
 +                          ghcLinkInfoSectionName ghcLinkInfoNoteName
 +   let sameLinkInfo = (Just (show link_info) == m_exe_link_info)
 +   debugTraceMsg logger 3 $ case m_exe_link_info of
 +     Nothing -> text "Exe link info: Not found"
 +     Just s
 +       | sameLinkInfo -> text ("Exe link info is the same")
 +       | otherwise    -> text ("Exe link info is different: " ++ s)
 +   return (not sameLinkInfo)
++
 +{- Note [LinkInfo section]
 +   ~~~~~~~~~~~~~~~~~~~~~~~
++
 +The "link info" is a string representing the parameters of the link. We save
 +this information in the binary, and the next time we link, if nothing else has
 +changed, we use the link info stored in the existing binary to decide whether
 +to re-link or not.
++
 +The "link info" string is stored in a ELF section called ".debug-ghc-link-info"
 +(see ghcLinkInfoSectionName) with the SHT_NOTE type.  For some time, it used to
 +not follow the specified record-based format (see #11022).
++
 +-}
++
 +{-
 +Note [-Xlinker -rpath vs -Wl,-rpath]
 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
++
 +-Wl takes a comma-separated list of options which in the case of
 +-Wl,-rpath -Wl,some,path,with,commas parses the path with commas
 +as separate options.
 +Buck, the build system, produces paths with commas in them.
++
 +-Xlinker doesn't have this disadvantage and as far as I can tell
 +it is supported by both gcc and clang. Anecdotally nvcc supports
 +-Xlinker, but not -Wl.
 +-}
++

compiler/GHC/Linker/ExtraObj.hs deleted

 ------------------------------------------------------------------------------
 ---
 --- GHC Extra object linking code
 ---
 --- (c) The GHC Team 2017
 ---
 ------------------------------------------------------------------------------
+-
 -module GHC.Linker.ExtraObj
 -   ( mkExtraObj
 -   , mkExtraObjToLinkIntoBinary
 -   , mkNoteObjsToLinkIntoBinary
 -   , checkLinkInfo
 -   , getLinkInfo
 -   , ghcLinkInfoSectionName
 -   , ghcLinkInfoNoteName
 -   , platformSupportsSavingLinkOpts
 -   , haveRtsOptsFlags
 -   )
 -where
+-
 -import GHC.Prelude
 -import GHC.Platform
+-
 -import GHC.Unit
 -import GHC.Unit.Env
+-
 -import GHC.Utils.Asm
 -import GHC.Utils.Error
 -import GHC.Utils.Misc
 -import GHC.Utils.Outputable as Outputable
 -import GHC.Utils.Logger
 -import GHC.Utils.TmpFs
+-
 -import GHC.Driver.Session
 -import GHC.Driver.Ppr
+-
 -import qualified GHC.Data.ShortText as ST
+-
 -import GHC.SysTools.Elf
 -import GHC.SysTools.Tasks
 -import GHC.Linker.Unit
+-
 -import Control.Monad
 -import Data.Maybe
+-
 -mkExtraObj :: Logger -> TmpFs -> DynFlags -> UnitState -> Suffix -> String -> IO FilePath
 -mkExtraObj logger tmpfs dflags unit_state extn xs
 - = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn
 -      oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o"
 -      writeFile cFile xs
 -      runCc Nothing logger tmpfs dflags
 -            ([Option        "-c",
 -              FileOption "" cFile,
 -              Option        "-o",
 -              FileOption "" oFile]
 -              ++ if extn /= "s"
 -                    then cOpts
 -                    else [])
 -      return oFile
 -    where
 -      -- Pass a different set of options to the C compiler depending one whether
 -      -- we're compiling C or assembler. When compiling C, we pass the usual
 -      -- set of include directories and PIC flags.
 -      cOpts = map Option (picCCOpts dflags)
 -                    ++ map (FileOption "-I" . ST.unpack)
 -                            (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit)
+-
 --- When linking a binary, we need to create a C main() function that
 --- starts everything off.  This used to be compiled statically as part
 --- of the RTS, but that made it hard to change the -rtsopts setting,
 --- so now we generate and compile a main() stub as part of every
 --- binary and pass the -rtsopts setting directly to the RTS (#5373)
 ---
 --- On Windows, when making a shared library we also may need a DllMain.
 ---
 -mkExtraObjToLinkIntoBinary :: Logger -> TmpFs -> DynFlags -> UnitState -> IO (Maybe FilePath)
 -mkExtraObjToLinkIntoBinary logger tmpfs dflags unit_state = do
 -  when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $
 -     logInfo logger $ withPprStyle defaultUserStyle
 -         (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
 -          text "    Call hs_init_ghc() from your main() function to set these options.")
+-
 -  case ghcLink dflags of
 -    -- Don't try to build the extra object if it is not needed.  Compiling the
 -    -- extra object assumes the presence of the RTS in the unit database
 -    -- (because the extra object imports Rts.h) but GHC's build system may try
 -    -- to build some helper programs before building and registering the RTS!
 -    -- See #18938 for an example where hp2ps failed to build because of a failed
 -    -- (unsafe) lookup for the RTS in the unit db.
 -    _ | gopt Opt_NoHsMain dflags
 -      -> return Nothing
+-
 -    LinkDynLib
 -      | OSMinGW32 <- platformOS (targetPlatform dflags)
 -      -> mk_extra_obj dllMain
+-
 -      | otherwise
 -      -> return Nothing
+-
 -    _ -> mk_extra_obj exeMain
+-
 -  where
 -    mk_extra_obj = fmap Just . mkExtraObj logger tmpfs dflags unit_state "c" . showSDoc dflags
+-
 -    exeMain = vcat [
 -        text "#include <Rts.h>",
 -        text "extern StgClosure ZCMain_main_closure;",
 -        text "int main(int argc, char *argv[])",
 -        char '{',
 -        text " RtsConfig __conf = defaultRtsConfig;",
 -        text " __conf.rts_opts_enabled = "
 -            <> text (show (rtsOptsEnabled dflags)) <> semi,
 -        text " __conf.rts_opts_suggestions = "
 -            <> (if rtsOptsSuggestions dflags
 -                then text "true"
 -                else text "false") <> semi,
 -        text "__conf.keep_cafs = "
 -            <> (if gopt Opt_KeepCAFs dflags
 -                then text "true"
 -                else text "false") <> semi,
 -        case rtsOpts dflags of
 -            Nothing   -> Outputable.empty
 -            Just opts -> text "    __conf.rts_opts= " <>
 -                          text (show opts) <> semi,
 -        text " __conf.rts_hs_main = true;",
 -        text " return hs_main(argc,argv,&ZCMain_main_closure,__conf);",
 -        char '}',
 -        char '\n' -- final newline, to keep gcc happy
 -        ]
+-
 -    dllMain = vcat [
 -        text "#include <Rts.h>",
 -        text "#include <windows.h>",
 -        text "#include <stdbool.h>",
 -        char '\n',
 -        text "bool",
 -        text "WINAPI",
 -        text "DllMain ( HINSTANCE hInstance STG_UNUSED",
 -        text "        , DWORD reason STG_UNUSED",
 -        text "        , LPVOID reserved STG_UNUSED",
 -        text "        )",
 -        text "{",
 -        text "  return true;",
 -        text "}",
 -        char '\n' -- final newline, to keep gcc happy
 -        ]
+-
 --- Write out the link info section into a new assembly file. Previously
 --- this was included as inline assembly in the main.c file but this
 --- is pretty fragile. gas gets upset trying to calculate relative offsets
 --- that span the .note section (notably .text) when debug info is present
 -mkNoteObjsToLinkIntoBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [UnitId] -> IO [FilePath]
 -mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_packages = do
 -   link_info <- getLinkInfo dflags unit_env dep_packages
+-
 -   if (platformSupportsSavingLinkOpts (platformOS platform ))
 -     then fmap (:[]) $ mkExtraObj logger tmpfs dflags unit_state "s" (showSDoc dflags (link_opts link_info))
 -     else return []
+-
 -  where
 -    unit_state = ue_homeUnitState unit_env
 -    platform   = ue_platform unit_env
 -    link_opts info = hcat
 -        [ -- "link info" section (see Note [LinkInfo section])
 -          makeElfNote platform ghcLinkInfoSectionName ghcLinkInfoNoteName 0 info
+-
 -        -- ALL generated assembly must have this section to disable
 -        -- executable stacks.  See also
 -        -- "GHC.CmmToAsm" for another instance
 -        -- where we need to do this.
 -        , if platformHasGnuNonexecStack platform
 -            then text ".section .note.GNU-stack,\"\","
 -                 <> sectionType platform "progbits" <> char '\n'
 -            else Outputable.empty
 -        ]
+-
 --- | Return the "link info" string
 ---
 --- See Note [LinkInfo section]
 -getLinkInfo :: DynFlags -> UnitEnv -> [UnitId] -> IO String
 -getLinkInfo dflags unit_env dep_packages = do
 -    package_link_opts <- getUnitLinkOpts (ghcNameVersion dflags) (ways dflags) unit_env dep_packages
 -    pkg_frameworks <- if not (platformUsesFrameworks (ue_platform unit_env))
 -      then return []
 -      else do
 -         ps <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_packages)
 -         return (collectFrameworks ps)
 -    let link_info =
 -             ( package_link_opts
 -             , pkg_frameworks
 -             , rtsOpts dflags
 -             , rtsOptsEnabled dflags
 -             , gopt Opt_NoHsMain dflags
 -             , map showOpt (ldInputs dflags)
 -             , getOpts dflags opt_l
 -             )
 -    return (show link_info)
+-
 -platformSupportsSavingLinkOpts :: OS -> Bool
 -platformSupportsSavingLinkOpts os
 - | os == OSSolaris2 = False -- see #5382
 - | otherwise        = osElfTarget os
+-
 --- See Note [LinkInfo section]
 -ghcLinkInfoSectionName :: String
 -ghcLinkInfoSectionName = ".debug-ghc-link-info"
 -  -- if we use the ".debug" prefix, then strip will strip it by default
+-
 --- Identifier for the note (see Note [LinkInfo section])
 -ghcLinkInfoNoteName :: String
 -ghcLinkInfoNoteName = "GHC link info"
+-
 --- Returns 'False' if it was, and we can avoid linking, because the
 --- previous binary was linked with "the same options".
 -checkLinkInfo :: Logger -> DynFlags -> UnitEnv -> [UnitId] -> FilePath -> IO Bool
 -checkLinkInfo logger dflags unit_env pkg_deps exe_file
 - | not (platformSupportsSavingLinkOpts (platformOS (ue_platform unit_env)))
 - -- ToDo: Windows and OS X do not use the ELF binary format, so
 - -- readelf does not work there.  We need to find another way to do
 - -- this.
 - = return False -- conservatively we should return True, but not
 -                -- linking in this case was the behaviour for a long
 -                -- time so we leave it as-is.
 - | otherwise
 - = do
 -   link_info <- getLinkInfo dflags unit_env pkg_deps
 -   debugTraceMsg logger 3 $ text ("Link info: " ++ link_info)
 -   m_exe_link_info <- readElfNoteAsString logger exe_file
 -                          ghcLinkInfoSectionName ghcLinkInfoNoteName
 -   let sameLinkInfo = (Just link_info == m_exe_link_info)
 -   debugTraceMsg logger 3 $ case m_exe_link_info of
 -     Nothing -> text "Exe link info: Not found"
 -     Just s
 -       | sameLinkInfo -> text ("Exe link info is the same")
 -       | otherwise    -> text ("Exe link info is different: " ++ s)
 -   return (not sameLinkInfo)
+-
 -{- Note [LinkInfo section]
 -   ~~~~~~~~~~~~~~~~~~~~~~~
+-
 -The "link info" is a string representing the parameters of the link. We save
 -this information in the binary, and the next time we link, if nothing else has
 -changed, we use the link info stored in the existing binary to decide whether
 -to re-link or not.
+-
 -The "link info" string is stored in a ELF section called ".debug-ghc-link-info"
 -(see ghcLinkInfoSectionName) with the SHT_NOTE type.  For some time, it used to
 -not follow the specified record-based format (see #11022).
+-
 --}
+-
 -haveRtsOptsFlags :: DynFlags -> Bool
 -haveRtsOptsFlags dflags =
 -        isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of
 -                                       RtsOptsSafeOnly -> False
 -                                       _ -> True

compiler/GHC/Linker/Loader.hs

@@ -406,6 +406,7 @@ loadCmdLineLibs'' interp hsc_env pls =
                             , libraryPaths = lib_paths_base})
              = hsc_dflags hsc_env
        let logger = hsc_logger hsc_env
 +      let ld_config = configureLd dflags
        -- (c) Link libraries from the command-line
        let minus_ls_1 = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ]
@@ -421,7 +422,7 @@ loadCmdLineLibs'' interp hsc_env pls =
                         OSMinGW32 -> "pthread" : minus_ls_1
                         _         -> minus_ls_1
        -- See Note [Fork/Exec Windows]
 -      gcc_paths <- getGCCPaths logger dflags os
 +      gcc_paths <- getGCCPaths logger platform ld_config
        lib_paths_env <- addEnvPaths "LIBRARY_PATH" lib_paths_base
@@ -1254,6 +1255,7 @@ loadPackage interp hsc_env pkgs
     = do
          let dflags    = hsc_dflags hsc_env
          let logger    = hsc_logger hsc_env
 +            ld_config = configureLd dflags
              platform  = targetPlatform dflags
              is_dyn    = interpreterDynamic interp
              dirs | is_dyn    = [map ST.unpack $ Packages.unitLibraryDynDirs pkg | pkg <- pkgs]
@@ -1281,7 +1283,7 @@ loadPackage interp hsc_env pkgs
              extra_libs = zipWith (++) extdeplibs linkerlibs
          -- See Note [Fork/Exec Windows]
 -        gcc_paths <- getGCCPaths logger dflags (platformOS platform)
 +        gcc_paths <- getGCCPaths logger platform ld_config
          dirs_env <- traverse (addEnvPaths "LIBRARY_PATH") dirs
          hs_classifieds
@@ -1507,6 +1509,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
       dflags = hsc_dflags hsc_env
       logger = hsc_logger hsc_env
       diag_opts = initDiagOpts dflags
 +     ld_config = configureLd dflags
       dirs   = lib_dirs ++ gcc_dirs
       gcc    = False
       user   = True
@@ -1570,7 +1573,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
       findSysDll    = fmap (fmap $ DLL . dropExtension . takeFileName) $
                          findSystemLibrary interp so_name
  #endif
 -     tryGcc        = let search   = searchForLibUsingGcc logger dflags
 +     tryGcc        = let search   = searchForLibUsingGcc logger ld_config
  #if defined(CAN_LOAD_DLL)
                           dllpath  = liftM (fmap DLLPath)
                           short    = dllpath $ search so_name lib_dirs
@@ -1624,11 +1627,11 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
  #endif
       os = platformOS platform
 -searchForLibUsingGcc :: Logger -> DynFlags -> String -> [FilePath] -> IO (Maybe FilePath)
 -searchForLibUsingGcc logger dflags so dirs = do
 +searchForLibUsingGcc :: Logger -> LdConfig -> String -> [FilePath] -> IO (Maybe FilePath)
 +searchForLibUsingGcc logger ld_config so dirs = do
     -- GCC does not seem to extend the library search path (using -L) when using
     -- --print-file-name. So instead pass it a new base location.
 -   str <- askLd logger dflags (map (FileOption "-B") dirs
 +   str <- askLd logger ld_config (map (FileOption "-B") dirs
                            ++ [Option "--print-file-name", Option so])
     let file = case lines str of
                  []  -> ""
@@ -1640,10 +1643,10 @@ searchForLibUsingGcc logger dflags so dirs = do
  -- | Retrieve the list of search directory GCC and the System use to find
  --   libraries and components. See Note [Fork/Exec Windows].
 -getGCCPaths :: Logger -> DynFlags -> OS -> IO [FilePath]
 -getGCCPaths logger dflags os
 -  | os == OSMinGW32 || platformArch (targetPlatform dflags) == ArchWasm32 =
 -        do gcc_dirs <- getGccSearchDirectory logger dflags "libraries"
 +getGCCPaths :: Logger -> Platform -> LdConfig -> IO [FilePath]
 +getGCCPaths logger platform ld_config
 +  | platformOS platform == OSMinGW32 || platformArch platform == ArchWasm32 =
 +        do gcc_dirs <- getGccSearchDirectory logger ld_config "libraries"
             sys_dirs <- getSystemDirectories
             return $ nub $ gcc_dirs ++ sys_dirs
    | otherwise = return []
@@ -1663,8 +1666,8 @@ gccSearchDirCache = unsafePerformIO $ newIORef []
  -- which hopefully is written in an optimized manner to take advantage of
  -- caching. At the very least we remove the overhead of the fork/exec and waits
  -- which dominate a large percentage of startup time on Windows.
 -getGccSearchDirectory :: Logger -> DynFlags -> String -> IO [FilePath]
 -getGccSearchDirectory logger dflags key = do
 +getGccSearchDirectory :: Logger -> LdConfig -> String -> IO [FilePath]
 +getGccSearchDirectory logger ld_config key = do
  #if defined(wasm32_HOST_ARCH)
      pure []
  #else
@@ -1672,7 +1675,7 @@ getGccSearchDirectory logger dflags key = do
      case lookup key cache of
        Just x  -> return x
        Nothing -> do
 -        str <- askLd logger dflags [Option "--print-search-dirs"]
 +        str <- askLd logger ld_config [Option "--print-search-dirs"]
          let line = dropWhile isSpace str
              name = key ++ ": ="
          if null line

compiler/GHC/Linker/MacOS.hs

@@ -17,7 +17,6 @@ import GHC.Unit.Types
  import GHC.Unit.State
  import GHC.Unit.Env
 -import GHC.Settings
  import GHC.SysTools.Tasks
  import GHC.Runtime.Interpreter
@@ -49,13 +48,13 @@ import Text.ParserCombinators.ReadP as Parser
  -- dynamic library through @-add_rpath@.
  --
  -- See Note [Dynamic linking on macOS]
 -runInjectRPaths :: Logger -> ToolSettings -> [FilePath] -> FilePath -> IO ()
 -runInjectRPaths logger toolSettings lib_paths dylib = do
 -  info <- lines <$> askOtool logger toolSettings Nothing [Option "-L", Option dylib]
 +runInjectRPaths :: Logger -> OtoolConfig -> InstallNameConfig -> [FilePath] -> FilePath -> IO ()
 +runInjectRPaths logger otool_opts install_name_opts lib_paths dylib = do
 +  info <- lines <$> askOtool logger otool_opts Nothing [Option "-L", Option dylib]
    -- filter the output for only the libraries. And then drop the @rpath prefix.
    let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info
    -- find any pre-existing LC_PATH items
 -  info <- lines <$> askOtool logger toolSettings Nothing [Option "-l", Option dylib]
 +  info <- lines <$> askOtool logger otool_opts Nothing [Option "-l", Option dylib]
    let paths = mapMaybe get_rpath info
        lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ]
    -- only find those rpaths, that aren't already in the library.
@@ -63,7 +62,7 @@ runInjectRPaths logger toolSettings lib_paths dylib = do
    -- inject the rpaths
    case rpaths of
      [] -> return ()
 -    _  -> runInstallNameTool logger toolSettings $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib]
 +    _  -> runInstallNameTool logger install_name_opts $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib]
  get_rpath :: String -> Maybe FilePath
  get_rpath l = case readP_to_S rpath_parser l of

compiler/GHC/Linker/Static.hs

  module GHC.Linker.Static
 -   ( linkBinary
 -   , linkStaticLib
 +   ( linkStaticLib
+    )
  where
  import GHC.Prelude
  import GHC.Platform
 -import GHC.Platform.Ways
  import GHC.Settings
  import GHC.SysTools
@@ -19,24 +17,15 @@ import GHC.Unit.State
  import GHC.Utils.Logger
  import GHC.Utils.Monad
 -import GHC.Utils.Misc
 -import GHC.Utils.TmpFs
 -import GHC.Linker.MacOS
  import GHC.Linker.Unit
 -import GHC.Linker.Dynamic
 -import GHC.Linker.ExtraObj
 -import GHC.Linker.External
 -import GHC.Linker.Windows
  import GHC.Linker.Static.Utils
 -import GHC.Driver.Config.Linker
  import GHC.Driver.Session
  import System.FilePath
  import System.Directory
  import Control.Monad
 -import Data.Maybe
  -----------------------------------------------------------------------------
  -- Static linking, of .o files
@@ -51,225 +40,6 @@ import Data.Maybe
  -- read any interface files), so the user must explicitly specify all
  -- the packages.
 -{-
 -Note [-Xlinker -rpath vs -Wl,-rpath]
 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-
 --Wl takes a comma-separated list of options which in the case of
 --Wl,-rpath -Wl,some,path,with,commas parses the path with commas
 -as separate options.
 -Buck, the build system, produces paths with commas in them.
+-
 --Xlinker doesn't have this disadvantage and as far as I can tell
 -it is supported by both gcc and clang. Anecdotally nvcc supports
 --Xlinker, but not -Wl.
 --}
+-
 -linkBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
 -linkBinary = linkBinary' False
+-
 -linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
 -linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
 -    let platform   = ue_platform unit_env
 -        unit_state = ue_homeUnitState unit_env
 -        toolSettings' = toolSettings dflags
 -        verbFlags = getVerbFlags dflags
 -        arch_os   = platformArchOS platform
 -        output_fn = exeFileName arch_os staticLink (outputFile_ dflags)
 -        namever   = ghcNameVersion dflags
 -        -- For the wasm target, when ghc is invoked with -dynamic,
 -        -- when linking the final .wasm binary we must still ensure
 -        -- the static archives are selected. Otherwise wasm-ld would
 -        -- fail to find and link the .so library dependencies. wasm-ld
 -        -- can link PIC objects into static .wasm binaries fine, so we
 -        -- only adjust the ways in the final linking step, and only
 -        -- when linking .wasm binary (which is supposed to be fully
 -        -- static), not when linking .so shared libraries.
 -        ways_
 -          | ArchWasm32 <- platformArch platform = removeWay WayDyn $ targetWays_ dflags
 -          | otherwise = ways dflags
+-
 -    full_output_fn <- if isAbsolute output_fn
 -                      then return output_fn
 -                      else do d <- getCurrentDirectory
 -                              return $ normalise (d </> output_fn)
+-
 -    -- get the full list of packages to link with, by combining the
 -    -- explicit packages with the auto packages and all of their
 -    -- dependencies, and eliminating duplicates.
 -    pkgs <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
 -    let pkg_lib_paths     = collectLibraryDirs ways_ pkgs
 -    let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
 -        get_pkg_lib_path_opts l
 -         | osElfTarget (platformOS platform) &&
 -           dynLibLoader dflags == SystemDependent &&
 -           ways_ `hasWay` WayDyn
 -            = let libpath = if gopt Opt_RelativeDynlibPaths dflags
 -                            then "$ORIGIN" </>
 -                                 (l `makeRelativeTo` full_output_fn)
 -                            else l
 -                  -- See Note [-Xlinker -rpath vs -Wl,-rpath]
 -                  rpath = if useXLinkerRPath dflags (platformOS platform)
 -                          then ["-Xlinker", "-rpath", "-Xlinker", libpath]
 -                          else []
 -                  -- Solaris 11's linker does not support -rpath-link option. It silently
 -                  -- ignores it and then complains about next option which is -l<some
 -                  -- dir> as being a directory and not expected object file, E.g
 -                  -- ld: elf error: file
 -                  -- /tmp/ghc-src/libraries/base/dist-install/build:
 -                  -- elf_begin: I/O error: region read: Is a directory
 -                  rpathlink = if (platformOS platform) == OSSolaris2
 -                              then []
 -                              else ["-Xlinker", "-rpath-link", "-Xlinker", l]
 -              in ["-L" ++ l] ++ rpathlink ++ rpath
 -         | osMachOTarget (platformOS platform) &&
 -           dynLibLoader dflags == SystemDependent &&
 -           ways_ `hasWay` WayDyn &&
 -           useXLinkerRPath dflags (platformOS platform)
 -            = let libpath = if gopt Opt_RelativeDynlibPaths dflags
 -                            then "@loader_path" </>
 -                                 (l `makeRelativeTo` full_output_fn)
 -                            else l
 -              in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath]
 -         | otherwise = ["-L" ++ l]
+-
 -    pkg_lib_path_opts <-
 -      if gopt Opt_SingleLibFolder dflags
 -      then do
 -        libs <- getLibs namever ways_ unit_env dep_units
 -        tmpDir <- newTempSubDir logger tmpfs (tmpDir dflags)
 -        sequence_ [ copyFile lib (tmpDir </> basename)
 -                  | (lib, basename) <- libs]
 -        return [ "-L" ++ tmpDir ]
 -      else pure pkg_lib_path_opts
+-
 -    let
 -      dead_strip
 -        | gopt Opt_WholeArchiveHsLibs dflags = []
 -        | otherwise = if osSubsectionsViaSymbols (platformOS platform)
 -                        then ["-Wl,-dead_strip"]
 -                        else []
 -    let lib_paths = libraryPaths dflags
 -    let lib_path_opts = map ("-L"++) lib_paths
+-
 -    extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger tmpfs dflags unit_state
 -    noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_units
+-
 -    let
 -      (pre_hs_libs, post_hs_libs)
 -        | gopt Opt_WholeArchiveHsLibs dflags
 -        = if platformOS platform == OSDarwin
 -            then (["-Wl,-all_load"], [])
 -              -- OS X does not have a flag to turn off -all_load
 -            else (["-Wl,--whole-archive"], ["-Wl,--no-whole-archive"])
 -        | otherwise
 -        = ([],[])
+-
 -    pkg_link_opts <- do
 -        unit_link_opts <- getUnitLinkOpts namever ways_ unit_env dep_units
 -        return $ otherFlags unit_link_opts ++ dead_strip
 -                  ++ pre_hs_libs ++ hsLibs unit_link_opts ++ post_hs_libs
 -                  ++ extraLibs unit_link_opts
 -                 -- -Wl,-u,<sym> contained in other_flags
 -                 -- needs to be put before -l<package>,
 -                 -- otherwise Solaris linker fails linking
 -                 -- a binary with unresolved symbols in RTS
 -                 -- which are defined in base package
 -                 -- the reason for this is a note in ld(1) about
 -                 -- '-u' option: "The placement of this option
 -                 -- on the command line is significant.
 -                 -- This option must be placed before the library
 -                 -- that defines the symbol."
+-
 -    -- frameworks
 -    pkg_framework_opts <- getUnitFrameworkOpts unit_env dep_units
 -    let framework_opts = getFrameworkOpts (initFrameworkOpts dflags) platform
+-
 -        -- probably _stub.o files
 -    let extra_ld_inputs = ldInputs dflags
+-
 -    rc_objs <- case platformOS platform of
 -      OSMinGW32 | gopt Opt_GenManifest dflags -> maybeCreateManifest logger tmpfs dflags output_fn
 -      _                                       -> return []
+-
 -    let linker_config = initLinkerConfig dflags
 -    let link dflags args = do
 -          runLink logger tmpfs linker_config args
 -          -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
 -          when (platformOS platform == OSDarwin && gopt Opt_RPath dflags) $
 -            GHC.Linker.MacOS.runInjectRPaths logger (toolSettings dflags) pkg_lib_paths output_fn
+-
 -    link dflags (
 -                       map GHC.SysTools.Option verbFlags
 -                      ++ [ GHC.SysTools.Option "-o"
 -                         , GHC.SysTools.FileOption "" output_fn
 -                         ]
 -                      ++ libmLinkOpts platform
 -                      ++ map GHC.SysTools.Option (
 -                         []
+-
 -                      -- See Note [No PIE when linking]
 -                      ++ pieCCLDOpts dflags
+-
 -                      -- Permit the linker to auto link _symbol to _imp_symbol.
 -                      -- This lets us link against DLLs without needing an "import library".
 -                      ++ (if platformOS platform == OSMinGW32
 -                          then ["-Wl,--enable-auto-import"]
 -                          else [])
+-
 -                      -- '-no_compact_unwind'
 -                      -- C++/Objective-C exceptions cannot use optimised
 -                      -- stack unwinding code. The optimised form is the
 -                      -- default in Xcode 4 on at least x86_64, and
 -                      -- without this flag we're also seeing warnings
 -                      -- like
 -                      --     ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
 -                      -- on x86.
 -                      ++ (if not (gopt Opt_CompactUnwind dflags) &&
 -                             toolSettings_ldSupportsCompactUnwind toolSettings' &&
 -                             (platformOS platform == OSDarwin) &&
 -                             case platformArch platform of
 -                               ArchX86_64  -> True
 -                               ArchAArch64 -> True
 -                               _ -> False
 -                          then ["-Wl,-no_compact_unwind"]
 -                          else [])
+-
 -                          -- We should rather be asking does it support --gc-sections?
 -                      ++ (if toolSettings_ldIsGnuLd toolSettings' &&
 -                             not (gopt Opt_WholeArchiveHsLibs dflags)
 -                          then ["-Wl,--gc-sections"]
 -                          else [])
+-
 -                      ++ o_files
 -                      ++ lib_path_opts)
 -                      ++ extra_ld_inputs
 -                      ++ map GHC.SysTools.Option (
 -                         rc_objs
 -                      ++ framework_opts
 -                      ++ pkg_lib_path_opts
 -                      ++ extraLinkObj
 -                      ++ noteLinkObjs
 -                      -- See Note [RTS/ghc-internal interface]
 -                      -- (-u<sym> must come before -lghc-internal...!)
 -                      ++ (if ghcInternalUnitId `elem` map unitId pkgs
 -                          then [concat [ "-Wl,-u,"
 -                                       , ['_' | platformLeadingUnderscore platform]
 -                                       , "init_ghc_hs_iface" ]]
 -                          else [])
 -                      ++ pkg_link_opts
 -                      ++ pkg_framework_opts
 -                      ++ (if platformOS platform == OSDarwin
 -                          --  dead_strip_dylibs, will remove unused dylibs, and thus save
 -                          --  space in the load commands. The -headerpad is necessary so
 -                          --  that we can inject more @rpath's later for the left over
 -                          --  libraries during runInjectRpaths phase.
 -                          --
 -                          --  See Note [Dynamic linking on macOS].
 -                          then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ]
 -                          else [])
 -                    ))
+-
  -- | Linking a static lib will not really link anything. It will merely produce
  -- a static archive of all dependent static libraries. The resulting library
  -- will still need to be linked with any remaining link flags.
@@ -309,4 +79,5 @@ linkStaticLib logger dflags unit_env o_files dep_units = do
      else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar
    -- run ranlib over the archive. write*Ar does *not* create the symbol index.
 -  runRanlib logger dflags [GHC.SysTools.FileOption "" output_fn]
 +  let ranlib_opts = configureRanlib dflags
 +  runRanlib logger ranlib_opts [GHC.SysTools.FileOption "" output_fn]

compiler/GHC/Linker/Windows.hs

  module GHC.Linker.Windows
 -   ( maybeCreateManifest
 +   ( ManifestOpts (..)
 +   , initManifestOpts
 +   , maybeCreateManifest
+    )
  where
@@ -12,13 +14,28 @@ import GHC.Utils.Logger
  import System.FilePath
  import System.Directory
 +data ManifestOpts = ManifestOpts
 +  { manifestEmbed :: !Bool    -- ^ Should the manifest be embedded in the binary with Windres
 +  , manifestTempdir :: TempDir
 +  , manifestWindresConfig :: WindresConfig
 +  , manifestObjectSuf :: String
 +  }
++
 +initManifestOpts :: DynFlags -> ManifestOpts
 +initManifestOpts dflags = ManifestOpts
 +  { manifestEmbed = gopt Opt_EmbedManifest dflags
 +  , manifestTempdir = tmpDir dflags
 +  , manifestWindresConfig = configureWindres dflags
 +  , manifestObjectSuf = objectSuf dflags
 +  }
++
  maybeCreateManifest
     :: Logger
     -> TmpFs
 -   -> DynFlags
 +   -> ManifestOpts
     -> FilePath      -- ^ filename of executable
     -> IO [FilePath] -- ^ extra objects to embed, maybe
 -maybeCreateManifest logger tmpfs dflags exe_filename = do
 +maybeCreateManifest logger tmpfs opts exe_filename = do
     let manifest_filename = exe_filename <.> "manifest"
         manifest =
           "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n\
@@ -42,18 +59,18 @@ maybeCreateManifest logger tmpfs dflags exe_filename = do
     -- foo.exe.manifest. However, for extra robustness, and so that
     -- we can move the binary around, we can embed the manifest in
     -- the binary itself using windres:
 -   if not (gopt Opt_EmbedManifest dflags)
 +   if not (manifestEmbed opts)
        then return []
        else do
 -         rc_filename <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "rc"
 +         rc_filename <- newTempName logger tmpfs (manifestTempdir opts) TFL_CurrentModule "rc"
           rc_obj_filename <-
 -           newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession (objectSuf dflags)
 +           newTempName logger tmpfs (manifestTempdir opts) TFL_GhcSession (manifestObjectSuf opts)
           writeFile rc_filename $
               "1 24 MOVEABLE PURE \"" ++ manifest_filename ++ "\"\n"
                 -- magic numbers :-)
 -         runWindres logger dflags $ map GHC.SysTools.Option $
 +         runWindres logger (manifestWindresConfig opts) $ map GHC.SysTools.Option $
                 ["--input="++rc_filename,
                  "--output="++rc_obj_filename,
                  "--output-format=coff"]

compiler/GHC/Runtime/Interpreter/C.hs

 +{-# LANGUAGE MultiWayIf #-}
++
 +-- | External interpreter program
 +module GHC.Runtime.Interpreter.C
 +  ( generateIservC
 +  )
 +where
++
 +import GHC.Prelude
 +import GHC.Platform
 +import GHC.Data.FastString
 +import GHC.Utils.Logger
 +import GHC.Utils.TmpFs
 +import GHC.Unit.Types
 +import GHC.Unit.Env
 +import GHC.Unit.Info
 +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
 +  -- get the unit-id of the ghci package. We need this to load the
 +  -- interpreter code.
 +  let unit_state = ue_homeUnitState unit_env
 +  ghci_unit_id <- case lookupPackageName unit_state (PackageName (fsLit "ghci")) of
 +    Nothing -> cmdLineErrorIO "C interpreter: couldn't find \"ghci\" package"
 +    Just i  -> pure i
++
 +  -- generate a temporary name for the iserv program
 +  let tmpdir = leTempDir opts
 +  exe_file <- newTempName logger tmpfs tmpdir TFL_GhcSession "iserv"
++
 +  let platform = ue_platform unit_env
 +  let os       = platformOS platform
++
 +  -- we inherit ExecutableLinkOpts for the target code (i.e. derived from
 +  -- DynFlags specified by the user and from settings). We need to adjust these
 +  -- options to generate the iserv program we want. Some settings are to be
 +  -- shared (e.g. ways, platform, etc.) but some other must be set specifically
 +  -- for iserv.
 +  let opts' = opts
 +        { -- write iserv program in some temporary directory
 +          leOutputFile = Just exe_file
++
 +          -- we need GHC to generate a main entry point...
 +        , leNoHsMain = False
++
 +          -- ...however the main symbol must be the iserv server
 +        , leMainSymbol = zString (zEncodeFS (unitIdFS ghci_unit_id)) ++ "_GHCiziServer_defaultServer"
++
 +          -- we need to reset inputs, otherwise one of them may be defining
 +          -- `main` too (with -no-hs-main).
 +        , leInputs = []
++
 +          -- we never know what symbols GHC will look up in the future, so we
 +          -- must retain CAFs for running interpreted code.
 +        , leKeepCafs = True
++
 +          -- enable all rts options
 +        , leRtsOptsEnabled = RtsOptsAll
++
 +          -- Add -Wl,--export-dynamic enables GHCi to load dynamic objects that
 +          -- refer to the RTS.  This is harmless if you don't use it (adds a bit
 +          -- of overhead to startup and increases the binary sizes) but if you
 +          -- need it there's no alternative.
 +          --
 +          -- The Solaris linker does not support --export-dynamic option. It also
 +          -- does not need it since it exports all dynamic symbols by default
 +        , leLinkerConfig = if
 +            | osElfTarget os
 +            , os /= OSFreeBSD
 +            , os /= OSSolaris2
 +            -> (leLinkerConfig opts)
 +                { linkerOptionsPost = linkerOptionsPost (leLinkerConfig opts) ++ [Option "-Wl,--export-dynamic"]
 +                }
 +            | otherwise
 +            -> leLinkerConfig opts
 +        }
 +  linkExecutable logger tmpfs opts' unit_env [] [ghci_unit_id]
++
 +  pure exe_file

compiler/GHC/Runtime/Interpreter/Init.hs

 +{-# LANGUAGE CPP #-}
 +{-# LANGUAGE MultiWayIf #-}
++
 +module GHC.Runtime.Interpreter.Init
 +  ( initInterpreter
 +  , InterpOpts (..)
 +  )
 +where
++
++
 +import GHC.Prelude
 +import GHC.Platform
 +import GHC.Platform.Ways
 +import GHC.Settings
 +import GHC.Unit.Finder
 +import GHC.Unit.Env
 +import GHC.Utils.TmpFs
 +import GHC.SysTools.Tasks
++
 +import GHC.Linker.Executable
 +import qualified GHC.Linker.Loader as Loader
 +import GHC.Runtime.Interpreter
 +import GHC.Runtime.Interpreter.C
 +import GHC.StgToJS.Types (StgToJSConfig)
++
 +import GHC.Utils.Monad
 +import GHC.Utils.Outputable
 +import GHC.Utils.Logger
 +import GHC.Utils.Error
 +import Control.Concurrent
 +import System.Process
++
 +data InterpOpts = InterpOpts
 +  { interpExternal :: !Bool
 +  , interpProg :: String
 +  , interpOpts :: [String]
 +  , interpWays :: Ways
 +  , interpNameVer :: GhcNameVersion
 +  , interpLdConfig :: LdConfig
 +  , interpCcConfig :: CcConfig
 +  , interpJsInterp :: FilePath
 +  , interpTmpDir :: TempDir
 +  , interpFinderOpts :: FinderOpts
 +  , interpJsCodegenCfg :: StgToJSConfig
 +  , interpVerbosity :: Int
 +  , interpCreateProcess :: Maybe (CreateProcess -> IO ProcessHandle) -- create iserv process hook
 +  , interpWasmDyld :: FilePath
 +  , interpBrowser :: Bool
 +  , interpBrowserHost :: String
 +  , interpBrowserPort :: Int
 +  , interpBrowserRedirectWasiConsole :: Bool
 +  , interpBrowserPuppeteerLaunchOpts :: Maybe String
 +  , interpBrowserPlaywrightBrowserType :: Maybe String
 +  , interpBrowserPlaywrightLaunchOpts :: Maybe String
 +  , interpExecutableLinkOpts :: ExecutableLinkOpts
 +  }
++
 +-- | Initialize code interpreter
 +initInterpreter
 +  :: TmpFs
 +  -> Logger
 +  -> Platform
 +  -> FinderCache
 +  -> UnitEnv
 +  -> InterpOpts
 +  -> IO (Maybe Interp)
 +initInterpreter tmpfs logger platform finder_cache unit_env opts = do
++
 +  lookup_cache  <- liftIO $ mkInterpSymbolCache
++
 +  -- see Note [Target code interpreter]
 +  if
 +#if !defined(wasm32_HOST_ARCH)
 +    -- Wasm dynamic linker
 +    | ArchWasm32 <- platformArch platform
 +    -> do
 +        s <- liftIO $ newMVar InterpPending
 +        loader <- liftIO Loader.uninitializedLoader
 +        libdir <- liftIO $ last <$> Loader.getGccSearchDirectory logger (interpLdConfig opts) "libraries"
 +        let profiled = interpWays opts `hasWay` WayProf
 +            way_tag = if profiled then "_p" else ""
 +        let cfg =
 +              WasmInterpConfig
 +                { wasmInterpDyLD = interpWasmDyld opts
 +                , wasmInterpLibDir = libdir
 +                , wasmInterpOpts = interpOpts opts
 +                , wasmInterpBrowser = interpBrowser opts
 +                , wasmInterpBrowserHost = interpBrowserHost opts
 +                , wasmInterpBrowserPort = interpBrowserPort opts
 +                , wasmInterpBrowserRedirectWasiConsole = interpBrowserRedirectWasiConsole opts
 +                , wasmInterpBrowserPuppeteerLaunchOpts = interpBrowserPuppeteerLaunchOpts opts
 +                , wasmInterpBrowserPlaywrightBrowserType = interpBrowserPlaywrightBrowserType opts
 +                , wasmInterpBrowserPlaywrightLaunchOpts = interpBrowserPlaywrightLaunchOpts opts
 +                , wasmInterpTargetPlatform = platform
 +                , wasmInterpProfiled = profiled
 +                , wasmInterpHsSoSuffix = way_tag ++ dynLibSuffix (interpNameVer opts)
 +                , wasmInterpUnitState = ue_homeUnitState unit_env
 +                }
 +        pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache
 +#endif
++
 +    -- JavaScript interpreter
 +    | ArchJavaScript <- platformArch platform
 +    -> do
 +         s <- liftIO $ newMVar InterpPending
 +         loader <- liftIO Loader.uninitializedLoader
 +         let cfg = JSInterpConfig
 +              { jsInterpNodeConfig  = defaultNodeJsSettings
 +              , jsInterpScript      = interpJsInterp opts
 +              , jsInterpTmpFs       = tmpfs
 +              , jsInterpTmpDir      = interpTmpDir opts
 +              , jsInterpLogger      = logger
 +              , jsInterpCodegenCfg  = interpJsCodegenCfg opts
 +              , jsInterpUnitEnv     = unit_env
 +              , jsInterpFinderOpts  = interpFinderOpts opts
 +              , jsInterpFinderCache = finder_cache
 +              }
 +         return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache))
++
 +    -- external interpreter
 +    | interpExternal opts
 +    -> do
 +        let
 +          profiled = interpWays opts `hasWay` WayProf
 +          dynamic  = interpWays opts `hasWay` WayDyn
 +        prog <- case interpProg opts of
 +          -- build iserv program if none specified
 +          "" -> generateIservC logger tmpfs (interpExecutableLinkOpts opts) unit_env
 +          _ -> pure (interpProg opts ++ flavour)
 +            where
 +              flavour
 +                | profiled && dynamic = "-prof-dyn"
 +                | profiled  = "-prof"
 +                | dynamic   = "-dyn"
 +                | otherwise = ""
 +        let msg = text "Starting " <> text prog
 +        tr <- if interpVerbosity opts >= 3
 +               then return (logInfo logger $ withPprStyle defaultDumpStyle msg)
 +               else return (pure ())
 +        let
 +         conf = IServConfig
 +           { iservConfProgram  = prog
 +           , iservConfOpts     = interpOpts opts
 +           , iservConfProfiled = profiled
 +           , iservConfDynamic  = dynamic
 +           , iservConfHook     = interpCreateProcess opts
 +           , iservConfTrace    = tr
 +           }
 +        s <- liftIO $ newMVar InterpPending
 +        loader <- liftIO Loader.uninitializedLoader
 +        return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache))
++
 +    -- Internal interpreter
 +    | otherwise
 +    ->
 +#if defined(HAVE_INTERNAL_INTERPRETER)
 +     do
 +      loader <- liftIO Loader.uninitializedLoader
 +      return (Just (Interp InternalInterp loader lookup_cache))
 +#else
 +      return Nothing
 +#endif

compiler/GHC/SysTools/Tasks.hs

@@ -13,7 +13,11 @@ module GHC.SysTools.Tasks
    , runSourceCodePreprocessor
    , runPp
    , runCc
 +  , configureCc
 +  , CcConfig (..)
 +  , configureLd
    , askLd
 +  , LdConfig(..)
    , runAs
    , runLlvmOpt
    , runLlvmLlc
@@ -22,10 +26,20 @@ module GHC.SysTools.Tasks
    , figureLlvmVersion
    , runMergeObjects
    , runAr
 +  , ArConfig (..)
 +  , configureAr
    , askOtool
 +  , configureOtool
 +  , OtoolConfig (..)
    , runInstallNameTool
 +  , InstallNameConfig (..)
 +  , configureInstallName
    , runRanlib
 +  , RanlibConfig (..)
 +  , configureRanlib
    , runWindres
 +  , WindresConfig (..)
 +  , configureWindres
    ) where
  import GHC.Prelude
@@ -207,15 +221,32 @@ runPp logger dflags args = traceSystoolCommand logger "pp" $ do
        opts = map Option (getOpts dflags opt_F)
    runSomething logger "Haskell pre-processor" prog (args ++ opts)
 +data CcConfig = CcConfig
 +  { ccProg :: String
 +  , cxxProg :: String
 +  , ccOpts :: [String]
 +  , cxxOpts :: [String]
 +  , ccPicOpts :: [String]
 +  }
++
 +configureCc :: DynFlags -> CcConfig
 +configureCc dflags = CcConfig
 +  { ccProg = pgm_c dflags
 +  , cxxProg = pgm_cxx dflags
 +  , ccOpts = getOpts dflags opt_c
 +  , cxxOpts = getOpts dflags opt_cxx
 +  , ccPicOpts = picCCOpts dflags
 +  }
++
  -- | Run compiler of C-like languages and raw objects (such as gcc or clang).
 -runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
 -runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do
 +runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> TempDir -> CcConfig -> [Option] -> IO ()
 +runCc mLanguage logger tmpfs tmpdir opts args = traceSystoolCommand logger "cc" $ do
    let args1 = map Option userOpts
        args2 = languageOptions ++ args ++ args1
        -- We take care to pass -optc flags in args1 last to ensure that the
        -- user can override flags passed by GHC. See #14452.
    mb_env <- getGccEnv args2
 -  runSomethingResponseFile logger tmpfs (tmpDir dflags) cc_filter dbgstring prog args2
 +  runSomethingResponseFile logger tmpfs tmpdir cc_filter dbgstring prog args2
                             mb_env
   where
    -- force the C compiler to interpret this file as C when
@@ -223,38 +254,49 @@ runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do
    -- Also useful for plain .c files, just in case GHC saw a
    -- -x c option.
    (languageOptions, userOpts, prog, dbgstring) = case mLanguage of
 -    Nothing -> ([], userOpts_c, pgm_c dflags, "C Compiler")
 -    Just language -> ([Option "-x", Option languageName], opts, prog, dbgstr)
 +    Nothing -> ([], ccOpts opts, ccProg opts, "C Compiler")
 +    Just language -> ([Option "-x", Option languageName], copts, prog, dbgstr)
        where
 -        (languageName, opts, prog, dbgstr) = case language of
 -          LangC      -> ("c",             userOpts_c
 -                        ,pgm_c dflags,    "C Compiler")
 -          LangCxx    -> ("c++",           userOpts_cxx
 -                        ,pgm_cxx dflags , "C++ Compiler")
 -          LangObjc   -> ("objective-c",   userOpts_c
 -                        ,pgm_c dflags   , "Objective C Compiler")
 -          LangObjcxx -> ("objective-c++", userOpts_cxx
 -                        ,pgm_cxx dflags,  "Objective C++ Compiler")
 +        (languageName, copts, prog, dbgstr) = case language of
 +          LangC      -> ("c",             ccOpts opts
 +                        ,ccProg opts,    "C Compiler")
 +          LangCxx    -> ("c++",           cxxOpts opts
 +                        ,cxxProg opts, "C++ Compiler")
 +          LangObjc   -> ("objective-c",   ccOpts opts
 +                        ,ccProg opts, "Objective C Compiler")
 +          LangObjcxx -> ("objective-c++", cxxOpts opts
 +                        ,cxxProg opts,  "Objective C++ Compiler")
            LangAsm    -> ("assembler",     []
 -                        ,pgm_c dflags,    "Asm Compiler")
 +                        ,ccProg opts,    "Asm Compiler")
            RawObject  -> ("c",             []
 -                        ,pgm_c dflags,    "C Compiler") -- claim C for lack of a better idea
 +                        ,ccProg opts,    "C Compiler") -- claim C for lack of a better idea
            --JS backend shouldn't reach here, so we just pass
            -- strings to satisfy the totality checker
            LangJs     -> ("js",            []
 -                        ,pgm_c dflags,    "JS Backend Compiler")
 -  userOpts_c   = getOpts dflags opt_c
 -  userOpts_cxx = getOpts dflags opt_cxx
 +                        ,ccProg opts,    "JS Backend Compiler")
  isContainedIn :: String -> String -> Bool
  xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
 --- | Run the linker with some arguments and return the output
 -askLd :: Logger -> DynFlags -> [Option] -> IO String
 -askLd logger dflags args = traceSystoolCommand logger "linker" $ do
 +data LdConfig = LdConfig
 +  { ldProg :: String    -- ^ LD program path
 +  , ldOpts :: [Option]  -- ^ LD program arguments
 +  }
++
 +configureLd :: DynFlags -> LdConfig
 +configureLd dflags =
    let (p,args0) = pgm_l dflags
        args1     = map Option (getOpts dflags opt_l)
 -      args2     = args0 ++ args1 ++ args
 +  in LdConfig
 +        { ldProg = p
 +        , ldOpts = args0 ++ args1
 +        }
++
 +-- | Run the linker with some arguments and return the output
 +askLd :: Logger -> LdConfig -> [Option] -> IO String
 +askLd logger ld_config args = traceSystoolCommand logger "linker" $ do
 +  let p     = ldProg ld_config
 +      args2 = ldOpts ld_config ++ args
    mb_env <- getGccEnv args2
    runSomethingWith logger "gcc" p args2 $ \real_args ->
      readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }
@@ -373,31 +415,80 @@ runMergeObjects logger tmpfs dflags args =
        else do
          runSomething logger "Merge objects" p args2
 -runAr :: Logger -> DynFlags -> Maybe FilePath -> [Option] -> IO ()
 -runAr logger dflags cwd args = traceSystoolCommand logger "ar" $ do
 -  let ar = pgm_ar dflags
 +newtype ArConfig = ArConfig
 +  { arProg :: String
 +  }
++
 +configureAr :: DynFlags -> ArConfig
 +configureAr dflags = ArConfig
 +  { arProg = pgm_ar dflags
 +  }
++
 +runAr :: Logger -> ArConfig -> Maybe FilePath -> [Option] -> IO ()
 +runAr logger opts cwd args = traceSystoolCommand logger "ar" $ do
 +  let ar = arProg opts
    runSomethingFiltered logger id "Ar" ar args cwd Nothing
 -askOtool :: Logger -> ToolSettings -> Maybe FilePath -> [Option] -> IO String
 -askOtool logger toolSettings mb_cwd args = do
 -  let otool = toolSettings_pgm_otool toolSettings
 +newtype OtoolConfig = OtoolConfig
 +  { otoolProg :: String
 +  }
++
 +configureOtool :: DynFlags -> OtoolConfig
 +configureOtool dflags = OtoolConfig
 +  { otoolProg = toolSettings_pgm_otool (toolSettings dflags)
 +  }
++
 +askOtool :: Logger -> OtoolConfig -> Maybe FilePath -> [Option] -> IO String
 +askOtool logger opts mb_cwd args = do
 +  let otool = otoolProg opts
    runSomethingWith logger "otool" otool args $ \real_args ->
      readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd }
 -runInstallNameTool :: Logger -> ToolSettings -> [Option] -> IO ()
 -runInstallNameTool logger toolSettings args = do
 -  let tool = toolSettings_pgm_install_name_tool toolSettings
 +newtype InstallNameConfig = InstallNameConfig
 +  { installNameProg :: String
 +  }
++
 +configureInstallName :: DynFlags -> InstallNameConfig
 +configureInstallName dflags = InstallNameConfig
 +  { installNameProg = toolSettings_pgm_install_name_tool (toolSettings dflags)
 +  }
++
 +runInstallNameTool :: Logger -> InstallNameConfig -> [Option] -> IO ()
 +runInstallNameTool logger opts args = do
 +  let tool = installNameProg opts
    runSomethingFiltered logger id "Install Name Tool" tool args Nothing Nothing
 -runRanlib :: Logger -> DynFlags -> [Option] -> IO ()
 -runRanlib logger dflags args = traceSystoolCommand logger "ranlib" $ do
 -  let ranlib = pgm_ranlib dflags
 +newtype RanlibConfig = RanlibConfig
 +  { ranlibProg :: String
 +  }
++
 +configureRanlib :: DynFlags -> RanlibConfig
 +configureRanlib dflags = RanlibConfig
 +  { ranlibProg = pgm_ranlib dflags
 +  }
++
 +runRanlib :: Logger -> RanlibConfig -> [Option] -> IO ()
 +runRanlib logger opts args = traceSystoolCommand logger "ranlib" $ do
 +  let ranlib = ranlibProg opts
    runSomethingFiltered logger id "Ranlib" ranlib args Nothing Nothing
 -runWindres :: Logger -> DynFlags -> [Option] -> IO ()
 -runWindres logger dflags args = traceSystoolCommand logger "windres" $ do
 -  let cc_args = map Option (sOpt_c (settings dflags))
 -      windres = pgm_windres dflags
 -      opts = map Option (getOpts dflags opt_windres)
 +data WindresConfig = WindresConfig
 +  { windresProg :: String
 +  , windresOpts :: [Option]
 +  , windresCOpts :: [Option]
 +  }
++
 +configureWindres :: DynFlags -> WindresConfig
 +configureWindres dflags = WindresConfig
 +  { windresProg = pgm_windres dflags
 +  , windresOpts = map Option (getOpts dflags opt_windres)
 +  , windresCOpts = map Option (sOpt_c (settings dflags))
 +  }
++
 +runWindres :: Logger -> WindresConfig -> [Option] -> IO ()
 +runWindres logger opts args = traceSystoolCommand logger "windres" $ do
 +  let cc_args = windresCOpts opts
 +      windres = windresProg opts
 +      wopts = windresOpts opts
    mb_env <- getGccEnv cc_args
 -  runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env
 +  runSomethingFiltered logger id "Windres" windres (wopts ++ args) Nothing mb_env

compiler/ghc.cabal.in

@@ -515,6 +515,7 @@ Library
          GHC.Driver.Config.HsToCore
          GHC.Driver.Config.HsToCore.Ticks
          GHC.Driver.Config.HsToCore.Usage
 +        GHC.Driver.Config.Interpreter
          GHC.Driver.Config.Linker
          GHC.Driver.Config.Logger
          GHC.Driver.Config.Parser
@@ -650,7 +651,7 @@ Library
          GHC.Linker.Deps
          GHC.Linker.Dynamic
          GHC.Linker.External
 -        GHC.Linker.ExtraObj
 +        GHC.Linker.Executable
          GHC.Linker.Loader
          GHC.Linker.MacOS
          GHC.Linker.Static
@@ -723,6 +724,8 @@ Library
          GHC.Runtime.Heap.Inspect
          GHC.Runtime.Heap.Layout
          GHC.Runtime.Interpreter
 +        GHC.Runtime.Interpreter.C
 +        GHC.Runtime.Interpreter.Init
          GHC.Runtime.Interpreter.JS
          GHC.Runtime.Interpreter.Process
          GHC.Runtime.Interpreter.Types

testsuite/tests/driver/T24731.hs

 +{-# LANGUAGE TemplateHaskell #-}
 +module T24731 where
++
 +foo :: Int
 +foo = $([|10|])

testsuite/tests/driver/all.T

@@ -333,3 +333,4 @@ test('T25382', normal, makefile_test, [])
  test('T26018', req_c, makefile_test, [])
  test('T24120', normal, compile, ['-Wunused-packages -hide-all-packages -package base -package system-cxx-std-lib'])
  test('T26551', [extra_files(['T26551.hs'])], makefile_test, [])
 +test('T24731', [only_ways(['ext-interp'])], compile, ['-fexternal-interpreter -pgmi ""'])

utils/iserv/iserv.cabal.in

@@ -30,15 +30,6 @@ Executable iserv
      C-Sources: cbits/iservmain.c
      Hs-Source-Dirs: src
      include-dirs: .
 -    Build-Depends: array      >= 0.5 && < 0.6,
 -                   base       >= 4   && < 5,
 -                   binary     >= 0.7 && < 0.11,
 -                   bytestring >= 0.10 && < 0.13,
 -                   containers >= 0.5 && < 0.9,
 -                   deepseq    >= 1.4 && < 1.6,
 -                   ghci       == @ProjectVersionMunged@
+-
 -    if os(windows)
 -        Cpp-Options: -DWINDOWS
 -    else
 -        Build-Depends: unix   >= 2.7 && < 2.9
 +    Build-Depends:
 +      base >= 4   && < 5,
 +      ghci == @ProjectVersionMunged@