diff options
author | Peter Trommler <ptrommler@acm.org> | 2021-04-17 17:59:44 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-02 04:11:27 -0400 |
commit | b4d39adbb5884c764c6c11b2614a340c78cc078e (patch) | |
tree | 57eb45d9078c90c34f8743b961bf87789e292ae8 /compiler/GHC/CmmToAsm | |
parent | 7e8c578ed9d3469d6a5c1481f9482982c42f10ea (diff) | |
download | haskell-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.hs | 33 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/X86/CodeGen.hs | 7 |
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 |