[Git][ghc/ghc][wip/clc-149] 4 commits: rts: Don't rely on EXTERN_INLINE for slop-zeroing logic
Ryan Scott (@RyanGlScott)
gitlab at gitlab.haskell.org
Sun Mar 26 00:32:35 UTC 2023
Ryan Scott pushed to branch wip/clc-149 at Glasgow Haskell Compiler / GHC
Commits:
c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00
rts: Don't rely on EXTERN_INLINE for slop-zeroing logic
Previously we relied on calling EXTERN_INLINE functions defined in
ClosureMacros.h from Cmm to zero slop. However, as far as I can tell,
this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted
in each compilation unit.
Fix this by explicitly declaring a new set of non-inline functions in
ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h
definitions as INLINE_HEADER.
In the future we should try to eliminate EXTERN_INLINE.
- - - - -
c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00
rts: Fix capability-count check in zeroSlop
Previously `zeroSlop` examined `RtsFlags` to determine whether the
program was single-threaded. This is wrong; a program may be started
with `+RTS -N1` yet the process may later increase the capability count
with `setNumCapabilities`. This lead to quite subtle and rare crashes.
Fixes #23088.
- - - - -
656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00
Add Eq/Ord instances for SSymbol, SChar, and SNat
This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148).
- - - - -
56656954 by Ryan Scott at 2023-03-25T20:32:19-04:00
Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat
This implements
[CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149).
- - - - -
10 changed files:
- libraries/base/Data/Typeable/Internal.hs
- libraries/base/GHC/TypeLits.hs
- libraries/base/GHC/TypeNats.hs
- libraries/base/changelog.md
- + libraries/base/tests/CLC149.hs
- libraries/base/tests/all.T
- + rts/ZeroSlop.c
- rts/include/Cmm.h
- rts/include/rts/storage/ClosureMacros.h
- rts/rts.cabal.in
Changes:
=====================================
libraries/base/Data/Typeable/Internal.hs
=====================================
@@ -272,6 +272,7 @@ typeableInstance rep = withTypeable rep TypeableInstance
pattern TypeRep :: forall {k :: Type} (a :: k). () => Typeable @k a => TypeRep @k a
pattern TypeRep <- (typeableInstance -> TypeableInstance)
where TypeRep = typeRep
+{-# COMPLETE TypeRep #-}
{- Note [TypeRep fingerprints]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/base/GHC/TypeLits.hs
=====================================
@@ -68,7 +68,7 @@ module GHC.TypeLits
) where
-import GHC.Base ( Eq(..), Functor(..), Ord(..), Ordering(..), String
+import GHC.Base ( Bool(..), Eq(..), Functor(..), Ord(..), Ordering(..), String
, (.), otherwise, withDict, Void, (++)
, errorWithoutStackTrace)
import GHC.Types(Symbol, Char, TYPE)
@@ -363,6 +363,7 @@ newtype SSymbol (s :: Symbol) = UnsafeSSymbol String
pattern SSymbol :: forall s. () => KnownSymbol s => SSymbol s
pattern SSymbol <- (knownSymbolInstance -> KnownSymbolInstance)
where SSymbol = symbolSing
+{-# COMPLETE SSymbol #-}
-- An internal data type that is only used for defining the SSymbol pattern
-- synonym.
@@ -374,6 +375,14 @@ data KnownSymbolInstance (s :: Symbol) where
knownSymbolInstance :: SSymbol s -> KnownSymbolInstance s
knownSymbolInstance ss = withKnownSymbol ss KnownSymbolInstance
+-- | @since 4.19.0.0
+instance Eq (SSymbol s) where
+ _ == _ = True
+
+-- | @since 4.19.0.0
+instance Ord (SSymbol s) where
+ compare _ _ = EQ
+
-- | @since 4.18.0.0
instance Show (SSymbol s) where
showsPrec p (UnsafeSSymbol s)
@@ -456,6 +465,7 @@ newtype SChar (s :: Char) = UnsafeSChar Char
pattern SChar :: forall c. () => KnownChar c => SChar c
pattern SChar <- (knownCharInstance -> KnownCharInstance)
where SChar = charSing
+{-# COMPLETE SChar #-}
-- An internal data type that is only used for defining the SChar pattern
-- synonym.
@@ -467,6 +477,14 @@ data KnownCharInstance (n :: Char) where
knownCharInstance :: SChar c -> KnownCharInstance c
knownCharInstance sc = withKnownChar sc KnownCharInstance
+-- | @since 4.19.0.0
+instance Eq (SChar c) where
+ _ == _ = True
+
+-- | @since 4.19.0.0
+instance Ord (SChar c) where
+ compare _ _ = EQ
+
-- | @since 4.18.0.0
instance Show (SChar c) where
showsPrec p (UnsafeSChar c)
=====================================
libraries/base/GHC/TypeNats.hs
=====================================
@@ -367,6 +367,7 @@ newtype SNat (n :: Nat) = UnsafeSNat Natural
pattern SNat :: forall n. () => KnownNat n => SNat n
pattern SNat <- (knownNatInstance -> KnownNatInstance)
where SNat = natSing
+{-# COMPLETE SNat #-}
-- An internal data type that is only used for defining the SNat pattern
-- synonym.
@@ -378,6 +379,14 @@ data KnownNatInstance (n :: Nat) where
knownNatInstance :: SNat n -> KnownNatInstance n
knownNatInstance sn = withKnownNat sn KnownNatInstance
+-- | @since 4.19.0.0
+instance Eq (SNat n) where
+ _ == _ = True
+
+-- | @since 4.19.0.0
+instance Ord (SNat n) where
+ compare _ _ = EQ
+
-- | @since 4.18.0.0
instance Show (SNat n) where
showsPrec p (UnsafeSNat n)
=====================================
libraries/base/changelog.md
=====================================
@@ -14,6 +14,10 @@
* Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88))
* Implement more members of `instance Foldable (Compose f g)` explicitly.
([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57))
+ * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`.
+ ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148))
+ * Add `COMPLETE` pragmas to the `TypeRep`, `SSymbol`, `SChar`, and `SNat` pattern synonyms.
+ ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149))
## 4.18.0.0 *TBA*
* Shipped with GHC 9.6.1
=====================================
libraries/base/tests/CLC149.hs
=====================================
@@ -0,0 +1,23 @@
+-- Test the COMPLETE pragmas for SChar, SNat, SSymbol, and TypeRep.
+{-# OPTIONS_GHC -Wincomplete-patterns #-}
+module CLC149 where
+
+import Data.Kind
+import GHC.TypeLits
+import Type.Reflection
+
+type Dict :: Constraint -> Type
+data Dict c where
+ Dict :: c => Dict c
+
+sc :: SChar c -> Dict (KnownChar c)
+sc SChar = Dict
+
+sn :: SNat n -> Dict (KnownNat n)
+sn SNat = Dict
+
+ss :: SSymbol s -> Dict (KnownSymbol s)
+ss SSymbol = Dict
+
+tr :: TypeRep a -> Dict (Typeable a)
+tr TypeRep = Dict
=====================================
libraries/base/tests/all.T
=====================================
@@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, [''])
test('trace', normal, compile_and_run, [''])
test('listThreads', js_broken(22261), compile_and_run, [''])
test('inits1tails1', normal, compile_and_run, [''])
+test('CLC149', normal, compile, [''])
=====================================
rts/ZeroSlop.c
=====================================
@@ -0,0 +1,27 @@
+/* ----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2012
+ *
+ * Utilities for zeroing slop callable from Cmm
+ *
+ * N.B. If you are in C you should rather using the inlineable utilities
+ * (e.g. overwritingClosure) defined in ClosureMacros.h.
+ *
+ * -------------------------------------------------------------------------- */
+
+#include "Rts.h"
+
+void stg_overwritingClosure (StgClosure *p)
+{
+ overwritingClosure(p);
+}
+
+void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset)
+{
+ overwritingMutableClosureOfs(p, offset);
+}
+
+void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */)
+{
+ overwritingClosureSize(p, size);
+}
=====================================
rts/include/Cmm.h
=====================================
@@ -647,9 +647,9 @@
#define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n))
#if defined(PROFILING) || defined(DEBUG)
-#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size)
-#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
-#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" overwritingMutableClosureOfs(c "ptr", off)
+#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" stg_overwritingClosureSize(c "ptr", size)
+#define OVERWRITING_CLOSURE(c) foreign "C" stg_overwritingClosure(c "ptr")
+#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off)
#else
#define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */
#define OVERWRITING_CLOSURE(c) /* nothing */
@@ -657,7 +657,7 @@
* this whenever profiling is enabled as described in Note [slop on the heap]
* in Storage.c. */
#define OVERWRITING_CLOSURE_MUTABLE(c, off) \
- if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); }
+ if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off); }
#endif
#define IS_STACK_CLEAN(stack) \
=====================================
rts/include/rts/storage/ClosureMacros.h
=====================================
@@ -517,16 +517,12 @@ void LDV_recordDead (const StgClosure *c, uint32_t size);
RTS_PRIVATE bool isInherentlyUsed ( StgHalfWord closure_type );
#endif
-EXTERN_INLINE void
-zeroSlop (
- StgClosure *p,
- uint32_t offset, /*< offset to start zeroing at, in words */
- uint32_t size, /*< total closure size, in words */
- bool known_mutable /*< is this a closure who's slop we can always zero? */
- );
-
-EXTERN_INLINE void
-zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable)
+INLINE_HEADER void
+zeroSlop (StgClosure *p,
+ uint32_t offset, /*< offset to start zeroing at, in words */
+ uint32_t size, /*< total closure size, in words */
+ bool known_mutable /*< is this a closure who's slop we can always zero? */
+ )
{
// see Note [zeroing slop when overwriting closures], also #8402
@@ -539,9 +535,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable)
#endif
;
- const bool can_zero_immutable_slop =
- // Only if we're running single threaded.
- RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1;
+ // Only if we're running single threaded.
+ const bool can_zero_immutable_slop = getNumCapabilities() == 1;
const bool zero_slop_immutable =
want_to_zero_immutable_slop && can_zero_immutable_slop;
@@ -574,8 +569,10 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable)
}
}
-EXTERN_INLINE void overwritingClosure (StgClosure *p);
-EXTERN_INLINE void overwritingClosure (StgClosure *p)
+// N.B. the stg_* variants of the utilities below are only for calling from
+// Cmm. The INLINE_HEADER functions should be used when in C.
+void stg_overwritingClosure (StgClosure *p);
+INLINE_HEADER void overwritingClosure (StgClosure *p)
{
W_ size = closure_sizeW(p);
#if defined(PROFILING)
@@ -585,15 +582,13 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p)
zeroSlop(p, sizeofW(StgThunkHeader), size, /*known_mutable=*/false);
}
+
// Version of 'overwritingClosure' which overwrites only a suffix of a
// closure. The offset is expressed in words relative to 'p' and shall
// be less than or equal to closure_sizeW(p), and usually at least as
// large as the respective thunk header.
-EXTERN_INLINE void
-overwritingMutableClosureOfs (StgClosure *p, uint32_t offset);
-
-EXTERN_INLINE void
-overwritingMutableClosureOfs (StgClosure *p, uint32_t offset)
+void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset);
+INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset)
{
// Since overwritingClosureOfs is only ever called by:
//
@@ -610,8 +605,8 @@ overwritingMutableClosureOfs (StgClosure *p, uint32_t offset)
}
// Version of 'overwritingClosure' which takes closure size as argument.
-EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */);
-EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size)
+void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */);
+INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size)
{
// This function is only called from stg_AP_STACK so we can assume it's not
// inherently used.
=====================================
rts/rts.cabal.in
=====================================
@@ -603,6 +603,7 @@ library
TSANUtils.c
WSDeque.c
Weak.c
+ ZeroSlop.c
eventlog/EventLog.c
eventlog/EventLogWriter.c
hooks/FlagDefaults.c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28b67c5f621a1d292e54b9819cf329fbcf7a74fd...56656954bc12efee009c9c0739e9e67153706379
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28b67c5f621a1d292e54b9819cf329fbcf7a74fd...56656954bc12efee009c9c0739e9e67153706379
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/20230325/58ddadf1/attachment-0001.html>
More information about the ghc-commits
mailing list