update to current master againwip/T13904

1 files changed, 111 insertions, 1062 deletions

diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index 3d16124d72..9bbce19602 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -8,123 +8,63 @@
 -----------------------------------------------------------------------------
 -}
 
-{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, MultiWayIf, ScopedTypeVariables #-}
 
 module SysTools (
-        -- Initialisation
+        -- * Initialisation
         initSysTools,
+        initLlvmConfig,
 
-        -- Interface to system tools
-        runUnlit, runCpp, runCc, -- [Option] -> IO ()
-        runPp,                   -- [Option] -> IO ()
-        runSplit,                -- [Option] -> IO ()
-        runAs, runLink, runLibtool, -- [Option] -> IO ()
-        runMkDLL,
-        runWindres,
-        runLlvmOpt,
-        runLlvmLlc,
-        runClang,
-        figureLlvmVersion,
-
-        getLinkerInfo,
-        getCompilerInfo,
+        -- * Interface to system tools
+        module SysTools.Tasks,
+        module SysTools.Info,
 
         linkDynLib,
 
-        askLd,
-
-        touch,                  -- String -> String -> IO ()
         copy,
         copyWithHeader,
 
+        -- * General utilities
         Option(..),
+        expandTopDir,
+
+        -- * Platform-specifics
+        libmLinkOpts,
 
-        -- frameworks
+        -- * Mac OS X frameworks
         getPkgFrameworkOpts,
         getFrameworkOpts
  ) where
 
 #include "HsVersions.h"
 
+import GhcPrelude
+
 import Module
 import Packages
 import Config
 import Outputable
 import ErrUtils
-import Panic
 import Platform
 import Util
 import DynFlags
-import Exception
-import FileCleanup
+import Fingerprint
 
-import LlvmCodeGen.Base (llvmVersionStr, supportedLlvmVersion)
-
-import Data.IORef
-import System.Exit
-import System.Environment
 import System.FilePath
 import System.IO
-import System.IO.Error as IO
 import System.Directory
-import Data.Char
-import Data.List
-
-#if defined(mingw32_HOST_OS)
-#if MIN_VERSION_Win32(2,5,0)
-import qualified System.Win32.Types as Win32
-#else
-import qualified System.Win32.Info as Win32
-#endif
-import Foreign
-import Foreign.C.String
-import System.Win32.Types (DWORD, LPTSTR, HANDLE)
-import System.Win32.Types (failIfNull, failIf, iNVALID_HANDLE_VALUE)
-import System.Win32.File (createFile,closeHandle, gENERIC_READ, fILE_SHARE_READ, oPEN_EXISTING, fILE_ATTRIBUTE_NORMAL, fILE_FLAG_BACKUP_SEMANTICS )
-import System.Win32.DLL (loadLibrary, getProcAddress)
-#endif
-
-import System.Process
-import Control.Concurrent
-import FastString
-import SrcLoc           ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
-
-#if defined(mingw32_HOST_OS)
-# if defined(i386_HOST_ARCH)
-#  define WINDOWS_CCONV stdcall
-# elif defined(x86_64_HOST_ARCH)
-#  define WINDOWS_CCONV ccall
-# else
-#  error Unknown mingw32 arch
-# endif
-#endif
+import SysTools.ExtraObj
+import SysTools.Info
+import SysTools.Tasks
+import SysTools.BaseDir
 
 {-
-How GHC finds its files
-~~~~~~~~~~~~~~~~~~~~~~~
-
-[Note topdir]
-
-GHC needs various support files (library packages, RTS etc), plus
-various auxiliary programs (cp, gcc, etc).  It starts by finding topdir,
-the root of GHC's support files
-
-On Unix:
-  - ghc always has a shell wrapper that passes a -B<dir> option
-
-On Windows:
-  - ghc never has a shell wrapper.
-  - we can find the location of the ghc binary, which is
-        $topdir/<foo>/<something>.exe
-    where <something> may be "ghc", "ghc-stage2", or similar
-  - we strip off the "<foo>/<something>.exe" to leave $topdir.
-
-from topdir we can find package.conf, ghc-asm, etc.
-
+Note [How GHC finds toolchain utilities]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 SysTools.initSysProgs figures out exactly where all the auxiliary programs
 are, and initialises mutable variables to make it easy to call them.
-To to this, it makes use of definitions in Config.hs, which is a Haskell
+To do this, it makes use of definitions in Config.hs, which is a Haskell
 file containing variables whose value is figured out by the build system.
 
 Config.hs contains two sorts of things
@@ -140,7 +80,6 @@ Config.hs contains two sorts of things
                    for use when running *in-place* in a build tree (only)
 
 
-
 ---------------------------------------------
 NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
 
@@ -171,23 +110,43 @@ stuff.
 ************************************************************************
 -}
 
-initSysTools :: Maybe String    -- Maybe TopDir path (without the '-B' prefix)
+initLlvmConfig :: String
+               -> IO LlvmConfig
+initLlvmConfig top_dir
+  = do
+      targets <- readAndParse "llvm-targets" mkLlvmTarget
+      passes <- readAndParse "llvm-passes" id
+      return (targets, passes)
+  where
+    readAndParse name builder =
+      do let llvmConfigFile = top_dir </> name
+         llvmConfigStr <- readFile llvmConfigFile
+         case maybeReadFuzzy llvmConfigStr of
+           Just s -> return (fmap builder <$> s)
+           Nothing -> pgmError ("Can't parse " ++ show llvmConfigFile)
+
+    mkLlvmTarget :: (String, String, String) -> LlvmTarget
+    mkLlvmTarget (dl, cpu, attrs) = LlvmTarget dl cpu (words attrs)
+
+
+initSysTools :: String          -- TopDir path
              -> IO Settings     -- Set all the mutable variables above, holding
                                 --      (a) the system programs
                                 --      (b) the package-config file
                                 --      (c) the GHC usage message
-initSysTools mbMinusB
-  = do top_dir <- findTopDir mbMinusB
-             -- see [Note topdir]
+initSysTools top_dir
+  = do       -- see Note [topdir: How GHC finds its files]
              -- NB: top_dir is assumed to be in standard Unix
              -- format, '/' separated
+       mtool_dir <- findToolDir top_dir
+             -- see Note [tooldir: How GHC finds mingw and perl on Windows]
 
-       let settingsFile = top_dir </> "settings"
-           platformConstantsFile = top_dir </> "platformConstants"
-           installed :: FilePath -> FilePath
+       let installed :: FilePath -> FilePath
            installed file = top_dir </> file
            libexec :: FilePath -> FilePath
            libexec file = top_dir </> "bin" </> file
+           settingsFile = installed "settings"
+           platformConstantsFile = installed "platformConstants"
 
        settingsStr <- readFile settingsFile
        platformConstantsStr <- readFile platformConstantsFile
@@ -203,16 +162,9 @@ initSysTools mbMinusB
                                 pgmError ("Can't parse " ++
                                           show platformConstantsFile)
        let getSetting key = case lookup key mySettings of
-                            Just xs ->
-                                return $ case stripPrefix "$topdir" xs of
-                                         Just [] ->
-                                             top_dir
-                                         Just xs'@(c:_)
-                                          | isPathSeparator c ->
-                                             top_dir ++ xs'
-                                         _ ->
-                                             xs
+                            Just xs -> return $ expandTopDir top_dir xs
                             Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
+           getToolSetting key = expandToolDir mtool_dir <$> getSetting key
            getBooleanSetting key = case lookup key mySettings of
                                    Just "YES" -> return True
                                    Just "NO" -> return False
@@ -234,14 +186,15 @@ initSysTools mbMinusB
        targetHasSubsectionsViaSymbols <- readSetting "target has subsections via symbols"
        myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
        -- On Windows, mingw is distributed with GHC,
-       -- so we look in TopDir/../mingw/bin
+       -- so we look in TopDir/../mingw/bin,
+       -- as well as TopDir/../../mingw/bin for hadrian.
        -- It would perhaps be nice to be able to override this
        -- with the settings file, but it would be a little fiddly
        -- to make that possible, so for now you can't.
-       gcc_prog <- getSetting "C compiler command"
+       gcc_prog <- getToolSetting "C compiler command"
        gcc_args_str <- getSetting "C compiler flags"
        gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
-       cpp_prog <- getSetting "Haskell CPP command"
+       cpp_prog <- getToolSetting "Haskell CPP command"
        cpp_args_str <- getSetting "Haskell CPP flags"
        let unreg_gcc_args = if targetUnregisterised
                             then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
@@ -259,7 +212,7 @@ initSysTools mbMinusB
        ldSupportsBuildId       <- getBooleanSetting "ld supports build-id"
        ldSupportsFilelist      <- getBooleanSetting "ld supports filelist"
        ldIsGnuLd               <- getBooleanSetting "ld is GNU ld"
-       perl_path <- getSetting "perl command"
+       perl_path <- getToolSetting "perl command"
 
        let pkgconfig_path = installed "package.conf.d"
            ghc_usage_msg_path  = installed "ghc-usage.txt"
@@ -272,12 +225,14 @@ initSysTools mbMinusB
              -- split is a Perl script
            split_script  = libexec cGHC_SPLIT_PGM
 
-       windres_path <- getSetting "windres command"
-       libtool_path <- getSetting "libtool command"
+       windres_path <- getToolSetting "windres command"
+       libtool_path <- getToolSetting "libtool command"
+       ar_path <- getToolSetting "ar command"
+       ranlib_path <- getToolSetting "ranlib command"
 
        tmpdir <- getTemporaryDirectory
 
-       touch_path <- getSetting "touch command"
+       touch_path <- getToolSetting "touch command"
 
        let -- On Win32 we don't want to rely on #!/bin/perl, so we prepend
            -- a call to Perl to get the invocation of split.
@@ -288,7 +243,7 @@ initSysTools mbMinusB
            (split_prog,  split_args)
              | isWindowsHost = (perl_path,    [Option split_script])
              | otherwise     = (split_script, [])
-       mkdll_prog <- getSetting "dllwrap command"
+       mkdll_prog <- getToolSetting "dllwrap command"
        let mkdll_args = []
 
        -- cpp is derived from gcc on all platforms
@@ -306,6 +261,7 @@ initSysTools mbMinusB
        -- We just assume on command line
        lc_prog <- getSetting "LLVM llc command"
        lo_prog <- getSetting "LLVM opt command"
+       lcc_prog <- getSetting "LLVM clang command"
 
        let iserv_prog = libexec "ghc-iserv"
 
@@ -325,6 +281,7 @@ initSysTools mbMinusB
                     sTmpDir         = normalise tmpdir,
                     sGhcUsagePath   = ghc_usage_msg_path,
                     sGhciUsagePath  = ghci_usage_msg_path,
+                    sToolDir        = mtool_dir,
                     sTopDir         = top_dir,
                     sRawSettings    = mySettings,
                     sExtraGccViaCFlags = words myExtraGccViaCFlags,
@@ -347,291 +304,27 @@ initSysTools mbMinusB
                     sPgm_T   = touch_path,
                     sPgm_windres = windres_path,
                     sPgm_libtool = libtool_path,
+                    sPgm_ar = ar_path,
+                    sPgm_ranlib = ranlib_path,
                     sPgm_lo  = (lo_prog,[]),
                     sPgm_lc  = (lc_prog,[]),
+                    sPgm_lcc = (lcc_prog,[]),
                     sPgm_i   = iserv_prog,
                     sOpt_L       = [],
                     sOpt_P       = [],
+                    sOpt_P_fingerprint = fingerprint0,
                     sOpt_F       = [],
                     sOpt_c       = [],
                     sOpt_a       = [],
                     sOpt_l       = [],
                     sOpt_windres = [],
+                    sOpt_lcc     = [],
                     sOpt_lo      = [],
                     sOpt_lc      = [],
                     sOpt_i       = [],
                     sPlatformConstants = platformConstants
              }
 
--- returns a Unix-format path (relying on getBaseDir to do so too)
-findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
-           -> IO String    -- TopDir (in Unix format '/' separated)
-findTopDir (Just minusb) = return (normalise minusb)
-findTopDir Nothing
-    = do -- Get directory of executable
-         maybe_exec_dir <- getBaseDir
-         case maybe_exec_dir of
-             -- "Just" on Windows, "Nothing" on unix
-             Nothing  -> throwGhcExceptionIO (InstallationError "missing -B<dir> option")
-             Just dir -> return dir
-
-{-
-************************************************************************
-*                                                                      *
-\subsection{Running an external program}
-*                                                                      *
-************************************************************************
--}
-
-runUnlit :: DynFlags -> [Option] -> IO ()
-runUnlit dflags args = do
-  let prog = pgm_L dflags
-      opts = getOpts dflags opt_L
-  runSomething dflags "Literate pre-processor" prog
-               (map Option opts ++ args)
-
-runCpp :: DynFlags -> [Option] -> IO ()
-runCpp dflags args =   do
-  let (p,args0) = pgm_P dflags
-      args1 = map Option (getOpts dflags opt_P)
-      args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags]
-                ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags]
-  mb_env <- getGccEnv args2
-  runSomethingFiltered dflags id  "C pre-processor" p
-                       (args0 ++ args1 ++ args2 ++ args) mb_env
-
-runPp :: DynFlags -> [Option] -> IO ()
-runPp dflags args =   do
-  let prog = pgm_F dflags
-      opts = map Option (getOpts dflags opt_F)
-  runSomething dflags "Haskell pre-processor" prog (args ++ opts)
-
-runCc :: DynFlags -> [Option] -> IO ()
-runCc dflags args =   do
-  let (p,args0) = pgm_c dflags
-      args1 = map Option (getOpts dflags opt_c)
-      args2 = args0 ++ args1 ++ args
-  mb_env <- getGccEnv args2
-  runSomethingResponseFile dflags cc_filter "C Compiler" p args2 mb_env
- where
-  -- discard some harmless warnings from gcc that we can't turn off
-  cc_filter = unlines . doFilter . lines
-
-  {-
-  gcc gives warnings in chunks like so:
-      In file included from /foo/bar/baz.h:11,
-                       from /foo/bar/baz2.h:22,
-                       from wibble.c:33:
-      /foo/flibble:14: global register variable ...
-      /foo/flibble:15: warning: call-clobbered r...
-  We break it up into its chunks, remove any call-clobbered register
-  warnings from each chunk, and then delete any chunks that we have
-  emptied of warnings.
-  -}
-  doFilter = unChunkWarnings . filterWarnings . chunkWarnings []
-  -- We can't assume that the output will start with an "In file inc..."
-  -- line, so we start off expecting a list of warnings rather than a
-  -- location stack.
-  chunkWarnings :: [String] -- The location stack to use for the next
-                            -- list of warnings
-                -> [String] -- The remaining lines to look at
-                -> [([String], [String])]
-  chunkWarnings loc_stack [] = [(loc_stack, [])]
-  chunkWarnings loc_stack xs
-      = case break loc_stack_start xs of
-        (warnings, lss:xs') ->
-            case span loc_start_continuation xs' of
-            (lsc, xs'') ->
-                (loc_stack, warnings) : chunkWarnings (lss : lsc) xs''
-        _ -> [(loc_stack, xs)]
-
-  filterWarnings :: [([String], [String])] -> [([String], [String])]
-  filterWarnings [] = []
-  -- If the warnings are already empty then we are probably doing
-  -- something wrong, so don't delete anything
-  filterWarnings ((xs, []) : zs) = (xs, []) : filterWarnings zs
-  filterWarnings ((xs, ys) : zs) = case filter wantedWarning ys of
-                                       [] -> filterWarnings zs
-                                       ys' -> (xs, ys') : filterWarnings zs
-
-  unChunkWarnings :: [([String], [String])] -> [String]
-  unChunkWarnings [] = []
-  unChunkWarnings ((xs, ys) : zs) = xs ++ ys ++ unChunkWarnings zs
-
-  loc_stack_start        s = "In file included from " `isPrefixOf` s
-  loc_start_continuation s = "                 from " `isPrefixOf` s
-  wantedWarning w
-   | "warning: call-clobbered register used" `isContainedIn` w = False
-   | otherwise = True
-
-isContainedIn :: String -> String -> Bool
-xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
-
--- | Run the linker with some arguments and return the output
-askLd :: DynFlags -> [Option] -> IO String
-askLd dflags args = do
-  let (p,args0) = pgm_l dflags
-      args1     = map Option (getOpts dflags opt_l)
-      args2     = args0 ++ args1 ++ args
-  mb_env <- getGccEnv args2
-  runSomethingWith dflags "gcc" p args2 $ \real_args ->
-    readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }
-
--- Similar to System.Process.readCreateProcessWithExitCode, but stderr is
--- inherited from the parent process, and output to stderr is not captured.
-readCreateProcessWithExitCode'
-    :: CreateProcess
-    -> IO (ExitCode, String)    -- ^ stdout
-readCreateProcessWithExitCode' proc = do
-    (_, Just outh, _, pid) <-
-        createProcess proc{ std_out = CreatePipe }
-
-    -- fork off a thread to start consuming the output
-    output  <- hGetContents outh
-    outMVar <- newEmptyMVar
-    _ <- forkIO $ evaluate (length output) >> putMVar outMVar ()
-
-    -- wait on the output
-    takeMVar outMVar
-    hClose outh
-
-    -- wait on the process
-    ex <- waitForProcess pid
-
-    return (ex, output)
-
-replaceVar :: (String, String) -> [(String, String)] -> [(String, String)]
-replaceVar (var, value) env =
-    (var, value) : filter (\(var',_) -> var /= var') env
-
--- | Version of @System.Process.readProcessWithExitCode@ that takes a
--- key-value tuple to insert into the environment.
-readProcessEnvWithExitCode
-    :: String -- ^ program path
-    -> [String] -- ^ program args
-    -> (String, String) -- ^ addition to the environment
-    -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr)
-readProcessEnvWithExitCode prog args env_update = do
-    current_env <- getEnvironment
-    readCreateProcessWithExitCode (proc prog args) {
-        env = Just (replaceVar env_update current_env) } ""
-
--- Don't let gcc localize version info string, #8825
-c_locale_env :: (String, String)
-c_locale_env = ("LANGUAGE", "C")
-
--- If the -B<dir> option is set, add <dir> to PATH.  This works around
--- a bug in gcc on Windows Vista where it can't find its auxiliary
--- binaries (see bug #1110).
-getGccEnv :: [Option] -> IO (Maybe [(String,String)])
-getGccEnv opts =
-  if null b_dirs
-     then return Nothing
-     else do env <- getEnvironment
-             return (Just (map mangle_path env))
- where
-  (b_dirs, _) = partitionWith get_b_opt opts
-
-  get_b_opt (Option ('-':'B':dir)) = Left dir
-  get_b_opt other = Right other
-
-  mangle_path (path,paths) | map toUpper path == "PATH"
-        = (path, '\"' : head b_dirs ++ "\";" ++ paths)
-  mangle_path other = other
-
-runSplit :: DynFlags -> [Option] -> IO ()
-runSplit dflags args = do
-  let (p,args0) = pgm_s dflags
-  runSomething dflags "Splitter" p (args0++args)
-
-runAs :: DynFlags -> [Option] -> IO ()
-runAs dflags args = do
-  let (p,args0) = pgm_a dflags
-      args1 = map Option (getOpts dflags opt_a)
-      args2 = args0 ++ args1 ++ args
-  mb_env <- getGccEnv args2
-  runSomethingFiltered dflags id "Assembler" p args2 mb_env
-
--- | Run the LLVM Optimiser
-runLlvmOpt :: DynFlags -> [Option] -> IO ()
-runLlvmOpt dflags args = do
-  let (p,args0) = pgm_lo dflags
-      args1 = map Option (getOpts dflags opt_lo)
-  runSomething dflags "LLVM Optimiser" p (args0 ++ args1 ++ args)
-
--- | Run the LLVM Compiler
-runLlvmLlc :: DynFlags -> [Option] -> IO ()
-runLlvmLlc dflags args = do
-  let (p,args0) = pgm_lc dflags
-      args1 = map Option (getOpts dflags opt_lc)
-  runSomething dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
-
--- | Run the clang compiler (used as an assembler for the LLVM
--- backend on OS X as LLVM doesn't support the OS X system
--- assembler)
-runClang :: DynFlags -> [Option] -> IO ()
-runClang dflags args = do
-  -- we simply assume its available on the PATH
-  let clang = "clang"
-      -- be careful what options we call clang with
-      -- see #5903 and #7617 for bugs caused by this.
-      (_,args0) = pgm_a dflags
-      args1 = map Option (getOpts dflags opt_a)
-      args2 = args0 ++ args1 ++ args
-  mb_env <- getGccEnv args2
-  Exception.catch (do
-        runSomethingFiltered dflags id "Clang (Assembler)" clang args2 mb_env
-    )
-    (\(err :: SomeException) -> do
-        errorMsg dflags $
-            text ("Error running clang! you need clang installed to use the" ++
-                  " LLVM backend") $+$
-            text "(or GHC tried to execute clang incorrectly)"
-        throwIO err
-    )
-
--- | Figure out which version of LLVM we are running this session
-figureLlvmVersion :: DynFlags -> IO (Maybe (Int, Int))
-figureLlvmVersion dflags = do
-  let (pgm,opts) = pgm_lc dflags
-      args = filter notNull (map showOpt opts)
-      -- we grab the args even though they should be useless just in
-      -- case the user is using a customised 'llc' that requires some
-      -- of the options they've specified. llc doesn't care what other
-      -- options are specified when '-version' is used.
-      args' = args ++ ["-version"]
-  ver <- catchIO (do
-             (pin, pout, perr, _) <- runInteractiveProcess pgm args'
-                                             Nothing Nothing
-             {- > llc -version
-                  LLVM (http://llvm.org/):
-                    LLVM version 3.5.2
-                    ...
-             -}
-             hSetBinaryMode pout False
-             _     <- hGetLine pout
-             vline <- dropWhile (not . isDigit) `fmap` hGetLine pout
-             v     <- case span (/= '.') vline of
-                        ("",_)  -> fail "no digits!"
-                        (x,y) -> return (read x
-                                        , read $ takeWhile isDigit $ drop 1 y)
-
-             hClose pin
-             hClose pout
-             hClose perr
-             return $ Just v
-            )
-            (\err -> do
-                debugTraceMsg dflags 2
-                    (text "Error (figuring out LLVM version):" <+>
-                     text (show err))
-                errorMsg dflags $ vcat
-                    [ text "Warning:", nest 9 $
-                          text "Couldn't figure out LLVM version!" $$
-                          text ("Make sure you have installed LLVM " ++
-                                llvmVersionStr supportedLlvmVersion) ]
-                return Nothing)
-  return ver
 
 {- Note [Windows stack usage]
 
@@ -664,340 +357,6 @@ for more information.
 
 -}
 
-{- Note [Run-time linker info]
-
-See also: Trac #5240, Trac #6063, Trac #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 (GnuLD o)     = o
-neededLinkArgs (GnuGold o)   = o
-neededLinkArgs (DarwinLD o)  = o
-neededLinkArgs (SolarisLD o) = o
-neededLinkArgs (AixLD o)     = o
-neededLinkArgs UnknownLD     = []
-
--- Grab linker info and cache it in DynFlags.
-getLinkerInfo :: DynFlags -> IO LinkerInfo
-getLinkerInfo dflags = do
-  info <- readIORef (rtldInfo dflags)
-  case info of
-    Just v  -> return v
-    Nothing -> do
-      v <- getLinkerInfo' dflags
-      writeIORef (rtldInfo dflags) (Just v)
-      return v
-
--- See Note [Run-time linker info].
-getLinkerInfo' :: DynFlags -> IO LinkerInfo
-getLinkerInfo' 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)
-
-      -- Try to grab the info from the process output.
-      parseLinkerInfo stdo _stde _exitc
-        | any ("GNU ld" `isPrefixOf`) stdo =
-          -- GNU ld specifically needs to use less memory. This especially
-          -- hurts on small object files. Trac #5240.
-          -- Set DT_NEEDED for all shared libraries. Trac #10110.
-          -- TODO: Investigate if these help or hurt when using split sections.
-          return (GnuLD $ map Option ["-Wl,--hash-size=31",
-                                      "-Wl,--reduce-memory-overheads",
-                                      -- ELF specific flag
-                                      -- see Note [ELF needed shared libs]
-                                      "-Wl,--no-as-needed"])
-
-        | any ("GNU gold" `isPrefixOf`) stdo =
-          -- GNU gold only needs --no-as-needed. Trac #10110.
-          -- ELF specific flag, see Note [ELF needed shared libs]
-          return (GnuGold [Option "-Wl,--no-as-needed"])
-
-         -- Unknown linker.
-        | otherwise = fail "invalid --version output, or linker is unsupported"
-
-  -- Process the executable call
-  info <- catchIO (do
-             case os of
-               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.
-                 return $ SolarisLD []
-               OSAIX ->
-                 -- IBM AIX uses its own non-binutils linker as well
-                 return $ AixLD []
-               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.
-                 return $ DarwinLD []
-               OSiOS ->
-                 -- Ditto for iOS
-                 return $ DarwinLD []
-               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.
-                 return $ GnuLD $ map Option
-                   [ -- Reduce ld memory usage
-                     "-Wl,--hash-size=31"
-                   , "-Wl,--reduce-memory-overheads"
-                     -- Emit gcc stack checks
-                     -- Note [Windows stack usage]
-                   , "-fstack-check"
-                     -- Force static linking of libGCC
-                     -- Note [Windows static libGCC]
-                   , "-static-libgcc" ]
-               _ -> do
-                 -- In practice, we use the compiler as the linker here. Pass
-                 -- -Wl,--version to get linker version info.
-                 (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
-                                        (["-Wl,--version"] ++ args3)
-                                        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.
-                 parseLinkerInfo (lines stdo) (lines stde) exitc
-            )
-            (\err -> do
-                debugTraceMsg dflags 2
-                    (text "Error (figuring out linker information):" <+>
-                     text (show err))
-                errorMsg dflags $ 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)
-  return info
-
--- Grab compiler info and cache it in DynFlags.
-getCompilerInfo :: DynFlags -> IO CompilerInfo
-getCompilerInfo dflags = do
-  info <- readIORef (rtccInfo dflags)
-  case info of
-    Just v  -> return v
-    Nothing -> do
-      v <- getCompilerInfo' dflags
-      writeIORef (rtccInfo dflags) (Just v)
-      return v
-
--- See Note [Run-time linker info].
-getCompilerInfo' :: DynFlags -> IO CompilerInfo
-getCompilerInfo' dflags = do
-  let (pgm,_) = pgm_c dflags
-      -- Try to grab the info from the process output.
-      parseCompilerInfo _stdo stde _exitc
-        -- Regular GCC
-        | any ("gcc version" `isInfixOf`) stde =
-          return GCC
-        -- Regular clang
-        | any ("clang version" `isInfixOf`) stde =
-          return Clang
-        -- XCode 5.1 clang
-        | any ("Apple LLVM version 5.1" `isPrefixOf`) stde =
-          return AppleClang51
-        -- XCode 5 clang
-        | any ("Apple LLVM version" `isPrefixOf`) stde =
-          return AppleClang
-        -- XCode 4.1 clang
-        | any ("Apple clang version" `isPrefixOf`) stde =
-          return AppleClang
-         -- Unknown linker.
-        | otherwise = fail "invalid -v output, or compiler is unsupported"
-
-  -- Process the executable call
-  info <- catchIO (do
-                (exitc, stdo, stde) <-
-                    readProcessEnvWithExitCode pgm ["-v"] c_locale_env
-                -- Split the output by lines to make certain kinds
-                -- of processing easier.
-                parseCompilerInfo (lines stdo) (lines stde) exitc
-            )
-            (\err -> do
-                debugTraceMsg dflags 2
-                    (text "Error (figuring out C compiler information):" <+>
-                     text (show err))
-                errorMsg dflags $ hang (text "Warning:") 9 $
-                  text "Couldn't figure out C compiler information!" $$
-                  text "Make sure you're using GNU gcc, or clang"
-                return UnknownCC)
-  return info
-
-runLink :: DynFlags -> [Option] -> IO ()
-runLink dflags args = do
-  -- See Note [Run-time linker info]
-  linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
-  let (p,args0) = pgm_l dflags
-      args1     = map Option (getOpts dflags opt_l)
-      args2     = args0 ++ linkargs ++ args1 ++ args
-  mb_env <- getGccEnv args2
-  runSomethingResponseFile dflags ld_filter "Linker" p args2 mb_env
-  where
-    ld_filter = case (platformOS (targetPlatform dflags)) of
-                  OSSolaris2 -> sunos_ld_filter
-                  _ -> id
-{-
-  SunOS/Solaris ld emits harmless warning messages about unresolved
-  symbols in case of compiling into shared library when we do not
-  link against all the required libs. That is the case of GHC which
-  does not link against RTS library explicitly in order to be able to
-  choose the library later based on binary application linking
-  parameters. The warnings look like:
-
-Undefined                       first referenced
- symbol                             in file
-stg_ap_n_fast                       ./T2386_Lib.o
-stg_upd_frame_info                  ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
-newCAF                              ./T2386_Lib.o
-stg_bh_upd_frame_info               ./T2386_Lib.o
-stg_ap_ppp_fast                     ./T2386_Lib.o
-templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
-stg_ap_p_fast                       ./T2386_Lib.o
-stg_ap_pp_fast                      ./T2386_Lib.o
-ld: warning: symbol referencing errors
-
-  this is actually coming from T2386 testcase. The emitting of those
-  warnings is also a reason why so many TH testcases fail on Solaris.
-
-  Following filter code is SunOS/Solaris linker specific and should
-  filter out only linker warnings. Please note that the logic is a
-  little bit more complex due to the simple reason that we need to preserve
-  any other linker emitted messages. If there are any. Simply speaking
-  if we see "Undefined" and later "ld: warning:..." then we omit all
-  text between (including) the marks. Otherwise we copy the whole output.
--}
-    sunos_ld_filter :: String -> String
-    sunos_ld_filter = unlines . sunos_ld_filter' . lines
-    sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)
-                         then (ld_prefix x) ++ (ld_postfix x)
-                         else x
-    breakStartsWith x y = break (isPrefixOf x) y
-    ld_prefix = fst . breakStartsWith "Undefined"
-    undefined_found = not . null . snd . breakStartsWith "Undefined"
-    ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors"
-    ld_postfix = tail . snd . ld_warn_break
-    ld_warning_found = not . null . snd . ld_warn_break
-
-
-runLibtool :: DynFlags -> [Option] -> IO ()
-runLibtool dflags args = do
-  linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
-  let args1      = map Option (getOpts dflags opt_l)
-      args2      = [Option "-static"] ++ args1 ++ args ++ linkargs
-      libtool    = pgm_libtool dflags
-  mb_env <- getGccEnv args2
-  runSomethingFiltered dflags id "Linker" libtool args2 mb_env
-
-runMkDLL :: DynFlags -> [Option] -> IO ()
-runMkDLL dflags args = do
-  let (p,args0) = pgm_dll dflags
-      args1 = args0 ++ args
-  mb_env <- getGccEnv (args0++args)
-  runSomethingFiltered dflags id "Make DLL" p args1 mb_env
-
-runWindres :: DynFlags -> [Option] -> IO ()
-runWindres dflags args = do
-  let (gcc, gcc_args) = pgm_c dflags
-      windres = pgm_windres dflags
-      opts = map Option (getOpts dflags opt_windres)
-      quote x = "\"" ++ x ++ "\""
-      args' = -- If windres.exe and gcc.exe are in a directory containing
-              -- spaces then windres fails to run gcc. We therefore need
-              -- to tell it what command to use...
-              Option ("--preprocessor=" ++
-                      unwords (map quote (gcc :
-                                          map showOpt gcc_args ++
-                                          map showOpt opts ++
-                                          ["-E", "-xc", "-DRC_INVOKED"])))
-              -- ...but if we do that then if windres calls popen then
-              -- it can't understand the quoting, so we have to use
-              -- --use-temp-file so that it interprets it correctly.
-              -- See #1828.
-            : Option "--use-temp-file"
-            : args
-  mb_env <- getGccEnv gcc_args
-  runSomethingFiltered dflags id "Windres" windres args' mb_env
-
-touch :: DynFlags -> String -> String -> IO ()
-touch dflags purpose arg =
-  runSomething dflags purpose (pgm_T dflags) [FileOption "" arg]
-
 copy :: DynFlags -> String -> FilePath -> FilePath -> IO ()
 copy dflags purpose from to = copyWithHeader dflags purpose Nothing from to
 
@@ -1022,240 +381,6 @@ copyWithHeader dflags purpose maybe_header from to = do
    hPutStr h str
    hSetBinaryMode h True
 
------------------------------------------------------------------------------
--- Running an external program
-
-runSomething :: DynFlags
-             -> String          -- For -v message
-             -> String          -- Command name (possibly a full path)
-                                --      assumed already dos-ified
-             -> [Option]        -- Arguments
-                                --      runSomething will dos-ify them
-             -> IO ()
-
-runSomething dflags phase_name pgm args =
-  runSomethingFiltered dflags id phase_name pgm args Nothing
-
--- | Run a command, placing the arguments in an external response file.
---
--- This command is used in order to avoid overlong command line arguments on
--- Windows. The command line arguments are first written to an external,
--- temporary response file, and then passed to the linker via @filepath.
--- response files for passing them in. See:
---
---     https://gcc.gnu.org/wiki/Response_Files
---     https://ghc.haskell.org/trac/ghc/ticket/10777
-runSomethingResponseFile
-  :: DynFlags -> (String->String) -> String -> String -> [Option]
-  -> Maybe [(String,String)] -> IO ()
-
-runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env =
-    runSomethingWith dflags phase_name pgm args $ \real_args -> do
-        fp <- getResponseFile real_args
-        let args = ['@':fp]
-        r <- builderMainLoop dflags filter_fn pgm args mb_env
-        return (r,())
-  where
-    getResponseFile args = do
-      fp <- newTempName dflags TFL_CurrentModule "rsp"
-      withFile fp WriteMode $ \h -> do
-#if defined(mingw32_HOST_OS)
-          hSetEncoding h latin1
-#else
-          hSetEncoding h utf8
-#endif
-          hPutStr h $ unlines $ map escape args
-      return fp
-
-    -- Note: Response files have backslash-escaping, double quoting, and are
-    -- whitespace separated (some implementations use newline, others any
-    -- whitespace character). Therefore, escape any backslashes, newlines, and
-    -- double quotes in the argument, and surround the content with double
-    -- quotes.
-    --
-    -- Another possibility that could be considered would be to convert
-    -- backslashes in the argument to forward slashes. This would generally do
-    -- the right thing, since backslashes in general only appear in arguments
-    -- as part of file paths on Windows, and the forward slash is accepted for
-    -- those. However, escaping is more reliable, in case somehow a backslash
-    -- appears in a non-file.
-    escape x = concat
-        [ "\""
-        , concatMap
-            (\c ->
-                case c of
-                    '\\' -> "\\\\"
-                    '\n' -> "\\n"
-                    '\"' -> "\\\""
-                    _    -> [c])
-            x
-        , "\""
-        ]
-
-runSomethingFiltered
-  :: DynFlags -> (String->String) -> String -> String -> [Option]
-  -> Maybe [(String,String)] -> IO ()
-
-runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do
-    runSomethingWith dflags phase_name pgm args $ \real_args -> do
-        r <- builderMainLoop dflags filter_fn pgm real_args mb_env
-        return (r,())
-
-runSomethingWith
-  :: DynFlags -> String -> String -> [Option]
-  -> ([String] -> IO (ExitCode, a))
-  -> IO a
-
-runSomethingWith dflags phase_name pgm args io = do
-  let real_args = filter notNull (map showOpt args)
-      cmdLine = showCommandForUser pgm real_args
-  traceCmd dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args
-
-handleProc :: String -> String -> IO (ExitCode, r) -> IO r
-handleProc pgm phase_name proc = do
-    (rc, r) <- proc `catchIO` handler
-    case rc of
-      ExitSuccess{} -> return r
-      ExitFailure n -> throwGhcExceptionIO (
-            ProgramError ("`" ++ takeFileName pgm ++ "'" ++
-                          " failed in phase `" ++ phase_name ++ "'." ++
-                          " (Exit code: " ++ show n ++ ")"))
-  where
-    handler err =
-       if IO.isDoesNotExistError err
-          then does_not_exist
-          else throwGhcExceptionIO (ProgramError $ show err)
-
-    does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: " ++ pgm))
-
-
-builderMainLoop :: DynFlags -> (String -> String) -> FilePath
-                -> [String] -> Maybe [(String, String)]
-                -> IO ExitCode
-builderMainLoop dflags filter_fn pgm real_args mb_env = do
-  chan <- newChan
-
-  -- We use a mask here rather than a bracket because we want
-  -- to distinguish between cleaning up with and without an
-  -- exception. This is to avoid calling terminateProcess
-  -- unless an exception was raised.
-  let safely inner = mask $ \restore -> do
-        -- acquire
-        (hStdIn, hStdOut, hStdErr, hProcess) <- restore $
-          runInteractiveProcess pgm real_args Nothing mb_env
-        let cleanup_handles = do
-              hClose hStdIn
-              hClose hStdOut
-              hClose hStdErr
-        r <- try $ restore $ do
-          hSetBuffering hStdOut LineBuffering
-          hSetBuffering hStdErr LineBuffering
-          let make_reader_proc h = forkIO $ readerProc chan h filter_fn
-          bracketOnError (make_reader_proc hStdOut) killThread $ \_ ->
-            bracketOnError (make_reader_proc hStdErr) killThread $ \_ ->
-            inner hProcess
-        case r of
-          -- onException
-          Left (SomeException e) -> do
-            terminateProcess hProcess
-            cleanup_handles
-            throw e
-          -- cleanup when there was no exception
-          Right s -> do
-            cleanup_handles
-            return s
-  safely $ \h -> do
-    -- we don't want to finish until 2 streams have been complete
-    -- (stdout and stderr)
-    log_loop chan (2 :: Integer)
-    -- after that, we wait for the process to finish and return the exit code.
-    waitForProcess h
-  where
-    -- t starts at the number of streams we're listening to (2) decrements each
-    -- time a reader process sends EOF. We are safe from looping forever if a
-    -- reader thread dies, because they send EOF in a finally handler.
-    log_loop _ 0 = return ()
-    log_loop chan t = do
-      msg <- readChan chan
-      case msg of
-        BuildMsg msg -> do
-          putLogMsg dflags NoReason SevInfo noSrcSpan
-              (defaultUserStyle dflags) msg
-          log_loop chan t
-        BuildError loc msg -> do
-          putLogMsg dflags NoReason SevError (mkSrcSpan loc loc)
-              (defaultUserStyle dflags) msg
-          log_loop chan t
-        EOF ->
-          log_loop chan  (t-1)
-
-readerProc :: Chan BuildMessage -> Handle -> (String -> String) -> IO ()
-readerProc chan hdl filter_fn =
-    (do str <- hGetContents hdl
-        loop (linesPlatform (filter_fn str)) Nothing)
-    `finally`
-       writeChan chan EOF
-        -- ToDo: check errors more carefully
-        -- ToDo: in the future, the filter should be implemented as
-        -- a stream transformer.
-    where
-        loop []     Nothing    = return ()
-        loop []     (Just err) = writeChan chan err
-        loop (l:ls) in_err     =
-                case in_err of
-                  Just err@(BuildError srcLoc msg)
-                    | leading_whitespace l -> do
-                        loop ls (Just (BuildError srcLoc (msg $$ text l)))
-                    | otherwise -> do
-                        writeChan chan err
-                        checkError l ls
-                  Nothing -> do
-                        checkError l ls
-                  _ -> panic "readerProc/loop"
-
-        checkError l ls
-           = case parseError l of
-                Nothing -> do
-                    writeChan chan (BuildMsg (text l))
-                    loop ls Nothing
-                Just (file, lineNum, colNum, msg) -> do
-                    let srcLoc = mkSrcLoc (mkFastString file) lineNum colNum
-                    loop ls (Just (BuildError srcLoc (text msg)))
-
-        leading_whitespace []    = False
-        leading_whitespace (x:_) = isSpace x
-
-parseError :: String -> Maybe (String, Int, Int, String)
-parseError s0 = case breakColon s0 of
-                Just (filename, s1) ->
-                    case breakIntColon s1 of
-                    Just (lineNum, s2) ->
-                        case breakIntColon s2 of
-                        Just (columnNum, s3) ->
-                            Just (filename, lineNum, columnNum, s3)
-                        Nothing ->
-                            Just (filename, lineNum, 0, s2)
-                    Nothing -> Nothing
-                Nothing -> Nothing
-
-breakColon :: String -> Maybe (String, String)
-breakColon xs = case break (':' ==) xs of
-                    (ys, _:zs) -> Just (ys, zs)
-                    _ -> Nothing
-
-breakIntColon :: String -> Maybe (Int, String)
-breakIntColon xs = case break (':' ==) xs of
-                       (ys, _:zs)
-                        | not (null ys) && all isAscii ys && all isDigit ys ->
-                           Just (read ys, zs)
-                       _ -> Nothing
-
-data BuildMessage
-  = BuildMsg   !SDoc
-  | BuildError !SrcLoc !SDoc
-  | EOF
-
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1264,117 +389,6 @@ data BuildMessage
 ************************************************************************
 -}
 
------------------------------------------------------------------------------
--- Define       getBaseDir     :: IO (Maybe String)
-
-getBaseDir :: IO (Maybe String)
-#if defined(mingw32_HOST_OS)
--- Assuming we are running ghc, accessed by path  $(stuff)/<foo>/ghc.exe,
--- return the path $(stuff)/lib.
-getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
-  where
-    try_size size = allocaArray (fromIntegral size) $ \buf -> do
-        ret <- c_GetModuleFileName nullPtr buf size
-        case ret of
-          0 -> return Nothing
-          _ | ret < size -> do
-                path <- peekCWString buf
-                real <- getFinalPath path -- try to resolve symlinks paths
-                let libdir = (rootDir . sanitize . maybe path id) real
-                exists <- doesDirectoryExist libdir
-                if exists
-                   then return $ Just libdir
-                   else fail path
-            | otherwise  -> try_size (size * 2)
-
-    -- getFinalPath returns paths in full raw form.
-    -- Unfortunately GHC isn't set up to handle these
-    -- So if the call succeeded, we need to drop the
-    -- \\?\ prefix.
-    sanitize s = if "\\\\?\\" `isPrefixOf` s
-                    then drop 4 s
-                    else s
-
-    rootDir s = case splitFileName $ normalise s of
-                (d, ghc_exe)
-                 | lower ghc_exe `elem` ["ghc.exe",
-                                         "ghc-stage1.exe",
-                                         "ghc-stage2.exe",
-                                         "ghc-stage3.exe"] ->
-                    case splitFileName $ takeDirectory d of
-                    -- ghc is in $topdir/bin/ghc.exe
-                    (d', _) -> takeDirectory d' </> "lib"
-                _ -> fail s
-
-    fail s = panic ("can't decompose ghc.exe path: " ++ show s)
-    lower = map toLower
-
-foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"
-  c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
-
--- Attempt to resolve symlinks in order to find the actual location GHC
--- is located at. See Trac #11759.
-getFinalPath :: FilePath -> IO (Maybe FilePath)
-getFinalPath name = do
-    dllHwnd <- failIfNull "LoadLibrary"     $ loadLibrary "kernel32.dll"
-    -- Note: The API GetFinalPathNameByHandleW is only available starting from Windows Vista.
-    -- This means that we can't bind directly to it since it may be missing.
-    -- Instead try to find it's address at runtime and if we don't succeed consider the
-    -- function failed.
-    addr_m  <- (fmap Just $ failIfNull "getProcAddress" $ getProcAddress dllHwnd "GetFinalPathNameByHandleW")
-                  `catch` (\(_ :: SomeException) -> return Nothing)
-    case addr_m of
-      Nothing   -> return Nothing
-      Just addr -> do handle  <- failIf (==iNVALID_HANDLE_VALUE) "CreateFile"
-                                        $ createFile name
-                                                     gENERIC_READ
-                                                     fILE_SHARE_READ
-                                                     Nothing
-                                                     oPEN_EXISTING
-                                                     (fILE_ATTRIBUTE_NORMAL .|. fILE_FLAG_BACKUP_SEMANTICS)
-                                                     Nothing
-                      let fnPtr = makeGetFinalPathNameByHandle $ castPtrToFunPtr addr
-                      path    <- Win32.try "GetFinalPathName"
-                                    (\buf len -> fnPtr handle buf len 0) 512
-                                    `finally` closeHandle handle
-                      return $ Just path
-
-type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD
-
-foreign import WINDOWS_CCONV unsafe "dynamic"
-  makeGetFinalPathNameByHandle :: FunPtr GetFinalPath -> GetFinalPath
-#else
-getBaseDir = return Nothing
-#endif
-
-
--- Divvy up text stream into lines, taking platform dependent
--- line termination into account.
-linesPlatform :: String -> [String]
-#if !defined(mingw32_HOST_OS)
-linesPlatform ls = lines ls
-#else
-linesPlatform "" = []
-linesPlatform xs =
-  case lineBreak xs of
-    (as,xs1) -> as : linesPlatform xs1
-  where
-   lineBreak "" = ("","")
-   lineBreak ('\r':'\n':xs) = ([],xs)
-   lineBreak ('\n':xs) = ([],xs)
-   lineBreak (x:xs) = let (as,bs) = lineBreak xs in (x:as,bs)
-
-#endif
-
-{-
-Note [No PIE eating while linking]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-As of 2016 some Linux distributions (e.g. Debian) have started enabling -pie by
-default in their gcc builds. This is incompatible with -r as it implies that we
-are producing an executable. Consequently, we must manually pass -no-pie to gcc
-when joining object files or linking dynamic libraries. See #12759.
--}
-
 linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
 linkDynLib dflags0 o_files dep_packages
  = do
@@ -1465,7 +479,7 @@ linkDynLib dflags0 o_files dep_packages
                  ++ pkg_lib_path_opts
                  ++ pkg_link_opts
                 ))
-        _ | os `elem` [OSDarwin, OSiOS] -> do
+        _ | os == OSDarwin -> do
             -------------------------------------------------------------------
             -- Making a darwin dylib
             -------------------------------------------------------------------
@@ -1524,6 +538,7 @@ linkDynLib dflags0 o_files dep_packages
                  ++ map Option pkg_lib_path_opts
                  ++ map Option pkg_link_opts
                  ++ map Option pkg_framework_opts
+                 ++ [ Option "-Wl,-dead_strip_dylibs" ]
               )
         _ -> do
             -------------------------------------------------------------------
@@ -1531,19 +546,19 @@ linkDynLib dflags0 o_files dep_packages
             -------------------------------------------------------------------
 
             let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
+                unregisterised = platformUnregisterised (targetPlatform dflags)
             let bsymbolicFlag = -- we need symbolic linking to resolve
-                                -- non-PIC intra-package-relocations
-                                ["-Wl,-Bsymbolic"]
+                                -- non-PIC intra-package-relocations for
+                                -- performance (where symbolic linking works)
+                                -- See Note [-Bsymbolic assumptions by GHC]
+                                ["-Wl,-Bsymbolic" | not unregisterised]
 
             runLink dflags (
                     map Option verbFlags
+                 ++ libmLinkOpts
                  ++ [ Option "-o"
                     , FileOption "" output_fn
                     ]
-                    -- See Note [No PIE eating when linking]
-                 ++ (if sGccSupportsNoPie (settings dflags)
-                     then [Option "-no-pie"]
-                     else [])
                  ++ map Option o_files
                  ++ [ Option "-shared" ]
                  ++ map Option bsymbolicFlag
@@ -1556,6 +571,16 @@ linkDynLib dflags0 o_files dep_packages
                  ++ map Option pkg_link_opts
               )
 
+-- | Some platforms require that we explicitly link against @libm@ if any
+-- math-y things are used (which we assume to include all programs). See #14022.
+libmLinkOpts :: [Option]
+libmLinkOpts =
+#if defined(HAVE_LIBM)
+  [Option "-lm"]
+#else
+  []
+#endif
+
 getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
 getPkgFrameworkOpts dflags platform dep_packages
   | platformUsesFrameworks platform = do
@@ -1583,3 +608,27 @@ getFrameworkOpts dflags platform
     -- reverse because they're added in reverse order from the cmd line:
     framework_opts = concat [ ["-framework", fw]
                             | fw <- reverse frameworks ]
+
+{-
+Note [-Bsymbolic assumptions by GHC]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+GHC has a few assumptions about interaction of relocations in NCG and linker:
+
+1. -Bsymbolic resolves internal references when the shared library is linked,
+   which is important for performance.
+2. When there is a reference to data in a shared library from the main program,
+   the runtime linker relocates the data object into the main program using an
+   R_*_COPY relocation.
+3. If we used -Bsymbolic, then this results in multiple copies of the data
+   object, because some references have already been resolved to point to the
+   original instance. This is bad!
+
+We work around [3.] for native compiled code by avoiding the generation of
+R_*_COPY relocations.
+
+Unregisterised compiler can't evade R_*_COPY relocations easily thus we disable
+-Bsymbolic linking there.
+
+See related Trac tickets: #4210, #15338
+-}