ghc-the-library: Retain cafs in both static in dynamic builds.

We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a
__attribute__((constructor)) function.

This broke for static builds where the linker discarded the object file
since it was not reverenced from any exported code. We fix this by
asserting that the flag is enabled using a function in the same module
as the constructor. Which causes the object file to be retained by the
linker, which in turn causes the constructor the be run in static builds.

This changes nothing for dynamic builds using the ghc library. But causes
static to also retain CAFs (as we expect them to).

Fixes #22417.

-------------------------
Metric Decrease:
    T21839r
-------------------------

(cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5)

4 files changed, 33 insertions, 19 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index dfdb1b6d42..2788a5dfb2 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -554,7 +554,12 @@ withCleanupSession ghc = ghc `MC.finally` cleanup
 
 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
 initGhcMonad mb_top_dir
-  = do { env <- liftIO $
+  = do { -- The call to c_keepCAFsForGHCi must not be optimized away. Even in non-debug builds.
+         -- So we can't use assertM here.
+         -- See Note [keepCAFsForGHCi] in keepCAFsForGHCi.c for details about why.
+         !keep_cafs <- liftIO $ c_keepCAFsForGHCi
+       ; MASSERT( keep_cafs )
+       ; env <- liftIO $
                 do { top_dir <- findTopDir mb_top_dir
                    ; mySettings <- initSysTools top_dir
                    ; myLlvmConfig <- lazyInitLlvmConfig top_dir
@@ -600,7 +605,6 @@ checkBrokenTablesNextToCode' logger dflags
         arch = platformArch platform
         tablesNextToCode = platformTablesNextToCode platform
 
-
 -- %************************************************************************
 -- %*                                                                      *
 --             Flags & settings
@@ -1931,3 +1935,5 @@ instance Exception GhcApiError
 mkApiErr :: DynFlags -> SDoc -> GhcApiError
 mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
 
+foreign import ccall unsafe "keepCAFsForGHCi"
+    c_keepCAFsForGHCi   :: IO Bool
diff --git a/compiler/cbits/keepCAFsForGHCi.c b/compiler/cbits/keepCAFsForGHCi.c
index ba635b0d95..9645f54c9b 100644
--- a/compiler/cbits/keepCAFsForGHCi.c
+++ b/compiler/cbits/keepCAFsForGHCi.c
@@ -1,15 +1,35 @@
 #include <Rts.h>
+#include <ghcversion.h>
 
+// Note [keepCAFsForGHCi]
+// ~~~~~~~~~~~~~~~~~~~~~~
 // This file is only included in the dynamic library.
 // It contains an __attribute__((constructor)) function (run prior to main())
 // which sets the keepCAFs flag in the RTS, before any Haskell code is run.
 // This is required so that GHCi can use dynamic libraries instead of HSxyz.o
 // files.
+//
+// For static builds we have to guarantee that the linker loads this object file
+// to ensure the constructor gets run and not discarded. If the object is part of
+// an archive and not otherwise referenced the linker would ignore the object.
+// To avoid this:
+// * When initializing a GHC session in initGhcMonad we assert keeping cafs has been
+//   enabled by calling keepCAFsForGHCi.
+// * This causes the GHC module from the ghc package to carry a reference to this object
+//   file.
+// * Which in turn ensures the linker doesn't discard this object file, causing
+//   the constructor to be run, allowing the assertion to succeed in the first place
+//   as keepCAFs will have been set already during initialization of constructors.
 
-static void keepCAFsForGHCi(void) __attribute__((constructor));
 
-static void keepCAFsForGHCi(void)
+
+bool keepCAFsForGHCi(void) __attribute__((constructor));
+
+bool keepCAFsForGHCi(void)
 {
-    keepCAFs = 1;
+    bool was_set = keepCAFs;
+    setKeepCAFs();
+    return was_set;
 }
 
+
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 2751218adf..3df661c1bd 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -288,20 +288,6 @@ $(eval $(call build-package,compiler,stage1,0))
 $(eval $(call build-package,compiler,stage2,1))
 $(eval $(call build-package,compiler,stage3,2))
 
-# We only want to turn keepCAFs on if we will be loading dynamic
-# Haskell libraries with GHCi. We therefore filter the object file
-# out for non-dynamic ways.
-define keepCAFsForGHCiDynOnly
-# $1 = stage
-# $2 = way
-ifeq "$$(findstring dyn, $2)" ""
-compiler_stage$1_$2_C_OBJS := $$(filter-out %/keepCAFsForGHCi.$$($2_osuf),$$(compiler_stage$1_$2_C_OBJS))
-endif
-endef
-$(foreach w,$(compiler_stage1_WAYS),$(eval $(call keepCAFsForGHCiDynOnly,1,$w)))
-$(foreach w,$(compiler_stage2_WAYS),$(eval $(call keepCAFsForGHCiDynOnly,2,$w)))
-$(foreach w,$(compiler_stage3_WAYS),$(eval $(call keepCAFsForGHCiDynOnly,3,$w)))
-
 # after build-package, because that adds --enable-library-for-ghci
 # to compiler_stage*_CONFIGURE_OPTS:
 # We don't build the GHCi library for the ghc package. We can load it
diff --git a/testsuite/tests/ghci/T16392/T16392.script b/testsuite/tests/ghci/T16392/T16392.script
index 5fdcb17dc0..ca570f0f28 100644
--- a/testsuite/tests/ghci/T16392/T16392.script
+++ b/testsuite/tests/ghci/T16392/T16392.script
@@ -1,5 +1,7 @@
 :set -fobject-code
+import System.Mem
 :load A.hs
 c_two caf
+performMajorGC
 :load A.hs
 c_two caf