{-# 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.

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.

-}

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 <- 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 a. a -> IO a
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
      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 a. a -> IO a
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       = (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 (f :: * -> *) a. Foldable f => f 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 :: [String] -> [String] -> ExitCode -> IO LinkerInfo
parseLinkerInfo [String]
stdo [String]
_stde ExitCode
_exitc
        | (String -> Bool) -> [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`) [String]
stdo =
          -- Set DT_NEEDED for all shared libraries. #10110.
          LinkerInfo -> IO LinkerInfo
forall a. a -> IO a
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 [-- ELF specific flag
                                      -- see Note [ELF needed shared libs]
                                      String
"-Wl,--no-as-needed"])

        | (String -> Bool) -> [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`) [String]
stdo =
          -- GNU gold only needs --no-as-needed. #10110.
          -- ELF specific flag, see Note [ELF needed shared libs]
          LinkerInfo -> IO LinkerInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
GnuGold [String -> Option
Option String
"-Wl,--no-as-needed"])

        | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
line -> String
"LLD" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
line Bool -> Bool -> Bool
|| String
"LLD" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String -> [String]
words String
line) [String]
stdo =
          LinkerInfo -> IO LinkerInfo
forall a. a -> IO a
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" | OS -> Bool
osElfTarget OS
os Bool -> Bool -> Bool
|| OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32 ])

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

  -- Process the executable call
  IO LinkerInfo -> (IOException -> IO LinkerInfo) -> IO LinkerInfo
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.
        LinkerInfo -> IO LinkerInfo
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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
          [ -- Emit stack checks
            -- See Note [Windows stack allocations]
           String
"-fstack-check"
          ]
      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
parseLinkerInfo (String -> [String]
lines String
stdo) (String -> [String]
lines String
stde) ExitCode
exitc
    )
    (\IOException
err -> do
        Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
2
            (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Error (figuring out linker information):" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
             String -> SDoc
forall doc. IsLine doc => String -> doc
text (IOException -> String
forall a. Show a => a -> String
show IOException
err))
        Logger -> SDoc -> IO ()
errorMsg Logger
logger (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Warning:") Int
9 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't figure out linker information!" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Make sure you're using GNU ld, GNU gold" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or the built in OS X linker, etc."
        LinkerInfo -> IO LinkerInfo
forall a. a -> IO a
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 <- 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
v
    Maybe CompilerInfo
Nothing -> do
      let pgm :: String
pgm = DynFlags -> String
pgm_c DynFlags
dflags
      CompilerInfo
v <- Logger -> String -> IO CompilerInfo
getCompilerInfo' Logger
logger String
pgm
      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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
v

-- | Grab assembler info and cache it in DynFlags.
getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo
getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo
getAssemblerInfo Logger
logger DynFlags
dflags = do
  Maybe CompilerInfo
info <- IORef (Maybe CompilerInfo) -> IO (Maybe CompilerInfo)
forall a. IORef a -> IO a
readIORef (DynFlags -> IORef (Maybe CompilerInfo)
rtasmInfo DynFlags
dflags)
  case Maybe CompilerInfo
info of
    Just CompilerInfo
v  -> CompilerInfo -> IO CompilerInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
v
    Maybe CompilerInfo
Nothing -> do
      let (String
pgm, [Option]
_) = DynFlags -> (String, [Option])
pgm_a DynFlags
dflags
      CompilerInfo
v <- Logger -> String -> IO CompilerInfo
getCompilerInfo' Logger
logger String
pgm
      IORef (Maybe CompilerInfo) -> Maybe CompilerInfo -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (DynFlags -> IORef (Maybe CompilerInfo)
rtasmInfo DynFlags
dflags) (CompilerInfo -> Maybe CompilerInfo
forall a. a -> Maybe a
Just CompilerInfo
v)
      CompilerInfo -> IO CompilerInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
v

-- See Note [Run-time linker info].
getCompilerInfo' :: Logger -> String -> IO CompilerInfo
getCompilerInfo' :: Logger -> String -> IO CompilerInfo
getCompilerInfo' Logger
logger String
pgm = do
  let -- Try to grab the info from the process output.
      parseCompilerInfo :: [String] -> [String] -> ExitCode -> IO CompilerInfo
parseCompilerInfo [String]
_stdo [String]
stde ExitCode
_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 -> IO CompilerInfo
forall a. a -> IO a
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 -> IO CompilerInfo
forall a. a -> IO a
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 -> IO CompilerInfo
forall a. a -> IO a
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 -> IO CompilerInfo
forall a. a -> IO a
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 -> IO CompilerInfo
forall a. a -> IO a
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 -> IO CompilerInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang
         -- Unknown compiler.
        | Bool
otherwise = String -> IO CompilerInfo
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO CompilerInfo) -> String -> IO 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
pgm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
stde

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