[Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] 4 commits: Rip out runtime linker/compiler checks
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Jun 26 15:49:10 UTC 2023
Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC
Commits:
9058db6a by Ben Gamari at 2023-06-26T16:11:20+01:00
Rip out runtime linker/compiler checks
- - - - -
36868983 by Rodrigo Mesquita at 2023-06-26T16:48:13+01:00
Drop Note [Run-time linker info] and SysTools.Info
Ultimately, this represents our change in policy: We no longer adapt at
runtime to the toolchain being used, but rather make final decisions at
configure time.
The end goal is to be able to configure multiple toolchains in a single
place (to then choose among them with a runtime-retargetable GHC)
For now that single place where configuration happens is autoconf, but
soon it will be the standalone ghc-toolchain program (see !9263)
* The flag -Wl,--no-as-needed for needed shared libs are configured
into settings
* The flag -fstack-check is configured into settings
* The check for broken tables-next-to-code was outdated
* We use the configured c compiler by default as the assembler program
* We drop `asmOpts` because we already configure -Qunused-arguments flag
into settings (see !10589)
- - - - -
88b89bbe by Rodrigo Mesquita at 2023-06-26T16:48:57+01:00
Configure -Wl,--no-as-needed
To fixup, but this is one of the things we must now configure instead of
determine at runtime
Be sure to enumerate those in a bullet list
- - - - -
ea1e4994 by Rodrigo Mesquita at 2023-06-26T16:48:57+01:00
fstackcheck
- - - - -
11 changed files:
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Linker/ExtraObj.hs
- compiler/GHC/SysTools.hs
- − compiler/GHC/SysTools/Info.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/ghc.cabal.in
- + m4/fp_link_supports_no_as_needed.m4
- m4/fptools_set_c_ld_flags.m4
Changes:
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -58,8 +58,6 @@ module GHC.Driver.Backend
, DefunctionalizedCodeOutput(..)
-- *** Back-end functions for assembly
, DefunctionalizedPostHscPipeline(..)
- , DefunctionalizedAssemblerProg(..)
- , DefunctionalizedAssemblerInfoGetter(..)
-- *** Other back-end functions
, DefunctionalizedCDefs(..)
-- ** Names of back ends (for API clients of version 9.4 or earlier)
@@ -94,8 +92,6 @@ module GHC.Driver.Backend
, backendSupportsHpc
, backendSupportsCImport
, backendSupportsCExport
- , backendAssemblerProg
- , backendAssemblerInfoGetter
, backendCDefs
, backendCodeOutput
, backendUseJSLinker
@@ -348,40 +344,6 @@ data PrimitiveImplementation
deriving Show
--- | Names a function that runs the assembler, of this type:
---
--- > Logger -> DynFlags -> Platform -> [Option] -> IO ()
---
--- The functions so named are defined in "GHC.Driver.Pipeline.Execute".
-
-data DefunctionalizedAssemblerProg
- = StandardAssemblerProg
- -- ^ Use the standard system assembler
- | JSAssemblerProg
- -- ^ JS Backend compile to JS via Stg, and so does not use any assembler
- | DarwinClangAssemblerProg
- -- ^ If running on Darwin, use the assembler from the @clang@
- -- toolchain. Otherwise use the standard system assembler.
-
-
-
--- | Names a function that discover from what toolchain the assembler
--- is coming, of this type:
---
--- > Logger -> DynFlags -> Platform -> IO CompilerInfo
---
--- The functions so named are defined in "GHC.Driver.Pipeline.Execute".
-
-data DefunctionalizedAssemblerInfoGetter
- = StandardAssemblerInfoGetter
- -- ^ Interrogate the standard system assembler
- | JSAssemblerInfoGetter
- -- ^ If using the JS backend; return 'Emscripten'
- | DarwinClangAssemblerInfoGetter
- -- ^ If running on Darwin, return `Clang`; otherwise
- -- interrogate the standard system assembler.
-
-
-- | Names a function that generates code and writes the results to a
-- file, of this type:
--
@@ -770,45 +732,6 @@ backendSupportsCExport (Named JavaScript) = True
backendSupportsCExport (Named Interpreter) = False
backendSupportsCExport (Named NoBackend) = True
--- | This (defunctionalized) function runs the assembler
--- used on the code that is written by this back end. A
--- program determined by a combination of back end,
--- `DynFlags`, and `Platform` is run with the given
--- `Option`s.
---
--- The function's type is
--- @
--- Logger -> DynFlags -> Platform -> [Option] -> IO ()
--- @
---
--- This field is usually defaulted.
-backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg
-backendAssemblerProg (Named NCG) = StandardAssemblerProg
-backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg
-backendAssemblerProg (Named ViaC) = StandardAssemblerProg
-backendAssemblerProg (Named JavaScript) = JSAssemblerProg
-backendAssemblerProg (Named Interpreter) = StandardAssemblerProg
-backendAssemblerProg (Named NoBackend) = StandardAssemblerProg
-
--- | This (defunctionalized) function is used to retrieve
--- an enumeration value that characterizes the C/assembler
--- part of a toolchain. The function caches the info in a
--- mutable variable that is part of the `DynFlags`.
---
--- The function's type is
--- @
--- Logger -> DynFlags -> Platform -> IO CompilerInfo
--- @
---
--- This field is usually defaulted.
-backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter
-backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter
-backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter
-backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter
-backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter
-backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter
-backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter
-
-- | When using this back end, it may be necessary or
-- advisable to pass some `-D` options to a C compiler.
-- This (defunctionalized) function produces those
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -420,15 +420,6 @@ data DynFlags = DynFlags {
avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions.
fma :: Bool, -- ^ Enable FMA instructions.
- -- | Run-time linker information (what options we need, etc.)
- rtldInfo :: IORef (Maybe LinkerInfo),
-
- -- | Run-time C compiler information
- rtccInfo :: IORef (Maybe CompilerInfo),
-
- -- | Run-time assembler information
- rtasmInfo :: IORef (Maybe CompilerInfo),
-
-- Constants used to control the amount of optimization done.
-- | Max size, in bytes, of inline array allocations.
@@ -490,9 +481,6 @@ class ContainsDynFlags t where
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
let
- refRtldInfo <- newIORef Nothing
- refRtccInfo <- newIORef Nothing
- refRtasmInfo <- newIORef Nothing
canUseUnicode <- do let enc = localeEncoding
str = "‘’"
(withCString enc str $ \cstr ->
@@ -514,9 +502,6 @@ initDynFlags dflags = do
useColor = useColor',
canUseColor = stderrSupportsAnsiColors,
colScheme = colScheme',
- rtldInfo = refRtldInfo,
- rtccInfo = refRtccInfo,
- rtasmInfo = refRtasmInfo,
tmpDir = TempDir tmp_dir
}
@@ -695,9 +680,6 @@ defaultDynFlags mySettings =
avx512f = False,
avx512pf = False,
fma = False,
- rtldInfo = panic "defaultDynFlags: no rtldInfo",
- rtccInfo = panic "defaultDynFlags: no rtccInfo",
- rtasmInfo = panic "defaultDynFlags: no rtasmInfo",
maxInlineAllocSize = 128,
maxInlineMemcpyInsns = 32,
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -336,41 +336,11 @@ initHscEnv mb_top_dir = do
mySettings <- initSysTools top_dir
dflags <- initDynFlags (defaultDynFlags mySettings)
hsc_env <- newHscEnv top_dir dflags
- checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags
setUnsafeGlobalDynFlags dflags
-- c.f. DynFlags.parseDynamicFlagsFull, which
-- creates DynFlags and sets the UnsafeGlobalDynFlags
return hsc_env
--- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which
--- breaks tables-next-to-code in dynamically linked modules. This
--- check should be more selective but there is currently no released
--- version where this bug is fixed.
--- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and
--- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333
-checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO ()
-checkBrokenTablesNextToCode logger dflags = do
- let invalidLdErr = "Tables-next-to-code not supported on ARM \
- \when using binutils ld (please see: \
- \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)"
- broken <- checkBrokenTablesNextToCode' logger dflags
- when broken (panic invalidLdErr)
-
-checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool
-checkBrokenTablesNextToCode' logger dflags
- | not (isARM arch) = return False
- | ways dflags `hasNotWay` WayDyn = return False
- | not tablesNextToCode = return False
- | otherwise = do
- linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags
- case linkerInfo of
- GnuLD _ -> return True
- _ -> return False
- where platform = targetPlatform dflags
- arch = platformArch platform
- tablesNextToCode = platformTablesNextToCode platform
-
-
-- -----------------------------------------------------------------------------
getDiagnostics :: Hsc (Messages GhcMessage)
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -290,10 +290,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
let unit_env = hsc_unit_env hsc_env
let platform = ue_platform unit_env
- -- LLVM from version 3.0 onwards doesn't support the OS X system
- -- assembler, so we use clang as the assembler instead. (#5636)
- let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags)
-
let cmdline_include_paths = includePaths dflags
let pic_c_flags = picCCOpts dflags
@@ -310,7 +306,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
includePathsQuoteImplicit cmdline_include_paths]
let runAssembler inputFilename outputFilename
= withAtomicRename outputFilename $ \temp_outputFilename ->
- as_prog
+ runAs
logger dflags
platform
(local_includes ++ global_includes
@@ -392,22 +388,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do
embedJsFile logger dflags tmpfs unit_env input_fn output_fn
return output_fn
-
-applyAssemblerProg
- :: DefunctionalizedAssemblerProg
- -> Logger -> DynFlags -> Platform -> [Option] -> IO ()
-applyAssemblerProg StandardAssemblerProg logger dflags _platform =
- runAs logger dflags
-applyAssemblerProg JSAssemblerProg logger dflags _platform =
- runEmscripten logger dflags
-applyAssemblerProg DarwinClangAssemblerProg logger dflags platform =
- if platformOS platform == OSDarwin then
- runClang logger dflags
- else
- runAs logger dflags
-
-
-
runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
runCcPhase cc_phase pipe_env hsc_env location input_fn = do
let dflags = hsc_dflags hsc_env
=====================================
compiler/GHC/Linker/ExtraObj.hs
=====================================
@@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj
, mkNoteObjsToLinkIntoBinary
, checkLinkInfo
, getLinkInfo
- , getCompilerInfo
, ghcLinkInfoSectionName
, ghcLinkInfoNoteName
, platformSupportsSavingLinkOpts
@@ -40,7 +39,6 @@ import qualified GHC.Data.ShortText as ST
import GHC.SysTools.Elf
import GHC.SysTools.Tasks
-import GHC.SysTools.Info
import GHC.Linker.Unit
import Control.Monad.IO.Class
@@ -52,7 +50,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs
= do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn
oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o"
writeFile cFile xs
- ccInfo <- liftIO $ getCompilerInfo logger dflags
runCc Nothing logger tmpfs dflags
([Option "-c",
FileOption "" cFile,
@@ -60,7 +57,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs
FileOption "" oFile]
++ if extn /= "s"
then cOpts
- else asmOpts ccInfo)
+ else [])
return oFile
where
-- Pass a different set of options to the C compiler depending one whether
@@ -70,14 +67,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs
++ map (FileOption "-I" . ST.unpack)
(unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit)
- -- When compiling assembler code, we drop the usual C options, and if the
- -- compiler is Clang, we add an extra argument to tell Clang to ignore
- -- unused command line options. See trac #11684.
- asmOpts ccInfo =
- if any (ccInfo ==) [Clang, AppleClang, AppleClang51]
- then [Option "-Qunused-arguments"]
- else []
-
-- When linking a binary, we need to create a C main() function that
-- starts everything off. This used to be compiled statically as part
-- of the RTS, but that made it hard to change the -rtsopts setting,
=====================================
compiler/GHC/SysTools.hs
=====================================
@@ -17,7 +17,6 @@ module GHC.SysTools (
-- * Interface to system tools
module GHC.SysTools.Tasks,
- module GHC.SysTools.Info,
-- * Fast file copy
copyFile,
@@ -36,7 +35,6 @@ import GHC.Utils.Panic
import GHC.Driver.Session
import GHC.Linker.ExtraObj
-import GHC.SysTools.Info
import GHC.SysTools.Tasks
import GHC.SysTools.BaseDir
import GHC.Settings.IO
=====================================
compiler/GHC/SysTools/Info.hs deleted
=====================================
@@ -1,243 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
------------------------------------------------------------------------------
---
--- Compiler information functions
---
--- (c) The GHC Team 2017
---
------------------------------------------------------------------------------
-module GHC.SysTools.Info where
-
-import GHC.Utils.Exception
-import GHC.Utils.Error
-import GHC.Driver.Session
-import GHC.Utils.Outputable
-import GHC.Utils.Misc
-import GHC.Utils.Logger
-
-import Data.List ( isInfixOf, isPrefixOf )
-import Data.IORef
-
-import System.IO
-
-import GHC.Platform
-import GHC.Prelude
-
-import GHC.SysTools.Process
-
-{- Note [Run-time linker info]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-See also: #5240, #6063, #10110
-
-Before 'runLink', we need to be sure to get the relevant information
-about the linker we're using at runtime to see if we need any extra
-options.
-
-Generally, the linker changing from what was detected at ./configure
-time has always been possible using -pgml, but on Linux it can happen
-'transparently' by installing packages like binutils-gold, which
-change what /usr/bin/ld actually points to.
-
-Clang vs GCC notes:
-
-For gcc, 'gcc -Wl,--version' gives a bunch of output about how to
-invoke the linker before the version information string. For 'clang',
-the version information for 'ld' is all that's output. For this
-reason, we typically need to slurp up all of the standard error output
-and look through it.
-
-Other notes:
-
-We cache the LinkerInfo inside DynFlags, since clients may link
-multiple times. The definition of LinkerInfo is there to avoid a
-circular dependency.
-
--}
-
-{- Note [ELF needed shared libs]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Some distributions change the link editor's default handling of
-ELF DT_NEEDED tags to include only those shared objects that are
-needed to resolve undefined symbols. For Template Haskell we need
-the last temporary shared library also if it is not needed for the
-currently linked temporary shared library. We specify --no-as-needed
-to override the default. This flag exists in GNU ld and GNU gold.
-
-The flag is only needed on ELF systems. On Windows (PE) and Mac OS X
-(Mach-O) the flag is not needed.
-
--}
-
-neededLinkArgs :: LinkerInfo -> [Option]
-neededLinkArgs (GnuLD o) = o
-neededLinkArgs (Mold o) = o
-neededLinkArgs (GnuGold o) = o
-neededLinkArgs (LlvmLLD o) = o
-neededLinkArgs (DarwinLD o) = o
-neededLinkArgs (SolarisLD o) = o
-neededLinkArgs (AixLD o) = o
-neededLinkArgs UnknownLD = []
-
--- Grab linker info and cache it in DynFlags.
-getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo
-getLinkerInfo logger dflags = do
- info <- readIORef (rtldInfo dflags)
- case info of
- Just v -> return v
- Nothing -> do
- v <- getLinkerInfo' logger dflags
- writeIORef (rtldInfo dflags) (Just v)
- return v
-
--- See Note [Run-time linker info].
-getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo
-getLinkerInfo' logger dflags = do
- let platform = targetPlatform dflags
- os = platformOS platform
- (pgm,args0) = pgm_l dflags
- args1 = map Option (getOpts dflags opt_l)
- args2 = args0 ++ args1
- args3 = filter notNull (map showOpt args2)
-
- -- Try to grab the info from the process output.
- parseLinkerInfo stdo _stde _exitc
- | any ("GNU ld" `isPrefixOf`) stdo =
- -- Set DT_NEEDED for all shared libraries. #10110.
- return (GnuLD $ map Option [-- ELF specific flag
- -- see Note [ELF needed shared libs]
- "-Wl,--no-as-needed"])
-
- | any ("mold" `isPrefixOf`) stdo =
- return (Mold $ map Option [ --see Note [ELF needed shared libs]
- "-Wl,--no-as-needed"])
-
- | any ("GNU gold" `isPrefixOf`) stdo =
- -- GNU gold only needs --no-as-needed. #10110.
- -- ELF specific flag, see Note [ELF needed shared libs]
- return (GnuGold [Option "-Wl,--no-as-needed"])
-
- | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo =
- return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs]
- "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ])
-
- -- Unknown linker.
- | otherwise = fail "invalid --version output, or linker is unsupported"
-
- -- Process the executable call
- catchIO (
- case os of
- OSSolaris2 ->
- -- Solaris uses its own Solaris linker. Even all
- -- GNU C are recommended to configure with Solaris
- -- linker instead of using GNU binutils linker. Also
- -- all GCC distributed with Solaris follows this rule
- -- precisely so we assume here, the Solaris linker is
- -- used.
- return $ SolarisLD []
- OSAIX ->
- -- IBM AIX uses its own non-binutils linker as well
- return $ AixLD []
- OSDarwin ->
- -- Darwin has neither GNU Gold or GNU LD, but a strange linker
- -- that doesn't support --version. We can just assume that's
- -- what we're using.
- return $ DarwinLD []
- OSMinGW32 ->
- -- GHC doesn't support anything but GNU ld on Windows anyway.
- -- Process creation is also fairly expensive on win32, so
- -- we short-circuit here.
- return $ GnuLD $ map Option
- [ -- Emit stack checks
- -- See Note [Windows stack allocations]
- "-fstack-check"
- ]
- _ -> do
- -- In practice, we use the compiler as the linker here. Pass
- -- -Wl,--version to get linker version info.
- (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
- (["-Wl,--version"] ++ args3)
- c_locale_env
- -- Split the output by lines to make certain kinds
- -- of processing easier. In particular, 'clang' and 'gcc'
- -- have slightly different outputs for '-Wl,--version', but
- -- it's still easy to figure out.
- parseLinkerInfo (lines stdo) (lines stde) exitc
- )
- (\err -> do
- debugTraceMsg logger 2
- (text "Error (figuring out linker information):" <+>
- text (show err))
- errorMsg logger $ hang (text "Warning:") 9 $
- text "Couldn't figure out linker information!" $$
- text "Make sure you're using GNU ld, GNU gold" <+>
- text "or the built in OS X linker, etc."
- return UnknownLD
- )
-
--- | Grab compiler info and cache it in DynFlags.
-getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo
-getCompilerInfo logger dflags = do
- info <- readIORef (rtccInfo dflags)
- case info of
- Just v -> return v
- Nothing -> do
- let pgm = pgm_c dflags
- v <- getCompilerInfo' logger pgm
- writeIORef (rtccInfo dflags) (Just v)
- return v
-
--- | Grab assembler info and cache it in DynFlags.
-getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo
-getAssemblerInfo logger dflags = do
- info <- readIORef (rtasmInfo dflags)
- case info of
- Just v -> return v
- Nothing -> do
- let (pgm, _) = pgm_a dflags
- v <- getCompilerInfo' logger pgm
- writeIORef (rtasmInfo dflags) (Just v)
- return v
-
--- See Note [Run-time linker info].
-getCompilerInfo' :: Logger -> String -> IO CompilerInfo
-getCompilerInfo' logger pgm = do
- let -- Try to grab the info from the process output.
- parseCompilerInfo _stdo stde _exitc
- -- Regular GCC
- | any ("gcc version" `isInfixOf`) stde =
- return GCC
- -- Regular clang
- | any ("clang version" `isInfixOf`) stde =
- return Clang
- -- FreeBSD clang
- | any ("FreeBSD clang version" `isInfixOf`) stde =
- return Clang
- -- Xcode 5.1 clang
- | any ("Apple LLVM version 5.1" `isPrefixOf`) stde =
- return AppleClang51
- -- Xcode 5 clang
- | any ("Apple LLVM version" `isPrefixOf`) stde =
- return AppleClang
- -- Xcode 4.1 clang
- | any ("Apple clang version" `isPrefixOf`) stde =
- return AppleClang
- -- Unknown compiler.
- | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde
-
- -- Process the executable call
- catchIO (do
- (exitc, stdo, stde) <-
- readProcessEnvWithExitCode pgm ["-v"] c_locale_env
- -- Split the output by lines to make certain kinds
- -- of processing easier.
- parseCompilerInfo (lines stdo) (lines stde) exitc
- )
- (\err -> do
- debugTraceMsg logger 2
- (text "Error (figuring out C compiler information):" <+>
- text (show err))
- errorMsg logger $ hang (text "Warning:") 9 $
- text "Couldn't figure out C compiler information!" $$
- text "Make sure you're using GNU gcc, or clang"
- return UnknownCC
- )
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp
import GHC.Settings
import GHC.SysTools.Process
-import GHC.SysTools.Info
import GHC.Driver.Session
@@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do
- -- See Note [Run-time linker info]
- --
-- `-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`.
- linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags
let (p,args0) = pgm_l dflags
optl_args = map Option (getOpts dflags opt_l)
- args2 = args0 ++ linkargs ++ args ++ optl_args
+ args2 = args0 ++ args ++ optl_args
mb_env <- getGccEnv args2
runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env
where
=====================================
compiler/ghc.cabal.in
=====================================
@@ -712,7 +712,6 @@ Library
GHC.SysTools.BaseDir
GHC.SysTools.Cpp
GHC.SysTools.Elf
- GHC.SysTools.Info
GHC.SysTools.Process
GHC.SysTools.Tasks
GHC.SysTools.Terminal
=====================================
m4/fp_link_supports_no_as_needed.m4
=====================================
@@ -0,0 +1,33 @@
+# FP_LINK_SUPPORTS_NO_AS_NEEDED
+# ----------------------------------
+# Set the Cc linker flag -Wl,--no-as-needed if it is supported
+# $1 is the name of the linker flags variable when linking with gcc
+# See also Note [ELF needed shared libs]
+AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED],
+[
+ AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed])
+ echo 'int f(int a) {return 2*a;}' > conftest.a.c
+ echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c
+ $CC -o conftest.a.o conftest.a.c
+ $CC -o conftest.b.o conftest.b.c
+ if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1
+ then
+ $1="$$1 -Wl,--no-as-needed"
+ AC_MSG_RESULT([yes])
+ else
+ AC_MSG_RESULT([no])
+ fi
+ rm -f conftest*
+])
+
+# Note [ELF needed shared libs]
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# Some distributions change the link editor's default handling of
+# ELF DT_NEEDED tags to include only those shared objects that are
+# needed to resolve undefined symbols. For Template Haskell we need
+# the last temporary shared library also if it is not needed for the
+# currently linked temporary shared library. We specify --no-as-needed
+# to override the default. This flag exists in GNU ld and GNU gold.
+#
+# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X
+# (Mach-O) the flag is not needed.
=====================================
m4/fptools_set_c_ld_flags.m4
=====================================
@@ -17,9 +17,19 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
;;
esac
+ # See Note [ELF needed shared libs]
+ case $$1 in
+ *-linux|*-freebsd*)
+ FP_LINK_SUPPORTS_NO_AS_NEEDED([$3])
+ ;;
+ esac
+
case $$1 in
i386-unknown-mingw32)
$2="$$2 -march=i686"
+ # Emit stack checks
+ # See Note [Windows stack allocations]
+ $3="$$3 -fstack-check"
;;
i386-portbld-freebsd*)
$2="$$2 -march=i686"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53ea4e07001bb6cc99c7360d91f05e07484b448b...ea1e4994c92d50bf4d6bd7a8ad649336fb4db1fb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53ea4e07001bb6cc99c7360d91f05e07484b448b...ea1e4994c92d50bf4d6bd7a8ad649336fb4db1fb
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/20230626/5dd52e82/attachment-0001.html>
More information about the ghc-commits
mailing list