diff options
author | Adam Sandberg Ericsson <adam@sandbergericsson.se> | 2021-05-16 10:41:32 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-05-19 23:40:47 -0400 |
commit | 441fdd6ce8af823e99fd260ed0f96b99e457bce5 (patch) | |
tree | 1faf6976c9178e9e65b84d53f52f15ccadd3a8dc | |
parent | d48b7e5c2fae5db1973a767be45aba82b2aa727c (diff) | |
download | haskell-441fdd6ce8af823e99fd260ed0f96b99e457bce5.tar.gz |
driver: check if clang is the assembler when passing clang specific arguments (#19827)
Previously we assumed that the assembler was the same as the c compiler,
but we allow setting them to different programs with -pgmc and -pgma.
-rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 11 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/SysTools/Info.hs | 28 |
3 files changed, 34 insertions, 15 deletions
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index e766fda3c7..9a5fa6819e 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -1598,11 +1598,13 @@ runPhase (RealPhase (As with_cpp)) input_fn -- 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 | backend dflags == LLVM + let (as_prog, get_asm_info) | backend dflags == LLVM , platformOS platform == OSDarwin - = GHC.SysTools.runClang + = (GHC.SysTools.runClang, pure Clang) | otherwise - = GHC.SysTools.runAs + = (GHC.SysTools.runAs, liftIO $ getAssemblerInfo logger dflags) + + asmInfo <- get_asm_info let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -1614,7 +1616,6 @@ runPhase (RealPhase (As with_cpp)) input_fn -- might be a hierarchical module. liftIO $ createDirectoryIfMissing True (takeDirectory output_fn) - ccInfo <- liftIO $ getCompilerInfo logger dflags let global_includes = [ GHC.SysTools.Option ("-I" ++ p) | p <- includePathsGlobal cmdline_include_paths ] let local_includes = [ GHC.SysTools.Option ("-iquote" ++ p) @@ -1643,7 +1644,7 @@ runPhase (RealPhase (As with_cpp)) input_fn ++ (if platformArch (targetPlatform dflags) == ArchSPARC then [GHC.SysTools.Option "-mcpu=v9"] else []) - ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51] + ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51] then [GHC.SysTools.Option "-Qunused-arguments"] else []) ++ [ GHC.SysTools.Option "-x" diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 6a2f4c6b73..12782af0a8 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -654,9 +654,12 @@ data DynFlags = DynFlags { -- | Run-time linker information (what options we need, etc.) rtldInfo :: IORef (Maybe LinkerInfo), - -- | Run-time compiler information + -- | 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. @@ -1047,6 +1050,7 @@ initDynFlags dflags = do refDynamicTooFailed <- newIORef (not platformCanGenerateDynamicToo) refRtldInfo <- newIORef Nothing refRtccInfo <- newIORef Nothing + refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -1069,7 +1073,8 @@ initDynFlags dflags = do canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo + rtccInfo = refRtccInfo, + rtasmInfo = refRtasmInfo } -- | The normal 'DynFlags'. Note that they are not suitable for use in this form @@ -1237,6 +1242,7 @@ defaultDynFlags mySettings llvmConfig = avx512pf = False, rtldInfo = panic "defaultDynFlags: no rtldInfo", rtccInfo = panic "defaultDynFlags: no rtccInfo", + rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, diff --git a/compiler/GHC/SysTools/Info.hs b/compiler/GHC/SysTools/Info.hs index b53d0fb567..733c2eaade 100644 --- a/compiler/GHC/SysTools/Info.hs +++ b/compiler/GHC/SysTools/Info.hs @@ -205,22 +205,34 @@ getLinkerInfo' logger dflags = do return UnknownLD ) --- Grab compiler info and cache it in DynFlags. +-- | 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 - v <- getCompilerInfo' logger dflags + let pgm = pgm_c dflags + v <- getCompilerInfo' logger dflags 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 dflags pgm + writeIORef (rtasmInfo dflags) (Just v) + return v + -- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo' logger dflags = do - let pgm = pgm_c dflags - -- Try to grab the info from the process output. +getCompilerInfo' :: Logger -> DynFlags -> String -> IO CompilerInfo +getCompilerInfo' logger dflags pgm = do + let -- Try to grab the info from the process output. parseCompilerInfo _stdo stde _exitc -- Regular GCC | any ("gcc version" `isInfixOf`) stde = @@ -240,8 +252,8 @@ getCompilerInfo' logger dflags = do -- Xcode 4.1 clang | any ("Apple clang version" `isPrefixOf`) stde = return AppleClang - -- Unknown linker. - | otherwise = fail $ "invalid -v output, or compiler is unsupported: " ++ unlines stde + -- Unknown compiler. + | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde -- Process the executable call catchIO (do |