1 files changed, 42 insertions, 0 deletions
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 30e37bb930..0b3a8d8b08 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -39,6 +39,11 @@ module GHC.StgToCmm.Utils (
         mkWordCLit,
         newStringCLit, newByteStringCLit,
         blankWord,
+
+        -- * Update remembered set operations
+        whenUpdRemSetEnabled,
+        emitUpdRemSetPush,
+        emitUpdRemSetPushThunk,
   ) where
 
 #include "HsVersions.h"
@@ -576,3 +581,40 @@ assignTemp' e
        let reg = CmmLocal lreg
        emitAssign reg e
        return (CmmReg reg)
+
+
+---------------------------------------------------------------------------
+-- Pushing to the update remembered set
+---------------------------------------------------------------------------
+
+whenUpdRemSetEnabled :: DynFlags -> FCode a -> FCode ()
+whenUpdRemSetEnabled dflags code = do
+    do_it <- getCode code
+    the_if <- mkCmmIfThenElse' is_enabled do_it mkNop (Just False)
+    emit the_if
+  where
+    enabled = CmmLoad (CmmLit $ CmmLabel mkNonmovingWriteBarrierEnabledLabel) (bWord dflags)
+    zero = zeroExpr dflags
+    is_enabled = cmmNeWord dflags enabled zero
+
+-- | Emit code to add an entry to a now-overwritten pointer to the update
+-- remembered set.
+emitUpdRemSetPush :: CmmExpr   -- ^ value of pointer which was overwritten
+                  -> FCode ()
+emitUpdRemSetPush ptr = do
+    emitRtsCall
+      rtsUnitId
+      (fsLit "updateRemembSetPushClosure_")
+      [(CmmReg (CmmGlobal BaseReg), AddrHint),
+       (ptr, AddrHint)]
+      False
+
+emitUpdRemSetPushThunk :: CmmExpr -- ^ the thunk
+                       -> FCode ()
+emitUpdRemSetPushThunk ptr = do
+    emitRtsCall
+      rtsUnitId
+      (fsLit "updateRemembSetPushThunk_")
+      [(CmmReg (CmmGlobal BaseReg), AddrHint),
+       (ptr, AddrHint)]
+      False