diff options
| -rw-r--r-- | compiler/main/DynFlags.hs | 26 | ||||
| -rw-r--r-- | compiler/main/SysTools.lhs | 54 |
2 files changed, 72 insertions, 8 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index f720db04d1..35e9c7e226 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -138,8 +138,9 @@ module DynFlags ( isAvx512fEnabled, isAvx512pfEnabled, - -- * Linker information + -- * Linker/compiler information LinkerInfo(..), + CompilerInfo(..), ) where #include "HsVersions.h" @@ -792,7 +793,10 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. -- | Run-time linker information (what options we need, etc.) - rtldFlags :: IORef (Maybe LinkerInfo) + rtldInfo :: IORef (Maybe LinkerInfo), + + -- | Run-time compiler information + rtccInfo :: IORef (Maybe CompilerInfo) } class HasDynFlags m where @@ -1270,7 +1274,8 @@ initDynFlags dflags = do refFilesToNotIntermediateClean <- newIORef [] refGeneratedDumps <- newIORef Set.empty refLlvmVersion <- newIORef 28 - refRtldFlags <- newIORef Nothing + refRtldInfo <- newIORef Nothing + refRtccInfo <- newIORef Nothing wrapperNum <- newIORef emptyModuleEnv canUseUnicodeQuotes <- do let enc = localeEncoding str = "‛’" @@ -1288,7 +1293,8 @@ initDynFlags dflags = do llvmVersion = refLlvmVersion, nextWrapperNum = wrapperNum, useUnicodeQuotes = canUseUnicodeQuotes, - rtldFlags = refRtldFlags + rtldInfo = refRtldInfo, + rtccInfo = refRtccInfo } -- | The normal 'DynFlags'. Note that they is not suitable for use in this form @@ -1438,7 +1444,8 @@ defaultDynFlags mySettings = avx512er = False, avx512f = False, avx512pf = False, - rtldFlags = panic "defaultDynFlags: no rtldFlags" + rtldInfo = panic "defaultDynFlags: no rtldInfo", + rtccInfo = panic "defaultDynFlags: no rtccInfo" } defaultWays :: Settings -> [Way] @@ -3722,7 +3729,7 @@ isAvx512pfEnabled :: DynFlags -> Bool isAvx512pfEnabled dflags = avx512pf dflags -- ----------------------------------------------------------------------------- --- Linker information +-- Linker/compiler information -- LinkerInfo contains any extra options needed by the system linker. data LinkerInfo @@ -3733,6 +3740,13 @@ data LinkerInfo | UnknownLD deriving Eq +-- CompilerInfo tells us which C compiler we're using +data CompilerInfo + = GCC + | Clang + | UnknownCC + deriving Eq + -- ----------------------------------------------------------------------------- -- RTS hooks diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index c179356514..2150c6d594 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -25,6 +25,7 @@ module SysTools ( readElfSection, getLinkerInfo, + getCompilerInfo, linkDynLib, @@ -644,12 +645,12 @@ neededLinkArgs UnknownLD = [] -- Grab linker info and cache it in DynFlags. getLinkerInfo :: DynFlags -> IO LinkerInfo getLinkerInfo dflags = do - info <- readIORef (rtldFlags dflags) + info <- readIORef (rtldInfo dflags) case info of Just v -> return v Nothing -> do v <- getLinkerInfo' dflags - writeIORef (rtldFlags dflags) (Just v) + writeIORef (rtldInfo dflags) (Just v) return v -- See Note [Run-time linker info]. @@ -721,6 +722,55 @@ getLinkerInfo' dflags = do return UnknownLD) return info +-- Grab compiler info and cache it in DynFlags. +getCompilerInfo :: DynFlags -> IO CompilerInfo +getCompilerInfo dflags = do + info <- readIORef (rtccInfo dflags) + case info of + Just v -> return v + Nothing -> do + v <- getCompilerInfo' dflags + writeIORef (rtccInfo dflags) (Just v) + return v + +-- See Note [Run-time linker info]. +getCompilerInfo' :: DynFlags -> IO CompilerInfo +getCompilerInfo' dflags = do + let (pgm,_) = pgm_c dflags + -- Try to grab the info from the process output. + parseCompilerInfo _stdo stde _exitc + -- Regular GCC + | any ("gcc version" `isPrefixOf`) stde = + return GCC + -- Regular clang + | any ("clang version" `isPrefixOf`) stde = + return Clang + -- XCode 5 clang + | any ("Apple LLVM version" `isPrefixOf`) stde = + return Clang + -- XCode 4.1 clang + | any ("Apple clang version" `isPrefixOf`) stde = + return Clang + -- Unknown linker. + | otherwise = fail "invalid -v output, or compiler is unsupported" + + -- Process the executable call + info <- catchIO (do + (exitc, stdo, stde) <- readProcessWithExitCode pgm ["-v"] "" + -- Split the output by lines to make certain kinds + -- of processing easier. + parseCompilerInfo (lines stdo) (lines stde) exitc + ) + (\err -> do + debugTraceMsg dflags 2 + (text "Error (figuring out compiler information):" <+> + text (show err)) + errorMsg dflags $ hang (text "Warning:") 9 $ + text "Couldn't figure out linker information!" $$ + text "Make sure you're using GNU gcc, or clang" + return UnknownCC) + return info + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = do -- See Note [Run-time linker info] |