{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

module GHC.Toolchain.Tools.Link ( CcLink(..), findCcLink ) where

import Control.Monad (when)
import Data.List (isInfixOf)
import System.FilePath

import GHC.Platform.ArchOS

import GHC.Toolchain.Prelude
import GHC.Toolchain.Utils
import GHC.Toolchain.Program
import GHC.Toolchain.Tools.Cc
import GHC.Toolchain.Tools.Readelf

-- | Configuration on how the C compiler can be used to link
data CcLink = CcLink { CcLink -> Program
ccLinkProgram :: Program
                     , CcLink -> Bool
ccLinkSupportsNoPie :: Bool -- See Note [No PIE when linking] in GHC.Driver.Session
                     , CcLink -> Bool
ccLinkSupportsCompactUnwind :: Bool
                     , CcLink -> Bool
ccLinkSupportsFilelist :: Bool
                     , CcLink -> Bool
ccLinkSupportsSingleModule :: Bool
                     , CcLink -> Bool
ccLinkIsGnu :: Bool
                     }
    deriving (ReadPrec [CcLink]
ReadPrec CcLink
Int -> ReadS CcLink
ReadS [CcLink]
(Int -> ReadS CcLink)
-> ReadS [CcLink]
-> ReadPrec CcLink
-> ReadPrec [CcLink]
-> Read CcLink
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CcLink
readsPrec :: Int -> ReadS CcLink
$creadList :: ReadS [CcLink]
readList :: ReadS [CcLink]
$creadPrec :: ReadPrec CcLink
readPrec :: ReadPrec CcLink
$creadListPrec :: ReadPrec [CcLink]
readListPrec :: ReadPrec [CcLink]
Read, CcLink -> CcLink -> Bool
(CcLink -> CcLink -> Bool)
-> (CcLink -> CcLink -> Bool) -> Eq CcLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CcLink -> CcLink -> Bool
== :: CcLink -> CcLink -> Bool
$c/= :: CcLink -> CcLink -> Bool
/= :: CcLink -> CcLink -> Bool
Eq, Eq CcLink
Eq CcLink =>
(CcLink -> CcLink -> Ordering)
-> (CcLink -> CcLink -> Bool)
-> (CcLink -> CcLink -> Bool)
-> (CcLink -> CcLink -> Bool)
-> (CcLink -> CcLink -> Bool)
-> (CcLink -> CcLink -> CcLink)
-> (CcLink -> CcLink -> CcLink)
-> Ord CcLink
CcLink -> CcLink -> Bool
CcLink -> CcLink -> Ordering
CcLink -> CcLink -> CcLink
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CcLink -> CcLink -> Ordering
compare :: CcLink -> CcLink -> Ordering
$c< :: CcLink -> CcLink -> Bool
< :: CcLink -> CcLink -> Bool
$c<= :: CcLink -> CcLink -> Bool
<= :: CcLink -> CcLink -> Bool
$c> :: CcLink -> CcLink -> Bool
> :: CcLink -> CcLink -> Bool
$c>= :: CcLink -> CcLink -> Bool
>= :: CcLink -> CcLink -> Bool
$cmax :: CcLink -> CcLink -> CcLink
max :: CcLink -> CcLink -> CcLink
$cmin :: CcLink -> CcLink -> CcLink
min :: CcLink -> CcLink -> CcLink
Ord)

-- These instances are more suitable for diffing
instance Show CcLink where
  show :: CcLink -> String
show CcLink{Bool
Program
ccLinkProgram :: CcLink -> Program
ccLinkSupportsNoPie :: CcLink -> Bool
ccLinkSupportsCompactUnwind :: CcLink -> Bool
ccLinkSupportsFilelist :: CcLink -> Bool
ccLinkSupportsSingleModule :: CcLink -> Bool
ccLinkIsGnu :: CcLink -> Bool
ccLinkProgram :: Program
ccLinkSupportsNoPie :: Bool
ccLinkSupportsCompactUnwind :: Bool
ccLinkSupportsFilelist :: Bool
ccLinkSupportsSingleModule :: Bool
ccLinkIsGnu :: Bool
..} = [String] -> String
unlines
    [ String
"CcLink"
    , String
"{ ccLinkProgram = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Program -> String
forall a. Show a => a -> String
show Program
ccLinkProgram
    , String
", ccLinkSupportsNoPie = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
ccLinkSupportsNoPie
    , String
", ccLinkSupportsCompactUnwind = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
ccLinkSupportsCompactUnwind
    , String
", ccLinkSupportsFilelist = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
ccLinkSupportsFilelist
    , String
", ccLinkSupportsSingleModule = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
ccLinkSupportsSingleModule
    , String
", ccLinkIsGnu = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
ccLinkIsGnu
    , String
"}"
    ]

_ccLinkProgram :: Lens CcLink Program
_ccLinkProgram :: Lens CcLink Program
_ccLinkProgram = (CcLink -> Program)
-> (Program -> CcLink -> CcLink) -> Lens CcLink Program
forall a b. (a -> b) -> (b -> a -> a) -> Lens a b
Lens CcLink -> Program
ccLinkProgram (\Program
x CcLink
o -> CcLink
o{ccLinkProgram=x})

findCcLink :: String -- ^ The llvm target to use if CcLink supports --target
           -> ProgOpt
           -> ProgOpt
           -> Bool   -- ^ Whether we should search for a more efficient linker
           -> ArchOS -> Cc -> Maybe Readelf -> M CcLink
findCcLink :: String
-> ProgOpt
-> ProgOpt
-> Bool
-> ArchOS
-> Cc
-> Maybe Readelf
-> M CcLink
findCcLink String
target ProgOpt
ld ProgOpt
progOpt Bool
ldOverride ArchOS
archOs Cc
cc Maybe Readelf
readelf = String -> M CcLink -> M CcLink
forall a. Show a => String -> M a -> M a
checking String
"for C compiler for linking command" (M CcLink -> M CcLink) -> M CcLink -> M CcLink
forall a b. (a -> b) -> a -> b
$ do
  -- Use the specified linker or try using the C compiler
  rawCcLink <- String -> ProgOpt -> [String] -> M Program
findProgram String
"C compiler for linking" ProgOpt
progOpt [] M Program -> M Program -> M Program
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Program -> M Program
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgOpt -> String -> [String] -> Program
programFromOpt ProgOpt
progOpt (Program -> String
prgPath (Program -> String) -> Program -> String
forall a b. (a -> b) -> a -> b
$ Cc -> Program
ccProgram Cc
cc) [])
  -- See #23857 for why we check to see if LD is set here
  -- TLDR: If the user explicitly sets LD then in ./configure
  -- we don't perform a linker search (and set -fuse-ld), so
  -- we do the same here for consistency.
  ccLinkProgram <- case (poPath ld, poFlags progOpt) of
                     (Maybe String
_, Just [String]
_) ->
                         -- If the user specified linker flags don't second-guess them
                         Program -> M Program
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program
rawCcLink
                     (Just {}, Maybe [String]
_) ->
                         Program -> M Program
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program
rawCcLink
                     (Maybe String, Maybe [String])
_ -> do
                         -- If not then try to find decent linker flags
                         Bool -> Cc -> Program -> M Program
findLinkFlags Bool
ldOverride Cc
cc Program
rawCcLink M Program -> M Program -> M Program
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Program -> M Program
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program
rawCcLink
  ccLinkProgram <- linkSupportsTarget archOs cc target ccLinkProgram
  ccLinkSupportsNoPie         <- checkSupportsNoPie  cc ccLinkProgram
  ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind archOs cc ccLinkProgram
  ccLinkSupportsFilelist      <- checkSupportsFilelist cc ccLinkProgram
  ccLinkSupportsSingleModule  <- checkSupportsSingleModule archOs cc ccLinkProgram
  ccLinkIsGnu                 <- checkLinkIsGnu archOs ccLinkProgram
  checkBfdCopyBug archOs cc readelf ccLinkProgram
  ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram
  let ccLink = CcLink {Program
ccLinkProgram :: Program
ccLinkProgram :: Program
ccLinkProgram, Bool
ccLinkSupportsNoPie :: Bool
ccLinkSupportsNoPie :: Bool
ccLinkSupportsNoPie,
                       Bool
ccLinkSupportsCompactUnwind :: Bool
ccLinkSupportsCompactUnwind :: Bool
ccLinkSupportsCompactUnwind, Bool
ccLinkSupportsFilelist :: Bool
ccLinkSupportsFilelist :: Bool
ccLinkSupportsFilelist,
                       Bool
ccLinkSupportsSingleModule :: Bool
ccLinkSupportsSingleModule :: Bool
ccLinkSupportsSingleModule, Bool
ccLinkIsGnu :: Bool
ccLinkIsGnu :: Bool
ccLinkIsGnu}
  ccLink <- linkRequiresNoFixupChains archOs cc ccLink
  ccLink <- linkRequiresNoWarnDuplicateLibraries archOs cc ccLink
  return ccLink


-- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@
findLinkFlags :: Bool -> Cc -> Program -> M Program
findLinkFlags :: Bool -> Cc -> Program -> M Program
findLinkFlags Bool
enableOverride Cc
cc Program
ccLink
  | Bool
enableOverride Bool -> Bool -> Bool
&& Bool
doLinkerSearch =
    String -> [M Program] -> M Program
forall b. String -> [M b] -> M b
oneOf String
"this can't happen"
        [ -- Annoyingly, gcc silently falls back to vanilla ld (typically bfd
          -- ld) if @-fuse-ld@ is given with a non-existent linker.
          -- Consequently, we must first check that the desired ld
          -- executable exists before trying cc.
          do _ <- String -> ProgOpt -> [String] -> M Program
findProgram (String
linker String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" linker") ProgOpt
emptyProgOpt [String
"ld."String -> ShowS
forall a. [a] -> [a] -> [a]
++String
linker]
             prog <$ checkLinkWorks cc prog
        | String
linker <- [String
"lld", String
"gold", String
"bfd"]
        , let prog :: Program
prog = Lens Program [String]
-> ([String] -> [String]) -> Program -> Program
forall a b. Lens a b -> (b -> b) -> a -> a
over Lens Program [String]
_prgFlags ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
"-fuse-ld="String -> ShowS
forall a. [a] -> [a] -> [a]
++String
linker]) Program
ccLink
        ]
        M Program -> M Program -> M Program
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Program
ccLink Program -> M () -> M Program
forall a b. a -> M b -> M a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Cc -> Program -> M ()
checkLinkWorks Cc
cc Program
ccLink)
  | Bool
otherwise =
    Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Program
ccLink

linkSupportsTarget :: ArchOS -> Cc -> String -> Program -> M Program
-- Javascript toolchain provided by emsdk just ignores --target flag so
-- we have this special case to match with ./configure (#23744)
linkSupportsTarget :: ArchOS -> Cc -> String -> Program -> M Program
linkSupportsTarget ArchOS
archOs Cc
cc String
target Program
link =
    String -> M Program -> M Program
forall a. Show a => String -> M a -> M a
checking String
"whether cc linker supports --target" (M Program -> M Program) -> M Program -> M Program
forall a b. (a -> b) -> a -> b
$
    ArchOS
-> Lens Program Program
-> (Program -> M ())
-> String
-> Program
-> M Program
forall compiler.
ArchOS
-> Lens compiler Program
-> (compiler -> M ())
-> String
-> compiler
-> M compiler
supportsTarget ArchOS
archOs ((Program -> Program)
-> (Program -> Program -> Program) -> Lens Program Program
forall a b. (a -> b) -> (b -> a -> a) -> Lens a b
Lens Program -> Program
forall a. a -> a
id Program -> Program -> Program
forall a b. a -> b -> a
const) (Cc -> Program -> M ()
checkLinkWorks Cc
cc) String
target Program
link

-- | Should we attempt to find a more efficient linker on this platform?
--
-- N.B. On Darwin it is quite important that we use the system linker
-- unchanged as it is very easy to run into broken setups (e.g. unholy mixtures
-- of Homebrew and the Apple toolchain).
--
-- See #21712.
doLinkerSearch :: Bool
#if defined(linux_HOST_OS)
doLinkerSearch :: Bool
doLinkerSearch = Bool
True
#else
doLinkerSearch = False
#endif

-- | See Note [No PIE when linking] in GHC.Driver.Session
checkSupportsNoPie :: Cc -> Program -> M Bool
checkSupportsNoPie :: Cc -> Program -> M Bool
checkSupportsNoPie Cc
cc Program
ccLink = String -> M Bool -> M Bool
forall a. Show a => String -> M a -> M a
checking String
"whether the cc linker supports -no-pie" (M Bool -> M Bool) -> M Bool -> M Bool
forall a b. (a -> b) -> a -> b
$
  (String -> M Bool) -> M Bool
forall a. (String -> M a) -> M a
withTempDir ((String -> M Bool) -> M Bool) -> (String -> M Bool) -> M Bool
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    let test_o :: String
test_o  = String
dir String -> ShowS
</> String
"test.o"
    let test :: String
test = String
dir String -> ShowS
</> String
"test"
    Cc -> String -> String -> M ()
compileC Cc
cc String
test_o String
"int main() { return 0; }"
    -- Check output as some GCC versions only warn and don't respect -Werror
    -- when passed an unrecognized flag.
    (code, out, err) <- Program -> [String] -> M (ExitCode, String, String)
readProgram Program
ccLink [String
"-no-pie", String
"-Werror", String
test_o, String
"-o", String
test]
    return (isSuccess code && not ("unrecognized" `isInfixOf` out) && not ("unrecognized" `isInfixOf` err))

-- ROMES:TODO: This check is wrong here and in configure because with ld.gold parses "-n" "o_compact_unwind"
-- TODO:
-- * Check if compiling for darwin
-- * Then do the check
-- * Otherwise say its just not supported
checkSupportsCompactUnwind :: ArchOS -> Cc -> Program -> M Bool
checkSupportsCompactUnwind :: ArchOS -> Cc -> Program -> M Bool
checkSupportsCompactUnwind ArchOS
archOs Cc
cc Program
ccLink
  | OS
OSDarwin <- ArchOS -> OS
archOS_OS ArchOS
archOs = String -> M Bool -> M Bool
forall a. Show a => String -> M a -> M a
checking String
"whether the cc linker understands -no_compact_unwind" (M Bool -> M Bool) -> M Bool -> M Bool
forall a b. (a -> b) -> a -> b
$
      (String -> M Bool) -> M Bool
forall a. (String -> M a) -> M a
withTempDir ((String -> M Bool) -> M Bool) -> (String -> M Bool) -> M Bool
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
        let test_o :: String
test_o  = String
dir String -> ShowS
</> String
"test.o"
            test2_o :: String
test2_o = String
dir String -> ShowS
</> String
"test2.o"

        Cc -> String -> String -> M ()
compileC Cc
cc String
test_o String
"int foo() { return 0; }"

        exitCode <- Program -> [String] -> M ExitCode
runProgram Program
ccLink [String
"-r", String
"-Wl,-no_compact_unwind", String
"-o", String
test2_o, String
test_o]
        return $ isSuccess exitCode
  | Bool
otherwise = Bool -> M Bool
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

checkSupportsFilelist :: Cc -> Program -> M Bool
checkSupportsFilelist :: Cc -> Program -> M Bool
checkSupportsFilelist Cc
cc Program
ccLink = String -> M Bool -> M Bool
forall a. Show a => String -> M a -> M a
checking String
"whether the cc linker understands -filelist" (M Bool -> M Bool) -> M Bool -> M Bool
forall a b. (a -> b) -> a -> b
$
  (String -> M Bool) -> M Bool
forall a. (String -> M a) -> M a
withTempDir ((String -> M Bool) -> M Bool) -> (String -> M Bool) -> M Bool
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    let test_o :: String
test_o   = String
dir String -> ShowS
</> String
"test.o"
        test1_o :: String
test1_o  = String
dir String -> ShowS
</> String
"test1.o"
        test2_o :: String
test2_o  = String
dir String -> ShowS
</> String
"test2.o"
        test_ofiles :: String
test_ofiles = String
dir String -> ShowS
</> String
"test.o-files"

    Cc -> String -> String -> M ()
compileC Cc
cc String
test1_o String
"int foo() { return 0; }"
    Cc -> String -> String -> M ()
compileC Cc
cc String
test2_o String
"int bar() { return 0; }"

    --  write the filenames test1_o and test2_o to the test_ofiles file
    String -> String -> M ()
writeFile  String
test_ofiles ([String] -> String
unlines [String
test1_o,String
test2_o])

    exitCode <- Program -> [String] -> M ExitCode
runProgram Program
ccLink [String
"-r", String
"-Wl,-filelist", String
test_ofiles, String
"-o", String
test_o]

    return (isSuccess exitCode)

-- | Check that the (darwin) linker supports @-single_module@.
--
-- In XCode 15, the linker warns when @-single_module@ is passed as the flag
-- became the default and is now obsolete to pass.
--
-- We assume non-darwin linkers don't support this flag.
checkSupportsSingleModule :: ArchOS -> Cc -> Program -> M Bool
checkSupportsSingleModule :: ArchOS -> Cc -> Program -> M Bool
checkSupportsSingleModule ArchOS
archOs Cc
cc Program
link
  | ArchOS Arch
_ OS
OSDarwin <- ArchOS
archOs
  = String -> M Bool -> M Bool
forall a. Show a => String -> M a -> M a
checking String
"whether the darwin linker supports -single_module" (M Bool -> M Bool) -> M Bool -> M Bool
forall a b. (a -> b) -> a -> b
$ do
      (String -> M Bool) -> M Bool
forall a. (String -> M a) -> M a
withTempDir ((String -> M Bool) -> M Bool) -> (String -> M Bool) -> M Bool
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
        let test_dylib :: String
test_dylib = String
dir String -> ShowS
</> String
"test.dylib"
            test_c :: String
test_c     = String
dir String -> ShowS
</> String
"test.c"
            testmain_o :: String
testmain_o = String
dir String -> ShowS
</> String
"testmain.o"
            testmain :: String
testmain   = String
dir String -> ShowS
</> String
"testmain"

        -- Main
        Cc -> String -> String -> M ()
compileC Cc
cc String
testmain_o String
"extern int foo(int); int main() { return foo(5); }"

        -- Dynamic library
        String -> String -> M ()
writeFile String
test_c String
"int foo(int x) { return x*x; }"
        _ <- Program -> [String] -> M ExitCode
runProgram (Cc -> Program
ccProgram Cc
cc) [String
"-shared", String
"-o", String
test_dylib, String
test_c]

        (_, out, err) <- readProgram link ["-Wl,-single_module", "-o", testmain, test_dylib, testmain_o]

        return $ not $ "obsolete" `isInfixOf` err || "obsolete" `isInfixOf` out
  | Bool
otherwise
  = Bool -> M Bool
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Check whether linking works.
checkLinkWorks :: Cc -> Program -> M ()
checkLinkWorks :: Cc -> Program -> M ()
checkLinkWorks Cc
cc Program
ccLink = (String -> M ()) -> M ()
forall a. (String -> M a) -> M a
withTempDir ((String -> M ()) -> M ()) -> (String -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    let test_o :: String
test_o = String
dir String -> ShowS
</> String
"test.o"
        main_o :: String
main_o = String
dir String -> ShowS
</> String
"main.o"
    Cc -> String -> String -> M ()
compileC Cc
cc String
test_o String
"int f(int a) { return 2*a; }"
    Cc -> String -> String -> M ()
compileC Cc
cc String
main_o String
"int f(int a); int main(int argc, char **argv) { return f(0); }"

    let out :: String
out = String
dir String -> ShowS
</> String
"test"
        err :: String
err = String
"linker didn't produce any output"
    Program -> [String] -> M ()
callProgram Program
ccLink [String
"-Werror", String
"-o", String
out, String
test_o, String
main_o]
    String -> String -> M ()
expectFileExists String
out String
err
      -- Linking in windows might produce an executable with an ".exe" extension
      M () -> M () -> M ()
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> M ()
expectFileExists (String
out String -> ShowS
<.> String
"exe") String
err

checkLinkIsGnu :: ArchOS -> Program -> M Bool
checkLinkIsGnu :: ArchOS -> Program -> M Bool
checkLinkIsGnu ArchOS
archOs Program
_
  -- emsdk is never going to provide gnu ld (See #23744)
  | Arch
ArchJavaScript <- ArchOS -> Arch
archOS_arch ArchOS
archOs = Bool -> M Bool
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
checkLinkIsGnu ArchOS
_ Program
ccLink = do
  out <- Program -> [String] -> M String
readProgramStdout Program
ccLink [String
"-Wl,--version"]
  return ("GNU" `isInfixOf` out)

-- | Check for binutils bug #16177 present in some versions of the bfd ld
-- implementation affecting ARM relocations.
-- https://sourceware.org/bugzilla/show_bug.cgi?id=16177
checkBfdCopyBug :: ArchOS -> Cc -> Maybe Readelf -> Program -> M ()
checkBfdCopyBug :: ArchOS -> Cc -> Maybe Readelf -> Program -> M ()
checkBfdCopyBug ArchOS
archOs Cc
cc Maybe Readelf
mb_readelf Program
ccLink
  | ArchARM{} <- ArchOS -> Arch
archOS_arch ArchOS
archOs =
    String -> M () -> M ()
forall a. Show a => String -> M a -> M a
checking String
"whether linker is affected by binutils #16177" (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ (String -> M ()) -> M ()
forall a. (String -> M a) -> M a
withTempDir ((String -> M ()) -> M ()) -> (String -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    readelf <- case Maybe Readelf
mb_readelf of
      Just Readelf
x -> Readelf -> M Readelf
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Readelf
x
      Maybe Readelf
Nothing -> String -> M Readelf
forall a. String -> M a
throwE String
"readelf needed to check for binutils #16177 but not found. Please set --readelf (and --readelf-opts as necessary)."

    let test_o = String
dir String -> ShowS
</> String
"test.o"
        lib_o = String
dir String -> ShowS
</> String
"lib.o"
        lib_so = String
dir String -> ShowS
</> String
"lib.so"
        main_o = String
dir String -> ShowS
</> String
"main.o"
        exe = String
dir String -> ShowS
</> String
"exe"

    compileAsm cc lib_o progLib
    callProgram ccLink ["-shared", lib_o, "-o", lib_so]

    compileC cc main_o progMain
    compileAsm cc test_o progTest

    callProgram ccLink ["-o", exe, test_o, main_o, lib_so]

    out <- readProgramStdout (readelfProgram readelf) ["-r", exe]
    when ("R_ARM_COPY" `isInfixOf` out) $
        throwE "Your linker is affected by binutils #16177. Please choose a different linker."

  | Bool
otherwise = () -> M ()
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  where
    progTest :: String
progTest = [String] -> String
unlines
        [ String
".data"
        , String
"  .globl data_object"
        , String
"object_reference:"
        , String
"  .long data_object"
        , String
"  .size object_reference, 4"
        ]

    progLib :: String
progLib = [String] -> String
unlines
        [ String
"  .data"
        , String
"  .globl data_object"
        , String
"  .type data_object, %object"
        , String
"  .size data_object, 4"
        , String
"data_object:"
        , String
"    .long 123"
        ]

    progMain :: String
progMain =
        String
"int main(int argc, char **argv) { return 0; }"

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

The flag is only needed on ELF systems. On Windows (PE) and Mac OS X
(Mach-O) the flag is not needed.
-}

-- | Add various platform-dependent flags needed for reliable linking.
addPlatformDepLinkFlags :: ArchOS -> Cc -> Program -> M Program
addPlatformDepLinkFlags :: ArchOS -> Cc -> Program -> M Program
addPlatformDepLinkFlags ArchOS
archOs Cc
cc Program
ccLink0 = do
  ccLink1 <- ArchOS -> Cc -> Program -> M Program
addNoAsNeeded ArchOS
archOs Cc
cc Program
ccLink0
  ccLink2 <- addOSMinGW32CcFlags archOs cc ccLink1
  -- As per FPTOOLS_SET_C_LD_FLAGS
  case archOs of
    -- ROMES:TODO: Consider dropping this alongside other configuration for solaris that was dropped
    ArchOS Arch
ArchX86_64 OS
OSSolaris2 ->
      -- Solaris is a multi-lib platform, providing both 32- and 64-bit
      -- user-land. It appears to default to 32-bit builds but we of course want to
      -- compile for 64-bits on x86-64.
      --
      -- On OpenSolaris uses gnu ld whereas SmartOS appears to use the Solaris
      -- implementation, which rather uses the -64 flag.
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> M Program) -> Program -> M Program
forall a b. (a -> b) -> a -> b
$ Program
ccLink2 Program -> (Program -> Program) -> Program
forall a b. a -> (a -> b) -> b
& Lens Program [String]
_prgFlags Lens Program [String] -> String -> Program -> Program
forall a b. Lens a [b] -> b -> a -> a
%++ String
"-m64"
    ArchOS Arch
ArchAlpha OS
_ ->
      -- For now, to suppress the gcc warning "call-clobbered
      -- register used for global register variable", we simply
      -- disable all warnings altogether using the -w flag. Oh well.
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> M Program) -> Program -> M Program
forall a b. (a -> b) -> a -> b
$ Program
ccLink2 Program -> (Program -> Program) -> Program
forall a b. a -> (a -> b) -> b
& Lens Program [String]
-> ([String] -> [String]) -> Program -> Program
forall a b. Lens a b -> (b -> b) -> a -> a
over Lens Program [String]
_prgFlags ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
"-w",String
"-mieee",String
"-D_REENTRANT"])
    -- ArchOS ArchHPPA? _ ->
    ArchOS ArchARM{} OS
OSFreeBSD ->
      -- On arm/freebsd, tell gcc to generate Arm
      -- instructions (ie not Thumb).
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> M Program) -> Program -> M Program
forall a b. (a -> b) -> a -> b
$ Program
ccLink2 Program -> (Program -> Program) -> Program
forall a b. a -> (a -> b) -> b
& Lens Program [String]
_prgFlags Lens Program [String] -> String -> Program -> Program
forall a b. Lens a [b] -> b -> a -> a
%++ String
"-Wl,-z,noexecstack"
    ArchOS ArchARM{} OS
OSLinux ->
      -- On arm/linux and arm/android, tell gcc to generate Arm
      -- instructions (ie not Thumb).
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> M Program) -> Program -> M Program
forall a b. (a -> b) -> a -> b
$ Program
ccLink2 Program -> (Program -> Program) -> Program
forall a b. a -> (a -> b) -> b
& Lens Program [String]
_prgFlags Lens Program [String] -> String -> Program -> Program
forall a b. Lens a [b] -> b -> a -> a
%++ String
"-Wl,-z,noexecstack"
    ArchOS Arch
ArchAArch64 OS
OSFreeBSD ->
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> M Program) -> Program -> M Program
forall a b. (a -> b) -> a -> b
$ Program
ccLink2 Program -> (Program -> Program) -> Program
forall a b. a -> (a -> b) -> b
& Lens Program [String]
_prgFlags Lens Program [String] -> String -> Program -> Program
forall a b. Lens a [b] -> b -> a -> a
%++ String
"-Wl,-z,noexecstack"
    ArchOS Arch
ArchAArch64 OS
OSLinux ->
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> M Program) -> Program -> M Program
forall a b. (a -> b) -> a -> b
$ Program
ccLink2 Program -> (Program -> Program) -> Program
forall a b. a -> (a -> b) -> b
& Lens Program [String]
_prgFlags Lens Program [String] -> String -> Program -> Program
forall a b. Lens a [b] -> b -> a -> a
%++ String
"-Wl,-z,noexecstack"
    ArchOS Arch
ArchAArch64 OS
OSNetBSD ->
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> M Program) -> Program -> M Program
forall a b. (a -> b) -> a -> b
$ Program
ccLink2 Program -> (Program -> Program) -> Program
forall a b. a -> (a -> b) -> b
& Lens Program [String]
_prgFlags Lens Program [String] -> String -> Program -> Program
forall a b. Lens a [b] -> b -> a -> a
%++ String
"-Wl,-z,noexecstack"
    ArchOS Arch
ArchPPC OS
OSAIX ->
      -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`.
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> M Program) -> Program -> M Program
forall a b. (a -> b) -> a -> b
$ Program
ccLink2 Program -> (Program -> Program) -> Program
forall a b. a -> (a -> b) -> b
& Lens Program [String]
-> ([String] -> [String]) -> Program -> Program
forall a b. Lens a b -> (b -> b) -> a -> a
over Lens Program [String]
_prgFlags ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
"-D_THREAD_SAFE",String
"-Wl,-bnotextro"])
    ArchOS
_ ->
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Program
ccLink2

-- | Adds flags specific to mingw32
addOSMinGW32CcFlags :: ArchOS -> Cc -> Program -> M Program
addOSMinGW32CcFlags :: ArchOS -> Cc -> Program -> M Program
addOSMinGW32CcFlags ArchOS
archOs Cc
cc Program
link
  | ArchOS Arch
_ OS
OSMinGW32 <- ArchOS
archOs = do
      Cc -> Program -> M Program
checkFStackCheck Cc
cc Program
link M Program -> M Program -> M Program
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> M Program
forall a. String -> M a
throwE String
"Windows requires -fstack-check support yet the C compiler linker appears not to support it"
  | Bool
otherwise = Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Program
link

-- | Check that @cc@ supports @-fstack-check@.
-- See Note [Windows stack allocations].
checkFStackCheck :: Cc -> Program -> M Program
checkFStackCheck :: Cc -> Program -> M Program
checkFStackCheck Cc
cc Program
link = String -> M Program -> M Program
forall a. Show a => String -> M a -> M a
checking String
"that -fstack-check works" (M Program -> M Program) -> M Program -> M Program
forall a b. (a -> b) -> a -> b
$ do
      let link' :: Program
link' = Program
link Program -> (Program -> Program) -> Program
forall a b. a -> (a -> b) -> b
& Lens Program [String]
_prgFlags Lens Program [String] -> String -> Program -> Program
forall a b. Lens a [b] -> b -> a -> a
%++ String
"-fstack-check"
      Cc -> Program -> M ()
checkLinkWorks Cc
cc Program
link'
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Program
link'

-- | See Note [ELF needed shared libs]
addNoAsNeeded :: ArchOS -> Cc -> Program -> M Program
addNoAsNeeded :: ArchOS -> Cc -> Program -> M Program
addNoAsNeeded ArchOS
archOs Cc
cc Program
ccLink
  | OS
os <- ArchOS -> OS
archOS_OS ArchOS
archOs
  , OS -> Bool
osElfTarget OS
os
  = String -> M Program -> M Program
forall a. Show a => String -> M a -> M a
checking String
"that --no-as-needed works" (M Program -> M Program) -> M Program -> M Program
forall a b. (a -> b) -> a -> b
$ do
      let ccLink' :: Program
ccLink' = Lens Program [String]
-> ([String] -> [String]) -> Program -> Program
forall a b. Lens a b -> (b -> b) -> a -> a
over Lens Program [String]
_prgFlags ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
"-Wl,--no-as-needed"]) Program
ccLink
      Cc -> Program -> M ()
checkLinkWorks Cc
cc Program
ccLink'
      Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Program
ccLink'
  | Bool
otherwise = Program -> M Program
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Program
ccLink

-- | See if whether we are using a version of ld64 on darwin platforms which
-- requires us to pass -no_fixup_chains
linkRequiresNoFixupChains :: ArchOS -> Cc -> CcLink -> M CcLink
linkRequiresNoFixupChains :: ArchOS -> Cc -> CcLink -> M CcLink
linkRequiresNoFixupChains ArchOS
archOs Cc
cc CcLink
ccLink
  | OS
OSDarwin <- ArchOS -> OS
archOS_OS ArchOS
archOs = String -> M CcLink -> M CcLink
forall a. Show a => String -> M a -> M a
checking String
"whether CC linker requires -no_fixup_chains" (M CcLink -> M CcLink) -> M CcLink -> M CcLink
forall a b. (a -> b) -> a -> b
$
      let ccLink' :: CcLink
ccLink' = Lens CcLink [String] -> ([String] -> [String]) -> CcLink -> CcLink
forall a b. Lens a b -> (b -> b) -> a -> a
over (Lens CcLink Program
_ccLinkProgram Lens CcLink Program
-> Lens Program [String] -> Lens CcLink [String]
forall a b c. Lens a b -> Lens b c -> Lens a c
% Lens Program [String]
_prgFlags) ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
"-Wl,-no_fixup_chains"]) CcLink
ccLink
       in (CcLink
ccLink' CcLink -> M () -> M CcLink
forall a b. a -> M b -> M a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Cc -> Program -> M ()
checkLinkWorks Cc
cc (CcLink -> Program
ccLinkProgram CcLink
ccLink')) M CcLink -> M CcLink -> M CcLink
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CcLink -> M CcLink
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return CcLink
ccLink
  | Bool
otherwise = CcLink -> M CcLink
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return CcLink
ccLink

-- | XCode 15 introduced a new linker which warns on duplicate libraries being
-- linked. To disable this warning, we pass -Wl,-no_warn_duplicate_libraries as
-- suggested by Brad King in CMake issue #25297.
--
-- This flag isn't necessarily available to other linkers on darwin, so we must
-- only configure it into the CC linker arguments if valid.
linkRequiresNoWarnDuplicateLibraries :: ArchOS -> Cc -> CcLink -> M CcLink
linkRequiresNoWarnDuplicateLibraries :: ArchOS -> Cc -> CcLink -> M CcLink
linkRequiresNoWarnDuplicateLibraries ArchOS
archOs Cc
cc CcLink
ccLink
  | OS
OSDarwin <- ArchOS -> OS
archOS_OS ArchOS
archOs = String -> M CcLink -> M CcLink
forall a. Show a => String -> M a -> M a
checking String
"whether CC linker requires -no_warn_duplicate_libraries" (M CcLink -> M CcLink) -> M CcLink -> M CcLink
forall a b. (a -> b) -> a -> b
$
      let ccLink' :: CcLink
ccLink' = Lens CcLink [String] -> ([String] -> [String]) -> CcLink -> CcLink
forall a b. Lens a b -> (b -> b) -> a -> a
over (Lens CcLink Program
_ccLinkProgram Lens CcLink Program
-> Lens Program [String] -> Lens CcLink [String]
forall a b c. Lens a b -> Lens b c -> Lens a c
% Lens Program [String]
_prgFlags) ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
"-Wl,-no_warn_duplicate_libraries"]) CcLink
ccLink
       in (CcLink
ccLink' CcLink -> M () -> M CcLink
forall a b. a -> M b -> M a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Cc -> Program -> M ()
checkLinkWorks Cc
cc (CcLink -> Program
ccLinkProgram CcLink
ccLink')) M CcLink -> M CcLink -> M CcLink
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CcLink -> M CcLink
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return CcLink
ccLink
  | Bool
otherwise = CcLink -> M CcLink
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return CcLink
ccLink