From 6b29154de6b63597553c5b69b9974c8838a7a80a Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Wed, 22 Mar 2023 20:29:21 -0400
Subject: Make atomicSwapMutVar# an inline primop

---
 compiler/GHC/Builtin/primops.txt.pp |  1 -
 compiler/GHC/StgToCmm/Prim.hs       | 30 ++++++++++++++++++++----------
 rts/PrimOps.cmm                     | 11 -----------
 rts/RtsSymbols.c                    |  1 -
 rts/include/stg/MiscClosures.h      |  1 -
 5 files changed, 20 insertions(+), 24 deletions(-)

diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index 3d6ad24666..559b8a972d 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -2608,7 +2608,6 @@ primop  AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp
    MutVar# s v -> v -> State# s -> (# State# s, v #)
    {Atomically exchange the value of a 'MutVar#'.}
    with
-   out_of_line = True
    has_side_effects = True
 
 -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?]
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 048da3c14f..f4a1924f19 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -297,16 +297,12 @@ emitPrimOp cfg primop =
     -- MutVar's value.
     emitPrimCall [] (MO_AtomicWrite (wordWidth platform) MemOrderRelease)
         [ cmmOffsetW platform mutv (fixedHdrSizeW profile), var ]
+    emitDirtyMutVar mutv (CmmReg old_val)
 
-    platform <- getPlatform
-    mkdirtyMutVarCCall <- getCode $! emitCCall
-      [{-no results-}]
-      (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
-      [(baseExpr platform, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)]
-    emit =<< mkCmmIfThen
-      (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel)
-       (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutv))
-      mkdirtyMutVarCCall
+  AtomicSwapMutVarOp -> \[mutv, val] -> opIntoRegs $ \[res] -> do
+    let dst = cmmOffsetW platform mutv (fixedHdrSizeW profile)
+    emitPrimCall [res] (MO_Xchg (wordWidth platform)) [dst, val]
+    emitDirtyMutVar mutv (CmmReg (CmmLocal res))
 
 --  #define sizzeofByteArrayzh(r,a) \
 --     r = ((StgArrBytes *)(a))->bytes
@@ -1562,7 +1558,6 @@ emitPrimOp cfg primop =
   ResizeMutableByteArrayOp_Char -> alwaysExternal
   ShrinkSmallMutableArrayOp_Char -> alwaysExternal
   NewMutVarOp -> alwaysExternal
-  AtomicSwapMutVarOp -> alwaysExternal
   AtomicModifyMutVar2Op -> alwaysExternal
   AtomicModifyMutVar_Op -> alwaysExternal
   CasMutVarOp -> alwaysExternal
@@ -3332,6 +3327,21 @@ doByteArrayBoundsCheck idx arr idx_ty elem_ty = whenCheckBounds $ do
       then emitBoundsCheck idx effective_arr_sz  -- aligned => simpler check
       else assert (idx_w == W8) (emitRangeBoundsCheck idx elem_sz arr_sz)
 
+-- | Write barrier for @MUT_VAR@ modification.
+emitDirtyMutVar :: CmmExpr -> CmmExpr -> FCode ()
+emitDirtyMutVar mutvar old_val = do
+    cfg <- getStgToCmmConfig
+    platform <- getPlatform
+    mkdirtyMutVarCCall <- getCode $! emitCCall
+      [{-no results-}]
+      (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
+      [(baseExpr platform, AddrHint), (mutvar, AddrHint), (old_val, AddrHint)]
+
+    emit =<< mkCmmIfThen
+      (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel)
+       (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutvar))
+      mkdirtyMutVarCCall
+
 ---------------------------------------------------------------------------
 -- Pushing to the update remembered set
 ---------------------------------------------------------------------------
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 9e86a8e0a2..60d0dc2ccc 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -689,17 +689,6 @@ stg_newMutVarzh ( gcptr init )
     return (mv);
 }
 
-stg_atomicSwapMutVarzh ( gcptr mv, gcptr new )
- /* MutVar# s a -> a -> State# s -> (# State#, a #) */
-{
-    W_ old;
-    (old) = prim %xchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, new);
-    if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) {
-        ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", old "ptr");
-    }
-    return (old);
-}
-
 // RRN: To support the "ticketed" approach, we return the NEW rather
 // than old value if the CAS is successful.  This is received in an
 // opaque form in the Haskell code, preventing the compiler from
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index ebf73a2b69..dee6c57f5e 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -633,7 +633,6 @@ extern char **environ;
       SymI_HasDataProto(stg_writeIOPortzh)                                  \
       SymI_HasDataProto(stg_newIOPortzh)                                    \
       SymI_HasDataProto(stg_noDuplicatezh)                                  \
-      SymI_HasDataProto(stg_atomicSwapMutVarzh)                             \
       SymI_HasDataProto(stg_atomicModifyMutVar2zh)                          \
       SymI_HasDataProto(stg_atomicModifyMutVarzuzh)                         \
       SymI_HasDataProto(stg_casMutVarzh)                                    \
diff --git a/rts/include/stg/MiscClosures.h b/rts/include/stg/MiscClosures.h
index da556870f1..8e50336e4a 100644
--- a/rts/include/stg/MiscClosures.h
+++ b/rts/include/stg/MiscClosures.h
@@ -481,7 +481,6 @@ RTS_FUN_DECL(stg_copySmallMutableArrayzh);
 RTS_FUN_DECL(stg_casSmallArrayzh);
 
 RTS_FUN_DECL(stg_newMutVarzh);
-RTS_FUN_DECL(stg_atomicSwapMutVarzh);
 RTS_FUN_DECL(stg_atomicModifyMutVar2zh);
 RTS_FUN_DECL(stg_atomicModifyMutVarzuzh);
 RTS_FUN_DECL(stg_casMutVarzh);
-- 
cgit v1.2.1