{-# 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.Linker.External
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
arch :: Arch
arch = Platform -> Arch
platformArch Platform
platform
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
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 = Ways -> [UnitInfo] -> [String]
collectLibraryDirs (DynFlags -> Ways
ways DynFlags
dflags) [UnitInfo]
pkgs_with_rts
let 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
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 = DynFlags -> [String]
libraryPaths DynFlags
dflags
let 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 -> 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
| Arch
ArchWasm32 <- Arch
arch = [UnitInfo]
pkgs_with_rts
| 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 = UnitLinkOpts -> [String]
hsLibs UnitLinkOpts
unit_link_opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ UnitLinkOpts -> [String]
extraLibs UnitLinkOpts
unit_link_opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ UnitLinkOpts -> [String]
otherFlags UnitLinkOpts
unit_link_opts
where
namever :: GhcNameVersion
namever = DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags
ways_ :: Ways
ways_ = DynFlags -> Ways
ways DynFlags
dflags
unit_link_opts :: UnitLinkOpts
unit_link_opts = GhcNameVersion -> Ways -> [UnitInfo] -> UnitLinkOpts
collectLinkOpts GhcNameVersion
namever Ways
ways_ [UnitInfo]
pkgs
let extra_ld_inputs = DynFlags -> [Option]
ldInputs DynFlags
dflags
pkg_framework_opts <- getUnitFrameworkOpts unit_env (map unitId pkgs)
let framework_opts = FrameworkOpts -> Platform -> [String]
getFrameworkOpts (DynFlags -> FrameworkOpts
initFrameworkOpts DynFlags
dflags) Platform
platform
let linker_config = DynFlags -> LinkerConfig
initLinkerConfig DynFlags
dflags
case 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 -> LinkerConfig -> [Option] -> IO ()
runLink Logger
logger TmpFs
tmpfs LinkerConfig
linker_config (
(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"; }
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)
runLink logger tmpfs linker_config (
map Option verbFlags
++ [ Option "-dynamiclib"
, Option "-o"
, FileOption "" output_fn
]
++ map Option o_files
++ [ Option "-undefined",
Option "dynamic_lookup"
]
++ (if toolSettings_ldSupportsSingleModule (toolSettings dflags)
then [ Option "-single_module" ]
else [ ])
++ (if platformArch platform `elem` [ ArchX86_64, ArchAArch64 ]
then [ ]
else [ Option "-Wl,-read_only_relocs,suppress" ])
++ [ Option "-install_name", Option instName ]
++ map Option lib_path_opts
++ extra_ld_inputs
++ map Option framework_opts
++ map Option pkg_lib_path_opts
++ map Option pkg_link_opts
++ map Option pkg_framework_opts
++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ]
)
when (gopt Opt_RPath dflags) $
runInjectRPaths logger (toolSettings dflags) pkg_lib_paths 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 Bool -> Bool -> Bool
&& Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchWasm32 ]
Logger -> TmpFs -> LinkerConfig -> [Option] -> IO ()
runLink Logger
logger TmpFs
tmpfs LinkerConfig
linker_config (
(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) | Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchWasm32 ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-Wl,--Bsymbolic,--experimental-pic,--unresolved-symbols=import-dynamic" | Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchWasm32 ]
[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 = []