{-# LANGUAGE CPP #-}
module GHC.Linker.Dynamic
( linkDynLib
, libmLinkOpts
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Platform.Ways
import GHC.Settings (ToolSettings(toolSettings_ldSupportsSingleModule))
import GHC.Driver.Config.Linker
import GHC.Driver.Session
import GHC.Unit.Env
import GHC.Unit.Types
import GHC.Unit.State
import GHC.Linker.MacOS
import GHC.Linker.Unit
import GHC.SysTools.Tasks
import GHC.Utils.Logger
import GHC.Utils.TmpFs
import Control.Monad (when)
import System.FilePath
linkDynLib :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
linkDynLib :: Logger
-> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
linkDynLib Logger
logger TmpFs
tmpfs DynFlags
dflags0 UnitEnv
unit_env [String]
o_files [UnitId]
dep_packages
= do
let platform :: Platform
platform = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
os :: OS
os = Platform -> OS
platformOS Platform
platform
dflags :: DynFlags
dflags | OS
OSMinGW32 <- OS
os
, Ways
hostWays Ways -> Way -> Bool
`hasWay` Way
WayDyn
= DynFlags
dflags0 { targetWays_ = hostWays }
| Bool
otherwise
= DynFlags
dflags0
verbFlags :: [String]
verbFlags = DynFlags -> [String]
getVerbFlags DynFlags
dflags
o_file :: Maybe String
o_file = DynFlags -> Maybe String
outputFile_ DynFlags
dflags
[UnitInfo]
pkgs_with_rts <- MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
dep_packages)
let pkg_lib_paths :: [String]
pkg_lib_paths = Ways -> [UnitInfo] -> [String]
collectLibraryDirs (DynFlags -> Ways
ways DynFlags
dflags) [UnitInfo]
pkgs_with_rts
let pkg_lib_path_opts :: [String]
pkg_lib_path_opts = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
get_pkg_lib_path_opts [String]
pkg_lib_paths
get_pkg_lib_path_opts :: String -> [String]
get_pkg_lib_path_opts String
l
| OS -> Bool
osElfTarget OS
os Bool -> Bool -> Bool
|| OS -> Bool
osMachOTarget OS
os
, DynFlags -> DynLibLoader
dynLibLoader DynFlags
dflags DynLibLoader -> DynLibLoader -> Bool
forall a. Eq a => a -> a -> Bool
== DynLibLoader
SystemDependent
,
DynFlags -> Ways
ways DynFlags
dflags Ways -> Way -> Bool
`hasWay` Way
WayDyn
, DynFlags -> OS -> Bool
useXLinkerRPath DynFlags
dflags OS
os
= [String
"-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l, String
"-Xlinker", String
"-rpath", String
"-Xlinker", String
l]
| Bool
otherwise = [String
"-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l]
let lib_paths :: [String]
lib_paths = DynFlags -> [String]
libraryPaths DynFlags
dflags
let lib_path_opts :: [String]
lib_path_opts = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-L"String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
lib_paths
let pkgs_without_rts :: [UnitInfo]
pkgs_without_rts = (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]
pkgs_with_rts
pkgs :: [UnitInfo]
pkgs
| OS
OSMinGW32 <- OS
os = [UnitInfo]
pkgs_with_rts
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LinkRts DynFlags
dflags = [UnitInfo]
pkgs_with_rts
| Bool
otherwise = [UnitInfo]
pkgs_without_rts
pkg_link_opts :: [String]
pkg_link_opts = [String]
package_hs_libs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extra_libs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
other_flags
where
namever :: GhcNameVersion
namever = DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags
ways_ :: Ways
ways_ = DynFlags -> Ways
ways DynFlags
dflags
([String]
package_hs_libs, [String]
extra_libs, [String]
other_flags) = GhcNameVersion
-> Ways -> [UnitInfo] -> ([String], [String], [String])
collectLinkOpts GhcNameVersion
namever Ways
ways_ [UnitInfo]
pkgs
let extra_ld_inputs :: [Option]
extra_ld_inputs = DynFlags -> [Option]
ldInputs DynFlags
dflags
[String]
pkg_framework_opts <- UnitEnv -> [UnitId] -> IO [String]
getUnitFrameworkOpts UnitEnv
unit_env ((UnitInfo -> UnitId) -> [UnitInfo] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map UnitInfo -> UnitId
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitId [UnitInfo]
pkgs)
let framework_opts :: [String]
framework_opts = FrameworkOpts -> Platform -> [String]
getFrameworkOpts (DynFlags -> FrameworkOpts
initFrameworkOpts DynFlags
dflags) Platform
platform
case OS
os of
OS
OSMinGW32 -> do
let output_fn :: String
output_fn = case Maybe String
o_file of
Just String
s -> String
s
Maybe String
Nothing -> String
"HSdll.dll"
Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runLink Logger
logger TmpFs
tmpfs DynFlags
dflags (
(String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
verbFlags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-o"
, String -> String -> Option
FileOption String
"" String
output_fn
, String -> Option
Option String
"-shared"
] [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++
[ String -> String -> Option
FileOption String
"-Wl,--out-implib=" (String
output_fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".a")
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SharedImplib DynFlags
dflags
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Option
FileOption String
"") [String]
o_files
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [String -> Option
Option String
"-Wl,--enable-auto-import"]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (
[String]
lib_path_opts
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pkg_lib_path_opts
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pkg_link_opts
))
OS
_ | OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin -> do
let output_fn :: String
output_fn = case Maybe String
o_file of { Just String
s -> String
s; Maybe String
Nothing -> String
"a.out"; }
String
instName <- case DynFlags -> Maybe String
dylibInstallName DynFlags
dflags of
Just String
n -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
Maybe String
Nothing -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"@rpath" String -> String -> String
`combine` (String -> String
takeFileName String
output_fn)
Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runLink Logger
logger TmpFs
tmpfs DynFlags
dflags (
(String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
verbFlags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-dynamiclib"
, String -> Option
Option String
"-o"
, String -> String -> Option
FileOption String
"" String
output_fn
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
o_files
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-undefined",
String -> Option
Option String
"dynamic_lookup"
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (if ToolSettings -> Bool
toolSettings_ldSupportsSingleModule (DynFlags -> ToolSettings
toolSettings DynFlags
dflags)
then [ String -> Option
Option String
"-single_module" ]
else [ ])
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (if Platform -> Arch
platformArch Platform
platform Arch -> [Arch] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Arch
ArchX86_64, Arch
ArchAArch64 ]
then [ ]
else [ String -> Option
Option String
"-Wl,-read_only_relocs,suppress" ])
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-install_name", String -> Option
Option String
instName ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
lib_path_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
framework_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_lib_path_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_link_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_framework_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-Wl,-dead_strip_dylibs", String -> Option
Option String
"-Wl,-headerpad,8000" ]
)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RPath DynFlags
dflags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Logger -> ToolSettings -> [String] -> String -> IO ()
runInjectRPaths Logger
logger (DynFlags -> ToolSettings
toolSettings DynFlags
dflags) [String]
pkg_lib_paths String
output_fn
OS
_ -> do
let output_fn :: String
output_fn = case Maybe String
o_file of { Just String
s -> String
s; Maybe String
Nothing -> String
"a.out"; }
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
unregisterised :: Bool
unregisterised = Platform -> Bool
platformUnregisterised Platform
platform
let bsymbolicFlag :: [String]
bsymbolicFlag =
[String
"-Wl,-Bsymbolic" | Bool -> Bool
not Bool
unregisterised]
Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runLink Logger
logger TmpFs
tmpfs DynFlags
dflags (
(String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
verbFlags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ Platform -> [Option]
libmLinkOpts Platform
platform
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-o"
, String -> String -> Option
FileOption String
"" String
output_fn
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
o_files
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-shared" ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
bsymbolicFlag
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option (String
"-Wl,-h," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
takeFileName String
output_fn) ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
lib_path_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_lib_path_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_link_opts
)
libmLinkOpts :: Platform -> [Option]
libmLinkOpts :: Platform -> [Option]
libmLinkOpts Platform
platform
| Platform -> Bool
platformHasLibm Platform
platform = [String -> Option
Option String
"-lm"]
| Bool
otherwise = []