[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sat Mar 25 21:53:50 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00
rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023

This patch does a few things:

- Add the missing RtsSymbols.c entry of performBlockingMajorGC
- Make hs_perform_gc call performBlockingMajorGC, which restores
  previous behavior
- Use hs_perform_gc in ffi023
- Remove rts_clearMemory() call in ffi023, it now works again in some
  test ways previously marked as broken. Fixes #23089

- - - - -
d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00
testsuite: add the rts_clearMemory test case

This patch adds a standalone test case for rts_clearMemory that mimics
how it's typically used by wasm backend users and ensures this RTS API
isn't broken by future RTS refactorings. Fixes #23901.

- - - - -
80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00
Improve documentation for resizing of byte arrays

- - - - -
c1fe2608 by Ben Gamari at 2023-03-25T17:53:39-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.

- - - - -
1f85621b by Ben Gamari at 2023-03-25T17:53:39-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.

- - - - -
981adc51 by Ryan Scott at 2023-03-25T17:53:40-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).

- - - - -


16 changed files:

- compiler/GHC/Builtin/primops.txt.pp
- libraries/base/GHC/TypeLits.hs
- libraries/base/GHC/TypeNats.hs
- libraries/base/changelog.md
- rts/HsFFI.c
- rts/RtsSymbols.c
- + rts/ZeroSlop.c
- rts/include/Cmm.h
- rts/include/rts/storage/ClosureMacros.h
- rts/rts.cabal.in
- testsuite/.gitignore
- testsuite/tests/ffi/should_run/Makefile
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/ffi/should_run/ffi023_c.c
- + testsuite/tests/ffi/should_run/rts_clearMemory.hs
- + testsuite/tests/ffi/should_run/rts_clearMemory_c.c


Changes:

=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1567,7 +1567,16 @@ primop  ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp
    SmallMutableArray# s v -> Int# -> State# s -> State# s
    {Shrink mutable array to new specified size, in
     the specified state thread. The new size argument must be less than or
-    equal to the current size as reported by 'getSizeofSmallMutableArray#'.}
+    equal to the current size as reported by 'getSizeofSmallMutableArray#'.
+
+    Assuming the non-profiling RTS, for the copying garbage collector
+    (default) this primitive compiles to an O(1) operation in C--, modifying
+    the array in-place. For the non-moving garbage collector, however, the
+    time is proportional to the number of elements shrinked out. Backends
+    bypassing C-- representation (such as JavaScript) might behave
+    differently.
+
+    @since 0.6.1}
    with out_of_line = True
         has_side_effects = True
 
@@ -1591,14 +1600,17 @@ primop  SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp
 
 primop  SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp
    SmallMutableArray# s v -> Int#
-   {Return the number of elements in the array. Note that this is deprecated
-   as it is unsafe in the presence of shrink and resize operations on the
-   same small mutable array.}
+   {Return the number of elements in the array. __Deprecated__, it is
+   unsafe in the presence of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@
+   operations on the same small mutable array.}
    with deprecated_msg = { Use 'getSizeofSmallMutableArray#' instead }
 
 primop  GetSizeofSmallMutableArrayOp "getSizeofSmallMutableArray#" GenPrimOp
    SmallMutableArray# s v -> State# s -> (# State# s, Int# #)
-   {Return the number of elements in the array.}
+   {Return the number of elements in the array, correctly accounting for
+   the effect of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@.
+
+   @since 0.6.1}
 
 primop  IndexSmallArrayOp "indexSmallArray#" GenPrimOp
    SmallArray# v -> Int# -> (# v #)
@@ -1807,13 +1819,19 @@ primop  ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp
    MutableByteArray# s -> Int# -> State# s -> State# s
    {Shrink mutable byte array to new specified size (in bytes), in
     the specified state thread. The new size argument must be less than or
-    equal to the current size as reported by 'getSizeofMutableByteArray#'.}
+    equal to the current size as reported by 'getSizeofMutableByteArray#'.
+
+    Assuming the non-profiling RTS, this primitive compiles to an O(1)
+    operation in C--, modifying the array in-place. Backends bypassing C--
+    representation (such as JavaScript) might behave differently.
+
+    @since 0.4.0.0}
    with out_of_line = True
         has_side_effects = True
 
 primop  ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp
    MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #)
-   {Resize (unpinned) mutable byte array to new specified size (in bytes).
+   {Resize mutable byte array to new specified size (in bytes), shrinking or growing it.
     The returned 'MutableByteArray#' is either the original
     'MutableByteArray#' resized in-place or, if not possible, a newly
     allocated (unpinned) 'MutableByteArray#' (with the original content
@@ -1823,7 +1841,9 @@ primop  ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp
     not be accessed anymore after a 'resizeMutableByteArray#' has been
     performed.  Moreover, no reference to the old one should be kept in order
     to allow garbage collection of the original 'MutableByteArray#' in
-    case a new 'MutableByteArray#' had to be allocated.}
+    case a new 'MutableByteArray#' had to be allocated.
+
+    @since 0.4.0.0}
    with out_of_line = True
         has_side_effects = True
 
@@ -1839,14 +1859,18 @@ primop  SizeofByteArrayOp "sizeofByteArray#" GenPrimOp
 
 primop  SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
    MutableByteArray# s -> Int#
-   {Return the size of the array in bytes. Note that this is deprecated as it is
-   unsafe in the presence of shrink and resize operations on the same mutable byte
+   {Return the size of the array in bytes. __Deprecated__, it is
+   unsafe in the presence of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'
+   operations on the same mutable byte
    array.}
    with deprecated_msg = { Use 'getSizeofMutableByteArray#' instead }
 
 primop  GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp
    MutableByteArray# s -> State# s -> (# State# s, Int# #)
-   {Return the number of elements in the array.}
+   {Return the number of elements in the array, correctly accounting for
+   the effect of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'.
+
+   @since 0.5.0.0}
 
 #include "bytearray-ops.txt.pp"
 


=====================================
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/HsFFI.c
=====================================
@@ -24,8 +24,8 @@ hs_set_argv(int argc, char *argv[])
 void
 hs_perform_gc(void)
 {
-    /* Hmmm, the FFI spec is a bit vague, but it seems to imply a major GC... */
-    performMajorGC();
+    /* Hmmm, the FFI spec is a bit vague, but it seems to imply a blocking major GC... */
+    performBlockingMajorGC();
 }
 
 // Lock the stable pointer table


=====================================
rts/RtsSymbols.c
=====================================
@@ -649,6 +649,7 @@ extern char **environ;
       SymI_HasProto(updateRemembSetPushClosure_)                          \
       SymI_HasProto(performGC)                                          \
       SymI_HasProto(performMajorGC)                                     \
+      SymI_HasProto(performBlockingMajorGC)                             \
       SymI_HasProto(prog_argc)                                          \
       SymI_HasProto(prog_argv)                                          \
       SymI_HasDataProto(stg_putMVarzh)                                      \


=====================================
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


=====================================
testsuite/.gitignore
=====================================
@@ -732,6 +732,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
 /tests/ffi/should_run/ffi021
 /tests/ffi/should_run/ffi022
 /tests/ffi/should_run/ffi023
+/tests/ffi/should_run/rts_clearMemory
 /tests/ffi/should_run/ffi_parsing_001
 /tests/ffi/should_run/fptr01
 /tests/ffi/should_run/fptr02


=====================================
testsuite/tests/ffi/should_run/Makefile
=====================================
@@ -25,6 +25,9 @@ T5594_setup :
 ffi023_setup :
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c ffi023.hs
 
+rts_clearMemory_setup :
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c rts_clearMemory.hs
+
 .PHONY: Capi_Ctype_001
 Capi_Ctype_001:
 	'$(HSC2HS)' Capi_Ctype_A_001.hsc


=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -191,7 +191,6 @@ test('T8083', [omit_ways(['ghci']), req_c], compile_and_run, ['T8083_c.c'])
 test('T9274', [omit_ways(['ghci'])], compile_and_run, [''])
 
 test('ffi023', [ omit_ways(['ghci']),
-                expect_broken_for(23089, ['threaded2', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc']),
                 extra_run_opts('1000 4'),
                 js_broken(22363),
                 pre_cmd('$MAKE -s --no-print-directory ffi023_setup') ],
@@ -200,6 +199,18 @@ test('ffi023', [ omit_ways(['ghci']),
                 # needs it.
               compile_and_run, ['ffi023_c.c'])
 
+test('rts_clearMemory', [
+     # We only care about different GC configurations under the
+     # single-threaded RTS for the time being.
+     only_ways(['normal', 'optasm' ,'g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']),
+     extra_ways(['g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']),
+     # On windows, nonmoving way fails with bad exit code (2816)
+     when(opsys('mingw32'), fragile(23091)),
+     js_broken(22363),
+     pre_cmd('$MAKE -s --no-print-directory rts_clearMemory_setup') ],
+     # Same hack as ffi023
+     compile_and_run, ['rts_clearMemory_c.c -no-hs-main'])
+
 test('T12134', [omit_ways(['ghci']), req_c], compile_and_run, ['T12134_c.c'])
 
 test('T12614', [omit_ways(['ghci']), req_c], compile_and_run, ['T12614_c.c'])


=====================================
testsuite/tests/ffi/should_run/ffi023_c.c
=====================================
@@ -4,7 +4,6 @@
 
 HsInt out (HsInt x)
 {
-    performBlockingMajorGC();
-    rts_clearMemory();
+    hs_perform_gc();
     return incall(x);
 }


=====================================
testsuite/tests/ffi/should_run/rts_clearMemory.hs
=====================================
@@ -0,0 +1,15 @@
+module RtsClearMemory
+  ( foo,
+  )
+where
+
+import Control.DeepSeq
+import Control.Exception
+import Data.Functor
+
+-- | Behold, mortal! This function doth summon forth a horde of trash,
+-- mere playthings for the garbage collector's insatiable appetite.
+foo :: Int -> IO ()
+foo n = void $ evaluate $ force [0 .. n]
+
+foreign export ccall foo :: Int -> IO ()


=====================================
testsuite/tests/ffi/should_run/rts_clearMemory_c.c
=====================================
@@ -0,0 +1,12 @@
+#include <Rts.h>
+#include "rts_clearMemory_stub.h"
+
+int main(int argc, char *argv[]) {
+  hs_init_with_rtsopts(&argc, &argv);
+
+  for (int i = 0; i < 8; ++i) {
+    foo(1000000);
+    hs_perform_gc();
+    rts_clearMemory();
+  }
+}



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6991f2b74783b39d201da3c9ac1836e17453f006...981adc5123f4763aab0c06e51990ced8d3e37071

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6991f2b74783b39d201da3c9ac1836e17453f006...981adc5123f4763aab0c06e51990ced8d3e37071
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/a5c4eeff/attachment-0001.html>


More information about the ghc-commits mailing list