diff options
-rw-r--r-- | compiler/GHC.hs | 18 | ||||
-rw-r--r-- | compiler/cbits/keepCAFsForGHCi.c | 26 | ||||
-rw-r--r-- | testsuite/tests/ghci/T16392/T16392.script | 2 |
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 |