    {-# LANGUAGE CPP #-}

    -- | Dynamic linker
    module GHC.Linker.Dynamic
       ( linkDynLib
       -- * Platform-specifics
       , 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
            os :: OS
    os         = Platform -> OS
    platformOS Platform
    platform

            -- This is a rather ugly hack to fix dynamically linked
            -- GHC on Windows. If GHC is linked with -threaded, then
            -- it links against libHSrts_thr. But if base is linked
            -- against libHSrts, then both end up getting loaded,
            -- and things go wrong. We therefore link the libraries
            -- with the same RTS flags that we link GHC with.
            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
             , -- Only if we want dynamic libraries
               DynFlags -> Ways
    ways DynFlags
    dflags Ways -> Way -> Bool
    `hasWay` Way
    WayDyn
               -- Only use RPath if we explicitly asked for it
             , 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]
                  -- See Note [-Xlinker -rpath vs -Wl,-rpath]
             | 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

        -- In general we don't want to link our dynamic libs against the RTS
        -- package, because the RTS lib comes in several flavours and we want to be
        -- able to pick the flavour when a binary is linked.
        --
        -- But:
        --   * on Windows we need to link the RTS import lib as Windows does not
        --   allow undefined symbols.
        --
        --   * the RTS library path is still added to the library search path above
        --   in case the RTS is being explicitly linked in (see #3807).
        --
        --   * if -flink-rts is used, we link with the rts.
        --
        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
             | 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]
    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

            -- probably _stub.o files
            -- and last temporary shared object file
        let extra_ld_inputs = DynFlags -> [Option]
    ldInputs DynFlags
    dflags

        -- frameworks
        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
                -------------------------------------------------------------
                -- Making a DLL
                -------------------------------------------------------------
                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

                     -- Permit the linker to auto link _symbol to _imp_symbol
                     -- This lets us link against DLLs without needing an "import library"
                     [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
                -------------------------------------------------------------------
                -- Making a darwin dylib
                -------------------------------------------------------------------
                -- About the options used for Darwin:
                -- -dynamiclib
                --   Apple's way of saying -shared
                -- -undefined dynamic_lookup:
                --   Without these options, we'd have to specify the correct
                --   dependencies for each of the dylibs. Note that we could
                --   (and should) do without this for all libraries except
                --   the RTS; all we need to do is to pass the correct
                --   HSfoo_dyn.dylib files to the link command.
                --   This feature requires Mac OS X 10.3 or later; there is
                --   a similar feature, -flat_namespace -undefined suppress,
                --   which works on earlier versions, but it has other
                --   disadvantages.
                -- -single_module
                --   Build the dynamic library as a single "module", i.e. no
                --   dynamic binding nonsense when referring to symbols from
                --   within the library. The NCG assumes that this option is
                --   specified (on i386, at least).
                --   In XCode 15, -single_module is the default and passing the
                --   flag is now obsolete and raises a warning (#24168). We encode
                --   this information into the toolchain field ...SupportsSingleModule.
                -- -install_name
                --   Mac OS/X stores the path where a dynamic library is (to
                --   be) installed in the library itself.  It's called the
                --   "install name" of the library. Then any library or
                --   executable that links against it before it's installed
                --   will search for it in its ultimate install location.
                --   By default we set the install name to the absolute path
                --   at build time, but it can be overridden by the
                --   -dylib-install-name option passed to ghc. Cabal does
                --   this.
                -------------------------------------------------------------------

                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
                     -- dead_strip_dylibs, will remove unused dylibs, and thus save
                     -- space in the load commands. The -headerpad is necessary so
                     -- that we can inject more @rpath's later for the leftover
                     -- libraries in the runInjectRpaths phase below.
                     --
                     -- See Note [Dynamic linking on macOS]
                     ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ]
                  )
                -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
                when (gopt Opt_RPath dflags) $
                  runInjectRPaths logger (toolSettings dflags) pkg_lib_paths output_fn
            OS
    _ -> do
                -------------------------------------------------------------------
                -- Making a DSO
                -------------------------------------------------------------------

                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 = -- we need symbolic linking to resolve
                                    -- non-PIC intra-package-relocations for
                                    -- performance (where symbolic linking works)
                                    -- See Note [-Bsymbolic assumptions by GHC]
                                    [String
    "-Wl,-Bsymbolic" | Bool -> Bool
    not Bool
    unregisterised]

                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
                        -- Set the library soname. We use -h rather than -soname as
                        -- Solaris 10 doesn't support the latter:
                     [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
                  )

    -- | Some platforms require that we explicitly link against @libm@ if any
    -- math-y things are used (which we assume to include all programs). See #14022.
    libmLinkOpts :: Platform -> [Option]
    libmLinkOpts :: Platform -> [Option]
    libmLinkOpts Platform
    platform
      | Platform -> Bool
    platformHasLibm Platform
    platform = [String -> Option
    Option String
    "-lm"]
      | Bool
    otherwise                = []

    {-
    Note [-Bsymbolic assumptions by GHC]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    GHC has a few assumptions about interaction of relocations in NCG and linker:

    1. -Bsymbolic resolves internal references when the shared library is linked,
       which is important for performance.
    2. When there is a reference to data in a shared library from the main program,
       the runtime linker relocates the data object into the main program using an
       R_*_COPY relocation.
    3. If we used -Bsymbolic, then this results in multiple copies of the data
       object, because some references have already been resolved to point to the
       original instance. This is bad!

    We work around [3.] for native compiled code by avoiding the generation of
    R_*_COPY relocations.

    Unregisterised compiler can't evade R_*_COPY relocations easily thus we disable
    -Bsymbolic linking there.

    See related tickets: #4210, #15338
    -}