[Git][ghc/ghc][wip/ghc-9.4.5-backports] 5 commits: Add test for T23184
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Tue Apr 11 05:41:51 UTC 2023
Zubin pushed to branch wip/ghc-9.4.5-backports at Glasgow Haskell Compiler / GHC
Commits:
ec4ea457 by Matthew Pickering at 2023-04-11T10:57:41+05:30
Add test for T23184
There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch:
```
commit 6656f0165a30fc2a22208532ba384fc8e2f11b46
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Jul 23 23:57:01 2021 +0100
A bunch of changes related to eta reduction
This is a large collection of changes all relating to eta
reduction, originally triggered by #18993, but there followed
a long saga.
Specifics:
...lots of lines omitted...
Other incidental changes
* Fix a fairly long-standing outright bug in the ApplyToVal case of
GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the
tail of 'dmds' in the recursive call, which meant the demands were All
Wrong. I have no idea why this has not caused problems before now.
```
Note this "Fix a fairly longstanding outright bug". This is the specific fix
```
@@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds
-- let a = ...arg...
-- in [...hole...] a
-- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
- do { let (dmd:_) = dmds -- Never fails
- ; (floats1, cont') <- mkDupableContWithDmds env dmds cont
+ do { let (dmd:cont_dmds) = dmds -- Never fails
+ ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont
; let env' = env `setInScopeFromF` floats1
; (_, se', arg') <- simplArg env' dup se arg
; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg'
```
Ticket #23184 is a report of the bug that this diff fixes.
(cherry picked from commit d97354a82b6f79c4d9a4d389fafdd94375454f59)
- - - - -
a1f87248 by Matthew Pickering at 2023-04-11T11:00:03+05:30
Backport fix to #23184 to 9.4
This backports the fix suggested in #23184 to GHC-9.4
It is from the larger patch (!7861):
```
commit 6656f0165a30fc2a22208532ba384fc8e2f11b46
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Jul 23 23:57:01 2021 +0100
A bunch of changes related to eta reduction
This is a large collection of changes all relating to eta
reduction, originally triggered by #18993, but there followed
a long saga.
Specifics:
...lots of lines omitted...
Other incidental changes
* Fix a fairly long-standing outright bug in the ApplyToVal case of
GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the
tail of 'dmds' in the recursive call, which meant the demands were All
Wrong. I have no idea why this has not caused problems before now.
```
(cherry picked from commit d2dee3f82dcfdfc49cfb708222bb78aea0713cd6)
- - - - -
cadf80f6 by Ben Gamari at 2023-04-11T11:04:08+05:30
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.
(cherry picked from commit c6ec4cd1a94a1b76b7b094d5c92ee605031ecf60)
- - - - -
bf8cec2b by Ben Gamari at 2023-04-11T11:05:19+05:30
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.
(cherry picked from commit c32abd4b936b3dfc61974ed5915c330fe7ed10d5)
- - - - -
a3ae1e5c by Ben Gamari at 2023-04-11T11:05:29+05:30
nonmoving: Disable slop-zeroing
As noted in #23170, the nonmoving GC can race with a mutator zeroing the
slop of an updated thunk (in much the same way that two mutators would
race). Consequently, we must disable slop-zeroing when the nonmoving GC
is in use.
Closes #23170
(cherry picked from commit d1bb16ed3e18a4f41fcfe31f0bf57dbaf589d6c5)
- - - - -
8 changed files:
- compiler/GHC/Core/Opt/Simplify.hs
- + rts/ZeroSlop.c
- rts/include/Cmm.h
- rts/include/rts/storage/ClosureMacros.h
- rts/rts.cabal.in
- + testsuite/tests/simplCore/should_run/T23184.hs
- + testsuite/tests/simplCore/should_run/T23184.stdout
- testsuite/tests/simplCore/should_run/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -3557,8 +3557,8 @@ mkDupableContWithDmds env dmds
-- let a = ...arg...
-- in [...hole...] a
-- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
- do { let (dmd:_) = dmds -- Never fails
- ; (floats1, cont') <- mkDupableContWithDmds env dmds cont
+ do { let (dmd:cont_dmds) = dmds -- Never fails
+ ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont
; let env' = env `setInScopeFromF` floats1
; (_, se', arg') <- simplArg env' dup se arg
; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg'
=====================================
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
=====================================
@@ -633,9 +633,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 */
@@ -643,7 +643,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
=====================================
@@ -442,11 +442,13 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
memory we're about to zero.
Thus, with the THREADED RTS and +RTS -N2 or greater we must not zero
- immutable closure's slop.
+ immutable closure's slop. Similarly, the concurrent GC's mark thread
+ may race when a mutator during slop-zeroing. Consequently, we also disable
+ zeroing when the non-moving GC is in use.
Hence, an immutable closure's slop is zeroed when either:
- - PROFILING && era > 0 (LDV is on) or
+ - PROFILING && era > 0 (LDV is on) && !nonmoving-gc-enabled or
- !THREADED && DEBUG
Additionally:
@@ -480,16 +482,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
@@ -504,7 +502,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable)
const bool can_zero_immutable_slop =
// Only if we're running single threaded.
- RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1;
+ getNumCapabilities() == 1
+ && !RTS_DEREF(RtsFlags).GcFlags.useNonmoving; // see #23170
const bool zero_slop_immutable =
want_to_zero_immutable_slop && can_zero_immutable_slop;
@@ -537,8 +536,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)
@@ -548,15 +549,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:
//
@@ -573,8 +572,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
=====================================
@@ -540,6 +540,7 @@ library
TraverseHeapTest.c
WSDeque.c
Weak.c
+ ZeroSlop.c
eventlog/EventLog.c
eventlog/EventLogWriter.c
hooks/FlagDefaults.c
=====================================
testsuite/tests/simplCore/should_run/T23184.hs
=====================================
@@ -0,0 +1,18 @@
+{-# LANGUAGE BangPatterns #-}
+module Main where
+
+import GHC.Magic
+
+main :: IO ()
+main = print $ noinline (\x -> sum $ tardisManual [0..x]) 0
+
+tardisManual :: [Int] -> [Int]
+tardisManual xs =
+ let
+ go [] !acc _ = ([], 0)
+ go (_:xs) !acc l =
+ let (xs', _) = go xs acc l
+ in (l:xs', 0)
+ (r, l) = go xs True l
+ in r
+{-# INLINE tardisManual #-}
=====================================
testsuite/tests/simplCore/should_run/T23184.stdout
=====================================
@@ -0,0 +1 @@
+0
=====================================
testsuite/tests/simplCore/should_run/all.T
=====================================
@@ -104,3 +104,4 @@ test('T21575', normal, compile_and_run, ['-O'])
test('T21575b', [], multimod_compile_and_run, ['T21575b', '-O'])
test('T20836', normal, compile_and_run, ['-O0']) # Should not time out; See #20836
test('T23134', normal, compile_and_run, ['-O0 -fcatch-nonexhaustive-cases'])
+test('T23184', normal, compile_and_run, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ccc435edf331aa625e5db3714d0951bd527372dd...a3ae1e5cce0a15f250ae2bf53232a5e4a573c495
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ccc435edf331aa625e5db3714d0951bd527372dd...a3ae1e5cce0a15f250ae2bf53232a5e4a573c495
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/20230411/0ce31284/attachment-0001.html>
More information about the ghc-commits
mailing list