{-# 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 Data.List
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. For example, GNU ld requires '--reduce-memory-overheads' and
'--hash-size=31' in order to use reasonable amounts of memory (see
trac #5240.) But this isn't supported in GNU gold.

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.

-}

{- Note [Windows static libGCC]

The GCC versions being upgraded to in #10726 are configured with
dynamic linking of libgcc supported. This results in libgcc being
linked dynamically when a shared library is created.

This introduces thus an extra dependency on GCC dll that was not
needed before by shared libraries created with GHC. This is a particular
issue on Windows because you get a non-obvious error due to this missing
dependency. This dependent dll is also not commonly on your path.

For this reason using the static libgcc is preferred as it preserves
the same behaviour that existed before. There are however some very good
reasons to have the shared version as well as described on page 181 of
https://gcc.gnu.org/onlinedocs/gcc-5.2.0/gcc.pdf :

"There are several situations in which an application should use the
 shared ‘libgcc’ instead of the static version. The most common of these
 is when the application wishes to throw and catch exceptions across different
 shared libraries. In that case, each of the libraries as well as the application
 itself should use the shared ‘libgcc’. "

-}

neededLinkArgs :: LinkerInfo -> [Option]
neededLinkArgs :: LinkerInfo -> [Option]
neededLinkArgs (GnuLD [Option]
o)     = [Option]
o
neededLinkArgs (GnuGold [Option]
o)   = [Option]
o
neededLinkArgs (LlvmLLD [Option]
o)   = [Option]
o
neededLinkArgs (DarwinLD [Option]
o)  = [Option]
o
neededLinkArgs (SolarisLD [Option]
o) = [Option]
o
neededLinkArgs (AixLD [Option]
o)     = [Option]
o
neededLinkArgs LinkerInfo
UnknownLD     = []

-- Grab linker info and cache it in DynFlags.
getLinkerInfo :: DynFlags -> IO LinkerInfo
getLinkerInfo :: DynFlags -> IO LinkerInfo
getLinkerInfo DynFlags
dflags = do
  Maybe LinkerInfo
info <- IORef (Maybe LinkerInfo) -> IO (Maybe LinkerInfo)
forall a. IORef a -> IO a
readIORef (DynFlags -> IORef (Maybe LinkerInfo)
rtldInfo DynFlags
dflags)
  case Maybe LinkerInfo
info of
    Just LinkerInfo
v  -> LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
v
    Maybe LinkerInfo
Nothing -> do
      LinkerInfo
v <- DynFlags -> IO LinkerInfo
getLinkerInfo' DynFlags
dflags
      IORef (Maybe LinkerInfo) -> Maybe LinkerInfo -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (DynFlags -> IORef (Maybe LinkerInfo)
rtldInfo DynFlags
dflags) (LinkerInfo -> Maybe LinkerInfo
forall a. a -> Maybe a
Just LinkerInfo
v)
      LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
v

-- See Note [Run-time linker info].
getLinkerInfo' :: DynFlags -> IO LinkerInfo
getLinkerInfo' :: DynFlags -> IO LinkerInfo
getLinkerInfo' DynFlags
dflags = do
  let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
      os :: OS
os = Platform -> OS
platformOS Platform
platform
      (String
pgm,[Option]
args0) = DynFlags -> (String, [Option])
pgm_l DynFlags
dflags
      args1 :: [Option]
args1     = (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (DynFlags -> (DynFlags -> [String]) -> [String]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [String]
opt_l)
      args2 :: [Option]
args2     = [Option]
args0 [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args1
      args3 :: [String]
args3     = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
forall a. [a] -> Bool
notNull ((Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
showOpt [Option]
args2)

      -- Try to grab the info from the process output.
      parseLinkerInfo :: t String -> p -> p -> m LinkerInfo
parseLinkerInfo t String
stdo p
_stde p
_exitc
        | (String -> Bool) -> t String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"GNU ld" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) t String
stdo =
          -- GNU ld specifically needs to use less memory. This especially
          -- hurts on small object files. #5240.
          -- Set DT_NEEDED for all shared libraries. #10110.
          -- TODO: Investigate if these help or hurt when using split sections.
          LinkerInfo -> m LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
GnuLD ([Option] -> LinkerInfo) -> [Option] -> LinkerInfo
forall a b. (a -> b) -> a -> b
$ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String
"-Wl,--hash-size=31",
                                      String
"-Wl,--reduce-memory-overheads",
                                      -- ELF specific flag
                                      -- see Note [ELF needed shared libs]
                                      String
"-Wl,--no-as-needed"])

        | (String -> Bool) -> t String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"GNU gold" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) t String
stdo =
          -- GNU gold only needs --no-as-needed. #10110.
          -- ELF specific flag, see Note [ELF needed shared libs]
          LinkerInfo -> m LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
GnuGold [String -> Option
Option String
"-Wl,--no-as-needed"])

        | (String -> Bool) -> t String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"LLD" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) t String
stdo =
          LinkerInfo -> m LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
LlvmLLD ([Option] -> LinkerInfo) -> [Option] -> LinkerInfo
forall a b. (a -> b) -> a -> b
$ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [
                                      -- see Note [ELF needed shared libs]
                                      String
"-Wl,--no-as-needed"])

         -- Unknown linker.
        | Bool
otherwise = String -> m LinkerInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid --version output, or linker is unsupported"

  -- Process the executable call
  LinkerInfo
info <- IO LinkerInfo -> (IOException -> IO LinkerInfo) -> IO LinkerInfo
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (do
             case OS
os of
               OS
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.
                 LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
SolarisLD []
               OS
OSAIX ->
                 -- IBM AIX uses its own non-binutils linker as well
                 LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
AixLD []
               OS
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.
                 LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
DarwinLD []
               OS
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.
                 LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
GnuLD ([Option] -> LinkerInfo) -> [Option] -> LinkerInfo
forall a b. (a -> b) -> a -> b
$ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option
                   [ -- Reduce ld memory usage
                     String
"-Wl,--hash-size=31"
                   , String
"-Wl,--reduce-memory-overheads"
                     -- Emit gcc stack checks
                     -- Note [Windows stack usage]
                   , String
"-fstack-check"
                     -- Force static linking of libGCC
                     -- Note [Windows static libGCC]
                   , String
"-static-libgcc" ]
               OS
_ -> do
                 -- In practice, we use the compiler as the linker here. Pass
                 -- -Wl,--version to get linker version info.
                 (ExitCode
exitc, String
stdo, String
stde) <- String
-> [String] -> (String, String) -> IO (ExitCode, String, String)
readProcessEnvWithExitCode String
pgm
                                        ([String
"-Wl,--version"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args3)
                                        (String, String)
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.
                 [String] -> [String] -> ExitCode -> IO LinkerInfo
forall {t :: * -> *} {m :: * -> *} {p} {p}.
(Foldable t, MonadFail m) =>
t String -> p -> p -> m LinkerInfo
parseLinkerInfo (String -> [String]
lines String
stdo) (String -> [String]
lines String
stde) ExitCode
exitc
            )
            (\IOException
err -> do
                DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2
                    (String -> MsgDoc
text String
"Error (figuring out linker information):" MsgDoc -> MsgDoc -> MsgDoc
<+>
                     String -> MsgDoc
text (IOException -> String
forall a. Show a => a -> String
show IOException
err))
                DynFlags -> MsgDoc -> IO ()
errorMsg DynFlags
dflags (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Warning:") Int
9 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$
                  String -> MsgDoc
text String
"Couldn't figure out linker information!" MsgDoc -> MsgDoc -> MsgDoc
$$
                  String -> MsgDoc
text String
"Make sure you're using GNU ld, GNU gold" MsgDoc -> MsgDoc -> MsgDoc
<+>
                  String -> MsgDoc
text String
"or the built in OS X linker, etc."
                LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
UnknownLD)
  LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
info

-- Grab compiler info and cache it in DynFlags.
getCompilerInfo :: DynFlags -> IO CompilerInfo
getCompilerInfo :: DynFlags -> IO CompilerInfo
getCompilerInfo DynFlags
dflags = do
  Maybe CompilerInfo
info <- IORef (Maybe CompilerInfo) -> IO (Maybe CompilerInfo)
forall a. IORef a -> IO a
readIORef (DynFlags -> IORef (Maybe CompilerInfo)
rtccInfo DynFlags
dflags)
  case Maybe CompilerInfo
info of
    Just CompilerInfo
v  -> CompilerInfo -> IO CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
v
    Maybe CompilerInfo
Nothing -> do
      CompilerInfo
v <- DynFlags -> IO CompilerInfo
getCompilerInfo' DynFlags
dflags
      IORef (Maybe CompilerInfo) -> Maybe CompilerInfo -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (DynFlags -> IORef (Maybe CompilerInfo)
rtccInfo DynFlags
dflags) (CompilerInfo -> Maybe CompilerInfo
forall a. a -> Maybe a
Just CompilerInfo
v)
      CompilerInfo -> IO CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
v

-- See Note [Run-time linker info].
getCompilerInfo' :: DynFlags -> IO CompilerInfo
getCompilerInfo' :: DynFlags -> IO CompilerInfo
getCompilerInfo' DynFlags
dflags = do
  let pgm :: String
pgm = DynFlags -> String
pgm_c DynFlags
dflags
      -- Try to grab the info from the process output.
      parseCompilerInfo :: p -> [String] -> p -> m CompilerInfo
parseCompilerInfo p
_stdo [String]
stde p
_exitc
        -- Regular GCC
        | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"gcc version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
          CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
GCC
        -- Regular clang
        | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"clang version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
          CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
Clang
        -- FreeBSD clang
        | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"FreeBSD clang version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
          CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
Clang
        -- Xcode 5.1 clang
        | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple LLVM version 5.1" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
          CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang51
        -- Xcode 5 clang
        | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple LLVM version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
          CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang
        -- Xcode 4.1 clang
        | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple clang version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
          CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang
         -- Unknown linker.
        | Bool
otherwise = String -> m CompilerInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m CompilerInfo) -> String -> m CompilerInfo
forall a b. (a -> b) -> a -> b
$ String
"invalid -v output, or compiler is unsupported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
stde

  -- Process the executable call
  CompilerInfo
info <- IO CompilerInfo
-> (IOException -> IO CompilerInfo) -> IO CompilerInfo
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (do
                (ExitCode
exitc, String
stdo, String
stde) <-
                    String
-> [String] -> (String, String) -> IO (ExitCode, String, String)
readProcessEnvWithExitCode String
pgm [String
"-v"] (String, String)
c_locale_env
                -- Split the output by lines to make certain kinds
                -- of processing easier.
                [String] -> [String] -> ExitCode -> IO CompilerInfo
forall {m :: * -> *} {p} {p}.
MonadFail m =>
p -> [String] -> p -> m CompilerInfo
parseCompilerInfo (String -> [String]
lines String
stdo) (String -> [String]
lines String
stde) ExitCode
exitc
            )
            (\IOException
err -> do
                DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2
                    (String -> MsgDoc
text String
"Error (figuring out C compiler information):" MsgDoc -> MsgDoc -> MsgDoc
<+>
                     String -> MsgDoc
text (IOException -> String
forall a. Show a => a -> String
show IOException
err))
                DynFlags -> MsgDoc -> IO ()
errorMsg DynFlags
dflags (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Warning:") Int
9 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$
                  String -> MsgDoc
text String
"Couldn't figure out C compiler information!" MsgDoc -> MsgDoc -> MsgDoc
$$
                  String -> MsgDoc
text String
"Make sure you're using GNU gcc, or clang"
                CompilerInfo -> IO CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
UnknownCC)
  CompilerInfo -> IO CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
info