rts: More const correct-ness fixes
[ghc.git] / includes / rts / storage / ClosureMacros.h
index c6b29aa..4ebec0f 100644 (file)
@@ -1,6 +1,6 @@
 /* ----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 1998-2004
+ * (c) The GHC Team, 1998-2012
  *
  * Macros for building and manipulating closures
  *
 
        "info pointer"    The first word of the closure.  Might point
                          to either the end or the beginning of the
-                        info table, depending on whether we're using
-                        the mini interpretter or not.  GET_INFO(c)
-                        retrieves the info pointer of a closure.
+                         info table, depending on whether we're using
+                         the mini interpreter or not.  GET_INFO(c)
+                         retrieves the info pointer of a closure.
 
        "info table"      The info table structure associated with a
                          closure.  This is always a pointer to the
-                        beginning of the structure, so we can
-                        use standard C structure indexing to pull out
-                        the fields.  get_itbl(c) returns a pointer to
-                        the info table for closure c.
+                         beginning of the structure, so we can
+                         use standard C structure indexing to pull out
+                         the fields.  get_itbl(c) returns a pointer to
+                         the info table for closure c.
 
    An address of the form xxxx_info points to the end of the info
    table or the beginning of the info table depending on whether we're
-   mangling or not respectively.  So, 
+   mangling or not respectively.  So,
 
-         c->header.info = xxx_info 
+         c->header.info = xxx_info
 
    makes absolute sense, whether mangling or not.
+
    -------------------------------------------------------------------------- */
 
-#define SET_INFO(c,i) ((c)->header.info = (i))
-#define GET_INFO(c)   ((c)->header.info)
-#define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
+INLINE_HEADER void SET_INFO(StgClosure *c, const StgInfoTable *info) {
+    c->header.info = info;
+}
+INLINE_HEADER const StgInfoTable *GET_INFO(StgClosure *c) {
+    return c->header.info;
+}
 
-#define GET_TAG(con) (get_itbl(con)->srt_bitmap)
+#define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
 
 #ifdef TABLES_NEXT_TO_CODE
 EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info);
@@ -78,17 +81,37 @@ INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {retu
 INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)i;}
 #endif
 
-EXTERN_INLINE StgInfoTable *get_itbl(const StgClosure *c);
-EXTERN_INLINE StgInfoTable *get_itbl(const StgClosure *c) {return INFO_PTR_TO_STRUCT(c->header.info);}
+EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c);
+EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c)
+{
+   return INFO_PTR_TO_STRUCT(c->header.info);
+}
 
-EXTERN_INLINE StgRetInfoTable *get_ret_itbl(const StgClosure *c);
-EXTERN_INLINE StgRetInfoTable *get_ret_itbl(const StgClosure *c) {return RET_INFO_PTR_TO_STRUCT(c->header.info);}
+EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c);
+EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c)
+{
+   return RET_INFO_PTR_TO_STRUCT(c->header.info);
+}
+
+INLINE_HEADER const StgFunInfoTable *get_fun_itbl(const StgClosure *c)
+{
+   return FUN_INFO_PTR_TO_STRUCT(c->header.info);
+}
 
-INLINE_HEADER StgFunInfoTable *get_fun_itbl(const StgClosure *c) {return FUN_INFO_PTR_TO_STRUCT(c->header.info);}
+INLINE_HEADER const StgThunkInfoTable *get_thunk_itbl(const StgClosure *c)
+{
+   return THUNK_INFO_PTR_TO_STRUCT(c->header.info);
+}
 
-INLINE_HEADER StgThunkInfoTable *get_thunk_itbl(const StgClosure *c) {return THUNK_INFO_PTR_TO_STRUCT(c->header.info);}
+INLINE_HEADER const StgConInfoTable *get_con_itbl(const StgClosure *c)
+{
+   return CON_INFO_PTR_TO_STRUCT((c)->header.info);
+}
 
-INLINE_HEADER StgConInfoTable *get_con_itbl(const StgClosure *c) {return CON_INFO_PTR_TO_STRUCT((c)->header.info);}
+INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con)
+{
+    return get_itbl(con)->srt_bitmap;
+}
 
 /* -----------------------------------------------------------------------------
    Macros for building closures
@@ -96,8 +119,8 @@ INLINE_HEADER StgConInfoTable *get_con_itbl(const StgClosure *c) {return CON_INF
 
 #ifdef PROFILING
 #ifdef DEBUG_RETAINER
-/* 
-  For the sake of debugging, we take the safest way for the moment. Actually, this 
+/*
+  For the sake of debugging, we take the safest way for the moment. Actually, this
   is useful to check the sanity of heap before beginning retainer profiling.
   flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
   Note: change those functions building Haskell objects from C datatypes, i.e.,
@@ -109,7 +132,7 @@ INLINE_HEADER StgConInfoTable *get_con_itbl(const StgClosure *c) {return CON_INF
 /*
   For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
   NULL | flip (flip is defined in RetainerProfile.c) because even when flip
-  is 1, rs is invalid and will be initialized to NULL | flip later when 
+  is 1, rs is invalid and will be initialized to NULL | flip later when
   the closure *c is visited.
  */
 /*
@@ -129,20 +152,20 @@ INLINE_HEADER StgConInfoTable *get_con_itbl(const StgClosure *c) {return CON_INF
 #define SET_PROF_HDR(c,ccs)
 #endif
 
-#define SET_HDR(c,_info,ccs)                           \
-   {                                                   \
-       (c)->header.info = _info;                       \
-       SET_PROF_HDR((StgClosure *)(c),ccs);            \
+#define SET_HDR(c,_info,ccs)                            \
+   {                                                    \
+        (c)->header.info = _info;                       \
+        SET_PROF_HDR((StgClosure *)(c),ccs);            \
    }
 
-#define SET_ARR_HDR(c,info,costCentreStack,n_bytes)    \
-   SET_HDR(c,info,costCentreStack);                    \
+#define SET_ARR_HDR(c,info,costCentreStack,n_bytes)     \
+   SET_HDR(c,info,costCentreStack);                     \
    (c)->bytes = n_bytes;
 
 // Use when changing a closure from one kind to another
 #define OVERWRITE_INFO(c, new_info)                             \
     OVERWRITING_CLOSURE((StgClosure *)(c));                     \
-    SET_INFO((c), (new_info));                                  \
+    SET_INFO((StgClosure *)(c), (new_info));                    \
     LDV_RECORD_CREATE(c);
 
 /* -----------------------------------------------------------------------------
@@ -156,30 +179,30 @@ INLINE_HEADER StgConInfoTable *get_con_itbl(const StgClosure *c) {return CON_INF
 
 INLINE_HEADER StgClosure **
 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
-{ 
+{
     switch (info->type) {
     case THUNK_STATIC:
-       return THUNK_STATIC_LINK(p);
+        return THUNK_STATIC_LINK(p);
     case FUN_STATIC:
-       return FUN_STATIC_LINK(p);
+        return FUN_STATIC_LINK(p);
     case IND_STATIC:
-       return IND_STATIC_LINK(p);
+        return IND_STATIC_LINK(p);
     default:
-       return &(p)->payload[info->layout.payload.ptrs +
-                            info->layout.payload.nptrs];
+        return &(p)->payload[info->layout.payload.ptrs +
+                             info->layout.payload.nptrs];
     }
 }
 
-#define STATIC_LINK2(info,p)                                                   \
-   (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +                 \
-                                       info->layout.payload.nptrs + 1])))
-
 /* -----------------------------------------------------------------------------
    INTLIKE and CHARLIKE closures.
    -------------------------------------------------------------------------- */
 
-#define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
-#define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
+INLINE_HEADER P_ CHARLIKE_CLOSURE(int n) {
+    return (P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE];
+}
+INLINE_HEADER P_ INTLIKE_CLOSURE(int n) {
+    return (P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE];
+}
 
 /* ----------------------------------------------------------------------------
    Macros for untagging and retagging closure pointers
@@ -187,7 +210,7 @@ STATIC_LINK(const StgInfoTable *info, StgClosure *p)
    ------------------------------------------------------------------------- */
 
 static inline StgWord
-GET_CLOSURE_TAG(StgClosure * p)
+GET_CLOSURE_TAG(const StgClosure * p)
 {
     return (StgWord)p & TAG_MASK;
 }
@@ -198,6 +221,12 @@ UNTAG_CLOSURE(StgClosure * p)
     return (StgClosure*)((StgWord)p & ~TAG_MASK);
 }
 
+static inline const StgClosure *
+UNTAG_CONST_CLOSURE(const StgClosure * p)
+{
+    return (const StgClosure*)((StgWord)p & ~TAG_MASK);
+}
+
 static inline StgClosure *
 TAG_CLOSURE(StgWord tag,StgClosure * p)
 {
@@ -232,37 +261,38 @@ TAG_CLOSURE(StgWord tag,StgClosure * p)
 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
 {
     StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)p);
-    return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;
+    return (info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES) ? rtsTrue : rtsFalse;
 }
 
 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
 {
-    return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));
+    return (p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p))) ? rtsTrue : rtsFalse;
 }
 
-INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (void *p)
+INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (const void *p)
 {
-    return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info);
+    return LOOKS_LIKE_INFO_PTR((StgWord)
+            (UNTAG_CONST_CLOSURE((const StgClosure *)(p)))->header.info);
 }
 
 /* -----------------------------------------------------------------------------
    Macros for calculating the size of a closure
    -------------------------------------------------------------------------- */
 
-EXTERN_INLINE StgOffset PAP_sizeW   ( nat n_args );
-EXTERN_INLINE StgOffset PAP_sizeW   ( nat n_args )
+EXTERN_INLINE StgOffset PAP_sizeW   ( uint32_t n_args );
+EXTERN_INLINE StgOffset PAP_sizeW   ( uint32_t n_args )
 { return sizeofW(StgPAP) + n_args; }
 
-EXTERN_INLINE StgOffset AP_sizeW   ( nat n_args );
-EXTERN_INLINE StgOffset AP_sizeW   ( nat n_args )
+EXTERN_INLINE StgOffset AP_sizeW   ( uint32_t n_args );
+EXTERN_INLINE StgOffset AP_sizeW   ( uint32_t n_args )
 { return sizeofW(StgAP) + n_args; }
 
-EXTERN_INLINE StgOffset AP_STACK_sizeW ( nat size );
-EXTERN_INLINE StgOffset AP_STACK_sizeW ( nat size )
+EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size );
+EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size )
 { return sizeofW(StgAP_STACK) + size; }
 
-EXTERN_INLINE StgOffset CONSTR_sizeW( nat p, nat np );
-EXTERN_INLINE StgOffset CONSTR_sizeW( nat p, nat np )
+EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np );
+EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np )
 { return sizeofW(StgHeader) + p + np; }
 
 EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void );
@@ -301,18 +331,22 @@ EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x );
 EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x )
 { return PAP_sizeW(x->n_args); }
 
-EXTERN_INLINE StgWord arr_words_words( StgArrWords* x);
-EXTERN_INLINE StgWord arr_words_words( StgArrWords* x)
+EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x);
+EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x)
 { return ROUNDUP_BYTES_TO_WDS(x->bytes); }
 
-EXTERN_INLINE StgOffset arr_words_sizeW( StgArrWords* x );
-EXTERN_INLINE StgOffset arr_words_sizeW( StgArrWords* x )
-{ return sizeofW(StgArrWords) + arr_words_words(x); }
+EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x );
+EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x )
+{ return sizeofW(StgArrBytes) + arr_words_words(x); }
 
 EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x );
 EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 { return sizeofW(StgMutArrPtrs) + x->size; }
 
+EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x );
+EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x )
+{ return sizeofW(StgSmallMutArrPtrs) + x->ptrs; }
+
 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack );
 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack )
 { return sizeofW(StgStack) + stack->stack_size; }
@@ -321,66 +355,76 @@ EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco );
 EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )
 { return bco->size; }
 
-EXTERN_INLINE nat closure_sizeW_ (StgClosure *p, StgInfoTable *info);
-EXTERN_INLINE nat
-closure_sizeW_ (StgClosure *p, StgInfoTable *info)
+/*
+ * TODO: Consider to switch return type from 'uint32_t' to 'StgWord' #8742
+ *
+ * (Also for 'closure_sizeW' below)
+ */
+EXTERN_INLINE uint32_t
+closure_sizeW_ (const StgClosure *p, const StgInfoTable *info);
+EXTERN_INLINE uint32_t
+closure_sizeW_ (const StgClosure *p, const StgInfoTable *info)
 {
     switch (info->type) {
     case THUNK_0_1:
     case THUNK_1_0:
-       return sizeofW(StgThunk) + 1;
+        return sizeofW(StgThunk) + 1;
     case FUN_0_1:
     case CONSTR_0_1:
     case FUN_1_0:
     case CONSTR_1_0:
-       return sizeofW(StgHeader) + 1;
+        return sizeofW(StgHeader) + 1;
     case THUNK_0_2:
     case THUNK_1_1:
     case THUNK_2_0:
-       return sizeofW(StgThunk) + 2;
+        return sizeofW(StgThunk) + 2;
     case FUN_0_2:
     case CONSTR_0_2:
     case FUN_1_1:
     case CONSTR_1_1:
     case FUN_2_0:
     case CONSTR_2_0:
-       return sizeofW(StgHeader) + 2;
+        return sizeofW(StgHeader) + 2;
     case THUNK:
-       return thunk_sizeW_fromITBL(info);
+        return thunk_sizeW_fromITBL(info);
     case THUNK_SELECTOR:
-       return THUNK_SELECTOR_sizeW();
+        return THUNK_SELECTOR_sizeW();
     case AP_STACK:
-       return ap_stack_sizeW((StgAP_STACK *)p);
+        return ap_stack_sizeW((StgAP_STACK *)p);
     case AP:
-       return ap_sizeW((StgAP *)p);
+        return ap_sizeW((StgAP *)p);
     case PAP:
-       return pap_sizeW((StgPAP *)p);
+        return pap_sizeW((StgPAP *)p);
     case IND:
-    case IND_PERM:
-       return sizeofW(StgInd);
+        return sizeofW(StgInd);
     case ARR_WORDS:
-       return arr_words_sizeW((StgArrWords *)p);
+        return arr_words_sizeW((StgArrBytes *)p);
     case MUT_ARR_PTRS_CLEAN:
     case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
-       return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+        return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
+        return small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
     case TSO:
         return sizeofW(StgTSO);
     case STACK:
         return stack_sizeW((StgStack*)p);
     case BCO:
-       return bco_sizeW((StgBCO *)p);
+        return bco_sizeW((StgBCO *)p);
     case TREC_CHUNK:
         return sizeofW(StgTRecChunk);
     default:
-       return sizeW_fromITBL(info);
+        return sizeW_fromITBL(info);
     }
 }
 
 // The definitive way to find the size, in words, of a heap-allocated closure
-EXTERN_INLINE nat closure_sizeW (StgClosure *p);
-EXTERN_INLINE nat closure_sizeW (StgClosure *p)
+EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p);
+EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p)
 {
     return closure_sizeW_(p, get_itbl(p));
 }
@@ -392,30 +436,22 @@ EXTERN_INLINE nat closure_sizeW (StgClosure *p)
 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame );
 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )
 {
-    StgRetInfoTable *info;
+    const StgRetInfoTable *info;
 
     info = get_ret_itbl(frame);
     switch (info->i.type) {
 
-    case RET_DYN:
-    {
-       StgRetDyn *dyn = (StgRetDyn *)frame;
-       return  sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + 
-           RET_DYN_NONPTR_REGS_SIZE +
-           RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness);
-    }
-           
     case RET_FUN:
-       return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
+        return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
 
     case RET_BIG:
-       return 1 + GET_LARGE_BITMAP(&info->i)->size;
+        return 1 + GET_LARGE_BITMAP(&info->i)->size;
 
     case RET_BCO:
-       return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
+        return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
 
     default:
-       return 1 + BITMAP_SIZE(info->i.layout.bitmap);
+        return 1 + BITMAP_SIZE(info->i.layout.bitmap);
     }
 }
 
@@ -429,20 +465,20 @@ EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )
    -------------------------------------------------------------------------- */
 
 // The number of card bytes needed
-INLINE_HEADER lnat mutArrPtrsCards (lnat elems)
+INLINE_HEADER W_ mutArrPtrsCards (W_ elems)
 {
-    return (lnat)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)
+    return (W_)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)
                            >> MUT_ARR_PTRS_CARD_BITS);
 }
 
 // The number of words in the card table
-INLINE_HEADER lnat mutArrPtrsCardTableSize (lnat elems)
+INLINE_HEADER W_ mutArrPtrsCardTableSize (W_ elems)
 {
     return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));
 }
 
 // The address of the card for a particular card number
-INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, lnat n)
+INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
 {
     return ((StgWord8 *)&(a->payload[a->ptrs]) + n);
 }
@@ -452,39 +488,57 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, lnat n)
    OVERWRITING_CLOSURE(p) on the old closure that is about to be
    overwritten.
 
-   In PROFILING mode, LDV profiling requires that we fill the slop
-   with zeroes, and record the old closure as dead (LDV_recordDead()).
+   Note [zeroing slop]
+
+   In some scenarios we write zero words into "slop"; memory that is
+   left unoccupied after we overwrite a closure in the heap with a
+   smaller closure.
+
+   Zeroing slop is required for:
 
-   In DEBUG mode, we must overwrite the slop with zeroes, because the
-   sanity checker wants to walk through the heap checking all the
-   pointers.
+    - full-heap sanity checks (DEBUG, and +RTS -DS)
+    - LDV profiling (PROFILING, and +RTS -hb)
 
-   In multicore mode, we *cannot* overwrite slop with zeroes, because
-   another thread might be reading it.  So,
+   Zeroing slop must be disabled for:
 
-      LDV PROFILING is not compatible with +RTS -N<n> (for n > 1)
+    - THREADED_RTS with +RTS -N2 and greater, because we cannot
+      overwrite slop when another thread might be reading it.
 
-      THREADED_RTS can be used with DEBUG, but full heap sanity
-      checking is disabled except after major GC.
+   Hence, slop is zeroed when either:
+
+    - PROFILING && era <= 0 (LDV is on)
+    - !THREADED_RTS && DEBUG
+
+   And additionally:
+
+    - LDV profiling and +RTS -N2 are incompatible
+    - full-heap sanity checks are disabled for THREADED_RTS
 
    -------------------------------------------------------------------------- */
 
-#if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
+#define ZERO_SLOP_FOR_LDV_PROF     (defined(PROFILING))
+#define ZERO_SLOP_FOR_SANITY_CHECK (defined(DEBUG) && !defined(THREADED_RTS))
+
+#if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK
 #define OVERWRITING_CLOSURE(c) overwritingClosure(c)
+#define OVERWRITING_CLOSURE_OFS(c,n) \
+    overwritingClosureOfs(c,n)
 #else
 #define OVERWRITING_CLOSURE(c) /* nothing */
+#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
 #endif
 
 #ifdef PROFILING
-void LDV_recordDead (StgClosure *c, nat size);
+void LDV_recordDead (const StgClosure *c, uint32_t size);
 #endif
 
 EXTERN_INLINE void overwritingClosure (StgClosure *p);
 EXTERN_INLINE void overwritingClosure (StgClosure *p)
 {
-    nat size, i;
+    uint32_t size, i;
 
-#if defined(PROFILING)
+#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
+    // see Note [zeroing slop], also #8402
     if (era <= 0) return;
 #endif
 
@@ -492,7 +546,7 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p)
 
     // For LDV profiling, we need to record the closure as dead
 #if defined(PROFILING)
-    LDV_recordDead((StgClosure *)(p), size);
+    LDV_recordDead(p, size);
 #endif
 
     for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
@@ -500,4 +554,34 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p)
     }
 }
 
+// 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.
+//
+// Note: As this calls LDV_recordDead() you have to call LDV_RECORD()
+//       on the final state of the closure at the call-site
+EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset);
+EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset)
+{
+    uint32_t size, i;
+
+#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
+    // see Note [zeroing slop], also #8402
+    if (era <= 0) return;
+#endif
+
+    size = closure_sizeW(p);
+
+    ASSERT(offset <= size);
+
+    // For LDV profiling, we need to record the closure as dead
+#if defined(PROFILING)
+    LDV_recordDead(p, size);
+#endif
+
+    for (i = offset; i < size; i++)
+        ((StgWord *)p)[i] = 0;
+}
+
 #endif /* RTS_STORAGE_CLOSUREMACROS_H */