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
linkBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary :: Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary = Bool
-> Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> [FilePath]
-> [UnitId]
-> IO ()
linkBinary' Bool
False
linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary' :: Bool
-> Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> [FilePath]
-> [UnitId]
-> IO ()
linkBinary' Bool
staticLink Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files [UnitId]
dep_units = do
let platform :: Platform
platform = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
unit_state :: UnitState
unit_state = HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
unit_env
toolSettings' :: ToolSettings
toolSettings' = DynFlags -> ToolSettings
toolSettings DynFlags
dflags
verbFlags :: [FilePath]
verbFlags = DynFlags -> [FilePath]
getVerbFlags DynFlags
dflags
arch_os :: ArchOS
arch_os = Platform -> ArchOS
platformArchOS Platform
platform
output_fn :: FilePath
output_fn = ArchOS -> Bool -> Maybe FilePath -> FilePath
exeFileName ArchOS
arch_os Bool
staticLink (DynFlags -> Maybe FilePath
outputFile_ DynFlags
dflags)
namever :: GhcNameVersion
namever = DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags
ways_ :: Ways
ways_
| Arch
ArchWasm32 <- Platform -> Arch
platformArch Platform
platform = Way -> Ways -> Ways
removeWay Way
WayDyn (Ways -> Ways) -> Ways -> Ways
forall a b. (a -> b) -> a -> b
$ DynFlags -> Ways
targetWays_ DynFlags
dflags
| Bool
otherwise = DynFlags -> Ways
ways DynFlags
dflags
full_output_fn <- if FilePath -> Bool
isAbsolute FilePath
output_fn
then FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
else do d <- IO FilePath
getCurrentDirectory
return $ normalise (d </> output_fn)
pkgs <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
let pkg_lib_paths = Ways -> [UnitInfo] -> [FilePath]
collectLibraryDirs Ways
ways_ [UnitInfo]
pkgs
let pkg_lib_path_opts = (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
get_pkg_lib_path_opts [FilePath]
pkg_lib_paths
get_pkg_lib_path_opts FilePath
l
| OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform) Bool -> Bool -> Bool
&&
DynFlags -> DynLibLoader
dynLibLoader DynFlags
dflags DynLibLoader -> DynLibLoader -> Bool
forall a. Eq a => a -> a -> Bool
== DynLibLoader
SystemDependent Bool -> Bool -> Bool
&&
Ways
ways_ Ways -> Way -> Bool
`hasWay` Way
WayDyn
= let libpath :: FilePath
libpath = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RelativeDynlibPaths DynFlags
dflags
then FilePath
"$ORIGIN" FilePath -> FilePath -> FilePath
</>
(FilePath
l FilePath -> FilePath -> FilePath
`makeRelativeTo` FilePath
full_output_fn)
else FilePath
l
rpath :: [FilePath]
rpath = if DynFlags -> OS -> Bool
useXLinkerRPath DynFlags
dflags (Platform -> OS
platformOS Platform
platform)
then [FilePath
"-Xlinker", FilePath
"-rpath", FilePath
"-Xlinker", FilePath
libpath]
else []
rpathlink :: [FilePath]
rpathlink = if (Platform -> OS
platformOS Platform
platform) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSSolaris2
then []
else [FilePath
"-Xlinker", FilePath
"-rpath-link", FilePath
"-Xlinker", FilePath
l]
in [FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpathlink [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpath
| OS -> Bool
osMachOTarget (Platform -> OS
platformOS Platform
platform) Bool -> Bool -> Bool
&&
DynFlags -> DynLibLoader
dynLibLoader DynFlags
dflags DynLibLoader -> DynLibLoader -> Bool
forall a. Eq a => a -> a -> Bool
== DynLibLoader
SystemDependent Bool -> Bool -> Bool
&&
Ways
ways_ Ways -> Way -> Bool
`hasWay` Way
WayDyn Bool -> Bool -> Bool
&&
DynFlags -> OS -> Bool
useXLinkerRPath DynFlags
dflags (Platform -> OS
platformOS Platform
platform)
= let libpath :: FilePath
libpath = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RelativeDynlibPaths DynFlags
dflags
then FilePath
"@loader_path" FilePath -> FilePath -> FilePath
</>
(FilePath
l FilePath -> FilePath -> FilePath
`makeRelativeTo` FilePath
full_output_fn)
else FilePath
l
in [FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-Xlinker", FilePath
"-rpath", FilePath
"-Xlinker", FilePath
libpath]
| Bool
otherwise = [FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
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
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WholeArchiveHsLibs DynFlags
dflags = []
| Bool
otherwise = if OS -> Bool
osSubsectionsViaSymbols (Platform -> OS
platformOS Platform
platform)
then [FilePath
"-Wl,-dead_strip"]
else []
let lib_paths = DynFlags -> [FilePath]
libraryPaths DynFlags
dflags
let lib_path_opts = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-L"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
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"], [])
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
pkg_framework_opts <- getUnitFrameworkOpts unit_env dep_units
let framework_opts = FrameworkOpts -> Platform -> [FilePath]
getFrameworkOpts (DynFlags -> FrameworkOpts
initFrameworkOpts DynFlags
dflags) Platform
platform
let extra_ld_inputs = DynFlags -> [Option]
ldInputs DynFlags
dflags
rc_objs <- case platformOS platform of
OS
OSMinGW32 | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GenManifest DynFlags
dflags -> Logger -> TmpFs -> DynFlags -> FilePath -> IO [FilePath]
maybeCreateManifest Logger
logger TmpFs
tmpfs DynFlags
dflags FilePath
output_fn
OS
_ -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
let linker_config = DynFlags -> LinkerConfig
initLinkerConfig DynFlags
dflags
let link DynFlags
dflags [Option]
args = do
Logger -> TmpFs -> LinkerConfig -> [Option] -> IO ()
runLink Logger
logger TmpFs
tmpfs LinkerConfig
linker_config [Option]
args
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin Bool -> Bool -> Bool
&& GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RPath DynFlags
dflags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Logger -> ToolSettings -> [FilePath] -> FilePath -> IO ()
GHC.Linker.MacOS.runInjectRPaths Logger
logger (DynFlags -> ToolSettings
toolSettings DynFlags
dflags) [FilePath]
pkg_lib_paths FilePath
output_fn
link dflags (
map GHC.SysTools.Option verbFlags
++ [ GHC.SysTools.Option "-o"
, GHC.SysTools.FileOption "" output_fn
]
++ libmLinkOpts platform
++ map GHC.SysTools.Option (
[]
++ pieCCLDOpts dflags
++ (if platformOS platform == OSMinGW32
then ["-Wl,--enable-auto-import"]
else [])
++ (if not (gopt Opt_CompactUnwind dflags) &&
toolSettings_ldSupportsCompactUnwind toolSettings' &&
(platformOS platform == OSDarwin) &&
case platformArch platform of
Arch
ArchX86_64 -> Bool
True
Arch
ArchAArch64 -> Bool
True
Arch
_ -> Bool
False
then ["-Wl,-no_compact_unwind"]
else [])
++ (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
++ pkg_link_opts
++ pkg_framework_opts
++ (if platformOS platform == OSDarwin
then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ]
else [])
))
linkStaticLib :: Logger -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
linkStaticLib :: Logger -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkStaticLib Logger
logger DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files [UnitId]
dep_units = do
let platform :: Platform
platform = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
extra_ld_inputs :: [FilePath]
extra_ld_inputs = [ FilePath
f | FileOption FilePath
_ FilePath
f <- DynFlags -> [Option]
ldInputs DynFlags
dflags ]
modules :: [FilePath]
modules = [FilePath]
o_files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extra_ld_inputs
arch_os :: ArchOS
arch_os = Platform -> ArchOS
platformArchOS Platform
platform
output_fn :: FilePath
output_fn = ArchOS -> Bool -> Maybe FilePath -> FilePath
exeFileName ArchOS
arch_os Bool
True (DynFlags -> Maybe FilePath
outputFile_ DynFlags
dflags)
namever :: GhcNameVersion
namever = DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags
ways_ :: Ways
ways_ = DynFlags -> Ways
ways DynFlags
dflags
full_output_fn <- if FilePath -> Bool
isAbsolute FilePath
output_fn
then FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
else do d <- IO FilePath
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
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LinkRts DynFlags
dflags
= [UnitInfo]
pkg_cfgs_init
| Bool
otherwise
= (UnitInfo -> Bool) -> [UnitInfo] -> [UnitInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
rtsUnitId) (UnitId -> Bool) -> (UnitInfo -> UnitId) -> UnitInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> UnitId
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitId) [UnitInfo]
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
runRanlib logger dflags [GHC.SysTools.FileOption "" output_fn]