summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Cmm/MachOp.hs17
-rw-r--r--compiler/GHC/CmmToAsm/AArch64/CodeGen.hs4
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs8
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs4
-rw-r--r--compiler/GHC/CmmToC.hs5
-rw-r--r--compiler/GHC/CmmToLlvm/CodeGen.hs14
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs4
7 files changed, 34 insertions, 22 deletions
diff --git a/compiler/GHC/Cmm/MachOp.hs b/compiler/GHC/Cmm/MachOp.hs
index 632165b6b2..08b1666f58 100644
--- a/compiler/GHC/Cmm/MachOp.hs
+++ b/compiler/GHC/Cmm/MachOp.hs
@@ -24,6 +24,7 @@ module GHC.Cmm.MachOp
, machOpMemcpyishAlign
-- Atomic read-modify-write
+ , MemoryOrdering(..)
, AtomicMachOp(..)
)
where
@@ -666,10 +667,12 @@ data CallishMachOp
| MO_BSwap Width
| MO_BRev Width
- -- Atomic read-modify-write.
+ -- | Atomic read-modify-write. Arguments are @[dest, n]@.
| MO_AtomicRMW Width AtomicMachOp
- | MO_AtomicRead Width
- | MO_AtomicWrite Width
+ -- | Atomic read. Arguments are @[addr]@.
+ | MO_AtomicRead Width MemoryOrdering
+ -- | Atomic write. Arguments are @[addr, value]@.
+ | MO_AtomicWrite Width MemoryOrdering
-- | Atomic compare-and-swap. Arguments are @[dest, expected, new]@.
-- Sequentially consistent.
-- Possible future refactoring: should this be an'MO_AtomicRMW' variant?
@@ -684,6 +687,14 @@ data CallishMachOp
| MO_ResumeThread
deriving (Eq, Show)
+-- | C11 memory ordering semantics.
+data MemoryOrdering
+ = MemOrderRelaxed -- ^ relaxed ordering
+ | MemOrderAcquire -- ^ acquire ordering
+ | MemOrderRelease -- ^ release ordering
+ | MemOrderSeqCst -- ^ sequentially consistent
+ deriving (Eq, Ord, Show)
+
-- | The operation to perform atomically.
data AtomicMachOp =
AMO_Add
diff --git a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
index dce67e40ca..4ad4b51e01 100644
--- a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
@@ -1535,8 +1535,8 @@ genCCall target dest_regs arg_regs bid = do
-- -- Atomic read-modify-write.
MO_AtomicRMW w amop -> mkCCall (atomicRMWLabel w amop)
- MO_AtomicRead w -> mkCCall (atomicReadLabel w)
- MO_AtomicWrite w -> mkCCall (atomicWriteLabel w)
+ MO_AtomicRead w _ -> mkCCall (atomicReadLabel w)
+ MO_AtomicWrite w _ -> mkCCall (atomicWriteLabel w)
MO_Cmpxchg w -> mkCCall (cmpxchgLabel w)
-- -- Should be an AtomicRMW variant eventually.
-- -- Sequential consistent.
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 844e4744da..7329b8c4b1 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -1174,7 +1174,7 @@ genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
(n_reg, n_code) <- getSomeReg n
return (op dst dst (RIReg n_reg), n_code)
-genCCall (PrimTarget (MO_AtomicRead width)) [dst] [addr]
+genCCall (PrimTarget (MO_AtomicRead width _)) [dst] [addr]
= do let fmt = intFormat width
reg_dst = getLocalRegReg dst
form = if widthInBits width == 64 then DS else D
@@ -1201,7 +1201,7 @@ genCCall (PrimTarget (MO_AtomicRead width)) [dst] [addr]
-- This is also what gcc does.
-genCCall (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do
+genCCall (PrimTarget (MO_AtomicWrite width _)) [] [addr, val] = do
code <- assignMem_IntCode (intFormat width) addr val
return $ unitOL HWSYNC `appOL` code
@@ -2068,8 +2068,8 @@ genCCall' config gcp target dest_regs args
MO_AtomicRMW {} -> unsupported
MO_Cmpxchg w -> (cmpxchgLabel w, False)
MO_Xchg w -> (xchgLabel w, False)
- MO_AtomicRead _ -> unsupported
- MO_AtomicWrite _ -> unsupported
+ MO_AtomicRead _ _ -> unsupported
+ MO_AtomicWrite _ _ -> unsupported
MO_S_Mul2 {} -> unsupported
MO_S_QuotRem {} -> unsupported
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index de0a7c56e3..9a42150119 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -2167,8 +2167,8 @@ genSimplePrim bid (MO_Pdep width) [dst] [src,mask] = genPdep bid widt
genSimplePrim bid (MO_Pext width) [dst] [src,mask] = genPext bid width dst src mask
genSimplePrim bid (MO_Clz width) [dst] [src] = genClz bid width dst src
genSimplePrim bid (MO_UF_Conv width) [dst] [src] = genWordToFloat bid width dst src
-genSimplePrim _ (MO_AtomicRead w) [dst] [addr] = genAtomicRead w dst addr
-genSimplePrim _ (MO_AtomicWrite w) [] [addr,val] = genAtomicWrite w addr val
+genSimplePrim _ (MO_AtomicRead w _) [dst] [addr] = genAtomicRead w dst addr
+genSimplePrim _ (MO_AtomicWrite w _) [] [addr,val] = genAtomicWrite w addr val
genSimplePrim bid (MO_Cmpxchg width) [dst] [addr,old,new] = genCmpXchg bid width dst addr old new
genSimplePrim _ (MO_Xchg width) [dst] [addr, value] = genXchg width dst addr value
genSimplePrim _ (MO_AddWordC w) [r,c] [x,y] = genAddSubRetCarry w ADD_CC (const Nothing) CARRY r c x y
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index c9f86e9afe..c36d8e6963 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -949,8 +949,9 @@ pprCallishMachOp_for_C mop
MO_AtomicRMW w amop -> ftext (atomicRMWLabel w amop)
MO_Cmpxchg w -> ftext (cmpxchgLabel w)
MO_Xchg w -> ftext (xchgLabel w)
- MO_AtomicRead w -> ftext (atomicReadLabel w)
- MO_AtomicWrite w -> ftext (atomicWriteLabel w)
+ -- TODO: handle orderings
+ MO_AtomicRead w _ -> ftext (atomicReadLabel w)
+ MO_AtomicWrite w _ -> ftext (atomicWriteLabel w)
MO_UF_Conv w -> ftext (word2FloatLabel w)
MO_S_Mul2 {} -> unsupported
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index f44fe1af6e..27e907c4b8 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -266,7 +266,7 @@ genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $
retVar <- doExprW targetTy $ AtomicRMW op ptrVar nVar SyncSeqCst
statement $ Store retVar dstVar Nothing
-genCall (PrimTarget (MO_AtomicRead _)) [dst] [addr] = runStmtsDecls $ do
+genCall (PrimTarget (MO_AtomicRead _ _)) [dst] [addr] = runStmtsDecls $ do
dstV <- getCmmRegW (CmmLocal dst)
v1 <- genLoadW True addr (localRegType dst) NaturallyAligned
statement $ Store v1 dstV Nothing
@@ -295,7 +295,7 @@ genCall (PrimTarget (MO_Xchg _width)) [dst] [addr, val] = runStmtsDecls $ do
resVar <- doExprW (getVarType valVar) (AtomicRMW LAO_Xchg ptrVar valVar SyncSeqCst)
statement $ Store resVar dstV Nothing
-genCall (PrimTarget (MO_AtomicWrite _width)) [] [addr, val] = runStmtsDecls $ do
+genCall (PrimTarget (MO_AtomicWrite _width _)) [] [addr, val] = runStmtsDecls $ do
addrVar <- exprToVarW addr
valVar <- exprToVarW val
let ptrTy = pLift $ getVarType valVar
@@ -1013,11 +1013,11 @@ cmmPrimOpFunctions mop = do
MO_Touch -> unsupported
MO_UF_Conv _ -> unsupported
- MO_AtomicRead _ -> unsupported
- MO_AtomicRMW _ _ -> unsupported
- MO_AtomicWrite _ -> unsupported
- MO_Cmpxchg _ -> unsupported
- MO_Xchg _ -> unsupported
+ MO_AtomicRead _ _ -> unsupported
+ MO_AtomicRMW _ _ -> unsupported
+ MO_AtomicWrite _ _ -> unsupported
+ MO_Cmpxchg _ -> unsupported
+ MO_Xchg _ -> unsupported
MO_I64_ToI -> dontReach64
MO_I64_FromI -> dontReach64
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 81f4f03a1c..b88d9314ca 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -3041,7 +3041,7 @@ doAtomicReadAddr
doAtomicReadAddr res addr ty =
emitPrimCall
[ res ]
- (MO_AtomicRead (typeWidth ty))
+ (MO_AtomicRead (typeWidth ty) MemOrderSeqCst)
[ addr ]
-- | Emit an atomic write to a byte array that acts as a memory barrier.
@@ -3069,7 +3069,7 @@ doAtomicWriteAddr
doAtomicWriteAddr addr ty val =
emitPrimCall
[ {- no results -} ]
- (MO_AtomicWrite (typeWidth ty))
+ (MO_AtomicWrite (typeWidth ty) MemOrderSeqCst)
[ addr, val ]
doCasByteArray
View Lorry Controller Status