summaryrefslogtreecommitdiff
path: root/compiler/GHC/CmmToAsm
diff options
context:
space:
mode:
authorPeter Trommler <ptrommler@acm.org>2021-04-17 17:59:44 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-08-02 04:11:27 -0400
commitb4d39adbb5884c764c6c11b2614a340c78cc078e (patch)
tree57eb45d9078c90c34f8743b961bf87789e292ae8 /compiler/GHC/CmmToAsm
parent7e8c578ed9d3469d6a5c1481f9482982c42f10ea (diff)
downloadhaskell-b4d39adbb5884c764c6c11b2614a340c78cc078e.tar.gz
PrimOps: Add CAS op for all int sizes
PPC NCG: Implement CAS inline for 32 and 64 bit testsuite: Add tests for smaller atomic CAS X86 NCG: Catch calls to CAS C fallback Primops: Add atomicCasWord[8|16|32|64]Addr# Add tests for atomicCasWord[8|16|32|64]Addr# Add changelog entry for new primops X86 NCG: Fix MO-Cmpxchg W64 on 32-bit arch ghc-prim: 64-bit CAS C fallback on all archs
Diffstat (limited to 'compiler/GHC/CmmToAsm')
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs33
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs7
2 files changed, 37 insertions, 3 deletions
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 67bc3d9bdb..1c3b244980 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -1221,7 +1221,38 @@ genCCall (PrimTarget (MO_AtomicRead width)) [dst] [addr]
genCCall (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do
code <- assignMem_IntCode (intFormat width) addr val
- return $ unitOL(HWSYNC) `appOL` code
+ return $ unitOL HWSYNC `appOL` code
+
+genCCall (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new]
+ | width == W32 || width == W64
+ = do
+ platform <- getPlatform
+ (old_reg, old_code) <- getSomeReg old
+ (new_reg, new_code) <- getSomeReg new
+ (addr_reg, addr_code) <- getSomeReg addr
+ lbl_retry <- getBlockIdNat
+ lbl_eq <- getBlockIdNat
+ lbl_end <- getBlockIdNat
+ let reg_dst = getRegisterReg platform (CmmLocal dst)
+ code = toOL
+ [ HWSYNC
+ , BCC ALWAYS lbl_retry Nothing
+ , NEWBLOCK lbl_retry
+ , LDR format reg_dst (AddrRegReg r0 addr_reg)
+ , CMP format reg_dst (RIReg old_reg)
+ , BCC NE lbl_end Nothing
+ , BCC ALWAYS lbl_eq Nothing
+ , NEWBLOCK lbl_eq
+ , STC format new_reg (AddrRegReg r0 addr_reg)
+ , BCC NE lbl_retry Nothing
+ , BCC ALWAYS lbl_end Nothing
+ , NEWBLOCK lbl_end
+ , ISYNC
+ ]
+ return $ addr_code `appOL` new_code `appOL` old_code `appOL` code
+ where
+ format = intFormat width
+
genCCall (PrimTarget (MO_Clz width)) [dst] [src]
= do platform <- getPlatform
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 5e7c261cbb..1ab24c4a25 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -2595,10 +2595,11 @@ genCCall' _ _ (PrimTarget (MO_AtomicWrite width)) [] [addr, val] _ = do
code <- assignMem_IntCode (intFormat width) addr val
return $ code `snocOL` MFENCE
-genCCall' _ is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] _ = do
+genCCall' _ is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] _
-- On x86 we don't have enough registers to use cmpxchg with a
-- complicated addressing mode, so on that architecture we
-- pre-compute the address first.
+ | not (is32Bit && width == W64) = do
Amode amode addr_code <- getSimpleAmode is32Bit addr
newval <- getNewRegNat format
newval_code <- getAnyReg new
@@ -3441,7 +3442,9 @@ outOfLineCmmOp bid mop res args
MO_AtomicRMW _ _ -> fsLit "atomicrmw"
MO_AtomicRead _ -> fsLit "atomicread"
MO_AtomicWrite _ -> fsLit "atomicwrite"
- MO_Cmpxchg _ -> fsLit "cmpxchg"
+ MO_Cmpxchg w -> cmpxchgLabel w -- for W64 on 32-bit
+ -- TODO: implement
+ -- cmpxchg8b instr
MO_Xchg _ -> should_be_inline
MO_UF_Conv _ -> unsupported