[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: rts: Ensure non-moving gc is not running when pausing
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri May 12 19:17:19 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
52740d9b by Teo Camarasu at 2023-05-12T15:17:03-04:00
rts: Ensure non-moving gc is not running when pausing
- - - - -
c9b5ac59 by Teo Camarasu at 2023-05-12T15:17:03-04:00
rts: Teach listAllBlocks about nonmoving heap
List all blocks on the non-moving heap.
Resolves #22627
- - - - -
81376b4e by Krzysztof Gogolewski at 2023-05-12T15:17:03-04:00
Fix coercion optimisation for SelCo (#23362)
setNominalRole_maybe is supposed to output a nominal coercion.
In the SelCo case, it was not updating the stored role to Nominal,
causing #23362.
- - - - -
fea09651 by Alexis King at 2023-05-12T15:17:12-04:00
hadrian: Fix linker script flag for MergeObjects builder
This fixes what appears to have been a typo in !9530. The `-t` flag just
enables tracing on all versions of `ld` I’ve looked at, while `-T` is
used to specify a linker script. It seems that this worked anyway for
some reason on some `ld` implementations (perhaps because they
automatically detect linker scripts), but the missing `-T` argument
causes `gold` to complain.
- - - - -
6 changed files:
- compiler/GHC/Core/Coercion.hs
- hadrian/src/Settings/Builders/SplitSections.hs
- rts/RtsAPI.c
- rts/sm/Storage.c
- + testsuite/tests/simplCore/should_compile/T23362.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Coercion.hs
=====================================
@@ -1355,7 +1355,7 @@ mkProofIrrelCo r kco g1 g2 = mkUnivCo (ProofIrrelProv kco) r
-- | Converts a coercion to be nominal, if possible.
-- See Note [Role twiddling functions]
setNominalRole_maybe :: Role -- of input coercion
- -> Coercion -> Maybe Coercion
+ -> Coercion -> Maybe CoercionN
setNominalRole_maybe r co
| r == Nominal = Just co
| otherwise = setNominalRole_maybe_helper co
@@ -1380,10 +1380,19 @@ setNominalRole_maybe r co
= AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2
setNominalRole_maybe_helper (ForAllCo tv kind_co co)
= ForAllCo tv kind_co <$> setNominalRole_maybe_helper co
- setNominalRole_maybe_helper (SelCo n co)
+ setNominalRole_maybe_helper (SelCo cs co) =
-- NB, this case recurses via setNominalRole_maybe, not
-- setNominalRole_maybe_helper!
- = SelCo n <$> setNominalRole_maybe (coercionRole co) co
+ case cs of
+ SelTyCon n _r ->
+ -- Remember to update the role in SelTyCon to nominal;
+ -- not doing this caused #23362.
+ -- See the typing rule in Note [SelCo] in GHC.Core.TyCo.Rep.
+ SelCo (SelTyCon n Nominal) <$> setNominalRole_maybe (coercionRole co) co
+ SelFun fs ->
+ SelCo (SelFun fs) <$> setNominalRole_maybe (coercionRole co) co
+ SelForAll ->
+ pprPanic "setNominalRole_maybe: the coercion should already be nominal" (ppr co)
setNominalRole_maybe_helper (InstCo co arg)
= InstCo <$> setNominalRole_maybe_helper co <*> pure arg
setNominalRole_maybe_helper (UnivCo prov _ co1 co2)
=====================================
hadrian/src/Settings/Builders/SplitSections.hs
=====================================
@@ -30,7 +30,7 @@ splitSectionsArgs = do
( mconcat
[ builder (Ghc CompileHs) ? arg "-fsplit-sections"
, builder MergeObjects ? ifM (expr isWinTarget)
- (pure ["-t", "driver/utils/merge_sections_pe.ld"])
- (pure ["-t", "driver/utils/merge_sections.ld"])
+ (pure ["-T", "driver/utils/merge_sections_pe.ld"])
+ (pure ["-T", "driver/utils/merge_sections.ld"])
]
) else mempty
=====================================
rts/RtsAPI.c
=====================================
@@ -19,6 +19,7 @@
#include "StablePtr.h"
#include "Threads.h"
#include "Weak.h"
+#include "sm/NonMoving.h"
/* ----------------------------------------------------------------------------
Building Haskell objects from C datatypes.
@@ -709,6 +710,16 @@ Capability *pauseTokenCapability(PauseToken *pauseToken) {
// See Note [Locking and Pausing the RTS]
PauseToken *rts_pause (void)
{
+
+ // Wait for any nonmoving collection to finish before pausing the RTS.
+ // The nonmoving collector needs to synchronise with the mutator,
+ // so pausing the mutator while a collection is ongoing might lead to deadlock or
+ // capabilities being prematurely re-awoken.
+ if (RtsFlags.GcFlags.useNonmoving) {
+ ACQUIRE_LOCK(&nonmoving_collection_mutex);
+ }
+
+
// It is an error if this thread already paused the RTS. If another
// thread has paused the RTS, then rts_pause will block until rts_resume is
// called (and compete with other threads calling rts_pause). The blocking
@@ -771,6 +782,10 @@ void rts_resume (PauseToken *pauseToken)
releaseAllCapabilities(getNumCapabilities(), NULL, task);
exitMyTask();
stgFree(pauseToken);
+
+ if (RtsFlags.GcFlags.useNonmoving) {
+ RELEASE_LOCK(&nonmoving_collection_mutex);
+ }
}
// See RtsAPI.h
=====================================
rts/sm/Storage.c
=====================================
@@ -42,7 +42,7 @@
#include "GC.h"
#include "Evac.h"
#include "NonMovingAllocate.h"
-#include "sm/NonMovingMark.h"
+#include "NonMovingMark.h"
#if defined(ios_HOST_OS) || defined(darwin_HOST_OS)
#include "Hash.h"
#endif
@@ -365,11 +365,20 @@ listGenBlocks (ListBlocksCb cb, void *user, generation* gen)
cb(user, gen->compact_blocks_in_import);
}
+static void
+listSegmentBlocks (ListBlocksCb cb, void *user, struct NonmovingSegment *seg)
+{
+ while (seg) {
+ cb(user, Bdescr((StgPtr) seg));
+ seg = seg->link;
+ }
+}
+
// Traverse all the different places that the rts stores blocks
// and call a callback on each of them.
void listAllBlocks (ListBlocksCb cb, void *user)
{
- uint32_t g, i;
+ uint32_t g, i, s;
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
for (i = 0; i < getNumCapabilities(); i++) {
cb(user, getCapability(i)->mut_lists[g]);
@@ -389,6 +398,24 @@ void listAllBlocks (ListBlocksCb cb, void *user)
}
cb(user, getCapability(i)->pinned_object_blocks);
cb(user, getCapability(i)->pinned_object_empty);
+
+ // list capabilities' current segments
+ if(RtsFlags.GcFlags.useNonmoving) {
+ for (s = 0; s < NONMOVING_ALLOCA_CNT; s++) {
+ listSegmentBlocks(cb, user, getCapability(i)->current_segments[s]);
+ }
+ }
+ }
+
+ // list blocks on the nonmoving heap
+ if(RtsFlags.GcFlags.useNonmoving) {
+ for(s = 0; s < NONMOVING_ALLOCA_CNT; s++) {
+ listSegmentBlocks(cb, user, nonmovingHeap.allocators[s].filled);
+ listSegmentBlocks(cb, user, nonmovingHeap.allocators[s].saved_filled);
+ listSegmentBlocks(cb, user, nonmovingHeap.allocators[s].active);
+ }
+ cb(user, nonmoving_large_objects);
+ cb(user, nonmoving_compact_objects);
}
}
=====================================
testsuite/tests/simplCore/should_compile/T23362.hs
=====================================
@@ -0,0 +1,21 @@
+module T23362 where
+
+import Unsafe.Coerce
+import Data.Kind
+
+type Phantom :: Type -> Type
+data Phantom a = MkPhantom
+
+newtype Id a = MkId a
+newtype First a = MkFirst (Id a)
+data Second a = MkSecond (First a)
+data Third a = MkThird !(Second a)
+
+a :: Second (Phantom Int)
+a = MkSecond (MkFirst (MkId MkPhantom))
+
+uc :: Second (Phantom Int) -> Second (Phantom Bool)
+uc = unsafeCoerce
+
+b :: Third (Phantom Bool)
+b = MkThird (uc a)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -478,3 +478,4 @@ test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -d
test('T23024', normal, multimod_compile, ['T23024', '-O -v0'])
test('T23026', normal, compile, ['-O'])
test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script'])
+test('T23362', normal, compile, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d834059621153f4fd56b6687058a2255cd38591d...fea09651a87cb6048271f731b0aaf12ecde641a5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d834059621153f4fd56b6687058a2255cd38591d...fea09651a87cb6048271f731b0aaf12ecde641a5
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/20230512/cdbb17b3/attachment-0001.html>
More information about the ghc-commits
mailing list