Commit 3428f76e authored by Austin Seipp's avatar Austin Seipp

Cache compiler info in DynFlags

Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent 20a25b56
......@@ -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
......
......@@ -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]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment