[macOS] improved runpath handling

In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using
-dead_strip_dylib on macOS when lining dynamic libraries and binaries.
The underlying reason being the Load Command Size Limit in macOS
Sierra (10.14) and later.

GHC will produce @rpath/libHS... dependency entries together with a
corresponding RPATH entry pointing to the location of the libHS...
library. Thus for every library we produce two Load Commands.  One to
specify the dependent library, and one with the path where to find it.
This makes relocating libraries and binaries easier, as we just need to
update the RPATH entry with the install_name_tool. The dynamic linker
will then subsitute each @rpath with the RPATH entries it finds in the
libraries load commands or the environement, when looking up @rpath
relative libraries.

-dead_strip_dylibs intructs the linker to drop unused libraries. This in
turn help us reduce the number of referenced libraries, and subsequently
the size of the load commands.  This however does not remove the RPATH
entries.  Subsequently we can end up (in extreme cases) with only a
single @rpath/libHS... entry, but 100s or more RPATH entries in the Load
Commands.

This patch rectifies this (slighly unorthodox) by passing *no* -rpath
arguments to the linker at link time, but -headerpad 8000.  The
headerpad argument is in hexadecimal and the maxium 32k of the load
command size.  This tells the linker to pad the load command section
enough for us to inject the RPATHs later.  We then proceed to link the
library or binary with -dead_strip_dylibs, and *after* the linking
inspect the library to find the left over (non-dead-stripped)
dependencies (using otool).  We find the corresponding RPATHs for each
@rpath relative dependency, and inject them into the library or binary
using the install_name_tool.  Thus achieving a deadstripped dylib (and
rpaths) build product.

We can not do this in GHC, without starting to reimplement a dynamic
linker as we do not know which symbols and subsequently libraries are
necessary.

Commissioned-by: Mercury Technologies, Inc. (mercury.com)

1 files changed, 50 insertions, 0 deletions

diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index f9962284f9..7dc40cef04 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -28,6 +28,10 @@ import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pa
 import GHC.SysTools.Process
 import GHC.SysTools.Info
 
+import Control.Monad (join, forM, filterM)
+import System.Directory (doesFileExist)
+import System.FilePath ((</>))
+
 {-
 ************************************************************************
 *                                                                      *
@@ -237,6 +241,41 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do
                 return Nothing)
 
 
+-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused
+-- libraries from the dynamic library.  We do this to reduce the number of load
+-- commands that end up in the dylib, and has been limited to 32K (32768) since
+-- macOS Sierra (10.14).
+--
+-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing
+-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not
+-- being included in the load commands, however the @-rpath@ entries are all
+-- forced to be included.  This can lead to 100s of @-rpath@ entries being
+-- included when only a handful of libraries end up being truely linked.
+--
+-- Thus after building the library, we run a fixup phase where we inject the
+-- @-rpath@ for each found library (in the given library search paths) into the
+-- dynamic library through @-add_rpath@.
+--
+-- See Note [Dynamic linking on macOS]
+runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO ()
+runInjectRPaths dflags lib_paths dylib = do
+  info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib]
+  -- filter the output for only the libraries. And then drop the @rpath prefix.
+  let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info
+  -- find any pre-existing LC_PATH items
+  info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib]
+  let paths = concatMap f info
+        where f ("path":p:_) = [p]
+              f _            = []
+      lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ]
+  -- only find those rpaths, that aren't already in the library.
+  rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l </> f)) lib_paths')
+  -- inject the rpaths
+  case rpaths of
+    [] -> return ()
+    _  -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib]
+
+
 runLink :: DynFlags -> [Option] -> IO ()
 runLink dflags args = traceToolCommand dflags "linker" $ do
   -- See Note [Run-time linker info]
@@ -329,6 +368,17 @@ runAr dflags cwd args = traceToolCommand dflags "ar" $ do
   let ar = pgm_ar dflags
   runSomethingFiltered dflags id "Ar" ar args cwd Nothing
 
+askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String
+askOtool dflags mb_cwd args = do
+  let otool = pgm_otool dflags
+  runSomethingWith dflags "otool" otool args $ \real_args ->
+    readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd }
+
+runInstallNameTool :: DynFlags -> [Option] -> IO ()
+runInstallNameTool dflags args = do
+  let tool = pgm_install_name_tool dflags
+  runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing
+
 runRanlib :: DynFlags -> [Option] -> IO ()
 runRanlib dflags args = traceToolCommand dflags "ranlib" $ do
   let ranlib = pgm_ranlib dflags