[Git][ghc/ghc][wip/backports] 12 commits: rts: Zero block flags with -DZ
Ben Gamari
gitlab at gitlab.haskell.org
Thu May 14 21:27:34 UTC 2020
Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC
Commits:
22fe8c6c by Ben Gamari at 2020-05-14T17:27:22-04:00
rts: Zero block flags with -DZ
Block flags are very useful for determining the state of a block.
However, some block allocator users don't touch them, leading to
misleading values. Ensure that we zero then when zero-on-gc is set. This
is safe and makes the flags more useful during debugging.
- - - - -
3e605c37 by Ben Gamari at 2020-05-14T17:27:22-04:00
nonmoving: Fix incorrect failed_to_evac value during deadlock gc
Previously we would incorrectly set the failed_to_evac flag if we
evacuated a value due to a deadlock GC. This would cause us to mark more
things as dirty than strictly necessary. It also turned up a nasty but
which I will fix next.
- - - - -
5d3ef6bc by Ben Gamari at 2020-05-14T17:27:22-04:00
nonmoving: Fix handling of dirty objects
Previously we (incorrectly) relied on failed_to_evac to be "precise".
That is, we expected it to only be true if *all* of an object's fields
lived outside of the non-moving heap. However, does not match the
behavior of failed_to_evac, which is true if *any* of the object's
fields weren't promoted (meaning that some others *may* live in the
non-moving heap).
This is problematic as we skip the non-moving write barrier for dirty
objects (which we can only safely do if *all* fields point outside of
the non-moving heap).
Clearly this arises due to a fundamental difference in the behavior
expected of failed_to_evac in the moving and non-moving collector.
e.g., in the moving collector it is always safe to conservatively say
failed_to_evac=true whereas in the non-moving collector the safe value
is false.
This issue went unnoticed as I never wrote down the dirtiness
invariant enforced by the non-moving collector. We now define this
invariant as
An object being marked as dirty implies that all of its fields are
on the mark queue (or, equivalently, update remembered set).
To maintain this invariant we teach nonmovingScavengeOne to push the
fields of objects which we fail to evacuate to the update remembered
set. This is a simple and reasonably cheap solution and avoids the
complexity and fragility that other, more strict alternative invariants
would require.
All of this is described in a new Note, Note [Dirty flags in the
non-moving collector] in NonMoving.c.
- - - - -
a2275146 by Ben Gamari at 2020-05-14T17:27:22-04:00
nonmoving: Optimise the write barrier
(cherry picked from commit a636eadac1f30bae37aeb6526f94893293f098b8)
- - - - -
76278971 by Ömer Sinan Ağacan at 2020-05-14T17:27:22-04:00
FastString: fix eager reading of string ptr in hashStr
This read causes NULL dereferencing when len is 0.
Fixes #17909
In the reproducer in #17909 this bug is triggered as follows:
- SimplOpt.dealWithStringLiteral is called with a single-char string
("=" in #17909)
- tailFS gets called on the FastString of the single-char string.
- tailFS checks the length of the string, which is 1, and calls
mkFastStringByteString on the tail of the ByteString, which is an
empty ByteString as the original ByteString has only one char.
- ByteString's unsafeUseAsCStringLen returns (NULL, 0) for the empty
ByteString, which is passed to mkFastStringWith.
- mkFastStringWith gets hash of the NULL pointer via hashStr, which
fails on empty strings because of this bug.
(cherry picked from commit d15b61608a542f6349b42224140b7d227b88ef4e)
- - - - -
f1fcaec7 by Simon Peyton Jones at 2020-05-14T17:27:22-04:00
Improve error handling for VTA + deferred type errors
This fixes #17792
See Note [VTA for out-of-scope functions] in TcExpr
(cherry picked from commit 335b18bac3c361d243f427b66e67c2c94f5c6494)
- - - - -
951a7783 by Simon Peyton Jones at 2020-05-14T17:27:22-04:00
Add a missing zonk in tcHsPartialType
I omitted a vital zonk when refactoring tcHsPartialType in
commit 48fb3482f8cbc8a4b37161021e846105f980eed4
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Wed Jun 5 08:55:17 2019 +0100
Fix typechecking of partial type signatures
This patch fixes it and adds commentary to explain why.
Fixes #18008
(cherry picked from commit 658bda511237593bb80389280d0364180648058d)
- - - - -
6bc44deb by Sylvain Henry at 2020-05-14T17:27:22-04:00
Rts: show errno on failure (#18033)
(cherry picked from commit 4875d419ba066e479f7ac07f8b39ebe10c855859)
- - - - -
e5f5e5ab by Ryan Scott at 2020-05-14T17:27:22-04:00
Fix two ASSERT buglets in reifyDataCon
Two `ASSERT`s in `reifyDataCon` were always using `arg_tys`, but
`arg_tys` is not meaningful for GADT constructors. In fact, it's
worse than non-meaningful, since using `arg_tys` when reifying a
GADT constructor can lead to failed `ASSERT`ions, as #17305
demonstrates.
This patch applies the simplest possible fix to the immediate
problem. The `ASSERT`s now use `r_arg_tys` instead of `arg_tys`, as
the former makes sure to give something meaningful for GADT
constructors. This makes the panic go away at the very least. There
is still an underlying issue with the way the internals of
`reifyDataCon` work, as described in
https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227023, but we
leave that as future work, since fixing the underlying issue is
much trickier (see
https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227087).
(cherry picked from commit cfb66d181ac45ce3d934bda3521b94277e6eb683)
- - - - -
880a6591 by Adam Gundry at 2020-05-14T17:27:22-04:00
Reject all duplicate declarations involving DuplicateRecordFields (fixes #17965)
This fixes a bug that resulted in some programs being accepted that used the same
identifier as a field label and another declaration, depending on the order they
appeared in the source code.
(cherry picked from commit 0d8c7a6c7c3513089668f49efb0a2dd8b4bbe74a)
- - - - -
73263d82 by Ben Gamari at 2020-05-14T17:27:22-04:00
Ensure that printMinimalImports closes handle
Fixes #18166.
(cherry picked from commit 5afc160dee7142c96a842037fb64bee1429ad9ec)
- - - - -
2b7c1326 by Ben Gamari at 2020-05-14T17:27:22-04:00
rts: Make non-existent linker search path merely a warning
As noted in #18105, previously this resulted in a rather intrusive error
message. This is in contrast to the general expectation that search
paths are merely places to look, not places that must exist.
Fixes #18105.
(cherry picked from commit 24af9f30681444380c25465f555599da563713cb)
- - - - -
28 changed files:
- compiler/basicTypes/RdrName.hs
- compiler/rename/RnNames.hs
- compiler/typecheck/TcExpr.hs
- compiler/typecheck/TcHsType.hs
- compiler/typecheck/TcSplice.hs
- compiler/utils/FastString.hs
- rts/Updates.h
- rts/linker/PEi386.c
- rts/posix/itimer/Pthread.c
- rts/sm/BlockAlloc.c
- rts/sm/Evac.c
- rts/sm/NonMoving.c
- rts/sm/NonMovingMark.c
- rts/sm/NonMovingScav.c
- rts/sm/Storage.c
- + testsuite/tests/overloadedrecflds/should_fail/T17965.hs
- + testsuite/tests/overloadedrecflds/should_fail/T17965.stderr
- testsuite/tests/overloadedrecflds/should_fail/all.T
- + testsuite/tests/partial-sigs/should_compile/T18008.hs
- + testsuite/tests/partial-sigs/should_compile/T18008.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- + testsuite/tests/th/T17305.hs
- + testsuite/tests/th/T17305.stderr
- testsuite/tests/th/all.T
- + testsuite/tests/typecheck/should_compile/T17792.hs
- + testsuite/tests/typecheck/should_compile/T17792.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T13834.stderr
Changes:
=====================================
compiler/basicTypes/RdrName.hs
=====================================
@@ -57,7 +57,7 @@ module RdrName (
gresToAvailInfo,
-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
- GlobalRdrElt(..), isLocalGRE, isRecFldGRE, greLabel,
+ GlobalRdrElt(..), isLocalGRE, isRecFldGRE, isOverloadedRecFldGRE, greLabel,
unQualOK, qualSpecOK, unQualSpecOK,
pprNameProvenance,
Parent(..), greParent_maybe,
@@ -842,6 +842,12 @@ isRecFldGRE :: GlobalRdrElt -> Bool
isRecFldGRE (GRE {gre_par = FldParent{}}) = True
isRecFldGRE _ = False
+isOverloadedRecFldGRE :: GlobalRdrElt -> Bool
+-- ^ Is this a record field defined with DuplicateRecordFields?
+-- (See Note [Parents for record fields])
+isOverloadedRecFldGRE (GRE {gre_par = FldParent{par_lbl = Just _}}) = True
+isOverloadedRecFldGRE _ = False
+
-- Returns the field label of this GRE, if it has one
greLabel :: GlobalRdrElt -> Maybe FieldLabelString
greLabel (GRE{gre_par = FldParent{par_lbl = Just lbl}}) = Just lbl
=====================================
compiler/rename/RnNames.hs
=====================================
@@ -635,9 +635,12 @@ extendGlobalRdrEnvRn avails new_fixities
| otherwise
= return (extendGlobalRdrEnv env gre)
where
- name = gre_name gre
- occ = nameOccName name
- dups = filter isLocalGRE (lookupGlobalRdrEnv env occ)
+ occ = greOccName gre
+ dups = filter isDupGRE (lookupGlobalRdrEnv env occ)
+ -- Duplicate GREs are those defined locally with the same OccName,
+ -- except cases where *both* GREs are DuplicateRecordFields (#17965).
+ isDupGRE gre' = isLocalGRE gre'
+ && not (isOverloadedRecFldGRE gre && isOverloadedRecFldGRE gre')
{- *********************************************************************
@@ -1611,9 +1614,8 @@ printMinimalImports imports_w_usage
= do { imports' <- getMinimalImports imports_w_usage
; this_mod <- getModule
; dflags <- getDynFlags
- ; liftIO $
- do { h <- openFile (mkFilename dflags this_mod) WriteMode
- ; printForUser dflags h neverQualify (vcat (map ppr imports')) }
+ ; liftIO $ withFile (mkFilename dflags this_mod) WriteMode $ \h ->
+ printForUser dflags h neverQualify (vcat (map ppr imports'))
-- The neverQualify is important. We are printing Names
-- but they are in the context of an 'import' decl, and
-- we never qualify things inside there
@@ -1769,14 +1771,13 @@ addDupDeclErr gres@(gre : _)
= addErrAt (getSrcSpan (last sorted_names)) $
-- Report the error at the later location
vcat [text "Multiple declarations of" <+>
- quotes (ppr (nameOccName name)),
+ quotes (ppr (greOccName gre)),
-- NB. print the OccName, not the Name, because the
-- latter might not be in scope in the RdrEnv and so will
-- be printed qualified.
text "Declared at:" <+>
vcat (map (ppr . nameSrcLoc) sorted_names)]
where
- name = gre_name gre
sorted_names = sortWith nameSrcLoc (map gre_name gres)
=====================================
compiler/typecheck/TcExpr.hs
=====================================
@@ -1080,10 +1080,6 @@ isHsValArg (HsValArg {}) = True
isHsValArg (HsTypeArg {}) = False
isHsValArg (HsArgPar {}) = False
-isHsTypeArg :: HsArg tm ty -> Bool
-isHsTypeArg (HsTypeArg {}) = True
-isHsTypeArg _ = False
-
isArgPar :: HsArg tm ty -> Bool
isArgPar (HsArgPar {}) = True
isArgPar (HsValArg {}) = False
@@ -1218,14 +1214,6 @@ tcArgs :: LHsExpr GhcRn -- ^ The function itself (for err msgs only)
-> TcM (HsWrapper, [LHsExprArgOut], TcSigmaType)
-- ^ (a wrapper for the function, the tc'd args, result type)
tcArgs fun orig_fun_ty fun_orig orig_args herald
- | fun_is_out_of_scope
- , any isHsTypeArg orig_args
- = failM -- See Note [VTA for out-of-scope functions]
- -- We have /already/ emitted a CHoleCan constraint (in tcInferFun),
- -- which will later cough up a "Variable not in scope error", so
- -- we can simply fail now, avoiding a confusing error cascade
-
- | otherwise
= go [] 1 orig_fun_ty orig_args
where
-- Don't count visible type arguments when determining how many arguments
@@ -1247,6 +1235,10 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald
}
go acc_args n fun_ty (HsTypeArg l hs_ty_arg : args)
+ | fun_is_out_of_scope -- See Note [VTA for out-of-scope functions]
+ = go acc_args (n+1) fun_ty args
+
+ | otherwise
= do { (wrap1, upsilon_ty) <- topInstantiateInferred fun_orig fun_ty
-- wrap1 :: fun_ty "->" upsilon_ty
; case tcSplitForAllTy_maybe upsilon_ty of
@@ -1337,17 +1329,23 @@ generate an immediate failure (in tc_app_err), saying that a function
of type 'alpha' can't be applied to Bool. That's insane! And indeed
users complain bitterly (#13834, #17150.)
-The right error is the CHoleCan, which reports 'wurble' as out of
-scope, and tries to give its type.
+The right error is the CHoleCan, which has /already/ been emitted by
+tcUnboundId. It later reports 'wurble' as out of scope, and tries to
+give its type.
+
+Fortunately in tcArgs we still have access to the function, so we can
+check if it is a HsUnboundVar. We use this info to simply skip over
+any visible type arguments. We've already inferred the type of the
+function, so we'll /already/ have emitted a CHoleCan constraint;
+failing preserves that constraint.
-Fortunately in tcArgs we still have acces to the function, so
-we can check if it is a HsUnboundVar. If so, we simply fail
-immediately. We've already inferred the type of the function,
-so we'll /already/ have emitted a CHoleCan constraint; failing
-preserves that constraint.
+We do /not/ want to fail altogether in this case (via failM) becuase
+that may abandon an entire instance decl, which (in the presence of
+-fdefer-type-errors) leads to leading to #17792.
-A mild shortcoming of this approach is that we thereby
-don't typecheck any of the arguments, but so be it.
+Downside; the typechecked term has lost its visible type arguments; we
+don't even kind-check them. But let's jump that bridge if we come to
+it. Meanwhile, let's not crash!
Note [Visible type application zonk]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/typecheck/TcHsType.hs
=====================================
@@ -725,6 +725,7 @@ tc_hs_type mode forall@(HsForAllTy { hst_fvf = fvf, hst_bndrs = hs_tvs
m_telescope = Just (sep (map ppr hs_tvs))
; emitResidualTvConstraint skol_info m_telescope tvs' tclvl wanted
+ -- See Note [Skolem escape and forall-types]
; return (mkForAllTys bndrs ty') }
@@ -913,6 +914,26 @@ under these conditions.
See related Note [Wildcards in visible type application] here and
Note [The wildcard story for types] in GHC.Hs.Types
+Note [Skolem escape and forall-types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ f :: forall a. (forall kb (b :: kb). Proxy '[a, b]) -> ()
+
+The Proxy '[a,b] forces a and b to have the same kind. But a's
+kind must be bound outside the 'forall a', and hence escapes.
+We discover this by building an implication constraint for
+each forall. So the inner implication constraint will look like
+ forall kb (b::kb). kb ~ ka
+where ka is a's kind. We can't unify these two, /even/ if ka is
+unification variable, because it would be untouchable inside
+this inner implication.
+
+That's what the pushLevelAndCaptureConstraints, plus subsequent
+emitResidualTvConstraint is all about, when kind-checking
+HsForAllTy.
+
+Note that we don't need to /simplify/ the constraints here
+because we aren't generalising. We just capture them.
-}
{- *********************************************************************
@@ -2810,10 +2831,13 @@ kindGeneralizeAll ty = do { traceTc "kindGeneralizeAll" empty
; kindGeneralizeSome (const True) ty }
-- | Specialized version of 'kindGeneralizeSome', but where no variables
--- can be generalized. Use this variant when it is unknowable whether metavariables
--- might later be constrained.
--- See Note [Recipe for checking a signature] for why and where this
--- function is needed.
+-- can be generalized, but perhaps some may neeed to be promoted.
+-- Use this variant when it is unknowable whether metavariables might
+-- later be constrained.
+--
+-- To see why this promotion is needed, see
+-- Note [Recipe for checking a signature], and especially
+-- Note [Promotion in signatures].
kindGeneralizeNone :: TcType -- needn't be zonked
-> TcM ()
kindGeneralizeNone ty
@@ -3148,7 +3172,7 @@ tcHsPartialSigType ctxt sig_ty
; return (wcs, wcx, theta, tau) }
- -- No kind-generalization here:
+ -- No kind-generalization here, but perhaps some promotion
; kindGeneralizeNone (mkSpecForAllTys implicit_tvs $
mkSpecForAllTys explicit_tvs $
mkPhiTy theta $
@@ -3159,6 +3183,14 @@ tcHsPartialSigType ctxt sig_ty
-- See Note [Extra-constraint holes in partial type signatures]
; emitNamedWildCardHoleConstraints wcs
+ -- Zonk, so that any nested foralls can "see" their occurrences
+ -- See Note [Checking partial type signatures], in
+ -- the bullet on Nested foralls.
+ ; implicit_tvs <- mapM zonkTcTyVarToTyVar implicit_tvs
+ ; explicit_tvs <- mapM zonkTcTyVarToTyVar explicit_tvs
+ ; theta <- mapM zonkTcType theta
+ ; tau <- zonkTcType tau
+
-- We return a proper (Name,TyVar) environment, to be sure that
-- we bring the right name into scope in the function body.
-- Test case: partial-sigs/should_compile/LocalDefinitionBug
@@ -3167,7 +3199,7 @@ tcHsPartialSigType ctxt sig_ty
-- NB: checkValidType on the final inferred type will be
-- done later by checkInferredPolyId. We can't do it
- -- here because we don't have a complete tuype to check
+ -- here because we don't have a complete type to check
; traceTc "tcHsPartialSigType" (ppr tv_prs)
; return (wcs, wcx, tv_prs, theta, tau) }
@@ -3189,13 +3221,32 @@ tcPartialContext hs_theta
{- Note [Checking partial type signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-See also Note [Recipe for checking a signature]
+This Note is about tcHsPartialSigType. See also
+Note [Recipe for checking a signature]
-When we have a parital signature like
- f,g :: forall a. a -> _
+When we have a partial signature like
+ f :: forall a. a -> _
we do the following
-* In TcSigs.tcUserSigType we return a PartialSig, which (unlike
+* tcHsPartialSigType does not make quantified type (forall a. blah)
+ and then instantiate it -- it makes no sense to instantiate a type
+ with wildcards in it. Rather, tcHsPartialSigType just returns the
+ 'a' and the 'blah' separately.
+
+ Nor, for the same reason, do we push a level in tcHsPartialSigType.
+
+* We instantiate 'a' to a unification variable, a TyVarTv, and /not/
+ a skolem; hence the "_Tv" in bindExplicitTKBndrs_Tv. Consider
+ f :: forall a. a -> _
+ g :: forall b. _ -> b
+ f = g
+ g = f
+ They are typechecked as a recursive group, with monomorphic types,
+ so 'a' and 'b' will get unified together. Very like kind inference
+ for mutually recursive data types (sans CUSKs or SAKS); see
+ Note [Cloning for tyvar binders] in GHC.Tc.Gen.HsType
+
+* In GHC.Tc.Gen.Sig.tcUserSigType we return a PartialSig, which (unlike
the companion CompleteSig) contains the original, as-yet-unchecked
source-code LHsSigWcType
@@ -3203,18 +3254,34 @@ we do the following
call tchsPartialSig (defined near this Note). It kind-checks the
LHsSigWcType, creating fresh unification variables for each "_"
wildcard. It's important that the wildcards for f and g are distinct
- becase they migh get instantiated completely differently. E.g.
+ because they might get instantiated completely differently. E.g.
f,g :: forall a. a -> _
f x = a
g x = True
It's really as if we'd written two distinct signatures.
-* Note that we don't make quantified type (forall a. blah) and then
- instantiate it -- it makes no sense to instantiate a type with
- wildcards in it. Rather, tcHsPartialSigType just returns the
- 'a' and the 'blah' separately.
-
- Nor, for the same reason, do we push a level in tcHsPartialSigType.
+* Nested foralls. Consider
+ f :: forall b. (forall a. a -> _) -> b
+ We do /not/ allow the "_" to be instantiated to 'a'; but we do
+ (as before) allow it to be instantiated to the (top level) 'b'.
+ Why not? Because suppose
+ f x = (x True, x 'c')
+ We must instantiate that (forall a. a -> _) when typechecking
+ f's body, so we must know precisely where all the a's are; they
+ must not be hidden under (filled-in) unification variables!
+
+ We achieve this in the usual way: we push a level at a forall,
+ so now the unification variable for the "_" can't unify with
+ 'a'.
+
+* Just as for ordinary signatures, we must zonk the type after
+ kind-checking it, to ensure that all the nested forall binders can
+ see their occurrenceds
+
+ Just as for ordinary signatures, this zonk also gets any Refl casts
+ out of the way of instantiation. Example: #18008 had
+ foo :: (forall a. (Show a => blah) |> Refl) -> _
+ and that Refl cast messed things up. See #18062.
Note [Extra-constraint holes in partial type signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/typecheck/TcSplice.hs
=====================================
@@ -1645,7 +1645,7 @@ reifyDataCon isGadtDataCon tys dc
-- constructors can be declared infix.
-- See Note [Infix GADT constructors] in TcTyClsDecls.
| dataConIsInfix dc && not isGadtDataCon ->
- ASSERT( arg_tys `lengthIs` 2 ) do
+ ASSERT( r_arg_tys `lengthIs` 2 ) do
{ let [r_a1, r_a2] = r_arg_tys
[s1, s2] = dcdBangs
; return $ TH.InfixC (s1,r_a1) name (s2,r_a2) }
@@ -1664,7 +1664,7 @@ reifyDataCon isGadtDataCon tys dc
{ cxt <- reifyCxt theta'
; ex_tvs'' <- reifyTyVars ex_tvs'
; return (TH.ForallC ex_tvs'' cxt main_con) }
- ; ASSERT( arg_tys `equalLength` dcdBangs )
+ ; ASSERT( r_arg_tys `equalLength` dcdBangs )
ret_con }
{-
=====================================
compiler/utils/FastString.hs
=====================================
@@ -531,16 +531,22 @@ cmpStringPrefix ptr1 ptr2 len =
do r <- memcmp ptr1 ptr2 len
return (r == 0)
-
hashStr :: Ptr Word8 -> Int -> Int
-- use the Addr to produce a hash value between 0 & m (inclusive)
hashStr (Ptr a#) (I# len#) = loop 0# 0#
- where
- loop h n | isTrue# (n ==# len#) = I# h
- | otherwise = loop h2 (n +# 1#)
- where
- !c = ord# (indexCharOffAddr# a# n)
- !h2 = (h *# 16777619#) `xorI#` c
+ where
+ loop h n =
+ if isTrue# (n ==# len#) then
+ I# h
+ else
+ let
+ -- DO NOT move this let binding! indexCharOffAddr# reads from the
+ -- pointer so we need to evaluate this based on the length check
+ -- above. Not doing this right caused #17909.
+ !c = ord# (indexCharOffAddr# a# n)
+ !h2 = (h *# 16777619#) `xorI#` c
+ in
+ loop h2 (n +# 1#)
-- -----------------------------------------------------------------------------
-- Operations
=====================================
rts/Updates.h
=====================================
@@ -50,22 +50,21 @@
\
prim_write_barrier; \
OVERWRITING_CLOSURE(p1); \
- IF_NONMOVING_WRITE_BARRIER_ENABLED { \
- ccall updateRemembSetPushThunk_(BaseReg, p1 "ptr"); \
- } \
- StgInd_indirectee(p1) = p2; \
- prim_write_barrier; \
- SET_INFO(p1, stg_BLACKHOLE_info); \
- LDV_RECORD_CREATE(p1); \
bd = Bdescr(p1); \
if (bdescr_gen_no(bd) != 0 :: bits16) { \
+ IF_NONMOVING_WRITE_BARRIER_ENABLED { \
+ ccall updateRemembSetPushThunk_(BaseReg, p1 "ptr"); \
+ } \
recordMutableCap(p1, TO_W_(bdescr_gen_no(bd))); \
TICK_UPD_OLD_IND(); \
- and_then; \
} else { \
TICK_UPD_NEW_IND(); \
- and_then; \
- }
+ } \
+ StgInd_indirectee(p1) = p2; \
+ prim_write_barrier; \
+ SET_INFO(p1, stg_BLACKHOLE_info); \
+ LDV_RECORD_CREATE(p1); \
+ and_then;
#else /* !CMINUSMINUS */
@@ -73,28 +72,26 @@ INLINE_HEADER void updateWithIndirection (Capability *cap,
StgClosure *p1,
StgClosure *p2)
{
- bdescr *bd;
-
ASSERT( (P_)p1 != (P_)p2 );
/* not necessarily true: ASSERT( !closure_IND(p1) ); */
/* occurs in RaiseAsync.c:raiseAsync() */
/* See Note [Heap memory barriers] in SMP.h */
write_barrier();
- OVERWRITING_CLOSURE(p1);
- IF_NONMOVING_WRITE_BARRIER_ENABLED {
- updateRemembSetPushThunk(cap, (StgThunk*)p1);
- }
- ((StgInd *)p1)->indirectee = p2;
- write_barrier();
- SET_INFO(p1, &stg_BLACKHOLE_info);
- LDV_RECORD_CREATE(p1);
- bd = Bdescr((StgPtr)p1);
+ bdescr *bd = Bdescr((StgPtr)p1);
if (bd->gen_no != 0) {
+ IF_NONMOVING_WRITE_BARRIER_ENABLED {
+ updateRemembSetPushThunk(cap, (StgThunk*)p1);
+ }
recordMutableCap(p1, cap, bd->gen_no);
TICK_UPD_OLD_IND();
} else {
TICK_UPD_NEW_IND();
}
+ OVERWRITING_CLOSURE(p1);
+ ((StgInd *)p1)->indirectee = p2;
+ write_barrier();
+ SET_INFO(p1, &stg_BLACKHOLE_info);
+ LDV_RECORD_CREATE(p1);
}
#endif /* CMINUSMINUS */
=====================================
rts/linker/PEi386.c
=====================================
@@ -776,12 +776,12 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path)
WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size);
DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL);
if (!wResult){
- sysErrorBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError());
+ IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError()));
}
else if (wResult > init_buf_size) {
abs_path = realloc(abs_path, sizeof(WCHAR) * wResult);
if (!GetFullPathNameW(dll_path, bufsize, abs_path, NULL)) {
- sysErrorBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError());
+ IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError()));
}
}
=====================================
rts/posix/itimer/Pthread.c
=====================================
@@ -109,13 +109,13 @@ static void *itimer_thread_func(void *_handle_tick)
timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC);
if (timerfd == -1) {
- barf("timerfd_create");
+ barf("timerfd_create: %s", strerror(errno));
}
if (!TFD_CLOEXEC) {
fcntl(timerfd, F_SETFD, FD_CLOEXEC);
}
if (timerfd_settime(timerfd, 0, &it, NULL)) {
- barf("timerfd_settime");
+ barf("timerfd_settime: %s", strerror(errno));
}
#endif
@@ -123,7 +123,7 @@ static void *itimer_thread_func(void *_handle_tick)
if (USE_TIMERFD_FOR_ITIMER) {
if (read(timerfd, &nticks, sizeof(nticks)) != sizeof(nticks)) {
if (errno != EINTR) {
- barf("Itimer: read(timerfd) failed");
+ barf("Itimer: read(timerfd) failed: %s", strerror(errno));
}
}
} else {
@@ -169,7 +169,7 @@ initTicker (Time interval, TickProc handle_tick)
pthread_setname_np(thread, "ghc_ticker");
#endif
} else {
- barf("Itimer: Failed to spawn thread");
+ barf("Itimer: Failed to spawn thread: %s", strerror(errno));
}
}
@@ -203,7 +203,7 @@ exitTicker (bool wait)
// wait for ticker to terminate if necessary
if (wait) {
if (pthread_join(thread, NULL)) {
- sysErrorBelch("Itimer: Failed to join");
+ sysErrorBelch("Itimer: Failed to join: %s", strerror(errno));
}
closeMutex(&mutex);
closeCondition(&start_cond);
=====================================
rts/sm/BlockAlloc.c
=====================================
@@ -233,6 +233,12 @@ initGroup(bdescr *head)
last->blocks = 0;
last->link = head;
}
+
+#if defined(DEBUG)
+ for (uint32_t i=0; i < head->blocks; i++) {
+ head[i].flags = 0;
+ }
+#endif
}
#if SIZEOF_VOID_P == SIZEOF_LONG
@@ -792,6 +798,12 @@ freeGroup(bdescr *p)
ASSERT(p->free != (P_)-1);
+#if defined(DEBUG)
+ for (uint32_t i=0; i < p->blocks; i++) {
+ p[i].flags = 0;
+ }
+#endif
+
node = p->node;
p->free = (void *)-1; /* indicates that this block is free */
=====================================
rts/sm/Evac.c
=====================================
@@ -80,16 +80,15 @@ alloc_for_copy (uint32_t size, uint32_t gen_no)
if (gen_no < gct->evac_gen_no) {
if (gct->eager_promotion) {
gen_no = gct->evac_gen_no;
+ } else if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving) && deadlock_detect_gc) {
+ /* See Note [Deadlock detection under nonmoving collector]. */
+ gen_no = oldest_gen->no;
} else {
gct->failed_to_evac = true;
}
}
if (RTS_UNLIKELY(RtsFlags.GcFlags.useNonmoving)) {
- /* See Note [Deadlock detection under nonmoving collector]. */
- if (deadlock_detect_gc)
- gen_no = oldest_gen->no;
-
if (gen_no == oldest_gen->no) {
gct->copied += size;
to = nonmovingAllocate(gct->cap, size);
=====================================
rts/sm/NonMoving.c
=====================================
@@ -228,6 +228,10 @@ Mutex concurrent_coll_finished_lock;
* - Note [Static objects under the nonmoving collector] (Storage.c) describes
* treatment of static objects.
*
+ * - Note [Dirty flags in the non-moving collector] (NonMoving.c) describes
+ * how we use the DIRTY flags associated with MUT_VARs and TVARs to improve
+ * barrier efficiency.
+ *
*
* Note [Concurrent non-moving collection]
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -369,6 +373,7 @@ Mutex concurrent_coll_finished_lock;
* approximate due to concurrent collection and ultimately seems more costly
* than the problem demands.
*
+ *
* Note [Spark management under the nonmoving collector]
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* Every GC, both minor and major, prunes the spark queue (using
@@ -387,6 +392,88 @@ Mutex concurrent_coll_finished_lock;
* BF_EVACUATED flag won't be set on the nursery blocks) and will consequently
* only prune dead sparks living in the non-moving heap.
*
+ *
+ * Note [Dirty flags in the non-moving collector]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * Some mutable object types (e.g. MUT_VARs, TVARs) have a one-bit dirty flag
+ * encoded in their info table pointer. The moving collector's uses this flag
+ * to minimize redundant mut_list entries. The flag is preserves the following
+ * simple invariant:
+ *
+ * An object being marked as dirty implies that the object is on mut_list.
+ *
+ * This allows a nice optimisation in the write barrier (e.g. dirty_MUT_VAR):
+ * if we write to an already-dirty object there is no need to
+ * push it to the mut_list as we know it's already there.
+ *
+ * During GC (scavenging) we will then keep track of whether all of the
+ * object's reference have been promoted. If so we can mark the object as clean.
+ * If not then we re-add it to mut_list and mark it as dirty.
+ *
+ * In the non-moving collector we use the same dirty flag to implement a
+ * related optimisation on the non-moving write barrier: Specifically, the
+ * snapshot invariant only requires that the non-moving write barrier applies
+ * to the *first* mutation to an object after collection begins. To achieve this,
+ * we impose the following invariant:
+ *
+ * An object being marked as dirty implies that all of its fields are on
+ * the mark queue (or, equivalently, update remembered set).
+ *
+ * With this guarantee we can safely make the the write barriers dirty objects
+ * no-ops. We perform this optimisation for the following object types:
+ *
+ * - MVAR
+ * - TVAR
+ * - MUT_VAR
+ *
+ * However, maintaining this invariant requires great care. For instance,
+ * consider the case of an MVar (which has two pointer fields) before
+ * preparatory collection:
+ *
+ * Non-moving heap ┊ Moving heap
+ * gen 1 ┊ gen 0
+ * ──────────────────────┼────────────────────────────────
+ * ┊
+ * MVAR A ────────────────→ X
+ * (dirty) ───────────╮
+ * ┊ ╰────→ Y
+ * ┊ │
+ * ┊ │
+ * ╭───────────────────────╯
+ * │ ┊
+ * ↓ ┊
+ * Z ┊
+ * ┊
+ *
+ * During the preparatory collection we promote Y to the nonmoving heap but
+ * fail to promote X. Since the failed_to_evac field is conservative (being set
+ * if *any* of the fields are not promoted), this gives us:
+ *
+ * Non-moving heap ┊ Moving heap
+ * gen 1 ┊ gen 0
+ * ──────────────────────┼────────────────────────────────
+ * ┊
+ * MVAR A ────────────────→ X
+ * (dirty) ┊
+ * │ ┊
+ * │ ┊
+ * ↓ ┊
+ * Y ┊
+ * │ ┊
+ * │ ┊
+ * ↓ ┊
+ * Z ┊
+ * ┊
+ *
+ * This is bad. When we resume mutation a mutator may mutate MVAR A; since it's
+ * already dirty we would fail to add Y to the update remembered set, breaking the
+ * snapshot invariant and potentially losing track of the liveness of Z.
+ *
+ * To avoid this nonmovingScavengeOne we eagerly pushes the values of the
+ * fields of all objects which it fails to evacuate (e.g. MVAR A) to the update
+ * remembered set during the preparatory GC. This allows us to safely skip the
+ * non-moving write barrier without jeopardizing the snapshot invariant.
+ *
*/
memcount nonmoving_live_words = 0;
=====================================
rts/sm/NonMovingMark.c
=====================================
@@ -27,6 +27,7 @@
#include "sm/Storage.h"
#include "CNF.h"
+static bool check_in_nonmoving_heap(StgClosure *p);
static void mark_closure (MarkQueue *queue, const StgClosure *p, StgClosure **origin);
static void mark_tso (MarkQueue *queue, StgTSO *tso);
static void mark_stack (MarkQueue *queue, StgStack *stack);
@@ -450,10 +451,17 @@ push (MarkQueue *q, const MarkQueueEnt *ent)
void
markQueuePushClosureGC (MarkQueue *q, StgClosure *p)
{
+ if (!check_in_nonmoving_heap(p)) {
+ return;
+ }
+
/* We should not make it here if we are doing a deadlock detect GC.
* See Note [Deadlock detection under nonmoving collector].
+ * This is actually no longer true due to call in nonmovingScavengeOne
+ * introduced due to Note [Dirty flags in the non-moving collector]
+ * (see NonMoving.c).
*/
- ASSERT(!deadlock_detect_gc);
+ //ASSERT(!deadlock_detect_gc);
// Are we at the end of the block?
if (q->top->head == MARK_QUEUE_BLOCK_ENTRIES) {
=====================================
rts/sm/NonMovingScav.c
=====================================
@@ -31,6 +31,11 @@ nonmovingScavengeOne (StgClosure *q)
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
mvar->header.info = &stg_MVAR_DIRTY_info;
+
+ // Note [Dirty flags in the non-moving collector] in NonMoving.c
+ markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) mvar->head);
+ markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) mvar->tail);
+ markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) mvar->value);
} else {
mvar->header.info = &stg_MVAR_CLEAN_info;
}
@@ -46,6 +51,10 @@ nonmovingScavengeOne (StgClosure *q)
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
tvar->header.info = &stg_TVAR_DIRTY_info;
+
+ // Note [Dirty flags in the non-moving collector] in NonMoving.c
+ markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) tvar->current_value);
+ markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) tvar->first_watch_queue_entry);
} else {
tvar->header.info = &stg_TVAR_CLEAN_info;
}
@@ -160,16 +169,21 @@ nonmovingScavengeOne (StgClosure *q)
}
case MUT_VAR_CLEAN:
- case MUT_VAR_DIRTY:
+ case MUT_VAR_DIRTY: {
+ StgMutVar *mv = (StgMutVar *) p;
gct->eager_promotion = false;
- evacuate(&((StgMutVar *)p)->var);
+ evacuate(&mv->var);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
+
+ // Note [Dirty flags in the non-moving collector] in NonMoving.c
+ markQueuePushClosureGC(&gct->cap->upd_rem_set.queue, (StgClosure *) mv->var);
} else {
((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
}
break;
+ }
case BLOCKING_QUEUE:
{
=====================================
rts/sm/Storage.c
=====================================
@@ -1206,6 +1206,7 @@ dirty_MUT_VAR(StgRegTable *reg, StgMutVar *mvar, StgClosure *old)
mvar->header.info = &stg_MUT_VAR_DIRTY_info;
recordClosureMutated(cap, (StgClosure *) mvar);
IF_NONMOVING_WRITE_BARRIER_ENABLED {
+ // See Note [Dirty flags in the non-moving collector] in NonMoving.c
updateRemembSetPushClosure_(reg, old);
}
}
@@ -1228,6 +1229,7 @@ dirty_TVAR(Capability *cap, StgTVar *p,
p->header.info = &stg_TVAR_DIRTY_info;
recordClosureMutated(cap,(StgClosure*)p);
IF_NONMOVING_WRITE_BARRIER_ENABLED {
+ // See Note [Dirty flags in the non-moving collector] in NonMoving.c
updateRemembSetPushClosure(cap, old);
}
}
@@ -1309,6 +1311,7 @@ update_MVAR(StgRegTable *reg, StgClosure *p, StgClosure *old_val)
{
Capability *cap = regTableToCapability(reg);
IF_NONMOVING_WRITE_BARRIER_ENABLED {
+ // See Note [Dirty flags in the non-moving collector] in NonMoving.c
StgMVar *mvar = (StgMVar *) p;
updateRemembSetPushClosure(cap, old_val);
updateRemembSetPushClosure(cap, (StgClosure *) mvar->head);
=====================================
testsuite/tests/overloadedrecflds/should_fail/T17965.hs
=====================================
@@ -0,0 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+main = return ()
+newtype Record a = Record { f :: a -> a }
+class C a where f :: a -> a
=====================================
testsuite/tests/overloadedrecflds/should_fail/T17965.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T17965.hs:4:17: error:
+ Multiple declarations of ‘f’
+ Declared at: T17965.hs:3:29
+ T17965.hs:4:17
=====================================
testsuite/tests/overloadedrecflds/should_fail/all.T
=====================================
@@ -32,3 +32,4 @@ test('hasfieldfail03', normal, compile_fail, [''])
test('T14953', [extra_files(['T14953_A.hs', 'T14953_B.hs'])],
multimod_compile_fail, ['T14953', ''])
test('DuplicateExports', normal, compile_fail, [''])
+test('T17965', normal, compile_fail, [''])
=====================================
testsuite/tests/partial-sigs/should_compile/T18008.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+module Bug where
+
+f :: (forall a. Show a => a -> String) -> _
+f s = s ()
+
=====================================
testsuite/tests/partial-sigs/should_compile/T18008.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T18008.hs:5:43: warning: [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘String’
+ • In the type ‘(forall a. Show a => a -> String) -> _’
+ In the type signature: f :: (forall a. Show a => a -> String) -> _
=====================================
testsuite/tests/partial-sigs/should_compile/all.T
=====================================
@@ -95,3 +95,4 @@ test('T16334', normal, compile, [''])
test('T16728', normal, compile, [''])
test('T16728a', normal, compile, [''])
test('T16728b', normal, compile, [''])
+test('T18008', normal, compile, [''])
=====================================
testsuite/tests/th/T17305.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+module T17305 where
+
+import Data.Kind
+import Language.Haskell.TH hiding (Type)
+import System.IO
+
+data family Foo a
+data instance Foo :: Type -> Type where
+ MkFoo :: Foo a
+
+$(do i <- reify ''Foo
+ runIO $ hPutStrLn stderr $ pprint i
+ pure [])
=====================================
testsuite/tests/th/T17305.stderr
=====================================
@@ -0,0 +1,3 @@
+data family T17305.Foo (a_0 :: *) :: *
+data instance T17305.Foo where
+ T17305.MkFoo :: forall (a_1 :: *) . T17305.Foo a_1
=====================================
testsuite/tests/th/all.T
=====================================
@@ -489,6 +489,7 @@ test('T16980a', expect_broken(16980), compile_fail, [''])
test('T17270a', extra_files(['T17270.hs']), multimod_compile, ['T17270', '-v0'])
test('T17270b', extra_files(['T17270.hs']), multimod_compile, ['T17270', '-fenable-th-splice-warnings -v0'])
test('T17296', normal, compile, ['-v0'])
+test('T17305', normal, compile, ['-v0'])
test('T17380', normal, compile_fail, [''])
test('T17394', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T17379a', normal, compile_fail, [''])
=====================================
testsuite/tests/typecheck/should_compile/T17792.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fdefer-type-errors #-}
+
+module T17792 where
+
+class C a where
+ m :: a
+
+instance C Bool where
+ m = notInScope @Word
=====================================
testsuite/tests/typecheck/should_compile/T17792.stderr
=====================================
@@ -0,0 +1,3 @@
+
+T17792.hs:10:7: warning: [-Wdeferred-out-of-scope-variables (in -Wdefault)]
+ Variable not in scope: notInScope :: Bool
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -693,3 +693,4 @@ test('T17202', expect_broken(17202), compile, [''])
test('T15839a', normal, compile, [''])
test('T15839b', normal, compile, [''])
test('T17343', exit_code(1), compile_and_run, [''])
+test('T17792', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_fail/T13834.stderr
=====================================
@@ -1,2 +1,3 @@
-T13834.hs:5:7: error: Variable not in scope: notInScope
+T13834.hs:5:7:
+ Variable not in scope: notInScope :: Bool -> t
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29ca4c5121f1b1b08417bc6b87bc7915a20fdd42...2b7c13267aaec9d2b3e2c0ad94ad343993e386d1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29ca4c5121f1b1b08417bc6b87bc7915a20fdd42...2b7c13267aaec9d2b3e2c0ad94ad343993e386d1
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/20200514/bf558c36/attachment-0001.html>
More information about the ghc-commits
mailing list