[Git][ghc/ghc][master] Modularity: modularize external linker
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Oct 26 12:45:47 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
9408b086 by Sylvain Henry at 2023-10-26T08:45:03-04:00
Modularity: modularize external linker
Decouple runLink from DynFlags to allow calling runLink more easily.
This is preliminary work for calling Emscripten's linker (emcc) from
our JavaScript linker.
- - - - -
7 changed files:
- compiler/GHC/Driver/Config/Linker.hs
- compiler/GHC/Linker/Config.hs
- compiler/GHC/Linker/Dynamic.hs
- + compiler/GHC/Linker/External.hs
- compiler/GHC/Linker/Static.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/ghc.cabal.in
Changes:
=====================================
compiler/GHC/Driver/Config/Linker.hs
=====================================
@@ -1,13 +1,93 @@
module GHC.Driver.Config.Linker
( initFrameworkOpts
- ) where
+ , initLinkerConfig
+ )
+where
+import GHC.Prelude
+import GHC.Platform
import GHC.Linker.Config
import GHC.Driver.DynFlags
+import GHC.Driver.Session
+
+import Data.List (isPrefixOf)
initFrameworkOpts :: DynFlags -> FrameworkOpts
initFrameworkOpts dflags = FrameworkOpts
{ foFrameworkPaths = frameworkPaths dflags
, foCmdlineFrameworks = cmdlineFrameworks dflags
}
+
+-- | Initialize linker configuration from DynFlags
+initLinkerConfig :: DynFlags -> LinkerConfig
+initLinkerConfig dflags =
+ let
+ -- see Note [Solaris linker]
+ ld_filter = case platformOS (targetPlatform dflags) of
+ OSSolaris2 -> sunos_ld_filter
+ _ -> id
+ sunos_ld_filter :: String -> String
+ sunos_ld_filter = unlines . sunos_ld_filter' . lines
+ sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)
+ then (ld_prefix x) ++ (ld_postfix x)
+ else x
+ breakStartsWith x y = break (isPrefixOf x) y
+ ld_prefix = fst . breakStartsWith "Undefined"
+ undefined_found = not . null . snd . breakStartsWith "Undefined"
+ ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors"
+ ld_postfix = tail . snd . ld_warn_break
+ ld_warning_found = not . null . snd . ld_warn_break
+
+ -- program and arguments
+ --
+ -- `-optl` args come at the end, so that later `-l` options
+ -- given there manually can fill in symbols needed by
+ -- Haskell libraries coming in via `args`.
+ (p,pre_args) = pgm_l dflags
+ post_args = map Option (getOpts dflags opt_l)
+
+ in LinkerConfig
+ { linkerProgram = p
+ , linkerOptionsPre = pre_args
+ , linkerOptionsPost = post_args
+ , linkerTempDir = tmpDir dflags
+ , linkerFilter = ld_filter
+ }
+
+{- Note [Solaris linker]
+ ~~~~~~~~~~~~~~~~~~~~~
+ SunOS/Solaris ld emits harmless warning messages about unresolved
+ symbols in case of compiling into shared library when we do not
+ link against all the required libs. That is the case of GHC which
+ does not link against RTS library explicitly in order to be able to
+ choose the library later based on binary application linking
+ parameters. The warnings look like:
+
+Undefined first referenced
+ symbol in file
+stg_ap_n_fast ./T2386_Lib.o
+stg_upd_frame_info ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
+newCAF ./T2386_Lib.o
+stg_bh_upd_frame_info ./T2386_Lib.o
+stg_ap_ppp_fast ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
+stg_ap_p_fast ./T2386_Lib.o
+stg_ap_pp_fast ./T2386_Lib.o
+ld: warning: symbol referencing errors
+
+ this is actually coming from T2386 testcase. The emitting of those
+ warnings is also a reason why so many TH testcases fail on Solaris.
+
+ Following filter code is SunOS/Solaris linker specific and should
+ filter out only linker warnings. Please note that the logic is a
+ little bit more complex due to the simple reason that we need to preserve
+ any other linker emitted messages. If there are any. Simply speaking
+ if we see "Undefined" and later "ld: warning:..." then we omit all
+ text between (including) the marks. Otherwise we copy the whole output.
+-}
+
=====================================
compiler/GHC/Linker/Config.hs
=====================================
@@ -2,12 +2,26 @@
module GHC.Linker.Config
( FrameworkOpts(..)
- ) where
+ , LinkerConfig(..)
+ )
+where
import GHC.Prelude
+import GHC.Utils.TmpFs
+import GHC.Utils.CliOption
-- used on darwin only
data FrameworkOpts = FrameworkOpts
{ foFrameworkPaths :: [String]
, foCmdlineFrameworks :: [String]
}
+
+-- | External linker configuration
+data LinkerConfig = LinkerConfig
+ { linkerProgram :: String -- ^ Linker program
+ , linkerOptionsPre :: [Option] -- ^ Linker options (before user options)
+ , linkerOptionsPost :: [Option] -- ^ Linker options (after user options)
+ , linkerTempDir :: TempDir -- ^ Temporary directory to use
+ , linkerFilter :: String -> String -- ^ Output filter
+ }
+
=====================================
compiler/GHC/Linker/Dynamic.hs
=====================================
@@ -20,7 +20,7 @@ import GHC.Unit.Types
import GHC.Unit.State
import GHC.Linker.MacOS
import GHC.Linker.Unit
-import GHC.SysTools.Tasks
+import GHC.Linker.External
import GHC.Utils.Logger
import GHC.Utils.TmpFs
@@ -98,6 +98,8 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
pkg_framework_opts <- getUnitFrameworkOpts unit_env (map unitId pkgs)
let framework_opts = getFrameworkOpts (initFrameworkOpts dflags) platform
+ let linker_config = initLinkerConfig dflags
+
case os of
OSMinGW32 -> do
-------------------------------------------------------------
@@ -107,7 +109,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
Just s -> s
Nothing -> "HSdll.dll"
- runLink logger tmpfs dflags (
+ runLink logger tmpfs linker_config (
map Option verbFlags
++ [ Option "-o"
, FileOption "" output_fn
@@ -167,7 +169,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
instName <- case dylibInstallName dflags of
Just n -> return n
Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
- runLink logger tmpfs dflags (
+ runLink logger tmpfs linker_config (
map Option verbFlags
++ [ Option "-dynamiclib"
, Option "-o"
@@ -212,7 +214,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
-- See Note [-Bsymbolic assumptions by GHC]
["-Wl,-Bsymbolic" | not unregisterised]
- runLink logger tmpfs dflags (
+ runLink logger tmpfs linker_config (
map Option verbFlags
++ libmLinkOpts platform
++ [ Option "-o"
=====================================
compiler/GHC/Linker/External.hs
=====================================
@@ -0,0 +1,26 @@
+-- | External ("system") linker
+module GHC.Linker.External
+ ( LinkerConfig(..)
+ , runLink
+ )
+where
+
+import GHC.Prelude
+import GHC.Utils.TmpFs
+import GHC.Utils.Logger
+import GHC.Utils.Error
+import GHC.Utils.CliOption
+import GHC.SysTools.Process
+import GHC.Linker.Config
+
+-- | Run the external linker
+runLink :: Logger -> TmpFs -> LinkerConfig -> [Option] -> IO ()
+runLink logger tmpfs cfg args = traceSystoolCommand logger "linker" $ do
+ let all_args = linkerOptionsPre cfg ++ args ++ linkerOptionsPost cfg
+
+ -- on Windows, mangle environment variables to account for a bug in Windows
+ -- Vista
+ mb_env <- getGccEnv all_args
+
+ runSomethingResponseFile logger tmpfs (linkerTempDir cfg) (linkerFilter cfg)
+ "Linker" (linkerProgram cfg) all_args mb_env
=====================================
compiler/GHC/Linker/Static.hs
=====================================
@@ -26,6 +26,7 @@ import GHC.Linker.MacOS
import GHC.Linker.Unit
import GHC.Linker.Dynamic
import GHC.Linker.ExtraObj
+import GHC.Linker.External
import GHC.Linker.Windows
import GHC.Linker.Static.Utils
@@ -181,14 +182,12 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
OSMinGW32 | gopt Opt_GenManifest dflags -> maybeCreateManifest logger tmpfs dflags output_fn
_ -> return []
- let link dflags args | platformOS platform == OSDarwin
- = do
- GHC.SysTools.runLink logger tmpfs dflags args
- -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
- when (gopt Opt_RPath dflags) $
- GHC.Linker.MacOS.runInjectRPaths logger (toolSettings dflags) pkg_lib_paths output_fn
- | otherwise
- = GHC.SysTools.runLink logger tmpfs dflags args
+ let linker_config = initLinkerConfig dflags
+ let link dflags args = 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
link dflags (
map GHC.SysTools.Option verbFlags
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -10,7 +10,6 @@
module GHC.SysTools.Tasks where
import GHC.Prelude
-import GHC.Platform
import GHC.ForeignSrcLang
import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUpperBound, parseLlvmVersion, supportedLlvmVersionLowerBound)
@@ -264,68 +263,6 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
++ ")") ]
return Nothing)
-
-
-runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
-runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do
- -- `-optl` args come at the end, so that later `-l` options
- -- given there manually can fill in symbols needed by
- -- Haskell libraries coming in via `args`.
- let (p,args0) = pgm_l dflags
- optl_args = map Option (getOpts dflags opt_l)
- args2 = args0 ++ args ++ optl_args
- mb_env <- getGccEnv args2
- runSomethingResponseFile logger tmpfs (tmpDir dflags) ld_filter "Linker" p args2 mb_env
- where
- ld_filter = case (platformOS (targetPlatform dflags)) of
- OSSolaris2 -> sunos_ld_filter
- _ -> id
-{-
- SunOS/Solaris ld emits harmless warning messages about unresolved
- symbols in case of compiling into shared library when we do not
- link against all the required libs. That is the case of GHC which
- does not link against RTS library explicitly in order to be able to
- choose the library later based on binary application linking
- parameters. The warnings look like:
-
-Undefined first referenced
- symbol in file
-stg_ap_n_fast ./T2386_Lib.o
-stg_upd_frame_info ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
-newCAF ./T2386_Lib.o
-stg_bh_upd_frame_info ./T2386_Lib.o
-stg_ap_ppp_fast ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
-stg_ap_p_fast ./T2386_Lib.o
-stg_ap_pp_fast ./T2386_Lib.o
-ld: warning: symbol referencing errors
-
- this is actually coming from T2386 testcase. The emitting of those
- warnings is also a reason why so many TH testcases fail on Solaris.
-
- Following filter code is SunOS/Solaris linker specific and should
- filter out only linker warnings. Please note that the logic is a
- little bit more complex due to the simple reason that we need to preserve
- any other linker emitted messages. If there are any. Simply speaking
- if we see "Undefined" and later "ld: warning:..." then we omit all
- text between (including) the marks. Otherwise we copy the whole output.
--}
- sunos_ld_filter :: String -> String
- sunos_ld_filter = unlines . sunos_ld_filter' . lines
- sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)
- then (ld_prefix x) ++ (ld_postfix x)
- else x
- breakStartsWith x y = break (isPrefixOf x) y
- ld_prefix = fst . breakStartsWith "Undefined"
- undefined_found = not . null . snd . breakStartsWith "Undefined"
- ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors"
- ld_postfix = tail . snd . ld_warn_break
- ld_warning_found = not . null . snd . ld_warn_break
-
-- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline.
runMergeObjects :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runMergeObjects logger tmpfs dflags args =
=====================================
compiler/ghc.cabal.in
=====================================
@@ -580,6 +580,7 @@ Library
GHC.Linker.Config
GHC.Linker.Deps
GHC.Linker.Dynamic
+ GHC.Linker.External
GHC.Linker.ExtraObj
GHC.Linker.Loader
GHC.Linker.MacOS
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9408b086775960a2e0a6b0b6f8091e79bcf9ddd5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9408b086775960a2e0a6b0b6f8091e79bcf9ddd5
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/20231026/6b239d49/attachment-0001.html>
More information about the ghc-commits
mailing list