[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rts: Don't rely on EXTERN_INLINE for slop-zeroing logic

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sun Mar 26 14:02:35 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job 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).

- - - - -
32f64f6d by David Feuer at 2023-03-26T10:02:25-04:00
Update and expand atomic modification Haddocks

* The documentation for `atomicModifyIORef` and `atomicModifyIORef'`
  were incomplete, and the documentation for `atomicModifyIORef` was
  out of date. Update and expand.

* Remove a useless lazy pattern match in the definition of
  `atomicModifyIORef`. The pair it claims to match lazily
  was already forced by `atomicModifyIORef2`.

- - - - -
31e40fdf by David Feuer at 2023-03-26T10:02:29-04:00
Document the constructor name for lists

Derived `Data` instances use raw infix constructor names when applicable.
The `Data.Data [a]` instance, if derived, would have a constructor name
of `":"`. However, it actually uses constructor name `"(:)"`. Document this
peculiarity.

See https://github.com/haskell/core-libraries-committee/issues/147

- - - - -


10 changed files:

- libraries/base/Data/Data.hs
- libraries/base/Data/IORef.hs
- libraries/base/GHC/IORef.hs
- libraries/base/GHC/TypeLits.hs
- libraries/base/GHC/TypeNats.hs
- libraries/base/changelog.md
- + rts/ZeroSlop.c
- rts/include/Cmm.h
- rts/include/rts/storage/ClosureMacros.h
- rts/rts.cabal.in


Changes:

=====================================
libraries/base/Data/Data.hs
=====================================
@@ -1136,7 +1136,10 @@ consConstr   = mkConstr listDataType "(:)" [] Infix
 listDataType :: DataType
 listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
 
--- | @since 4.0.0.0
+-- | For historical reasons, the constructor name used for @(:)@ is
+-- @"(:)"@. In a derived instance, it would be @":"@.
+--
+-- @since 4.0.0.0
 instance Data a => Data [a] where
   gfoldl _ z []     = z []
   gfoldl f z (x:xs) = z (:) `f` x `f` xs


=====================================
libraries/base/Data/IORef.hs
=====================================
@@ -85,21 +85,45 @@ modifyIORef' ref f = do
 -- is recommended that if you need to do anything more complicated
 -- then using 'Control.Concurrent.MVar.MVar' instead is a good idea.
 --
--- 'atomicModifyIORef' does not apply the function strictly.  This is important
--- to know even if all you are doing is replacing the value.  For example, this
--- will leak memory:
+-- Conceptually,
 --
--- >ref <- newIORef '1'
--- >forever $ atomicModifyIORef ref (\_ -> ('2', ()))
+-- @
+-- atomicModifyIORef ref f = do
+--   -- Begin atomic block
+--   old <- 'readIORef' ref
+--   let r = f old
+--       new = fst r
+--   'writeIORef' ref new
+--   -- End atomic block
+--   case r of
+--     (_new, res) -> pure res
+-- @
 --
--- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem.
+-- The actions in the section labeled \"atomic block\" are not subject to
+-- interference from other threads. In particular, it is impossible for the
+-- value in the 'IORef' to change between the 'readIORef' and 'writeIORef'
+-- invocations.
 --
--- This function imposes a memory barrier, preventing reordering;
--- see "Data.IORef#memmodel" for details.
+-- The user-supplied function is applied to the value stored in the 'IORef',
+-- yielding a new value to store in the 'IORef' and a value to return. After
+-- the new value is (lazily) stored in the 'IORef', @atomicModifyIORef@ forces
+-- the result pair, but does not force either component of the result. To force
+-- /both/ components, use 'atomicModifyIORef''.
+--
+-- Note that
+--
+-- @atomicModifyIORef ref (\_ -> undefined)@
+--
+-- will raise an exception in the calling thread, but will /also/
+-- install the bottoming value in the 'IORef', where it may be read by
+-- other threads.
+--
+-- This function imposes a memory barrier, preventing reordering around the
+-- \"atomic block\"; see "Data.IORef#memmodel" for details.
 --
 atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
 atomicModifyIORef ref f = do
-  (_old, ~(_new, res)) <- atomicModifyIORef2 ref f
+  (_old, (_new, res)) <- atomicModifyIORef2 ref f
   pure res
 
 -- | Variant of 'writeIORef'. The prefix "atomic" relates to a fact that


=====================================
libraries/base/GHC/IORef.hs
=====================================
@@ -134,9 +134,28 @@ atomicSwapIORef (IORef (STRef ref)) new = IO $ \s ->
 
 data Box a = Box a
 
--- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both
--- the value stored in the 'IORef' and the value returned. The new value
--- is installed in the 'IORef' before the returned value is forced.
+-- | A strict version of 'Data.IORef.atomicModifyIORef'.  This forces both the
+-- value stored in the 'IORef' and the value returned.
+--
+-- Conceptually,
+--
+-- @
+-- atomicModifyIORef' ref f = do
+--   -- Begin atomic block
+--   old <- 'readIORef' ref
+--   let r = f old
+--       new = fst r
+--   'writeIORef' ref new
+--   -- End atomic block
+--   case r of
+--     (!_new, !res) -> pure res
+-- @
+--
+-- The actions in the \"atomic block\" are not subject to interference
+-- by other threads. In particular, the value in the 'IORef' cannot
+-- change between the 'readIORef' and 'writeIORef' invocations.
+--
+-- The new value is installed in the 'IORef' before either value is forced.
 -- So
 --
 -- @atomicModifyIORef' ref (\x -> (x+1, undefined))@
@@ -144,8 +163,18 @@ data Box a = Box a
 -- will increment the 'IORef' and then throw an exception in the calling
 -- thread.
 --
--- This function imposes a memory barrier, preventing reordering;
--- see "Data.IORef#memmodel" for details.
+-- @atomicModifyIORef' ref (\x -> (undefined, x))@
+--
+-- and
+--
+-- @atomicModifyIORef' ref (\_ -> undefined)@
+--
+-- will each raise an exception in the calling thread, but will /also/
+-- install the bottoming value in the 'IORef', where it may be read by
+-- other threads.
+--
+-- This function imposes a memory barrier, preventing reordering around
+-- the \"atomic block\"; see "Data.IORef#memmodel" for details.
 --
 -- @since 4.6.0.0
 atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b


=====================================
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)
@@ -374,6 +374,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)
@@ -467,6 +475,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
=====================================
@@ -378,6 +378,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,8 @@
   * 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))
 
 ## 4.18.0.0 *TBA*
   * Shipped with GHC 9.6.1


=====================================
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/981adc5123f4763aab0c06e51990ced8d3e37071...31e40fdf2ed3f56f710afe96da7db1ed7b4e21cb

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/981adc5123f4763aab0c06e51990ced8d3e37071...31e40fdf2ed3f56f710afe96da7db1ed7b4e21cb
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/20230326/387c54d2/attachment-0001.html>


More information about the ghc-commits mailing list