[Git][ghc/ghc][master] Fix unboxed-sums GC ptr-slot rubbish value (#17791)
Marge Bot
gitlab at gitlab.haskell.org
Sun May 10 01:46:51 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
951c1fb0 by Sylvain Henry at 2020-05-09T21:46:38-04:00
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
- - - - -
14 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Stg/Unarise.hs
- includes/stg/MiscClosures.h
- libraries/base/Control/Exception/Base.hs
- + libraries/ghc-prim/GHC/Prim/Panic.hs
- libraries/ghc-prim/ghc-prim.cabal
- rts/Exception.cmm
- rts/Prelude.h
- rts/RtsStartup.c
- rts/RtsSymbols.c
- rts/package.conf.in
- rts/rts.cabal.in
- rts/win32/libHSbase.def
Changes:
=====================================
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")
=====================================
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
=====================================
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)
+
--------------------------------------------------------------------------------
{-
=====================================
includes/stg/MiscClosures.h
=====================================
@@ -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);
=====================================
libraries/base/Control/Exception/Base.hs
=====================================
@@ -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."#
=====================================
libraries/ghc-prim/GHC/Prim/Panic.hs
=====================================
@@ -0,0 +1,45 @@
+{-# 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 #-}
=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -46,6 +46,7 @@ Library
GHC.IntWord64
GHC.Magic
GHC.Prim.Ext
+ GHC.Prim.Panic
GHC.PrimopWrappers
GHC.Tuple
GHC.Types
=====================================
rts/Exception.cmm
=====================================
@@ -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;
+}
=====================================
rts/Prelude.h
=====================================
@@ -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)
=====================================
rts/RtsStartup.c
=====================================
@@ -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);
=====================================
rts/RtsSymbols.c
=====================================
@@ -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) \
=====================================
rts/package.conf.in
=====================================
@@ -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"
=====================================
rts/rts.cabal.in
=====================================
@@ -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"
=====================================
rts/win32/libHSbase.def
=====================================
@@ -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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/951c1fb03d80094c8b0d9bcc463d86fa71695b3a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/951c1fb03d80094c8b0d9bcc463d86fa71695b3a
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/20200509/bd32352d/attachment-0001.html>
More information about the ghc-commits
mailing list