[Git][ghc/ghc][wip/andreask/lsp-crash] ghc-the-library: Retain cafs in both static in dynamic builds.

[Andreas Klebinger (@AndreasK)]

Andreas Klebinger pushed to branch wip/andreask/lsp-crash at Glasgow Haskell Compiler / GHC


Commits:
394a8744 by Andreas Klebinger at 2023-01-11T18:36:32+01:00
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.

- - - - -


5 changed files:

- compiler/GHC.hs
- compiler/cbits/keepCAFsForGHCi.c
- rts/include/rts/storage/GC.h
- rts/sm/Storage.c
- testsuite/tests/ghci/T16392/T16392.script


Changes:

=====================================
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
 
@@ -557,7 +559,14 @@ 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.
+    !keep_cafs <- c_keepCAFsForGHCi
+    massert keep_cafs
+    initHscEnv mb_top_dir
+  )
 
 -- %************************************************************************
 -- %*                                                                      *
@@ -1949,3 +1958,8 @@ instance Exception GhcApiError
 
 mkApiErr :: DynFlags -> SDoc -> GhcApiError
 mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
+
+--
+foreign import ccall unsafe "keepCAFsForGHCi"
+    c_keepCAFsForGHCi   :: IO Bool
+


=====================================
compiler/cbits/keepCAFsForGHCi.c
=====================================
@@ -1,15 +1,36 @@
 #include <Rts.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.
+// We employ a catch-22 to avoid this.
+// * When initializing a GHC session in initGhcMonad we assert keeping cafs has been
+//   enabled by calling get_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.
 
-static void keepCAFsForGHCi(void) __attribute__((constructor));
 
-static void keepCAFsForGHCi(void)
+
+void keepCAFsForGHCi(void) __attribute__((constructor));
+
+void keepCAFsForGHCi(void)
+{
+    setKeepCAFs();
+}
+
+bool get_keepCAFsForGHCi(void)
 {
-    keepCAFs = 1;
+    return getKeepCAFs();
 }
 


=====================================
rts/include/rts/storage/GC.h
=====================================
@@ -229,6 +229,9 @@ void revertCAFs (void);
 // (preferably use RtsConfig.keep_cafs instead)
 void setKeepCAFs (void);
 
+// Are CAFs being retained?
+bool getKeepCAFs (void);
+
 // Let the runtime know that all the CAFs in high mem are not
 // to be retained. Useful in conjunction with loadNativeObj
 void setHighMemDynamic (void);


=====================================
rts/sm/Storage.c
=====================================
@@ -646,6 +646,13 @@ setKeepCAFs (void)
     keepCAFs = 1;
 }
 
+// External API for setting the keepCAFs flag. see #3900.
+bool
+getKeepCAFs (void)
+{
+    return keepCAFs;
+}
+
 void
 setHighMemDynamic (void)
 {


=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/394a87443fbb801ff99b6a6d925069c7d663ad12

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/394a87443fbb801ff99b6a6d925069c7d663ad12
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230111/fcf0ac1f/attachment-0001.html>