diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Builtin/Names.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Core/Make.hs | 74 | ||||
| -rw-r--r-- | compiler/GHC/Stg/Unarise.hs | 26 |
3 files changed, 77 insertions, 26 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index 52d5bf0fa2..14cfc22cc1 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -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") diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs index 38710f3829..5992bcc4f5 100644 --- a/compiler/GHC/Core/Make.hs +++ b/compiler/GHC/Core/Make.hs @@ -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 diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs index e0b96d0249..da2b06809e 100644 --- a/compiler/GHC/Stg/Unarise.hs +++ b/compiler/GHC/Stg/Unarise.hs @@ -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) + -------------------------------------------------------------------------------- {- |