summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC.hs18
-rw-r--r--compiler/cbits/keepCAFsForGHCi.c26
-rw-r--r--testsuite/tests/ghci/T16392/T16392.script2
3 files changed, 42 insertions, 4 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index dfa5bf5ff2..e079a08cdd 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE TupleSections, NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -ddump-stg-final -ddump-to-file #-}
-- -----------------------------------------------------------------------------
--
@@ -357,6 +358,7 @@ import GHC.Utils.Monad
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
import GHC.Utils.Logger
import GHC.Utils.Fingerprint
@@ -556,7 +558,16 @@ withCleanupSession ghc = ghc `MC.finally` cleanup
-- <http://hackage.haskell.org/package/ghc-paths>.
initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
-initGhcMonad mb_top_dir = setSession =<< liftIO (initHscEnv mb_top_dir)
+initGhcMonad mb_top_dir = setSession =<< 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.
+-- #if MIN_VERSION_GLASGOW_HASKELL(9,7,0,0)
+ !keep_cafs <- c_keepCAFsForGHCi
+ massert keep_cafs
+-- #endif
+ initHscEnv mb_top_dir
+ )
-- %************************************************************************
-- %* *
@@ -1948,3 +1959,8 @@ 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/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