Fix slop zeroing for AP_STACK eager blackholes in debug build

As #15571 reports, eager blackholing breaks sanity checks as we can't
zero the payload when eagerly blackholing (because we'll be using the
payload after blackholing), but by the time we blackhole a previously
eagerly blackholed object (in `threadPaused()`) we don't have the
correct size information for the object (because the object's type
becomes BLACKHOLE when we eagerly blackhole it) so can't properly zero
the slop.

This problem can be solved for AP_STACK eager blackholing (which unlike
eager blackholing in general, is not optional) by zeroing the payload
after entering the stack. This patch implements this idea.

Fixes #15571.

Test Plan:
Previously concprog001 when compiled and run with sanity checks

    ghc-stage2 Mult.hs -debug -rtsopts
    ./Mult +RTS -DS

was failing with

    Mult: internal error: checkClosure: stack frame
        (GHC version 8.7.20180821 for x86_64_unknown_linux)
        Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug

thic patch fixes this panic. The test still panics, but it runs for a while
before panicking (instead of directly panicking as before), and the new problem
seems unrelated:

    Mult: internal error: ASSERTION FAILED: file rts/sm/Sanity.c, line 296
        (GHC version 8.7.20180919 for x86_64_unknown_linux)
        Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug

The new problem will be fixed in another diff.

I also tried slow validate (which requires D5164): this does not introduce any
new failures.

Reviewers: simonmar, bgamari, erikd

Reviewed By: simonmar

Subscribers: rwbarton, carter

GHC Trac Issues: #15571

Differential Revision: https://phabricator.haskell.org/D5165

2 files changed, 23 insertions, 29 deletions

diff --git a/includes/Cmm.h b/includes/Cmm.h
index 059220a813..7334eab8c1 100644
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -617,10 +617,11 @@
 #define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n))
 
 #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
+#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size)
 #define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
-#define OVERWRITING_CLOSURE_OFS(c,n) \
-    foreign "C" overwritingClosureOfs(c "ptr", n)
+#define OVERWRITING_CLOSURE_OFS(c,n) foreign "C" overwritingClosureOfs(c "ptr", n)
 #else
+#define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */
 #define OVERWRITING_CLOSURE(c) /* nothing */
 #define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
 #endif
diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h
index 71d53ae8a2..e52059e790 100644
--- a/includes/rts/storage/ClosureMacros.h
+++ b/includes/rts/storage/ClosureMacros.h
@@ -530,8 +530,7 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
 
 #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)
+#define OVERWRITING_CLOSURE_OFS(c,n) overwritingClosureOfs(c,n)
 #else
 #define OVERWRITING_CLOSURE(c) /* nothing */
 #define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
@@ -541,28 +540,32 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
 void LDV_recordDead (const StgClosure *c, uint32_t size);
 #endif
 
-EXTERN_INLINE void overwritingClosure (StgClosure *p);
-EXTERN_INLINE void overwritingClosure (StgClosure *p)
+EXTERN_INLINE void overwritingClosure_ (StgClosure *p,
+                                        uint32_t offset /* in words */,
+                                        uint32_t size /* closure size, in words */);
+EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t size)
 {
-    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);
-
     // For LDV profiling, we need to record the closure as dead
 #if defined(PROFILING)
     LDV_recordDead(p, size);
 #endif
 
-    for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
-        ((StgThunk *)(p))->payload[i] = 0;
+    for (uint32_t i = offset; i < size; i++) {
+        ((StgWord *)p)[i] = 0;
     }
 }
 
+EXTERN_INLINE void overwritingClosure (StgClosure *p);
+EXTERN_INLINE void overwritingClosure (StgClosure *p)
+{
+    overwritingClosure_(p, sizeofW(StgThunkHeader), closure_sizeW(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
@@ -573,22 +576,12 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p)
 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
+    overwritingClosure_(p, offset, closure_sizeW(p));
+}
 
-    for (i = offset; i < size; i++)
-        ((StgWord *)p)[i] = 0;
+// 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);
 }