From 813c52198a4642b9ad27786b9a01c812d9d0b5c4 Mon Sep 17 00:00:00 2001
From: GHC GitLab CI <ghc-ci@gitlab-haskell.org>
Date: Thu, 26 Nov 2020 00:11:41 +0000
Subject: [PATCH] nonmoving: Add missing write barrier in shrinkSmallByteArray

(cherry picked from commit 35c22991ae5c22b10ca1a81f0aa888d1939f0b3f)
---
 rts/PrimOps.cmm | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 65bc2d01df6b..2b32e12d2a14 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -233,6 +233,22 @@ stg_shrinkSmallMutableArrayzh ( gcptr mba, W_ new_size )
 
    OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) +
                                  new_size));
+
+   IF_NONMOVING_WRITE_BARRIER_ENABLED {
+     // Ensure that the elements we are about to shrink out of existence
+     // remain visible to the non-moving collector.
+     W_ p, end;
+     p = mba + SIZEOF_StgSmallMutArrPtrs + WDS(new_size);
+     end = mba + SIZEOF_StgSmallMutArrPtrs + WDS(StgSmallMutArrPtrs_ptrs(mba));
+again:
+     ccall updateRemembSetPushClosure_(BaseReg "ptr",
+                                       W_[p] "ptr");
+     if (p < end) {
+       p = p + SIZEOF_W;
+       goto again;
+     }
+   }
+
    StgSmallMutArrPtrs_ptrs(mba) = new_size;
    // See the comments in overwritingClosureOfs for an explanation
    // of the interaction with LDV profiling.
-- 
GitLab