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
neededLinkArgs :: LinkerInfo -> [Option]
neededLinkArgs (GnuLD o) = o
neededLinkArgs (GnuGold o) = o
neededLinkArgs (LlvmLLD o) = o
neededLinkArgs (DarwinLD o) = o
neededLinkArgs (SolarisLD o) = o
neededLinkArgs (AixLD o) = o
neededLinkArgs UnknownLD = []
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
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)
parseLinkerInfo stdo _stde _exitc
| any ("GNU ld" `isPrefixOf`) stdo =
return (GnuLD $ map Option [
"-Wl,--no-as-needed"])
| any ("GNU gold" `isPrefixOf`) stdo =
return (GnuGold [Option "-Wl,--no-as-needed"])
| any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo =
return (LlvmLLD $ map Option [
"-Wl,--no-as-needed"])
| otherwise = fail "invalid --version output, or linker is unsupported"
catchIO (
case os of
OSSolaris2 ->
return $ SolarisLD []
OSAIX ->
return $ AixLD []
OSDarwin ->
return $ DarwinLD []
OSMinGW32 ->
return $ GnuLD $ map Option
[
"-fstack-check"
]
_ -> do
(exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
(["-Wl,--version"] ++ args3)
c_locale_env
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
)
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
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
getCompilerInfo' :: Logger -> String -> IO CompilerInfo
getCompilerInfo' logger pgm = do
let
parseCompilerInfo _stdo stde _exitc
| any ("gcc version" `isInfixOf`) stde =
return GCC
| any ("clang version" `isInfixOf`) stde =
return Clang
| any ("FreeBSD clang version" `isInfixOf`) stde =
return Clang
| any ("Apple LLVM version 5.1" `isPrefixOf`) stde =
return AppleClang51
| any ("Apple LLVM version" `isPrefixOf`) stde =
return AppleClang
| any ("Apple clang version" `isPrefixOf`) stde =
return AppleClang
| otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde
catchIO (do
(exitc, stdo, stde) <-
readProcessEnvWithExitCode pgm ["-v"] c_locale_env
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
)