ghc-9.14.1: GHC/Linker/Static.hs
module GHC.Linker.Static
( linkBinary
, linkStaticLib
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Platform.Ways
import GHC.Settings
import GHC.SysTools
import GHC.SysTools.Ar
import GHC.Unit.Env
import GHC.Unit.Types
import GHC.Unit.Info
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
-- The list of packages passed to link is the list of packages on
-- which this program depends, as discovered by the compilation
-- manager. It is combined with the list of packages that the user
-- specifies on the command line with -package flags.
--
-- In one-shot linking mode, we can't discover the package
-- dependencies (because we haven't actually done any compilation or
-- 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.
linkStaticLib :: Logger -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
linkStaticLib logger dflags unit_env o_files dep_units = do
let platform = ue_platform unit_env
extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
modules = o_files ++ extra_ld_inputs
arch_os = platformArchOS platform
output_fn = exeFileName arch_os True (outputFile_ dflags)
namever = ghcNameVersion dflags
ways_ = ways dflags
full_output_fn <- if isAbsolute output_fn
then return output_fn
else do d <- getCurrentDirectory
return $ normalise (d </> output_fn)
output_exists <- doesFileExist full_output_fn
(when output_exists) $ removeFile full_output_fn
pkg_cfgs_init <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
let pkg_cfgs
| gopt Opt_LinkRts dflags
= pkg_cfgs_init
| otherwise
= filter ((/= rtsUnitId) . unitId) pkg_cfgs_init
archives <- concatMapM (collectArchives namever ways_) pkg_cfgs
ar <- foldl mappend
<$> (Archive <$> mapM loadObj modules)
<*> mapM loadAr archives
if toolSettings_ldIsGnuLd (toolSettings dflags)
then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar
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]