Ensure that wired-in exception closures aren't GC'dwip/T21141-9.2

As described in Note [Wired-in exceptions are not CAFfy], a small set of
built-in exception closures get special treatment in the code generator,
being declared as non-CAFfy despite potentially containing CAF
references. The original intent of this treatment for the RTS to then
add StablePtrs for each of the closures, ensuring that they are not
GC'd. However, this logic was not applied consistently and eventually
removed entirely in 951c1fb0. This lead to #21141.

Here we fix this bug by reintroducing the StablePtrs and document the
status quo.

Closes #21141.

(cherry picked from commit 2ac45ba0ff0ab2911ecfe443e54df6f30eec5ff5)

4 files changed, 41 insertions, 3 deletions

diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index f002637556..9f9e92e9f8 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -824,7 +824,9 @@ tYPE_ERROR_ID                   = mkRuntimeErrorId typeErrorName
 --       argument would require allocating a thunk.
 --
 --    4. it can't be CAFFY because that would mean making some non-CAFFY
---       definitions that use unboxed sums CAFFY in unarise.
+--       definitions that use unboxed sums CAFFY in unarise. We work around
+--       this by declaring the absentSumFieldError as non-CAFfy, as described
+--       in Note [Wired-in exceptions are not CAFfy].
 --
 --       Getting this wrong causes hard-to-debug runtime issues, see #15038.
 --
@@ -858,6 +860,21 @@ tYPE_ERROR_ID                   = mkRuntimeErrorId typeErrorName
 --   error. That's why it is OK for it to be un-catchable.
 --
 
+-- Note [Wired-in exceptions are not CAFfy]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- mkExceptionId claims that all exceptions are not CAFfy, despite the fact
+-- that their closures' code may in fact contain CAF references. We get away
+-- with this lie because the RTS ensures that all exception closures are
+-- considered live by the GC by creating StablePtrs during initialization.
+-- The lie is necessary to avoid unduly growing SRTs as these exceptions are
+-- sufficiently common to warrant special treatment.
+--
+-- At some point we could consider removing this optimisation as it is quite
+-- fragile, but we do want to be careful to avoid adding undue cost. Unboxed
+-- sums in particular are intended to be used in performance-critical contexts.
+--
+-- See #15038, #21141.
+
 absentSumFieldErrorName
    = mkWiredInIdName
       gHC_PRIM_PANIC
@@ -899,6 +916,9 @@ rAISE_UNDERFLOW_ID        = mkExceptionId raiseUnderflowName
 rAISE_DIVZERO_ID          = mkExceptionId raiseDivZeroName
 
 -- | Exception with type \"forall a. a\"
+--
+-- Any exceptions added via this function needs to be added to
+-- the RTS's initBuiltinGcRoots() function.
 mkExceptionId :: Name -> Id
 mkExceptionId name
   = mkVanillaGlobalWithInfo name
@@ -906,7 +926,8 @@ mkExceptionId name
       (vanillaIdInfo `setStrictnessInfo` mkClosedStrictSig [] botDiv
                      `setCprInfo` mkCprSig 0 botCpr
                      `setArityInfo` 0
-                     `setCafInfo` NoCafRefs) -- #15038
+                     `setCafInfo` NoCafRefs)
+                        -- See Note [Wired-in exceptions are not CAFfy]
 
 mkRuntimeErrorId :: Name -> Id
 -- Error function
diff --git a/libraries/ghc-prim/GHC/Prim/Exception.hs b/libraries/ghc-prim/GHC/Prim/Exception.hs
index 592d597f44..0b9e9c165c 100644
--- a/libraries/ghc-prim/GHC/Prim/Exception.hs
+++ b/libraries/ghc-prim/GHC/Prim/Exception.hs
@@ -20,13 +20,14 @@ default () -- Double and Integer aren't available yet
 
 -- Note [Arithmetic exceptions]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
 -- ghc-prim provides several functions to raise arithmetic exceptions
 -- (raiseDivZero, raiseUnderflow, raiseOverflow) that are wired-in the RTS.
 -- These exceptions are meant to be used by the package implementing arbitrary
 -- precision numbers (Natural,Integer). It can't depend on `base` package to
 -- raise exceptions in a normal way because it would create a dependency
 -- cycle (base <-> bignum package). See #14664
+--
+-- See also: Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make.
 
 foreign import prim "stg_raiseOverflowzh" raiseOverflow# :: State# RealWorld -> (# State# RealWorld, (# #) #)
 foreign import prim "stg_raiseUnderflowzh" raiseUnderflow# :: State# RealWorld -> (# State# RealWorld, (# #) #)
diff --git a/rts/Prelude.h b/rts/Prelude.h
index d2511b2fc3..5f1e070e33 100644
--- a/rts/Prelude.h
+++ b/rts/Prelude.h
@@ -19,6 +19,12 @@
 #define PRELUDE_CLOSURE(i)    extern StgClosure DLL_IMPORT_DATA_VARNAME(i)
 #endif
 
+/* See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. */
+PRELUDE_CLOSURE(ghczmprim_GHCziPrimziPanic_absentSumFieldError_closure);
+PRELUDE_CLOSURE(ghczmprim_GHCziPrimziException_raiseUnderflow_closure);
+PRELUDE_CLOSURE(ghczmprim_GHCziPrimziException_raiseOverflow_closure);
+PRELUDE_CLOSURE(ghczmprim_GHCziPrimziException_raiseDivZZero_closure);
+
 /* Define canonical names so we can abstract away from the actual
  * modules these names are defined in.
  */
@@ -111,6 +117,10 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info);
 #define nonTermination_closure    DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nonTermination_closure)
 #define nestedAtomically_closure  DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nestedAtomically_closure)
 #define doubleReadException  DLL_IMPORT_DATA_REF(base_GHCziIOPort_doubleReadException_closure)
+#define absentSumFieldError_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziPrimziPanic_absentSumFieldError_closure)
+#define raiseUnderflowException_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziPrimziException_raiseUnderflow_closure)
+#define raiseOverflowException_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziPrimziException_raiseOverflow_closure)
+#define raiseDivZeroException_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziPrimziException_raiseDivZZero_closure)
 
 #define blockedOnBadFD_closure    DLL_IMPORT_DATA_REF(base_GHCziEventziThread_blockedOnBadFD_closure)
 
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index d64f87cf7e..649489d1e3 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -213,6 +213,12 @@ static void initBuiltinGcRoots(void)
 #else
     getStablePtr((StgPtr)processRemoteCompletion_closure);
 #endif
+
+    /* See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. */
+    getStablePtr((StgPtr)absentSumFieldError_closure);
+    getStablePtr((StgPtr)raiseUnderflowException_closure);
+    getStablePtr((StgPtr)raiseOverflowException_closure);
+    getStablePtr((StgPtr)raiseDivZeroException_closure);
 }
 
 void