diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index fe0f2890260debed5fd9422f89d52bce2ffa9107..9c927b509cf8c8ba7f0f7f090977da50934e147b 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -810,59 +810,94 @@ tYPE_ERROR_ID = mkRuntimeErrorId typeErrorName
-- Note [aBSENT_SUM_FIELD_ERROR_ID]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Unboxed sums are transformed into unboxed tuples in GHC.Stg.Unarise.mkUbxSum
--- and fields that can't be reached are filled with rubbish values. It's easy to
--- come up with rubbish literal values: we use 0 (ints/words) and 0.0
--- (floats/doubles). Coming up with a rubbish pointer value is more delicate:
+-- and fields that can't be reached are filled with rubbish values.
+-- For instance, consider the case of the program:
--
--- 1. it needs to be a valid closure pointer for the GC (not a NULL pointer)
+-- f :: (# Int | Float# #) -> Int
+-- f = ...
--
--- 2. it is never used in Core, only in STG; and even then only for filling a
--- GC-ptr slot in an unboxed sum (see GHC.Stg.Unarise.ubxSumRubbishArg).
--- So all we need is a pointer, and its levity doesn't matter. Hence we
--- can safely give it the (lifted) type:
+-- x = f (# | 2.0## #)
--
--- absentSumFieldError :: forall a. a
+-- Unarise will represent f's unboxed sum argument as a tuple (# Int#, Int,
+-- Float# #), where Int# is a tag. Consequently, `x` will be rewritten to:
--
--- despite the fact that Unarise might instantiate it at non-lifted
--- types.
+-- x = f (# 2#, ???, 2.0## #)
--
--- 3. it can't take arguments because it's used in unarise and applying an
--- argument would require allocating a thunk.
+-- We must come up with some rubbish literal to use in place of `???`. In the
+-- case of unboxed integer types this is easy: we can simply use 0 for
+-- Int#/Word# and 0.0 Float#/Double#.
--
--- 4. it can't be CAFFY because that would mean making some non-CAFFY
--- definitions that use unboxed sums CAFFY in unarise.
+-- However, coming up with a rubbish pointer value is more delicate as the
+-- value must satisfy the following requirements:
--
--- Getting this wrong causes hard-to-debug runtime issues, see #15038.
+-- 1. it needs to be a valid closure pointer for the GC (not a NULL pointer)
+--
+-- 2. it can't take arguments because it's used in unarise and applying an
+-- argument would require allocating a thunk, which is both difficult to
+-- do and costly.
--
--- 5. it can't be defined in `base` package.
+-- 3. it shouldn't be CAFfy since this would make otherwise non-CAFfy
+-- bindings CAFfy, incurring a cost in GC performance. Given that unboxed
+-- sums are intended to be used in performance-critical code, this is to
+-- We work-around this by declaring the absentSumFieldError as non-CAFfy,
+-- as described in Note [Wired-in exceptions are not CAFfy].
--
--- Defining `absentSumFieldError` in `base` package introduces a
--- dependency on `base` for any code using unboxed sums. It became an
--- issue when we wanted to use unboxed sums in boot libraries used by
+-- Getting this wrong causes hard-to-debug runtime issues, see #15038.
+--
+-- 4. it can't be defined in `base` package. Afterall, not all code which
+-- uses unboxed sums uses depends upon `base`. Specifically, this became
+-- an issue when we wanted to use unboxed sums in boot libraries used by
-- `base`, see #17791.
--
+-- To fill this role we define `ghc-prim:GHC.Prim.Panic.absentSumFieldError`
+-- with the type:
+--
+-- absentSumFieldError :: forall a. a
--
--- * Most runtime-error functions throw a proper Haskell exception, which can be
--- caught in the usual way. But these functions are defined in
--- `base:Control.Exception.Base`, hence, they cannot be directly invoked in
--- any library compiled before `base`. Only exceptions that have been wired
--- in the RTS can be thrown (indirectly, via a call into the RTS) by libraries
--- compiled before `base`.
+-- Note that this type is something of a lie since Unarise may use it at an
+-- unlifted type. However, this lie is benign as absent sum fields are examined
+-- only by the GC, which does not care about levity..
--
--- However wiring exceptions in the RTS is a bit annoying because we need to
--- explicitly import exception closures via their mangled symbol name (e.g.
--- `import CLOSURE base_GHCziIOziException_heapOverflow_closure`) in Cmm files
--- and every imported symbol must be indicated to the linker in a few files
--- (`package.conf`, `rts.cabal`, `win32/libHSbase.def`, `Prelude.h`...). It
--- explains why exceptions are only wired in the RTS when necessary.
+-- When entered, this closure calls `stg_panic#`, which immediately halts
+-- execution and cannot be caught. This is in contrast to most other runtime
+-- errors, which are thrown as proper Haskell exceptions. This design is
+-- intentional since entering an absent sum field is an indication that
+-- something has gone horribly wrong, very likely due to a compiler bug.
--
--- * `absentSumFieldError` is defined in ghc-prim:GHC.Prim.Panic, hence, it can
--- be invoked in libraries compiled before `base`. It does not throw a Haskell
--- exception; instead, it calls `stg_panic#`, which immediately halts
--- execution. A runtime invocation of `absentSumFieldError` indicates a GHC
--- bug. Unlike (say) pattern-match errors, it cannot be caused by a user
--- error. That's why it is OK for it to be un-catchable.
+
+-- Note [Wired-in exceptions are not CAFfy]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- GHC has logic wiring-in a small number of exceptions, which may be thrown in
+-- generated code. Specifically, these are implemented via closures (defined
+-- in `GHC.Prim.Exception` in `ghc-prim`) which, when entered, raise the desired
+-- exception. For instance, in the case of OverflowError we have
+--
+-- raiseOverflow :: forall a. a
+-- raiseOverflow = runRW# (\s ->
+-- case raiseOverflow# s of
+-- (# _, _ #) -> let x = x in x)
+--
+-- where `raiseOverflow#` is defined in the rts/Exception.cmm.
+--
+-- Note that `raiseOverflow` and friends, being top-level thunks, are CAFs.
+-- Normally, this would be reflected in their IdInfo; however, as these
+-- functions are widely used and CAFfyness is transitive, we very much want to
+-- avoid declaring them as CAFfy. This is especially true in especially in
+-- performance-critical code like that using unboxed sums and
+-- absentSumFieldError.
--
+-- Consequently, `mkExceptionId` instead declares the exceptions to be
+-- non-CAFfy and rather ensure in the RTS (in `initBuiltinGcRoots` in
+-- rts/RtsStartup.c) that these closures remain reachable by creating a
+-- StablePtr to each. Note that we are using the StablePtr mechanism not
+-- because we need a StablePtr# object, but rather because the stable pointer
+-- table is a source of GC roots.
+--
+-- 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
@@ -904,12 +939,16 @@ rAISE_OVERFLOW_ID = mkExceptionId raiseOverflowName
rAISE_UNDERFLOW_ID = mkExceptionId raiseUnderflowName
rAISE_DIVZERO_ID = mkExceptionId raiseDivZeroName
--- | Non-CAFFY Exception with type \"forall a. a\"
+-- | 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
(mkSpecForAllTys [alphaTyVar] (mkTyVarTy alphaTyVar)) -- forall a . a
- (divergingIdInfo [] `setCafInfo` NoCafRefs) -- No CAFs: #15038
+ (divergingIdInfo [] `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 9d496d397cd0c385417861628afedc2bd3cfbccd..0b9e9c165c5d62b5c95e3f33f6d09d545eaa9eca 100644
--- a/libraries/ghc-prim/GHC/Prim/Exception.hs
+++ b/libraries/ghc-prim/GHC/Prim/Exception.hs
@@ -26,6 +26,8 @@ default () -- Double and Integer aren't available yet
-- 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 d2511b2fc3b675fd389ba1de700c36da97e16ac8..5f1e070e331f5fc20df88742f496dd90a160d8ad 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 27002ca81bc520cdaa377d6dee03362a5c7526a8..491d745668552890b0a3a1ac88dbddf88edff7c9 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -214,6 +214,16 @@ static void initBuiltinGcRoots(void)
#else
getStablePtr((StgPtr)processRemoteCompletion_closure);
#endif
+
+ /*
+ * See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make.
+ * These are precisely the functions for which we construct `Id`s using
+ * GHC.Core.Make.mkExceptionId.
+ */
+ getStablePtr((StgPtr)absentSumFieldError_closure);
+ getStablePtr((StgPtr)raiseUnderflowException_closure);
+ getStablePtr((StgPtr)raiseOverflowException_closure);
+ getStablePtr((StgPtr)raiseDivZeroException_closure);
}
void