summaryrefslogtreecommitdiff
path: root/compiler/GHC/CmmToAsm
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/CmmToAsm')
-rw-r--r--compiler/GHC/CmmToAsm/CPrim.hs10
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs1
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/CodeGen.hs1
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs22
-rw-r--r--compiler/GHC/CmmToAsm/X86/Instr.hs4
-rw-r--r--compiler/GHC/CmmToAsm/X86/Ppr.hs3
6 files changed, 41 insertions, 0 deletions
diff --git a/compiler/GHC/CmmToAsm/CPrim.hs b/compiler/GHC/CmmToAsm/CPrim.hs
index fc2d06262b..826a6e2224 100644
--- a/compiler/GHC/CmmToAsm/CPrim.hs
+++ b/compiler/GHC/CmmToAsm/CPrim.hs
@@ -4,6 +4,7 @@ module GHC.CmmToAsm.CPrim
, atomicWriteLabel
, atomicRMWLabel
, cmpxchgLabel
+ , xchgLabel
, popCntLabel
, pdepLabel
, pextLabel
@@ -105,6 +106,15 @@ atomicRMWLabel w amop = "hs_atomic_" ++ pprFunName amop ++ pprWidth w
pprFunName AMO_Or = "or"
pprFunName AMO_Xor = "xor"
+xchgLabel :: Width -> String
+xchgLabel w = "hs_xchg" ++ pprWidth w
+ where
+ pprWidth W8 = "8"
+ pprWidth W16 = "16"
+ pprWidth W32 = "32"
+ pprWidth W64 = "64"
+ pprWidth w = pprPanic "xchgLabel: Unsupported word width " (ppr w)
+
cmpxchgLabel :: Width -> String
cmpxchgLabel w = "hs_cmpxchg" ++ pprWidth w
where
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 764945c2bc..367faa25bc 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -2024,6 +2024,7 @@ genCCall' config gcp target dest_regs args
MO_Ctz _ -> unsupported
MO_AtomicRMW {} -> unsupported
MO_Cmpxchg w -> (fsLit $ cmpxchgLabel w, False)
+ MO_Xchg w -> (fsLit $ xchgLabel w, False)
MO_AtomicRead _ -> unsupported
MO_AtomicWrite _ -> unsupported
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
index 2112983e73..9ecb0fcc76 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
@@ -677,6 +677,7 @@ outOfLineMachOp_table mop
MO_Ctz w -> fsLit $ ctzLabel w
MO_AtomicRMW w amop -> fsLit $ atomicRMWLabel w amop
MO_Cmpxchg w -> fsLit $ cmpxchgLabel w
+ MO_Xchg w -> fsLit $ xchgLabel w
MO_AtomicRead w -> fsLit $ atomicReadLabel w
MO_AtomicWrite w -> fsLit $ atomicWriteLabel w
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index dab4c62122..d842bcc94a 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -2518,6 +2518,22 @@ genCCall' _ is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] _ = d
where
format = intFormat width
+genCCall' config is32Bit (PrimTarget (MO_Xchg width)) [dst] [addr, value] _
+ | (is32Bit && width == W64) = panic "gencCall: 64bit atomic exchange not supported on 32bit platforms"
+ | otherwise = do
+ let dst_r = getRegisterReg platform (CmmLocal dst)
+ Amode amode addr_code <- getSimpleAmode is32Bit addr
+ (newval, newval_code) <- getSomeReg value
+ -- Copy the value into the target register, perform the exchange.
+ let code = toOL
+ [ MOV format (OpReg newval) (OpReg dst_r)
+ , XCHG format (OpAddr amode) dst_r
+ ]
+ return $ addr_code `appOL` newval_code `appOL` code
+ where
+ format = intFormat width
+ platform = ncgPlatform config
+
genCCall' _ is32Bit target dest_regs args bid = do
platform <- ncgPlatform <$> getConfig
case (target, dest_regs) of
@@ -3213,6 +3229,7 @@ outOfLineCmmOp bid mop res args
MO_AtomicRead _ -> fsLit "atomicread"
MO_AtomicWrite _ -> fsLit "atomicwrite"
MO_Cmpxchg _ -> fsLit "cmpxchg"
+ MO_Xchg _ -> should_be_inline
MO_UF_Conv _ -> unsupported
@@ -3232,6 +3249,11 @@ outOfLineCmmOp bid mop res args
(MO_Prefetch_Data _ ) -> unsupported
unsupported = panic ("outOfLineCmmOp: " ++ show mop
++ " not supported here")
+ -- If we generate a call for the given primop
+ -- something went wrong.
+ should_be_inline = panic ("outOfLineCmmOp: " ++ show mop
+ ++ " should be handled inline")
+
-- -----------------------------------------------------------------------------
-- Generating a table-branch
diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs
index 67a6ffb930..eafe7198e6 100644
--- a/compiler/GHC/CmmToAsm/X86/Instr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Instr.hs
@@ -329,6 +329,7 @@ data Instr
| LOCK Instr -- lock prefix
| XADD Format Operand Operand -- src (r), dst (r/m)
| CMPXCHG Format Operand Operand -- src (r), dst (r/m), eax implicit
+ | XCHG Format Operand Reg -- src (r/m), dst (r/m)
| MFENCE
data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2
@@ -431,6 +432,7 @@ x86_regUsageOfInstr platform instr
LOCK i -> x86_regUsageOfInstr platform i
XADD _ src dst -> usageMM src dst
CMPXCHG _ src dst -> usageRMM src dst (OpReg eax)
+ XCHG _ src dst -> usageMM src (OpReg dst)
MFENCE -> noUsage
_other -> panic "regUsage: unrecognised instr"
@@ -460,6 +462,7 @@ x86_regUsageOfInstr platform instr
usageMM :: Operand -> Operand -> RegUsage
usageMM (OpReg src) (OpReg dst) = mkRU [src, dst] [src, dst]
usageMM (OpReg src) (OpAddr ea) = mkRU (use_EA ea [src]) [src]
+ usageMM (OpAddr ea) (OpReg dst) = mkRU (use_EA ea [dst]) [dst]
usageMM _ _ = panic "X86.RegInfo.usageMM: no match"
-- 3 operand form; first operand Read; second Modified; third Modified
@@ -589,6 +592,7 @@ x86_patchRegsOfInstr instr env
LOCK i -> LOCK (x86_patchRegsOfInstr i env)
XADD fmt src dst -> patch2 (XADD fmt) src dst
CMPXCHG fmt src dst -> patch2 (CMPXCHG fmt) src dst
+ XCHG fmt src dst -> XCHG fmt (patchOp src) (env dst)
MFENCE -> instr
_other -> panic "patchRegs: unrecognised instr"
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 6ed5842389..6be1c8ef4d 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -824,6 +824,9 @@ pprInstr platform i = case i of
SETCC cond op
-> pprCondInstr (sLit "set") cond (pprOperand platform II8 op)
+ XCHG format src val
+ -> pprFormatOpReg (sLit "xchg") format src val
+
JXX cond blockid
-> pprCondInstr (sLit "j") cond (ppr lab)
where lab = blockLbl blockid
View Lorry Controller Status