ghc-bin: Add --merge-objs mode

This adds a new mode, `--merge-objs`, which can be used to produce
merged GHCi library objects.

As future work we will rip out the object-merging logic in Hadrian and
Cabal and instead use this mode.

Closes #20712.

13 files changed, 100 insertions, 27 deletions

diff --git a/compiler/GHC/Driver/Phases.hs b/compiler/GHC/Driver/Phases.hs
index 2b4e234d12..31a1e45361 100644
--- a/compiler/GHC/Driver/Phases.hs
+++ b/compiler/GHC/Driver/Phases.hs
@@ -66,19 +66,20 @@ import System.FilePath
    C compiler (opt.)      | .hc or .c     | -S            | .s
    assembler              | .s  or .S     | -c            | .o
    linker                 | other         | -             | a.out
+   linker (merge objects) | other         | -             | .o
 -}
 
 -- Phases we can actually stop after
-data StopPhase = StopPreprocess -- -E
-               | StopC  -- -C
-               | StopAs -- -S
-               | NoStop -- -c
+data StopPhase = StopPreprocess -- ^ @-E@
+               | StopC          -- ^ @-C@
+               | StopAs         -- ^ @-S@
+               | NoStop         -- ^ @-c@
 
 stopPhaseToPhase :: StopPhase -> Phase
 stopPhaseToPhase StopPreprocess = anyHsc
-stopPhaseToPhase StopC   = HCc
-stopPhaseToPhase StopAs  = As False
-stopPhaseToPhase NoStop  = StopLn
+stopPhaseToPhase StopC          = HCc
+stopPhaseToPhase StopAs         = As False
+stopPhaseToPhase NoStop         = StopLn
 
 -- | Untyped Phase description
 data Phase
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 92782176b2..22bd9c3280 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -378,9 +378,10 @@ link ghcLink logger tmpfs hooks dflags unit_env batch_attempt_linking hpt =
   case linkHook hooks of
       Nothing -> case ghcLink of
           NoLink        -> return Succeeded
-          LinkBinary    -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt
-          LinkStaticLib -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt
-          LinkDynLib    -> link' logger tmpfs dflags unit_env batch_attempt_linking hpt
+          LinkBinary    -> normal_link
+          LinkStaticLib -> normal_link
+          LinkDynLib    -> normal_link
+          LinkMergedObj -> normal_link
           LinkInMemory
               | platformMisc_ghcWithInterpreter $ platformMisc dflags
               -> -- Not Linking...(demand linker will do the job)
@@ -388,6 +389,8 @@ link ghcLink logger tmpfs hooks dflags unit_env batch_attempt_linking hpt =
               | otherwise
               -> panicBadLink LinkInMemory
       Just h  -> h ghcLink dflags batch_attempt_linking hpt
+  where
+    normal_link = link' logger tmpfs dflags unit_env batch_attempt_linking hpt
 
 
 panicBadLink :: GhcLink -> a
@@ -559,6 +562,11 @@ doLink hsc_env o_files =
         LinkBinary    -> linkBinary         logger tmpfs dflags unit_env o_files []
         LinkStaticLib -> linkStaticLib      logger       dflags unit_env o_files []
         LinkDynLib    -> linkDynLibCheck    logger tmpfs dflags unit_env o_files []
+        LinkMergedObj
+          | Just out <- outputFile dflags
+          , let objs = [ f | FileOption _ f <- ldInputs dflags ]
+                      -> joinObjectFiles hsc_env (o_files ++ objs) out
+          | otherwise -> panic "Output path must be specified for LinkMergedObj"
         other         -> panicBadLink other
 
 -----------------------------------------------------------------------------
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index ef311c64ff..2c371d17c9 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -165,10 +165,7 @@ runMergeForeign _pipe_env hsc_env input_fn foreign_os = do
                               (tmpDir (hsc_dflags hsc_env))
                               TFL_CurrentModule "o"
          copyFile input_fn new_o
-         let dflags = hsc_dflags hsc_env
-             logger = hsc_logger hsc_env
-         let tmpfs = hsc_tmpfs hsc_env
-         joinObjectFiles logger tmpfs dflags (new_o : foreign_os) input_fn
+         joinObjectFiles hsc_env (new_o : foreign_os) input_fn
          return input_fn
 
 runLlvmLlcPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath
@@ -1098,7 +1095,7 @@ enabled in the toolchain:
 
 We must enable bigobj output in a few places:
 
- * When merging object files (GHC.Driver.Pipeline.joinObjectFiles)
+ * When merging object files (GHC.Driver.Pipeline.Execute.joinObjectFiles)
 
  * When assembling (GHC.Driver.Pipeline.runPhase (RealPhase As ...))
 
@@ -1123,19 +1120,12 @@ via gcc.
 
 -}
 
-joinObjectFiles :: Logger -> TmpFs -> DynFlags -> [FilePath] -> FilePath -> IO ()
-joinObjectFiles logger tmpfs dflags o_files output_fn = do
+joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO ()
+joinObjectFiles hsc_env o_files output_fn = do
   let toolSettings' = toolSettings dflags
       ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'
-      osInfo = platformOS (targetPlatform dflags)
-      ld_r args = GHC.SysTools.runMergeObjects logger tmpfs dflags (
-                        -- See Note [Produce big objects on Windows]
-                        concat
-                          [ [GHC.SysTools.Option "--oformat", GHC.SysTools.Option "pe-bigobj-x86-64"]
-                          | OSMinGW32 == osInfo
-                          , not $ target32Bit (targetPlatform dflags)
-                          ]
-                     ++ map GHC.SysTools.Option ld_build_id
+      ld_r args = GHC.SysTools.runMergeObjects (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) (
+                        map GHC.SysTools.Option ld_build_id
                      ++ [ GHC.SysTools.Option "-o",
                           GHC.SysTools.FileOption "" output_fn ]
                      ++ args)
@@ -1144,7 +1134,7 @@ joinObjectFiles logger tmpfs dflags o_files output_fn = do
       -- which we don't need and sometimes causes ld to emit a
       -- warning:
       ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["--build-id=none"]
-                  | otherwise                     = []
+                  | otherwise                                    = []
 
   if ldIsGnuLd
      then do
@@ -1161,6 +1151,11 @@ joinObjectFiles logger tmpfs dflags o_files output_fn = do
                 GHC.SysTools.FileOption "" filelist]
      else
           ld_r (map (GHC.SysTools.FileOption "") o_files)
+  where
+    dflags = hsc_dflags hsc_env
+    tmpfs = hsc_tmpfs hsc_env
+    logger = hsc_logger hsc_env
+
 
 -----------------------------------------------------------------------------
 -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 232740dfe4..33b27c2f9f 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -917,6 +917,7 @@ data GhcLink
                         --   bytecode and object code).
   | LinkDynLib          -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
   | LinkStaticLib       -- ^ Link objects into a static lib
+  | LinkMergedObj       -- ^ Link objects into a merged "GHCi object"
   deriving (Eq, Show)
 
 isNoLink :: GhcLink -> Bool
@@ -2174,6 +2175,8 @@ dynamic_flags_deps = [
         (noArg (\d -> d { ghcLink=LinkDynLib }))
   , make_ord_flag defGhcFlag "staticlib"
         (noArg (\d -> setGeneralFlag' Opt_LinkRts (d { ghcLink=LinkStaticLib })))
+  , make_ord_flag defGhcFlag "merge-objs"
+        (noArg (\d -> d { ghcLink=LinkMergedObj }))
   , make_ord_flag defGhcFlag "dynload"            (hasArg parseDynLibLoaderMode)
   , make_ord_flag defGhcFlag "dylib-install-name" (hasArg setDylibInstallName)
 
@@ -4665,6 +4668,10 @@ makeDynFlagsConsistent dflags
     = loop dflags{targetWays_ = addWay WayProf (targetWays_ dflags)}
          "Enabling -prof, because -fobject-code is enabled and GHCi is profiled"
 
+ | LinkMergedObj <- ghcLink dflags
+ , Nothing <- outputFile dflags
+ = pgmError "--output must be specified when using --merge-objs"
+
  | otherwise = (dflags, [])
     where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
           loop updated_dflags warning
diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index 07377dab77..427829da99 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -3488,6 +3488,21 @@ will be executed on the target. As such packages like ``git-embed``,
 ``file-embed`` and others might not behave as expected if the target
 and host do not share the same filesystem.
 
+.. _building-ghci-libraries:
+
+Building GHCi libraries
+-----------------------
+
+When invoked in the static way, GHCi will use the GHC RTS's static runtime
+linker to load object files for imported modules when available. However, when
+these modules are built with :ghc-flag:`-split-sections` this linking can be
+quite expensive. To reduce this cost, package managers and build systems may
+opt to produce a pre-linked *GHCi object* using the :ghc-flag:`-merge-objs`
+mode. This merges the per-module objects into a single object, collapsing
+function sections into a single text section which can be efficiently loaded by
+the runtime linker.
+
+
 .. _ghci-faq:
 
 FAQ and Things To Watch Out For
diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst
index 59b89d1348..2184946571 100644
--- a/docs/users_guide/using.rst
+++ b/docs/users_guide/using.rst
@@ -345,6 +345,14 @@ The available mode flags are:
     compile source files one at a time, or link objects together into an
     executable. See :ref:`options-order`.
 
+.. ghc-flag:: -merge-objs
+    :shortdesc: Merge a set of objects into a GHCi library.
+    :type: mode
+    :category: phases
+
+    Merge a set of static object files into a library optimised for loading in
+    GHCi. See :ref:`building-ghci-libraries`.
+
 .. ghc-flag:: -M
     :shortdesc: generate dependency information suitable for use in a
         ``Makefile``; see :ref:`makefile-dependencies` for details.
diff --git a/testsuite/tests/driver/MergeObjsMode/A.hs b/testsuite/tests/driver/MergeObjsMode/A.hs
new file mode 100644
index 0000000000..af7ebc8eb9
--- /dev/null
+++ b/testsuite/tests/driver/MergeObjsMode/A.hs
@@ -0,0 +1,5 @@
+module A where
+
+a :: Int
+a = 42
+
diff --git a/testsuite/tests/driver/MergeObjsMode/B.hs b/testsuite/tests/driver/MergeObjsMode/B.hs
new file mode 100644
index 0000000000..0cb45d3f54
--- /dev/null
+++ b/testsuite/tests/driver/MergeObjsMode/B.hs
@@ -0,0 +1,4 @@
+module B where
+
+b :: String
+b = "hello world"
diff --git a/testsuite/tests/driver/MergeObjsMode/Main.hs b/testsuite/tests/driver/MergeObjsMode/Main.hs
new file mode 100644
index 0000000000..4785441214
--- /dev/null
+++ b/testsuite/tests/driver/MergeObjsMode/Main.hs
@@ -0,0 +1,7 @@
+module Main where
+
+import A
+import B
+
+main :: IO ()
+main = print (a,b)
diff --git a/testsuite/tests/driver/MergeObjsMode/Makefile b/testsuite/tests/driver/MergeObjsMode/Makefile
new file mode 100644
index 0000000000..c36e0626a6
--- /dev/null
+++ b/testsuite/tests/driver/MergeObjsMode/Makefile
@@ -0,0 +1,12 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+MergeObjsMode :
+	"$(TEST_HC)" $(TEST_HC_OPTS) -c A.hs
+	"$(TEST_HC)" $(TEST_HC_OPTS) -c B.hs
+	"$(TEST_HC)" $(TEST_HC_OPTS) -c Main.hs
+	"$(TEST_HC)" $(TEST_HC_OPTS) -merge-objs -o HSlib.o A.o B.o
+	"$(TEST_HC)" $(TEST_HC_OPTS) -o Main Main.o HSlib.o
+	./Main
+
diff --git a/testsuite/tests/driver/MergeObjsMode/MergeObjsMode.stdout b/testsuite/tests/driver/MergeObjsMode/MergeObjsMode.stdout
new file mode 100644
index 0000000000..79c8eebc6e
--- /dev/null
+++ b/testsuite/tests/driver/MergeObjsMode/MergeObjsMode.stdout
@@ -0,0 +1 @@
+(42,"hello world")
diff --git a/testsuite/tests/driver/MergeObjsMode/all.T b/testsuite/tests/driver/MergeObjsMode/all.T
new file mode 100644
index 0000000000..ebcf4546c6
--- /dev/null
+++ b/testsuite/tests/driver/MergeObjsMode/all.T
@@ -0,0 +1,4 @@
+test('MergeObjsMode',
+     extra_files(['A.hs', 'B.hs', 'Main.hs']),
+     makefile_test,
+     [])
diff --git a/testsuite/tests/driver/MergeObjsMode/app/Main.hs b/testsuite/tests/driver/MergeObjsMode/app/Main.hs
new file mode 100644
index 0000000000..c1ce71b0e6
--- /dev/null
+++ b/testsuite/tests/driver/MergeObjsMode/app/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import A
+import B
+
+