Detect linker information at runtime. Fixes Trac #6063

Previously, we did ./configure time checks to see if 'GNU ld' supported
certain options. If it does, we bake those options into the link step.
See Trac #5240.

Unfortunately, the linker we use at runtime can change for several
reasons. One is that the user specifies -pgml 'foo'. The other is if
/usr/bin/ld or whatnot changes from when GHC was built.  Those options
mentioned earlier are specific to GNU ld, but many systems support GNU
gold too. This is Trac #6063.

So we need to check at runtime what linker we're using. This is actually
a little bit complicated because we normally use the C compiler as our
linker. Windows and OS X are also special here.

Finally, this patch also unconditionally gives '--hash-size=31' and
'--reduce-memory-overheads' to the system linker if it's GNU ld. These
options have been supported for 8+ years from what I can see, and there
are probably a lot of other reasons why GHC would not work with such an
ancient binutils, all things considered.

See Note [Run-time linker info] in SysTools for details. There are
plenty of comments as well in the surrounding code.

Signed-off-by: Austin Seipp <aseipp@pobox.com>

2 files changed, 137 insertions, 6 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 0e96a2069c..64ae9b5699 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -129,6 +129,9 @@ module DynFlags (
         -- * SSE
         isSse2Enabled,
         isSse4_2Enabled,
+
+        -- * Linker information
+        LinkerInfo(..),
   ) where
 
 #include "HsVersions.h"
@@ -742,7 +745,10 @@ data DynFlags = DynFlags {
   nextWrapperNum        :: IORef Int,
 
   -- | Machine dependant flags (-m<blah> stuff)
-  sseVersion            :: Maybe (Int, Int)  -- (major, minor)
+  sseVersion            :: Maybe (Int, Int),  -- (major, minor)
+
+  -- | Run-time linker information (what options we need, etc.)
+  rtldFlags             :: IORef (Maybe LinkerInfo)
  }
 
 class HasDynFlags m where
@@ -1201,6 +1207,7 @@ initDynFlags dflags = do
  refFilesToNotIntermediateClean <- newIORef []
  refGeneratedDumps <- newIORef Set.empty
  refLlvmVersion <- newIORef 28
+ refRtldFlags <- newIORef Nothing
  wrapperNum <- newIORef 0
  canUseUnicodeQuotes <- do let enc = localeEncoding
                                str = "‛’"
@@ -1216,7 +1223,8 @@ initDynFlags dflags = do
         generatedDumps = refGeneratedDumps,
         llvmVersion    = refLlvmVersion,
         nextWrapperNum = wrapperNum,
-        useUnicodeQuotes = canUseUnicodeQuotes
+        useUnicodeQuotes = canUseUnicodeQuotes,
+        rtldFlags      = refRtldFlags
         }
 
 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
@@ -1349,7 +1357,8 @@ defaultDynFlags mySettings =
         llvmVersion = panic "defaultDynFlags: No llvmVersion",
         interactivePrint = Nothing,
         nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum",
-        sseVersion = Nothing
+        sseVersion = Nothing,
+        rtldFlags = panic "defaultDynFlags: no rtldFlags"
       }
 
 defaultWays :: Settings -> [Way]
@@ -3519,3 +3528,14 @@ isSse2Enabled dflags = case platformArch (targetPlatform dflags) of
 
 isSse4_2Enabled :: DynFlags -> Bool
 isSse4_2Enabled dflags = sseVersion dflags >= Just (4,2)
+
+-- -----------------------------------------------------------------------------
+-- Linker information
+
+-- LinkerInfo contains any extra options needed by the system linker.
+data LinkerInfo
+  = GnuLD    [Option]
+  | GnuGold  [Option]
+  | DarwinLD [Option]
+  | UnknownLD
+  deriving Eq
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 5926114984..d43826a046 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -24,6 +24,8 @@ module SysTools (
         figureLlvmVersion,
         readElfSection,
 
+        getLinkerInfo,
+
         linkDynLib,
 
         askCc,
@@ -596,13 +598,122 @@ figureLlvmVersion dflags = do
                           text "Make sure you have installed LLVM"]
                 return Nothing)
   return ver
-  
+
+
+{- Note [Run-time linker info]
+
+See also: Trac #5240, Trac #6063
+
+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.
+
+-}
+
+
+neededLinkArgs :: LinkerInfo -> [Option]
+neededLinkArgs (GnuLD o)     = o
+neededLinkArgs (GnuGold o)   = o
+neededLinkArgs (DarwinLD o)  = o
+neededLinkArgs UnknownLD     = []
+
+-- Grab linker info and cache it in DynFlags.
+getLinkerInfo :: DynFlags -> IO LinkerInfo
+getLinkerInfo dflags = do
+  info <- readIORef (rtldFlags dflags)
+  case info of
+    Just v  -> return v
+    Nothing -> do
+      v <- getLinkerInfo' dflags
+      writeIORef (rtldFlags 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,_) = pgm_l dflags
+
+      -- 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.
+          return (GnuLD $ map Option ["-Wl,--hash-size=31",
+                                      "-Wl,--reduce-memory-overheads"])
+
+        | any ("GNU gold" `isPrefixOf`) stdo =
+          -- GNU gold does not require any special arguments.
+          return (GnuGold [])
+
+         -- Unknown linker.
+        | otherwise = fail "invalid --version output, or linker is unsupported"
+
+  -- Process the executable call
+  info <- catchIO (do
+             case os of
+               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 []
+               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 ["-Wl,--hash-size=31",
+                                              "-Wl,--reduce-memory-overheads"]
+               _ -> do
+                 -- In practice, we use the compiler as the linker here. Pass
+                 -- -Wl,--version to get linker version info.
+                 (exitc, stdo, stde) <- readProcessWithExitCode pgm
+                                        ["-Wl,--version"] ""
+                 -- 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
 
 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 ++ args1 ++ args
+      args1     = map Option (getOpts dflags opt_l)
+      args2     = args0 ++ args1 ++ args ++ linkargs
   mb_env <- getGccEnv args2
   runSomethingFiltered dflags id "Linker" p args2 mb_env