Require all dirty_MUT_VAR callers to do explicit stg_MUT_VAR_CLEAN_info comparison (#20088)

3 files changed, 24 insertions, 12 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 723970e520..6dd774421d 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -48,6 +48,7 @@ module GHC.Cmm.CLabel (
         mkAsmTempDieLabel,
 
         mkDirty_MUT_VAR_Label,
+        mkMUT_VAR_CLEAN_infoLabel,
         mkNonmovingWriteBarrierEnabledLabel,
         mkUpdInfoLabel,
         mkBHUpdInfoLabel,
@@ -599,7 +600,8 @@ mkDirty_MUT_VAR_Label,
     mkTopTickyCtrLabel,
     mkCAFBlackHoleInfoTableLabel,
     mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel,
-    mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel
+    mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel,
+    mkMUT_VAR_CLEAN_infoLabel :: CLabel
 mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
 mkNonmovingWriteBarrierEnabledLabel
                                 = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData
@@ -617,6 +619,7 @@ mkSMAP_FROZEN_CLEAN_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsL
 mkSMAP_FROZEN_DIRTY_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
 mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
 mkBadAlignmentLabel             = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment")      CmmEntry
+mkMUT_VAR_CLEAN_infoLabel       = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN")     CmmInfo
 
 mkSRTInfoLabel :: Int -> CLabel
 mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index dff86341b1..c8a2ba8aad 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -39,6 +39,7 @@ import GHC.Unit         ( rtsUnit )
 import GHC.Core.Type    ( Type, tyConAppTyCon )
 import GHC.Core.TyCon
 import GHC.Cmm.CLabel
+import GHC.Cmm.Info     ( closureInfoPtr )
 import GHC.Cmm.Utils
 import GHC.Builtin.PrimOps
 import GHC.Runtime.Heap.Layout
@@ -303,10 +304,16 @@ emitPrimOp dflags primop = case primop of
     -- MutVar's value.
     emitPrimCall res MO_WriteBarrier []
     emitStore (cmmOffsetW platform mutv (fixedHdrSizeW profile)) var
-    emitCCall
-            [{-no results-}]
-            (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
-            [(baseExpr, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)]
+
+    ptrOpts <- getPtrOpts
+    platform <- getPlatform
+    mkdirtyMutVarCCall <- getCode $! emitCCall
+      [{-no results-}]
+      (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
+      [(baseExpr, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)]
+    emit =<< mkCmmIfThen
+      (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) (closureInfoPtr ptrOpts mutv))
+      mkdirtyMutVarCCall
 
 --  #define sizzeofByteArrayzh(r,a) \
 --     r = ((StgArrBytes *)(a))->bytes
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 5241494365..ede47d3eb2 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -1401,20 +1401,22 @@ allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ alig
    MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
    is.  When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
    and is put on the mutable list.
+   Note that it is responsibility of the caller to do the
+   stg_MUT_VAR_CLEAN comparison.
 */
 void
 dirty_MUT_VAR(StgRegTable *reg, StgMutVar *mvar, StgClosure *old)
 {
+    ASSERT(RELAXED_LOAD(&mvar->header.info) == &stg_MUT_VAR_CLEAN_info);
+
     Capability *cap = regTableToCapability(reg);
     // No barrier required here as no other heap object fields are read. See
     // note [Heap memory barriers] in SMP.h.
-    if (RELAXED_LOAD(&mvar->header.info) == &stg_MUT_VAR_CLEAN_info) {
-        SET_INFO((StgClosure*) mvar, &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);
-        }
+    SET_INFO((StgClosure*) mvar, &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);
     }
 }