[Git][ghc/ghc][wip/romes/rpath-flag] 2 commits: Refactor -Xlinker opts construction into function
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Thu Dec 21 11:39:16 UTC 2023
Rodrigo Mesquita pushed to branch wip/romes/rpath-flag at Glasgow Haskell Compiler / GHC
Commits:
c4f49463 by Rodrigo Mesquita at 2023-12-21T11:37:53+00:00
Refactor -Xlinker opts construction into function
Previously we had multiple standalone constructions of -Xlinker and
references to the Note [-Xlinker -rpath vs -Wl,-rpath]. Now, we have one
function to construct the -Xlinker -rpath -Xlinker path list of options
and call out to it to construct options to pass an rpath to the linker.
Additionally, some small improvements in Linker.Loader:
* Collapse two 'concatMaps' of the same function into one
* Change 'nub' occurrences to 'nubOrd'
- - - - -
7e8bf767 by Rodrigo Mesquita at 2023-12-21T11:37:53+00:00
Introduce -rpath flag for runtime lib search paths
Introduces a list flag `-rpath` for users to specify runtime library
search paths where GHC's linker invocations will look for libraries at
load time.
Previously, clients (notably Cabal) would add specify runtime search
paths directly to the linker via @-optl-Wl,-rpath,/actual/path@,
bypassing the compiler abstraction and the special logic GHC has to
handle runtime search paths -- that is especially important on macOS (4ff9329224).
Additionally, this enables a better solution for cabal#7339, for the
above reasons.
- - - - -
5 changed files:
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Linker/Dynamic.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Static.hs
Changes:
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -302,6 +302,7 @@ data DynFlags = DynFlags {
includePaths :: IncludeSpecs,
libraryPaths :: [String],
+ libraryRuntimePaths :: [String],
frameworkPaths :: [String], -- used on darwin only
cmdlineFrameworks :: [String], -- ditto
@@ -614,6 +615,7 @@ defaultDynFlags mySettings =
ldInputs = [],
includePaths = IncludeSpecs [] [] [],
libraryPaths = [],
+ libraryRuntimePaths = [],
frameworkPaths = [],
cmdlineFrameworks = [],
rtsOpts = Nothing,
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -214,6 +214,7 @@ module GHC.Driver.Session (
LinkerInfo(..),
CompilerInfo(..),
useXLinkerRPath,
+ optXLinkerRPath,
-- * Include specifications
IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,
@@ -1160,6 +1161,7 @@ dynamic_flags_deps = [
------- Libraries ---------------------------------------------------
, make_ord_flag defFlag "L" (Prefix addLibraryPath)
, make_ord_flag defFlag "l" (hasArg (addLdInputs . Option . ("-l" ++)))
+ , make_ord_flag defFlag "rpath" (HasArg addLibraryRuntimePath)
------- Frameworks --------------------------------------------------
-- -framework-path should really be -F ...
@@ -3372,7 +3374,7 @@ parseEnvFile envfile = mapM_ parseEntry . lines
-----------------------------------------------------------------------------
-- Paths & Libraries
-addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
+addImportPath, addLibraryPath, addIncludePath, addLibraryRuntimePath, addFrameworkPath :: FilePath -> DynP ()
-- -i on its own deletes the import paths
addImportPath "" = upd (\s -> s{importPaths = []})
@@ -3385,6 +3387,9 @@ addIncludePath p =
upd (\s -> s{includePaths =
addGlobalInclude (includePaths s) (splitPathList p)})
+addLibraryRuntimePath p =
+ upd (\s -> s{libraryRuntimePaths = libraryRuntimePaths s ++ splitPathList p})
+
addFrameworkPath p =
upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
@@ -3756,7 +3761,28 @@ useXLinkerRPath :: DynFlags -> OS -> Bool
useXLinkerRPath _ OSDarwin = False -- See Note [Dynamic linking on macOS]
useXLinkerRPath dflags _ = gopt Opt_RPath dflags
+-- | Create a list of options from a path to pass an rpath @path@ to the
+-- linker.
+--
+-- The rpath is passed via @-XLinker -rpath -XLinker path@ rather than
+-- @-Wl,-rpath, at . See Note [-Xlinker -rpath vs -Wl,-rpath].
+optXLinkerRPath :: FilePath -> [String]
+optXLinkerRPath rpath = ["-Xlinker", "-rpath", "-Xlinker", rpath]
+
{-
+Note [-Xlinker -rpath vs -Wl,-rpath]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+-Wl takes a comma-separated list of options which in the case of
+-Wl,-rpath -Wl,some,path,with,commas parses the path with commas
+as separate options.
+Buck, the build system, produces paths with commas in them.
+
+-Xlinker doesn't have this disadvantage and as far as I can tell
+it is supported by both gcc and clang. Anecdotally nvcc supports
+-Xlinker, but not -Wl.
+
+
Note [-fno-use-rpaths]
~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Linker/Dynamic.hs
=====================================
@@ -52,7 +52,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
pkgs_with_rts <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_packages)
let pkg_lib_paths = collectLibraryDirs (ways dflags) pkgs_with_rts
- let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
+ pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
get_pkg_lib_path_opts l
| osElfTarget os || osMachOTarget os
, dynLibLoader dflags == SystemDependent
@@ -60,12 +60,13 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
ways dflags `hasWay` WayDyn
-- Only use RPath if we explicitly asked for it
, useXLinkerRPath dflags os
- = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]
- -- See Note [-Xlinker -rpath vs -Wl,-rpath]
+ = ["-L" ++ l] ++ optXLinkerRPath l
| otherwise = ["-L" ++ l]
let lib_paths = libraryPaths dflags
- let lib_path_opts = map ("-L"++) lib_paths
+ lib_path_opts = map ("-L"++) lib_paths
+ r_paths = libraryRuntimePaths dflags
+ r_path_opts = concatMap optXLinkerRPath r_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
@@ -128,6 +129,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
++ extra_ld_inputs
++ map Option (
lib_path_opts
+ ++ r_path_opts
++ pkg_lib_path_opts
++ pkg_link_opts
))
@@ -191,6 +193,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
else [ Option "-Wl,-read_only_relocs,suppress" ])
++ [ Option "-install_name", Option instName ]
++ map Option lib_path_opts
+ ++ map Option r_path_opts
++ extra_ld_inputs
++ map Option framework_opts
++ map Option pkg_lib_path_opts
@@ -206,7 +209,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
)
-- 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
+ runInjectRPaths logger (toolSettings dflags) (pkg_lib_paths ++ r_paths) output_fn
_ -> do
-------------------------------------------------------------------
-- Making a DSO
@@ -235,6 +238,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
++ extra_ld_inputs
++ map Option lib_path_opts
+ ++ map Option r_path_opts
++ map Option pkg_lib_path_opts
++ map Option pkg_link_opts
)
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -94,7 +94,8 @@ import Control.Monad
import qualified Data.Set as Set
import Data.Char (isSpace)
import Data.IORef
-import Data.List (intercalate, isPrefixOf, nub, partition)
+import Data.List (intercalate, isPrefixOf, partition)
+import Data.Containers.ListUtils (nubOrd)
import Data.Maybe
import Control.Concurrent.MVar
import qualified Control.Monad.Catch as MC
@@ -328,7 +329,7 @@ loadCmdLineLibs' interp hsc_env pls = snd <$>
(done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls)
(homeUnitDepends (hsc_units hsc'))
pls'' <- loadCmdLineLibs'' interp hsc' pls'
- return $ (Set.insert uid done', pls'')
+ return (Set.insert uid done', pls'')
loadCmdLineLibs''
:: Interp
@@ -339,7 +340,8 @@ loadCmdLineLibs'' interp hsc_env pls =
do
let dflags@(DynFlags { ldInputs = cmdline_ld_inputs
- , libraryPaths = lib_paths_base})
+ , libraryPaths = lib_paths_base
+ , libraryRuntimePaths = r_paths_base })
= hsc_dflags hsc_env
let logger = hsc_logger hsc_env
@@ -392,9 +394,13 @@ loadCmdLineLibs'' interp hsc_env pls =
let all_paths = let paths = takeDirectory (pgm_c dflags)
: framework_paths
++ lib_paths_base
+ ++ r_paths_base
+ -- OMES:TODO: Should this also have gcc_paths?
+ -- in that case, we should just add
+ -- lib_paths
++ [ takeDirectory dll | DLLPath dll <- libspecs ]
- in nub $ map normalise paths
- let lib_paths = nub $ lib_paths_base ++ gcc_paths
+ in nubOrd $ map normalise paths
+ let lib_paths = nubOrd $ lib_paths_base ++ r_paths_base ++ gcc_paths
all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
pathCache <- mapM (addLibrarySearchPath interp) all_paths_env
@@ -790,25 +796,13 @@ dynLoadObjs interp hsc_env pls at LoaderState{..} objs = do
-- library.
ldInputs =
concatMap (\l -> [ Option ("-l" ++ l) ])
- (nub $ snd <$> temp_sos)
+ (nubOrd $ snd <$> temp_sos)
++ concatMap (\lp -> Option ("-L" ++ lp)
: if useXLinkerRPath dflags (platformOS platform)
- then [ Option "-Xlinker"
- , Option "-rpath"
- , Option "-Xlinker"
- , Option lp ]
+ then map Option
+ (optXLinkerRPath lp)
else [])
- (nub $ fst <$> temp_sos)
- ++ concatMap
- (\lp -> Option ("-L" ++ lp)
- : if useXLinkerRPath dflags (platformOS platform)
- then [ Option "-Xlinker"
- , Option "-rpath"
- , Option "-Xlinker"
- , Option lp ]
- else [])
- minus_big_ls
- -- See Note [-Xlinker -rpath vs -Wl,-rpath]
+ (nubOrd (fst <$> temp_sos) ++ minus_big_ls)
++ map (\l -> Option ("-l" ++ l)) minus_ls,
-- Add -l options and -L options from dflags.
--
@@ -1128,7 +1122,7 @@ loadPackage interp hsc_env pkg
-- Add directories to library search paths
let dll_paths = map takeDirectory known_dlls
- all_paths = nub $ map normalise $ dll_paths ++ dirs
+ all_paths = nubOrd $ map normalise $ dll_paths ++ dirs
all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
pathCache <- mapM (addLibrarySearchPath interp) all_paths_env
@@ -1459,7 +1453,7 @@ getGCCPaths logger dflags os
OSMinGW32 ->
do gcc_dirs <- getGccSearchDirectory logger dflags "libraries"
sys_dirs <- getSystemDirectories
- return $ nub $ gcc_dirs ++ sys_dirs
+ return $ nubOrd $ gcc_dirs ++ sys_dirs
_ -> return []
-- | Cache for the GCC search directories as this can't easily change
=====================================
compiler/GHC/Linker/Static.hs
=====================================
@@ -51,20 +51,6 @@ import Data.Maybe
-- read any interface files), so the user must explicitly specify all
-- the packages.
-{-
-Note [-Xlinker -rpath vs -Wl,-rpath]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
--Wl takes a comma-separated list of options which in the case of
--Wl,-rpath -Wl,some,path,with,commas parses the path with commas
-as separate options.
-Buck, the build system, produces paths with commas in them.
-
--Xlinker doesn't have this disadvantage and as far as I can tell
-it is supported by both gcc and clang. Anecdotally nvcc supports
--Xlinker, but not -Wl.
--}
-
linkBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary = linkBinary' False
@@ -98,9 +84,8 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
then "$ORIGIN" </>
(l `makeRelativeTo` full_output_fn)
else l
- -- See Note [-Xlinker -rpath vs -Wl,-rpath]
rpath = if useXLinkerRPath dflags (platformOS platform)
- then ["-Xlinker", "-rpath", "-Xlinker", libpath]
+ then optXLinkerRPath libpath
else []
-- Solaris 11's linker does not support -rpath-link option. It silently
-- ignores it and then complains about next option which is -l<some
@@ -120,7 +105,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
then "@loader_path" </>
(l `makeRelativeTo` full_output_fn)
else l
- in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath]
+ in ["-L" ++ l] ++ optXLinkerRPath libpath
| otherwise = ["-L" ++ l]
pkg_lib_path_opts <-
@@ -136,11 +121,13 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
let
dead_strip
| gopt Opt_WholeArchiveHsLibs dflags = []
- | otherwise = if osSubsectionsViaSymbols (platformOS platform)
- then ["-Wl,-dead_strip"]
- else []
- let lib_paths = libraryPaths dflags
- let lib_path_opts = map ("-L"++) lib_paths
+ | osSubsectionsViaSymbols (platformOS platform) = ["-Wl,-dead_strip"]
+ | otherwise = []
+ lib_paths = libraryPaths dflags
+ lib_path_opts = map ("-L"++) lib_paths
+ r_paths = libraryRuntimePaths dflags
+ r_path_opts = concatMap optXLinkerRPath r_paths
+
extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger tmpfs dflags unit_state
noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_units
@@ -187,7 +174,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
runLink logger tmpfs linker_config args
-- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
when (platformOS platform == OSDarwin && gopt Opt_RPath dflags) $
- GHC.Linker.MacOS.runInjectRPaths logger (toolSettings dflags) pkg_lib_paths output_fn
+ GHC.Linker.MacOS.runInjectRPaths logger (toolSettings dflags) (pkg_lib_paths ++ r_paths) output_fn
link dflags (
map GHC.SysTools.Option verbFlags
@@ -245,7 +232,8 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
else [])
++ o_files
- ++ lib_path_opts)
+ ++ lib_path_opts
+ ++ r_path_opts)
++ extra_ld_inputs
++ map GHC.SysTools.Option (
rc_objs
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5617bb9d0bf78e45525df3e1e6f9bc7dde2c4a8...7e8bf7674966bbee96b0a57f00876849ab4112c1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5617bb9d0bf78e45525df3e1e6f9bc7dde2c4a8...7e8bf7674966bbee96b0a57f00876849ab4112c1
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231221/c63f1c5a/attachment-0001.html>
More information about the ghc-commits
mailing list