[Git][ghc/ghc][master] 3 commits: rts: Fix nomenclature in OVERWRITING_CLOSURE macros
Marge Bot
gitlab at gitlab.haskell.org
Wed Apr 15 03:31:48 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
e149dea9 by Daniel Gröber at 2020-04-14T23:31:38-04:00
rts: Fix nomenclature in OVERWRITING_CLOSURE macros
The additional commentary introduced by commit 8916e64e5437 ("Implement
shrinkSmallMutableArray# and resizeSmallMutableArray#.") unfortunately got
this wrong. We set 'prim' to true in overwritingClosureOfs because we
_don't_ want to call LDV_recordDead().
The reason is because of this "inherently used" distinction made in the LDV
profiler so I rename the variable to be more appropriate.
- - - - -
1dd3d18c by Daniel Gröber at 2020-04-14T23:31:38-04:00
Remove call to LDV_RECORD_CREATE for array resizing
- - - - -
19de2fb0 by Daniel Gröber at 2020-04-14T23:31:38-04:00
rts: Assert LDV_recordDead is not called for inherently used closures
The comments make it clear LDV_recordDead should not be called for
inhererently used closures, so add an assertion to codify this fact.
- - - - -
4 changed files:
- includes/rts/storage/ClosureMacros.h
- rts/LdvProfile.c
- rts/PrimOps.cmm
- rts/ProfHeap.c
Changes:
=====================================
includes/rts/storage/ClosureMacros.h
=====================================
@@ -532,14 +532,15 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
#if defined(PROFILING)
void LDV_recordDead (const StgClosure *c, uint32_t size);
+RTS_PRIVATE bool isInherentlyUsed ( StgHalfWord closure_type );
#endif
EXTERN_INLINE void overwritingClosure_ (StgClosure *p,
uint32_t offset /* in words */,
uint32_t size /* closure size, in words */,
- bool prim /* Whether to call LDV_recordDead */
+ bool inherently_used USED_IF_PROFILING
);
-EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t size, bool prim USED_IF_PROFILING)
+EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t size, bool inherently_used USED_IF_PROFILING)
{
#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
// see Note [zeroing slop when overwriting closures], also #8402
@@ -548,7 +549,7 @@ EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t
// For LDV profiling, we need to record the closure as dead
#if defined(PROFILING)
- if (!prim) { LDV_recordDead(p, size); };
+ if (!inherently_used) { LDV_recordDead(p, size); };
#endif
for (uint32_t i = offset; i < size; i++) {
@@ -559,7 +560,11 @@ EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t
EXTERN_INLINE void overwritingClosure (StgClosure *p);
EXTERN_INLINE void overwritingClosure (StgClosure *p)
{
- overwritingClosure_(p, sizeofW(StgThunkHeader), closure_sizeW(p), false);
+#if defined(PROFILING)
+ ASSERT(!isInherentlyUsed(get_itbl(p)->type));
+#endif
+ overwritingClosure_(p, sizeofW(StgThunkHeader), closure_sizeW(p),
+ /*inherently_used=*/false);
}
// Version of 'overwritingClosure' which overwrites only a suffix of a
@@ -572,21 +577,24 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p)
EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset);
EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset)
{
- // Set prim = true because overwritingClosureOfs is only
- // ever called by
- // shrinkMutableByteArray# (ARR_WORDS)
- // shrinkSmallMutableArray# (SMALL_MUT_ARR_PTRS)
- // This causes LDV_recordDead to be invoked. We want this
- // to happen because the implementations of the above
- // primops both call LDV_RECORD_CREATE after calling this,
- // effectively replacing the LDV closure biography.
- // See Note [LDV Profiling when Shrinking Arrays]
- overwritingClosure_(p, offset, closure_sizeW(p), true);
+ // Since overwritingClosureOfs is only ever called by:
+ //
+ // - shrinkMutableByteArray# (ARR_WORDS) and
+ //
+ // - shrinkSmallMutableArray# (SMALL_MUT_ARR_PTRS)
+ //
+ // we can safely set inherently_used = true, which means LDV_recordDead
+ // won't be invoked below. Since these closures are inherenlty used we don't
+ // need to track their destruction.
+ overwritingClosure_(p, offset, closure_sizeW(p), /*inherently_used=*/true);
}
// 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)
{
- overwritingClosure_(p, sizeofW(StgThunkHeader), size, false);
+#if defined(PROFILING)
+ ASSERT(!isInherentlyUsed(get_itbl(p)->type));
+#endif
+ overwritingClosure_(p, sizeofW(StgThunkHeader), size, /*inherently_used=*/false);
}
=====================================
rts/LdvProfile.c
=====================================
@@ -18,6 +18,37 @@
#include "RtsUtils.h"
#include "Schedule.h"
+bool isInherentlyUsed( StgHalfWord closure_type )
+{
+ switch(closure_type) {
+ case TSO:
+ case STACK:
+ case MVAR_CLEAN:
+ case MVAR_DIRTY:
+ case TVAR:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
+ case MUT_ARR_PTRS_FROZEN_CLEAN:
+ case MUT_ARR_PTRS_FROZEN_DIRTY:
+ case SMALL_MUT_ARR_PTRS_CLEAN:
+ case SMALL_MUT_ARR_PTRS_DIRTY:
+ case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
+ case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
+ case ARR_WORDS:
+ case WEAK:
+ case MUT_VAR_CLEAN:
+ case MUT_VAR_DIRTY:
+ case BCO:
+ case PRIM:
+ case MUT_PRIM:
+ case TREC_CHUNK:
+ return true;
+
+ default:
+ return false;
+ }
+}
+
/* --------------------------------------------------------------------------
* This function is called eventually on every object destroyed during
* a garbage collection, whether it is a major garbage collection or
@@ -55,33 +86,13 @@ processHeapClosureForDead( const StgClosure *c )
size = closure_sizeW(c);
- switch (info->type) {
- /*
+ /*
'inherently used' cases: do nothing.
- */
- case TSO:
- case STACK:
- case MVAR_CLEAN:
- case MVAR_DIRTY:
- case TVAR:
- case MUT_ARR_PTRS_CLEAN:
- case MUT_ARR_PTRS_DIRTY:
- case MUT_ARR_PTRS_FROZEN_CLEAN:
- case MUT_ARR_PTRS_FROZEN_DIRTY:
- case SMALL_MUT_ARR_PTRS_CLEAN:
- case SMALL_MUT_ARR_PTRS_DIRTY:
- case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
- case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
- case ARR_WORDS:
- case WEAK:
- case MUT_VAR_CLEAN:
- case MUT_VAR_DIRTY:
- case BCO:
- case PRIM:
- case MUT_PRIM:
- case TREC_CHUNK:
+ */
+ if(isInherentlyUsed(info->type))
return size;
+ switch (info->type) {
/*
ordinary cases: call LDV_recordDead().
*/
=====================================
rts/PrimOps.cmm
=====================================
@@ -158,6 +158,17 @@ stg_isMutableByteArrayPinnedzh ( gcptr mba )
jump stg_isByteArrayPinnedzh(mba);
}
+/* Note [LDV profiling and resizing arrays]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ * As far as the LDV profiler is concerned arrays are "inherently used" which
+ * means we don't track their time of use and eventual destruction. We just
+ * assume they get used.
+ *
+ * Thus it is not necessary to call LDV_RECORD_CREATE when resizing them as we
+ * used to as the LDV profiler will essentially ignore arrays anyways.
+ */
+
// shrink size of MutableByteArray in-place
stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
// MutableByteArray# s -> Int# -> State# s -> State# s
@@ -167,9 +178,7 @@ stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgArrBytes) +
ROUNDUP_BYTES_TO_WDS(new_size)));
StgArrBytes_bytes(mba) = new_size;
- // See the comments in overwritingClosureOfs for an explanation
- // of the interaction with LDV profiling.
- LDV_RECORD_CREATE(mba);
+ // No need to call LDV_RECORD_CREATE. See Note [LDV profiling and resizing arrays]
return ();
}
@@ -193,7 +202,7 @@ stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size )
OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgArrBytes) +
new_size_wds));
StgArrBytes_bytes(mba) = new_size;
- LDV_RECORD_CREATE(mba);
+ // No need to call LDV_RECORD_CREATE. See Note [LDV profiling and resizing arrays]
return (mba);
} else {
@@ -222,9 +231,7 @@ stg_shrinkSmallMutableArrayzh ( gcptr mba, W_ new_size )
OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) +
new_size));
StgSmallMutArrPtrs_ptrs(mba) = new_size;
- // See the comments in overwritingClosureOfs for an explanation
- // of the interaction with LDV profiling.
- LDV_RECORD_CREATE(mba);
+ // No need to call LDV_RECORD_CREATE. See Note [LDV profiling and resizing arrays]
return ();
}
=====================================
rts/ProfHeap.c
=====================================
@@ -280,6 +280,8 @@ LDV_recordDead( const StgClosure *c, uint32_t size )
uint32_t t;
counter *ctr;
+ ASSERT(!isInherentlyUsed(get_itbl(c)->type));
+
if (era > 0 && closureSatisfiesConstraints(c)) {
size -= sizeofW(StgProfHeader);
ASSERT(LDVW(c) != 0);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3c0f662df06500a11970fd391d0a88e081a5296...19de2fb090a25ab0d640d0cd5aef09f35e7455a0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3c0f662df06500a11970fd391d0a88e081a5296...19de2fb090a25ab0d640d0cd5aef09f35e7455a0
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/20200414/d71177e8/attachment-0001.html>
More information about the ghc-commits
mailing list