[Git][ghc/ghc][master] compiler: add SEQ_CST fence support
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Feb 17 11:04:19 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
bd5a1f91 by Cheng Shao at 2024-02-17T06:03:00-05:00
compiler: add SEQ_CST fence support
In addition to existing Acquire/Release fences, this commit adds
SEQ_CST fence support to GHC, allowing Cmm code to explicitly emit a
fence that enforces total memory ordering. The following logic is
added:
- The MO_SeqCstFence callish MachOp
- The %prim fence_seq_cst() Cmm syntax and the SEQ_CST_FENCE macro in Cmm.h
- MO_SeqCstFence lowering logic in every single GHC codegen backend
- - - - -
9 changed files:
- compiler/GHC/Cmm/MachOp.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- rts/include/Cmm.h
Changes:
=====================================
compiler/GHC/Cmm/MachOp.hs
=====================================
@@ -727,6 +727,7 @@ data CallishMachOp
| MO_AcquireFence
| MO_ReleaseFence
+ | MO_SeqCstFence
-- | Atomic read-modify-write. Arguments are @[dest, n]@.
| MO_AtomicRMW Width AtomicMachOp
=====================================
compiler/GHC/Cmm/Parser.y
=====================================
@@ -1133,6 +1133,8 @@ callishMachOps platform = listToUFM $
-- with an overlapping token ('acquire') in the lexer.
( "fence_acquire", (MO_AcquireFence,)),
( "fence_release", (MO_ReleaseFence,)),
+ ( "fence_seq_cst", (MO_SeqCstFence,)),
+
( "memcpy", memcpyLikeTweakArgs MO_Memcpy ),
( "memset", memcpyLikeTweakArgs MO_Memset ),
( "memmove", memcpyLikeTweakArgs MO_Memmove ),
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -1730,6 +1730,7 @@ genCCall target dest_regs arg_regs bid = do
-- Memory Ordering
MO_AcquireFence -> return (unitOL DMBISH, Nothing)
MO_ReleaseFence -> return (unitOL DMBISH, Nothing)
+ MO_SeqCstFence -> return (unitOL DMBISH, Nothing)
MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers)
-- Prefetch
MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint.
=====================================
compiler/GHC/CmmToAsm/PPC/CodeGen.hs
=====================================
@@ -1132,6 +1132,8 @@ genCCall (PrimTarget MO_AcquireFence) _ _
= return $ unitOL LWSYNC
genCCall (PrimTarget MO_ReleaseFence) _ _
= return $ unitOL LWSYNC
+genCCall (PrimTarget MO_SeqCstFence) _ _
+ = return $ unitOL HWSYNC
genCCall (PrimTarget MO_Touch) _ _
= return $ nilOL
@@ -2098,6 +2100,7 @@ genCCall' config gcp target dest_regs args
MO_U_Mul2 {} -> unsupported
MO_AcquireFence -> unsupported
MO_ReleaseFence -> unsupported
+ MO_SeqCstFence -> unsupported
MO_Touch -> unsupported
MO_Prefetch_Data _ -> unsupported
unsupported = panic ("outOfLineCmmOp: " ++ show mop
=====================================
compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
=====================================
@@ -1189,6 +1189,7 @@ lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs
lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs
lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop
lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop
+lower_CallishMachOp _ MO_SeqCstFence _ _ = pure $ WasmStatements WasmNop
lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop
lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop
lower_CallishMachOp lbl (MO_Memcpy {}) [] xs = do
=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -2403,6 +2403,7 @@ genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid a
genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n
genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64;
genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations.
+genSimplePrim _ MO_SeqCstFence [] [] = return $ unitOL MFENCE
genSimplePrim _ MO_Touch [] [_] = return nilOL
genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src
genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src
@@ -4667,4 +4668,3 @@ genPred64 cond dst x y = do
, SETCC cond (OpReg dst_r)
, MOVZxL II8 (OpReg dst_r) (OpReg dst_r)
]
-
=====================================
compiler/GHC/CmmToC.hs
=====================================
@@ -265,6 +265,8 @@ pprStmt platform stmt =
text "__atomic_thread_fence(__ATOMIC_RELEASE);"
CmmUnsafeForeignCall (PrimTarget MO_AcquireFence) [] [] ->
text "__atomic_thread_fence(__ATOMIC_ACQUIRE);"
+ CmmUnsafeForeignCall (PrimTarget MO_SeqCstFence) [] [] ->
+ text "__atomic_thread_fence(__ATOMIC_SEQ_CST);"
CmmUnsafeForeignCall target@(PrimTarget op) results args ->
fn_call
@@ -959,6 +961,7 @@ pprCallishMachOp_for_C mop
MO_F32_Fabs -> text "fabsf"
MO_AcquireFence -> unsupported
MO_ReleaseFence -> unsupported
+ MO_SeqCstFence -> unsupported
MO_Memcpy _ -> text "__builtin_memcpy"
MO_Memset _ -> text "__builtin_memset"
MO_Memmove _ -> text "__builtin_memmove"
=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -180,6 +180,8 @@ genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $
statement $ Fence False SyncAcquire
genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $
statement $ Fence False SyncRelease
+genCall (PrimTarget MO_SeqCstFence) _ _ = runStmtsDecls $
+ statement $ Fence False SyncSeqCst
genCall (PrimTarget MO_Touch) _ _ =
return (nilOL, [])
@@ -992,8 +994,11 @@ cmmPrimOpFunctions mop = do
-- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the
-- appropriate case of genCall.
MO_U_Mul2 {} -> unsupported
+
MO_ReleaseFence -> unsupported
MO_AcquireFence -> unsupported
+ MO_SeqCstFence -> unsupported
+
MO_Touch -> unsupported
MO_UF_Conv _ -> unsupported
=====================================
rts/include/Cmm.h
=====================================
@@ -696,6 +696,7 @@
// See Note [ThreadSanitizer and fences]
#define RELEASE_FENCE prim %fence_release();
#define ACQUIRE_FENCE prim %fence_acquire();
+#define SEQ_CST_FENCE prim %fence_seq_cst();
#if TSAN_ENABLED
// This is may be efficient than a fence but TSAN can reason about it.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd5a1f9156ee4e405e52a1ec4789dada5e98336d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd5a1f9156ee4e405e52a1ec4789dada5e98336d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240217/db2c7dfd/attachment-0001.html>
More information about the ghc-commits
mailing list