Commit 951c1fb0 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Fix unboxed-sums GC ptr-slot rubbish value (#17791)

This patch allows boot libraries to use unboxed sums without implicitly
depending on `base` package because of `absentSumFieldError`.

See updated Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make
parent ea86360f
......@@ -511,7 +511,7 @@ genericTyConNames = [
pRELUDE :: Module
pRELUDE = mkBaseModule_ pRELUDE_NAME
gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM,
gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING,
gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_INTEGER_TYPE, gHC_NATURAL,
......@@ -527,6 +527,7 @@ gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE :: Module
gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values
gHC_PRIM_PANIC = mkPrimModule (fsLit "GHC.Prim.Panic")
gHC_TYPES = mkPrimModule (fsLit "GHC.Types")
gHC_MAGIC = mkPrimModule (fsLit "GHC.Magic")
gHC_CSTRING = mkPrimModule (fsLit "GHC.CString")
......
......@@ -735,6 +735,7 @@ errorIds
rEC_CON_ERROR_ID,
rEC_SEL_ERROR_ID,
aBSENT_ERROR_ID,
aBSENT_SUM_FIELD_ERROR_ID,
tYPE_ERROR_ID -- Used with Opt_DeferTypeErrors, see #10284
]
......@@ -746,8 +747,6 @@ absentSumFieldErrorName :: Name
recSelErrorName = err_nm "recSelError" recSelErrorIdKey rEC_SEL_ERROR_ID
absentErrorName = err_nm "absentError" absentErrorIdKey aBSENT_ERROR_ID
absentSumFieldErrorName = err_nm "absentSumFieldError" absentSumFieldErrorIdKey
aBSENT_SUM_FIELD_ERROR_ID
runtimeErrorName = err_nm "runtimeError" runtimeErrorIdKey rUNTIME_ERROR_ID
recConErrorName = err_nm "recConError" recConErrorIdKey rEC_CON_ERROR_ID
patErrorName = err_nm "patError" patErrorIdKey pAT_ERROR_ID
......@@ -774,25 +773,68 @@ tYPE_ERROR_ID = mkRuntimeErrorId typeErrorName
-- Note [aBSENT_SUM_FIELD_ERROR_ID]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Absent argument error for unused unboxed sum fields are different than absent
-- error used in dummy worker functions (see `mkAbsentErrorApp`):
--
-- - `absentSumFieldError` can't take arguments because it's used in unarise for
-- unused pointer fields in unboxed sums, and applying an argument would
-- require allocating a thunk.
-- 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:
--
-- - `absentSumFieldError` can't be CAFFY because that would mean making some
-- non-CAFFY definitions that use unboxed sums CAFFY in unarise.
-- 1. it needs to be a valid closure pointer for the GC (not a NULL pointer)
--
-- To make `absentSumFieldError` non-CAFFY we get a stable pointer to it in
-- RtsStartup.c and mark it as non-CAFFY here.
-- 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:
--
-- Getting this wrong causes hard-to-debug runtime issues, see #15038.
-- absentSumFieldError :: forall a. a
--
-- TODO: Remove stable pointer hack after fixing #9718.
-- However, we should still be careful about not making things CAFFY just
-- because they use unboxed sums. Unboxed objects are supposed to be
-- efficient, and none of the other unboxed literals make things CAFFY.
-- despite the fact that Unarise might instantiate it at non-lifted
-- types.
--
-- 3. it can't take arguments because it's used in unarise and applying an
-- 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.
--
-- Getting this wrong causes hard-to-debug runtime issues, see #15038.
--
-- 5. it can't be defined in `base` package.
--
-- 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
-- `base`, see #17791.
--
--
-- * 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`.
--
-- 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.
--
-- * `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.
--
absentSumFieldErrorName
= mkWiredInIdName
gHC_PRIM_PANIC
(fsLit "absentSumFieldError")
absentSumFieldErrorIdKey
aBSENT_SUM_FIELD_ERROR_ID
aBSENT_SUM_FIELD_ERROR_ID
= mkVanillaGlobalWithInfo absentSumFieldErrorName
......
......@@ -577,18 +577,26 @@ mkUbxSum dc ty_args args0
| Just stg_arg <- IM.lookup arg_idx arg_map
= stg_arg : mkTupArgs (arg_idx + 1) slots_left arg_map
| otherwise
= slotRubbishArg slot : mkTupArgs (arg_idx + 1) slots_left arg_map
slotRubbishArg :: SlotTy -> StgArg
slotRubbishArg PtrSlot = StgVarArg aBSENT_SUM_FIELD_ERROR_ID
-- See Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make
slotRubbishArg WordSlot = StgLitArg (LitNumber LitNumWord 0 wordPrimTy)
slotRubbishArg Word64Slot = StgLitArg (LitNumber LitNumWord64 0 word64PrimTy)
slotRubbishArg FloatSlot = StgLitArg (LitFloat 0)
slotRubbishArg DoubleSlot = StgLitArg (LitDouble 0)
= ubxSumRubbishArg slot : mkTupArgs (arg_idx + 1) slots_left arg_map
in
tag_arg : mkTupArgs 0 sum_slots arg_idxs
-- | Return a rubbish value for the given slot type.
--
-- We use the following rubbish values:
-- * Literals: 0 or 0.0
-- * Pointers: `ghc-prim:GHC.Prim.Panic.absentSumFieldError`
--
-- See Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make
--
ubxSumRubbishArg :: SlotTy -> StgArg
ubxSumRubbishArg PtrSlot = StgVarArg aBSENT_SUM_FIELD_ERROR_ID
ubxSumRubbishArg WordSlot = StgLitArg (LitNumber LitNumWord 0 wordPrimTy)
ubxSumRubbishArg Word64Slot = StgLitArg (LitNumber LitNumWord64 0 word64PrimTy)
ubxSumRubbishArg FloatSlot = StgLitArg (LitFloat 0)
ubxSumRubbishArg DoubleSlot = StgLitArg (LitDouble 0)
--------------------------------------------------------------------------------
{-
......
......@@ -418,6 +418,7 @@ RTS_FUN_DECL(stg_raiseDivZZerozh);
RTS_FUN_DECL(stg_raiseUnderflowzh);
RTS_FUN_DECL(stg_raiseOverflowzh);
RTS_FUN_DECL(stg_raiseIOzh);
RTS_FUN_DECL(stg_paniczh);
RTS_FUN_DECL(stg_makeStableNamezh);
RTS_FUN_DECL(stg_makeStablePtrzh);
......
......@@ -95,7 +95,7 @@ module Control.Exception.Base (
-- * Calls for GHC runtime
recSelError, recConError, runtimeError,
nonExhaustiveGuardsError, patError, noMethodBindingError,
absentError, absentSumFieldError, typeError,
absentError, typeError,
nonTermination, nestedAtomically,
) where
......@@ -398,7 +398,3 @@ nonTermination = toException NonTermination
-- GHC's RTS calls this
nestedAtomically :: SomeException
nestedAtomically = toException NestedAtomically
-- Introduced by unarise for unused unboxed sum fields
absentSumFieldError :: a
absentSumFieldError = absentError " in unboxed sum."#
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE EmptyCase #-}
-- | Primitive panics.
module GHC.Prim.Panic
( absentSumFieldError
, panicError
)
where
import GHC.Prim
import GHC.Magic
default () -- Double and Integer aren't available yet
-- `stg_panic#` never returns but it can't just return `State# RealWorld` so we
-- indicate that it returns `Void#` too to make the compiler happy.
foreign import prim "stg_paniczh" panic# :: Addr# -> State# RealWorld -> (# State# RealWorld, Void# #)
-- | Display the CString whose address is given as an argument and exit.
panicError :: Addr# -> a
panicError errmsg =
runRW# (\s ->
case panic# errmsg s of
(# _, _ #) -> -- This bottom is unreachable but we can't
-- use an empty case lest the pattern match
-- checker squawks.
let x = x in x)
-- | Closure introduced by GHC.Stg.Unarise for unused unboxed sum fields.
--
-- See Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make
absentSumFieldError :: a
absentSumFieldError = panicError "entered absent sum field!"#
-- GHC.Core.Make.aBSENT_SUM_FIELD_ERROR_ID gives absentSumFieldError a bottoming
-- demand signature. But if we ever inlined it (to a call to panicError) we'd
-- lose that information. Should not happen because absentSumFieldError is only
-- introduced in Stg.Unarise, long after inlining has stopped, but it seems
-- more direct simply to give it a NOINLINE pragma
{-# NOINLINE absentSumFieldError #-}
......@@ -46,6 +46,7 @@ Library
GHC.IntWord64
GHC.Magic
GHC.Prim.Ext
GHC.Prim.Panic
GHC.PrimopWrappers
GHC.Tuple
GHC.Types
......
......@@ -632,3 +632,12 @@ stg_raiseIOzh (P_ exception)
{
jump stg_raisezh (exception);
}
/* The FFI doesn't support variadic C functions so we can't directly expose
* `barf` to Haskell code. Instead we define "stg_panic#" and it is exposed to
* Haskell programs in GHC.Prim.Panic.
*/
stg_paniczh (W_ str)
{
ccall barf(str) never returns;
}
......@@ -45,7 +45,6 @@ PRELUDE_CLOSURE(base_GHCziIOziException_cannotCompactPinned_closure);
PRELUDE_CLOSURE(base_GHCziIOziException_cannotCompactMutable_closure);
PRELUDE_CLOSURE(base_ControlziExceptionziBase_nonTermination_closure);
PRELUDE_CLOSURE(base_ControlziExceptionziBase_nestedAtomically_closure);
PRELUDE_CLOSURE(base_ControlziExceptionziBase_absentSumFieldError_closure);
PRELUDE_CLOSURE(base_GHCziEventziThread_blockedOnBadFD_closure);
PRELUDE_CLOSURE(base_GHCziExceptionziType_divZZeroException_closure);
PRELUDE_CLOSURE(base_GHCziExceptionziType_underflowException_closure);
......@@ -103,7 +102,6 @@ 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 blockedOnBadFD_closure DLL_IMPORT_DATA_REF(base_GHCziEventziThread_blockedOnBadFD_closure)
#define absentSumFieldError_closure DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_absentSumFieldError_closure)
#define Czh_con_info DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_Czh_con_info)
#define Izh_con_info DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_Izh_con_info)
......
......@@ -275,10 +275,6 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
getStablePtr((StgPtr)cannotCompactPinned_closure);
getStablePtr((StgPtr)cannotCompactMutable_closure);
getStablePtr((StgPtr)nestedAtomically_closure);
getStablePtr((StgPtr)absentSumFieldError_closure);
// `Id` for this closure is marked as non-CAFFY,
// see Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make.
getStablePtr((StgPtr)runSparks_closure);
getStablePtr((StgPtr)ensureIOManagerIsRunning_closure);
getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure);
......
......@@ -732,6 +732,7 @@
SymI_HasProto(stg_raiseUnderflowzh) \
SymI_HasProto(stg_raiseOverflowzh) \
SymI_HasProto(stg_raiseIOzh) \
SymI_HasProto(stg_paniczh) \
SymI_HasProto(stg_readTVarzh) \
SymI_HasProto(stg_readTVarIOzh) \
SymI_HasProto(resumeThread) \
......
......@@ -97,7 +97,6 @@ ld-options:
, "-Wl,-u,_base_GHCziIOziException_cannotCompactFunction_closure"
, "-Wl,-u,_base_GHCziIOziException_cannotCompactPinned_closure"
, "-Wl,-u,_base_GHCziIOziException_cannotCompactMutable_closure"
, "-Wl,-u,_base_ControlziExceptionziBase_absentSumFieldError_closure"
, "-Wl,-u,_base_ControlziExceptionziBase_nonTermination_closure"
, "-Wl,-u,_base_ControlziExceptionziBase_nestedAtomically_closure"
, "-Wl,-u,_base_GHCziEventziThread_blockedOnBadFD_closure"
......@@ -203,7 +202,6 @@ ld-options:
, "-Wl,-u,base_GHCziIOziException_cannotCompactFunction_closure"
, "-Wl,-u,base_GHCziIOziException_cannotCompactPinned_closure"
, "-Wl,-u,base_GHCziIOziException_cannotCompactMutable_closure"
, "-Wl,-u,base_ControlziExceptionziBase_absentSumFieldError_closure"
, "-Wl,-u,base_ControlziExceptionziBase_nonTermination_closure"
, "-Wl,-u,base_ControlziExceptionziBase_nestedAtomically_closure"
, "-Wl,-u,base_GHCziEventziThread_blockedOnBadFD_closure"
......
......@@ -218,7 +218,6 @@ library
"-Wl,-u,_base_GHCziIOziException_cannotCompactFunction_closure"
"-Wl,-u,_base_GHCziIOziException_cannotCompactPinned_closure"
"-Wl,-u,_base_GHCziIOziException_cannotCompactMutable_closure"
"-Wl,-u,_base_ControlziExceptionziBase_absentSumFieldError_closure"
"-Wl,-u,_base_ControlziExceptionziBase_nonTermination_closure"
"-Wl,-u,_base_ControlziExceptionziBase_nestedAtomically_closure"
"-Wl,-u,_base_GHCziEventziThread_blockedOnBadFD_closure"
......@@ -294,7 +293,6 @@ library
"-Wl,-u,base_GHCziIOziException_cannotCompactFunction_closure"
"-Wl,-u,base_GHCziIOziException_cannotCompactPinned_closure"
"-Wl,-u,base_GHCziIOziException_cannotCompactMutable_closure"
"-Wl,-u,base_ControlziExceptionziBase_absentSumFieldError_closure"
"-Wl,-u,base_ControlziExceptionziBase_nonTermination_closure"
"-Wl,-u,base_ControlziExceptionziBase_nestedAtomically_closure"
"-Wl,-u,base_GHCziEventziThread_blockedOnBadFD_closure"
......
......@@ -42,7 +42,6 @@ EXPORTS
base_GHCziIOziException_cannotCompactPinned_closure
base_GHCziIOziException_cannotCompactMutable_closure
base_ControlziExceptionziBase_absentSumFieldError_closure
base_ControlziExceptionziBase_nonTermination_closure
base_ControlziExceptionziBase_nestedAtomically_closure
base_GHCziEventziThread_blockedOnBadFD_closure
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment