{-# 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 GHC.Utils.Logger

import Data.List ( isInfixOf, isPrefixOf )
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 :: Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo Logger
logger DynFlags
dflags = do
  Maybe LinkerInfo
info <- forall a. IORef a -> IO a
readIORef (DynFlags -> IORef (Maybe LinkerInfo)
rtldInfo DynFlags
dflags)
  case Maybe LinkerInfo
info of
    Just LinkerInfo
v  -> forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
v
    Maybe LinkerInfo
Nothing -> do
      LinkerInfo
v <- Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo' Logger
logger DynFlags
dflags
      forall a. IORef a -> a -> IO ()
writeIORef (DynFlags -> IORef (Maybe LinkerInfo)
rtldInfo DynFlags
dflags) (forall a. a -> Maybe a
Just LinkerInfo
v)
      forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
v

-- See Note [Run-time linker info].
getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo' Logger
logger 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       = forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [String]
opt_l)
      args2 :: [Option]
args2       = [Option]
args0 forall a. [a] -> [a] -> [a]
++ [Option]
args1
      args3 :: [String]
args3       = forall a. (a -> Bool) -> [a] -> [a]
filter forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull (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
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"GNU ld" 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.
          forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
GnuLD forall a b. (a -> b) -> a -> b
$ 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"])

        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"GNU gold" 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]
          forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
GnuGold [String -> Option
Option String
"-Wl,--no-as-needed"])

        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
line -> String
"LLD" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
line Bool -> Bool -> Bool
|| String
"LLD" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String -> [String]
words String
line) t String
stdo =
          forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
LlvmLLD forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid --version output, or linker is unsupported"

  -- Process the executable call
  forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (
    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.
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
SolarisLD []
      OS
OSAIX ->
        -- IBM AIX uses its own non-binutils linker as well
        forall (m :: * -> *) a. Monad m => a -> m a
return 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.
        forall (m :: * -> *) a. Monad m => a -> m a
return 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.
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
GnuLD forall a b. (a -> b) -> a -> b
$ 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"] 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.
        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
        Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
2
            (String -> SDoc
text String
"Error (figuring out linker information):" SDoc -> SDoc -> SDoc
<+>
             String -> SDoc
text (forall a. Show a => a -> String
show IOException
err))
        Logger -> DynFlags -> SDoc -> IO ()
errorMsg Logger
logger DynFlags
dflags forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Warning:") Int
9 forall a b. (a -> b) -> a -> b
$
          String -> SDoc
text String
"Couldn't figure out linker information!" SDoc -> SDoc -> SDoc
$$
          String -> SDoc
text String
"Make sure you're using GNU ld, GNU gold" SDoc -> SDoc -> SDoc
<+>
          String -> SDoc
text String
"or the built in OS X linker, etc."
        forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
UnknownLD
    )

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

-- See Note [Run-time linker info].
getCompilerInfo' :: Logger -> DynFlags -> IO CompilerInfo
getCompilerInfo' :: Logger -> DynFlags -> IO CompilerInfo
getCompilerInfo' Logger
logger 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
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"gcc version" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
          forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
GCC
        -- Regular clang
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"clang version" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
          forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
Clang
        -- FreeBSD clang
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"FreeBSD clang version" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
          forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
Clang
        -- Xcode 5.1 clang
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple LLVM version 5.1" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
          forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang51
        -- Xcode 5 clang
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple LLVM version" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
          forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang
        -- Xcode 4.1 clang
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple clang version" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
          forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang
         -- Unknown linker.
        | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid -v output, or compiler is unsupported: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
stde

  -- Process the executable call
  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.
      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
          Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
2
              (String -> SDoc
text String
"Error (figuring out C compiler information):" SDoc -> SDoc -> SDoc
<+>
               String -> SDoc
text (forall a. Show a => a -> String
show IOException
err))
          Logger -> DynFlags -> SDoc -> IO ()
errorMsg Logger
logger DynFlags
dflags forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Warning:") Int
9 forall a b. (a -> b) -> a -> b
$
            String -> SDoc
text String
"Couldn't figure out C compiler information!" SDoc -> SDoc -> SDoc
$$
            String -> SDoc
text String
"Make sure you're using GNU gcc, or clang"
          forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
UnknownCC
      )