[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: rts: improve memory ordering and add some comments in the StablePtr implementation
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Apr 14 05:37:53 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
68032477 by Adam Sandberg Ericsson at 2023-04-14T01:37:44-04:00
rts: improve memory ordering and add some comments in the StablePtr implementation
- - - - -
4e25561a by Matthew Pickering at 2023-04-14T01:37:45-04:00
docs: Generate docs/index.html with version number
* Generate docs/index.html to include the version of the ghc library
* This also fixes the packageVersions interpolations which were
- Missing an interpolation for `LIBRARY_ghc_VERSION`
- Double quoting the version so that "9.7" was being inserted.
Fixes #23121
- - - - -
7a1b9b01 by Simon Peyton Jones at 2023-04-14T01:37:46-04:00
Stop if type constructors have kind errors
Otherwise we get knock-on errors, such as #23252.
This makes GHC fail a bit sooner, and I have not attempted to add
recovery code, to add a fake TyCon place of the erroneous one,
in an attempt to get more type errors in one pass. We could
do that (perhaps) if there was a call for it.
- - - - -
10 changed files:
- compiler/GHC/Tc/TyCl.hs
- docs/index.html → docs/index.html.in
- hadrian/src/Rules/Documentation.hs
- hadrian/src/Rules/Generate.hs
- rts/StablePtr.c
- testsuite/tests/dependent/should_fail/T15743c.hs
- testsuite/tests/dependent/should_fail/T15743c.stderr
- + testsuite/tests/roles/should_fail/T23252.hs
- + testsuite/tests/roles/should_fail/T23252.stderr
- testsuite/tests/roles/should_fail/all.T
Changes:
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -248,7 +248,13 @@ tcTyClDecls tyclds kisig_env role_annots
= do { -- Step 1: kind-check this group and returns the final
-- (possibly-polymorphic) kind of each TyCon and Class
-- See Note [Kind checking for type and class decls]
- (tc_tycons, kindless) <- kcTyClGroup kisig_env tyclds
+ (tc_tycons, kindless) <- checkNoErrs $
+ kcTyClGroup kisig_env tyclds
+ -- checkNoErrs: If the TyCons are ill-kinded, stop now. Else we
+ -- can get follow-on errors. Example: #23252, where the TyCon
+ -- had an ill-scoped kind forall (d::k) k (a::k). blah
+ -- and that ill-scoped kind made role inference fall over.
+
; traceTc "tcTyAndCl generalized kinds" (vcat (map ppr_tc_tycon tc_tycons))
-- Step 2: type-check all groups together, returning
=====================================
docs/index.html → docs/index.html.in
=====================================
@@ -39,7 +39,7 @@
<LI>
<P>
- <B><A HREF="libraries/ghc/index.html">GHC API</A></B>
+ <B><A HREF="libraries/ghc- at LIBRARY_ghc_VERSION@/index.html">GHC API</A></B>
</P>
<P>
Documentation for the GHC API.
=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -193,7 +193,7 @@ buildHtmlDocumentation = do
| SphinxHTML `Set.member` doctargets ]
need $ map ((root -/-) . pathIndex) targets
- copyFileUntracked "docs/index.html" file
+ copyFile "docs/index.html" file
-- | Compile a Sphinx ReStructured Text package to HTML.
buildSphinxHtml :: FilePath -> Rules ()
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -305,10 +305,10 @@ rtsCabalFlags = mconcat
flag = interpolateCabalFlag
packageVersions :: Interpolations
-packageVersions = foldMap f [ base, ghcPrim, ghc, cabal, templateHaskell, ghcCompact, array ]
+packageVersions = foldMap f [ base, ghcPrim, compiler, ghc, cabal, templateHaskell, ghcCompact, array ]
where
f :: Package -> Interpolations
- f pkg = interpolateVar var $ show . version <$> readPackageData pkg
+ f pkg = interpolateVar var $ version <$> readPackageData pkg
where var = "LIBRARY_" <> pkgName pkg <> "_VERSION"
templateRule :: FilePath -> Interpolations -> Rules ()
@@ -335,6 +335,7 @@ templateRules = do
templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion
templateRule "libraries/template-haskell/template-haskell.cabal" $ projectVersion
templateRule "libraries/prologue.txt" $ packageVersions
+ templateRule "docs/index.html" $ packageVersions
-- Generators
=====================================
rts/StablePtr.c
=====================================
@@ -98,8 +98,13 @@
*/
+// the global stable pointer entry table
spEntry *stable_ptr_table = NULL;
+
+// the next free stable ptr, the free entries form a linked list where spEntry.addr points to the next after
static spEntry *stable_ptr_free = NULL;
+
+// current stable pointer table size
static unsigned int SPT_size = 0;
#define INIT_SPT_SIZE 64
@@ -117,6 +122,7 @@ static unsigned int SPT_size = 0;
#error unknown SIZEOF_VOID_P
#endif
+// old stable pointer tables
static spEntry *old_SPTs[MAX_N_OLD_SPTS];
static uint32_t n_old_SPTs = 0;
@@ -149,8 +155,9 @@ stablePtrUnlock(void)
* -------------------------------------------------------------------------- */
STATIC_INLINE void
-initSpEntryFreeList(spEntry *table, uint32_t n, spEntry *free)
+initSpEntryFreeList(spEntry *table, uint32_t n)
{
+ spEntry* free = NULL;
spEntry *p;
for (p = table + n - 1; p >= table; p--) {
p->addr = (P_)free;
@@ -166,7 +173,7 @@ initStablePtrTable(void)
SPT_size = INIT_SPT_SIZE;
stable_ptr_table = stgMallocBytes(SPT_size * sizeof(spEntry),
"initStablePtrTable");
- initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE,NULL);
+ initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE);
#if defined(THREADED_RTS)
initMutex(&stable_ptr_mutex);
@@ -181,6 +188,8 @@ initStablePtrTable(void)
static void
enlargeStablePtrTable(void)
{
+ ASSERT_LOCK_HELD(&stable_ptr_mutex);
+
uint32_t old_SPT_size = SPT_size;
spEntry *new_stable_ptr_table;
@@ -206,7 +215,8 @@ enlargeStablePtrTable(void)
*/
RELEASE_STORE(&stable_ptr_table, new_stable_ptr_table);
- initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
+ // add the new entries to the free list
+ initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size);
}
/* Note [Enlarging the stable pointer table]
@@ -245,6 +255,7 @@ exitStablePtrTable(void)
{
if (stable_ptr_table)
stgFree(stable_ptr_table);
+
stable_ptr_table = NULL;
SPT_size = 0;
@@ -265,12 +276,17 @@ freeSpEntry(spEntry *sp)
void
freeStablePtrUnsafe(StgStablePtr sp)
{
+ ASSERT_LOCK_HELD(&stable_ptr_mutex);
+
// see Note [NULL StgStablePtr]
if (sp == NULL) {
return;
}
+
StgWord spw = (StgWord)sp - 1;
+
ASSERT(spw < SPT_size);
+
freeSpEntry(&stable_ptr_table[spw]);
}
@@ -278,25 +294,35 @@ void
freeStablePtr(StgStablePtr sp)
{
stablePtrLock();
+
freeStablePtrUnsafe(sp);
+
stablePtrUnlock();
}
/* -----------------------------------------------------------------------------
- * Looking up
+ * Allocating stable pointers
* -------------------------------------------------------------------------- */
StgStablePtr
getStablePtr(StgPtr p)
{
- StgWord sp;
-
stablePtrLock();
- if (!stable_ptr_free) enlargeStablePtrTable();
- sp = stable_ptr_free - stable_ptr_table;
- stable_ptr_free = (spEntry*)(stable_ptr_free->addr);
- RELAXED_STORE(&stable_ptr_table[sp].addr, p);
+
+ if (!stable_ptr_free)
+ enlargeStablePtrTable();
+
+ // find the index of free stable ptr
+ StgWord sp = stable_ptr_free - stable_ptr_table;
+
+ // unlink the table entry we grabbed from the free list
+ stable_ptr_free = (spEntry*)(stable_ptr_free->addr);
+
+ // release store to pair with acquire load in deRefStablePtr
+ RELEASE_STORE(&stable_ptr_table[sp].addr, p);
+
stablePtrUnlock();
+
// see Note [NULL StgStablePtr]
sp = sp + 1;
return (StgStablePtr)(sp);
=====================================
testsuite/tests/dependent/should_fail/T15743c.hs
=====================================
@@ -8,4 +8,4 @@ import Data.Proxy
data SimilarKind :: forall (c :: k) (d :: k). Proxy c -> Proxy d -> Type
data T k (c :: k) (a :: Proxy c) b (x :: SimilarKind a b)
-data T2 k (c :: k) (a :: Proxy c) (b :: Proxy d) (x :: SimilarKind a b)
+
=====================================
testsuite/tests/dependent/should_fail/T15743c.stderr
=====================================
@@ -13,18 +13,3 @@ T15743c.hs:10:1: error:
(b :: Proxy d)
(x :: SimilarKind a b)
• In the data type declaration for ‘T’
-
-T15743c.hs:11:1: error:
- • The kind of ‘T2’ is ill-scoped
- Inferred kind: T2 :: forall (d :: k).
- forall k (c :: k) (a :: Proxy c) (b :: Proxy d) ->
- SimilarKind a b -> *
- NB: Specified variables (namely: (d :: k)) always come first
- Perhaps try this order instead:
- k
- (d :: k)
- (c :: k)
- (a :: Proxy c)
- (b :: Proxy d)
- (x :: SimilarKind a b)
- • In the data type declaration for ‘T2’
=====================================
testsuite/tests/roles/should_fail/T23252.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE PolyKinds, DataKinds, ExplicitForAll #-}
+{-# LANGUAGE RoleAnnotations #-}
+
+module T15743 where
+
+import Data.Kind
+import Data.Proxy
+
+data SimilarKind :: forall (c :: k) (d :: k). Proxy c -> Proxy d -> Type
+
+data T2 k (c :: k) (a :: Proxy c) (b :: Proxy d) (x :: SimilarKind a b)
+type role T2 nominal nominal nominal nominal -- Too few!
=====================================
testsuite/tests/roles/should_fail/T23252.stderr
=====================================
@@ -0,0 +1,14 @@
+T23252.hs:11:1: error:
+ • The kind of ‘T2’ is ill-scoped
+ Inferred kind: T2 :: forall (d :: k).
+ forall k (c :: k) (a :: Proxy c) (b :: Proxy d) ->
+ SimilarKind a b -> *
+ NB: Specified variables (namely: (d :: k)) always come first
+ Perhaps try this order instead:
+ k
+ (d :: k)
+ (c :: k)
+ (a :: Proxy c)
+ (b :: Proxy d)
+ (x :: SimilarKind a b)
+ • In the data type declaration for ‘T2’
=====================================
testsuite/tests/roles/should_fail/all.T
=====================================
@@ -8,3 +8,4 @@ test('Roles12', [], makefile_test, [])
test('T8773', normal, compile_fail, [''])
test('T9204', [], makefile_test, [])
test('RolesIArray', normal, compile_fail, [''])
+test('T23252', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6813e72540043bc52fa86e66e916f4e911682728...7a1b9b016a86a5a31b9c01e29060973c348fab07
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6813e72540043bc52fa86e66e916f4e911682728...7a1b9b016a86a5a31b9c01e29060973c348fab07
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/20230414/e2b638ac/attachment-0001.html>
More information about the ghc-commits
mailing list