{-# LANGUAGE CPP #-}
module GHC.Linker.Dynamic
   ( linkDynLib
   
   , libmLinkOpts
   )
where
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 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 <- 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 ([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 ((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 = 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 (
                    (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",
                      String -> Option
Option String
"-single_module" ]
                 [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" ]
              )
            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"; }
                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                = []