{-# LANGUAGE CPP #-}
module GHC.Linker.Dynamic
( linkDynLib
, libmLinkOpts
)
where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Platform
import GHC.Platform.Ways
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 qualified Data.Set as Set
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_ :: Ways
targetWays_ = Ways
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 <- 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 = 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 forall a. Eq a => a -> a -> Bool
== DynLibLoader
SystemDependent
,
Way
WayDyn forall a. Ord a => a -> Set a -> Bool
`Set.member` DynFlags -> Ways
ways DynFlags
dflags
, DynFlags -> OS -> Bool
useXLinkerRPath DynFlags
dflags OS
os
= [String
"-L" forall a. [a] -> [a] -> [a]
++ String
l, String
"-Xlinker", String
"-rpath", String
"-Xlinker", String
l]
| Bool
otherwise = [String
"-L" 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 = forall a b. (a -> b) -> [a] -> [b]
map (String
"-L"forall a. [a] -> [a] -> [a]
++) [String]
lib_paths
let pkgs_without_rts :: [UnitInfo]
pkgs_without_rts = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= UnitId
rtsUnitId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid 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 forall a. [a] -> [a] -> [a]
++ [String]
extra_libs forall a. [a] -> [a] -> [a]
++ [String]
other_flags
where ([String]
package_hs_libs, [String]
extra_libs, [String]
other_flags) = DynFlags -> [UnitInfo] -> ([String], [String], [String])
collectLinkOpts DynFlags
dflags [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 (forall a b. (a -> b) -> [a] -> [b]
map forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId [UnitInfo]
pkgs)
let framework_opts :: [String]
framework_opts = DynFlags -> Platform -> [String]
getFrameworkOpts 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 (
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
verbFlags
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-o"
, String -> String -> Option
FileOption String
"" String
output_fn
, String -> Option
Option String
"-shared"
] forall a. [a] -> [a] -> [a]
++
[ String -> String -> Option
FileOption String
"-Wl,--out-implib=" (String
output_fn forall a. [a] -> [a] -> [a]
++ String
".a")
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SharedImplib DynFlags
dflags
]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Option
FileOption String
"") [String]
o_files
forall a. [a] -> [a] -> [a]
++ [String -> Option
Option String
"-Wl,--enable-auto-import"]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (
[String]
lib_path_opts
forall a. [a] -> [a] -> [a]
++ [String]
pkg_lib_path_opts
forall a. [a] -> [a] -> [a]
++ [String]
pkg_link_opts
))
OS
_ | OS
os 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return String
n
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 (
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
verbFlags
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-dynamiclib"
, String -> Option
Option String
"-o"
, String -> String -> Option
FileOption String
"" String
output_fn
]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
o_files
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-undefined",
String -> Option
Option String
"dynamic_lookup",
String -> Option
Option String
"-single_module" ]
forall a. [a] -> [a] -> [a]
++ (if Platform -> Arch
platformArch Platform
platform 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" ])
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-install_name", String -> Option
Option String
instName ]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
lib_path_opts
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
framework_opts
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_lib_path_opts
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_link_opts
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_framework_opts
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-Wl,-dead_strip_dylibs", String -> Option
Option String
"-Wl,-headerpad,8000" ]
)
Logger -> DynFlags -> [String] -> String -> IO ()
runInjectRPaths Logger
logger 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"; }
unregisterised :: Bool
unregisterised = Platform -> Bool
platformUnregisterised (DynFlags -> Platform
targetPlatform DynFlags
dflags)
let bsymbolicFlag :: [String]
bsymbolicFlag =
[String
"-Wl,-Bsymbolic" | Bool -> Bool
not Bool
unregisterised]
Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runLink Logger
logger TmpFs
tmpfs DynFlags
dflags (
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
verbFlags
forall a. [a] -> [a] -> [a]
++ [Option]
libmLinkOpts
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-o"
, String -> String -> Option
FileOption String
"" String
output_fn
]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
o_files
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-shared" ]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
bsymbolicFlag
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option (String
"-Wl,-h," forall a. [a] -> [a] -> [a]
++ String -> String
takeFileName String
output_fn) ]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
lib_path_opts
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_lib_path_opts
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_link_opts
)
libmLinkOpts :: [Option]
libmLinkOpts :: [Option]
libmLinkOpts =
#if defined(HAVE_LIBM)
[Option "-lm"]
#else
[]
#endif