summaryrefslogtreecommitdiff
path: root/compiler/nativeGen
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/nativeGen')
-rw-r--r--compiler/nativeGen/CPrim.hs50
-rw-r--r--compiler/nativeGen/PPC/CodeGen.hs4
-rw-r--r--compiler/nativeGen/SPARC/CodeGen.hs4
-rw-r--r--compiler/nativeGen/X86/CodeGen.hs92
-rw-r--r--compiler/nativeGen/X86/Instr.hs38
-rw-r--r--compiler/nativeGen/X86/Ppr.hs8
6 files changed, 2 insertions, 194 deletions
diff --git a/compiler/nativeGen/CPrim.hs b/compiler/nativeGen/CPrim.hs
index 34782dfc1c..a6f4cab7bd 100644
--- a/compiler/nativeGen/CPrim.hs
+++ b/compiler/nativeGen/CPrim.hs
@@ -1,16 +1,11 @@
-- | Generating C symbol names emitted by the compiler.
module CPrim
- ( atomicReadLabel
- , atomicWriteLabel
- , atomicRMWLabel
- , cmpxchgLabel
- , popCntLabel
+ ( popCntLabel
, bSwapLabel
, word2FloatLabel
) where
import CmmType
-import CmmMachOp
import Outputable
popCntLabel :: Width -> String
@@ -36,46 +31,3 @@ word2FloatLabel w = "hs_word2float" ++ pprWidth w
pprWidth W32 = "32"
pprWidth W64 = "64"
pprWidth w = pprPanic "word2FloatLabel: Unsupported word width " (ppr w)
-
-atomicRMWLabel :: Width -> AtomicMachOp -> String
-atomicRMWLabel w amop = "hs_atomic_" ++ pprFunName amop ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "atomicRMWLabel: Unsupported word width " (ppr w)
-
- pprFunName AMO_Add = "add"
- pprFunName AMO_Sub = "sub"
- pprFunName AMO_And = "and"
- pprFunName AMO_Nand = "nand"
- pprFunName AMO_Or = "or"
- pprFunName AMO_Xor = "xor"
-
-cmpxchgLabel :: Width -> String
-cmpxchgLabel w = "hs_cmpxchg" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "cmpxchgLabel: Unsupported word width " (ppr w)
-
-atomicReadLabel :: Width -> String
-atomicReadLabel w = "hs_atomicread" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "atomicReadLabel: Unsupported word width " (ppr w)
-
-atomicWriteLabel :: Width -> String
-atomicWriteLabel w = "hs_atomicwrite" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "atomicWriteLabel: Unsupported word width " (ppr w)
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 22a2c7cb6a..91651e6065 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -1160,10 +1160,6 @@ genCCall' dflags gcp target dest_regs args0
MO_BSwap w -> (fsLit $ bSwapLabel w, False)
MO_PopCnt w -> (fsLit $ popCntLabel w, False)
- MO_AtomicRMW w amop -> (fsLit $ atomicRMWLabel w amop, False)
- MO_Cmpxchg w -> (fsLit $ cmpxchgLabel w, False)
- MO_AtomicRead w -> (fsLit $ atomicReadLabel w, False)
- MO_AtomicWrite w -> (fsLit $ atomicWriteLabel w, False)
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 51f89d629f..f5e61d0a8f 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -654,10 +654,6 @@ outOfLineMachOp_table mop
MO_BSwap w -> fsLit $ bSwapLabel w
MO_PopCnt w -> fsLit $ popCntLabel w
- MO_AtomicRMW w amop -> fsLit $ atomicRMWLabel w amop
- MO_Cmpxchg w -> fsLit $ cmpxchgLabel w
- MO_AtomicRead w -> fsLit $ atomicReadLabel w
- MO_AtomicWrite w -> fsLit $ atomicWriteLabel w
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 140e8b2992..fa93767fa3 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1761,93 +1761,6 @@ genCCall dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do
where
lbl = mkCmmCodeLabel primPackageId (fsLit (word2FloatLabel width))
-genCCall dflags _ (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = do
- Amode amode addr_code <- getAmode addr
- arg <- getNewRegNat size
- arg_code <- getAnyReg n
- use_sse2 <- sse2Enabled
- let platform = targetPlatform dflags
- dst_r = getRegisterReg platform use_sse2 (CmmLocal dst)
- code <- op_code dst_r arg amode
- return $ addr_code `appOL` arg_code arg `appOL` code
- where
- -- Code for the operation
- op_code :: Reg -- ^ The destination reg
- -> Reg -- ^ Register containing argument
- -> AddrMode -- ^ Address of location to mutate
- -> NatM (OrdList Instr)
- op_code dst_r arg amode = case amop of
- -- In the common case where dst_r is a virtual register the
- -- final move should go away, because it's the last use of arg
- -- and the first use of dst_r.
- AMO_Add -> return $ toOL [ LOCK
- , XADD size (OpReg arg) (OpAddr amode)
- , MOV size (OpReg arg) (OpReg dst_r)
- ]
- AMO_Sub -> return $ toOL [ NEGI size (OpReg arg)
- , LOCK
- , XADD size (OpReg arg) (OpAddr amode)
- , MOV size (OpReg arg) (OpReg dst_r)
- ]
- AMO_And -> cmpxchg_code (\ src dst -> unitOL $ AND size src dst)
- AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND size src dst
- , NOT size dst
- ])
- AMO_Or -> cmpxchg_code (\ src dst -> unitOL $ OR size src dst)
- AMO_Xor -> cmpxchg_code (\ src dst -> unitOL $ XOR size src dst)
- where
- -- Simulate operation that lacks a dedicated instruction using
- -- cmpxchg.
- cmpxchg_code :: (Operand -> Operand -> OrdList Instr)
- -> NatM (OrdList Instr)
- cmpxchg_code instrs = do
- lbl <- getBlockIdNat
- tmp <- getNewRegNat size
- return $ toOL
- [ MOV size (OpAddr amode) (OpReg eax)
- , JXX ALWAYS lbl
- , NEWBLOCK lbl
- -- Keep old value so we can return it:
- , MOV size (OpReg eax) (OpReg dst_r)
- , MOV size (OpReg eax) (OpReg tmp)
- ]
- `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL
- [ LOCK
- , CMPXCHG size (OpReg tmp) (OpAddr amode)
- , JXX NE lbl
- ]
-
- size = intSize width
-
-genCCall dflags _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] = do
- load_code <- intLoadCode (MOV (intSize width)) addr
- let platform = targetPlatform dflags
- use_sse2 <- sse2Enabled
- return (load_code (getRegisterReg platform use_sse2 (CmmLocal dst)))
-
-genCCall _ _ (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do
- assignMem_IntCode (intSize width) addr val
-
-genCCall dflags _ (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] = do
- Amode amode addr_code <- getAmode addr
- newval <- getNewRegNat size
- newval_code <- getAnyReg new
- oldval <- getNewRegNat size
- oldval_code <- getAnyReg old
- use_sse2 <- sse2Enabled
- let platform = targetPlatform dflags
- dst_r = getRegisterReg platform use_sse2 (CmmLocal dst)
- code = toOL
- [ MOV size (OpReg oldval) (OpReg eax)
- , LOCK
- , CMPXCHG size (OpReg newval) (OpAddr amode)
- , MOV size (OpReg eax) (OpReg dst_r)
- ]
- return $ addr_code `appOL` newval_code newval `appOL` oldval_code oldval
- `appOL` code
- where
- size = intSize width
-
genCCall _ is32Bit target dest_regs args
| is32Bit = genCCall32 target dest_regs args
| otherwise = genCCall64 target dest_regs args
@@ -2472,11 +2385,6 @@ outOfLineCmmOp mop res args
MO_PopCnt _ -> fsLit "popcnt"
MO_BSwap _ -> fsLit "bswap"
- MO_AtomicRMW _ _ -> fsLit "atomicrmw"
- MO_AtomicRead _ -> fsLit "atomicread"
- MO_AtomicWrite _ -> fsLit "atomicwrite"
- MO_Cmpxchg _ -> fsLit "cmpxchg"
-
MO_UF_Conv _ -> unsupported
MO_S_QuotRem {} -> unsupported
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index ac91747171..05fff9be96 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -327,10 +327,6 @@ data Instr
| PREFETCH PrefetchVariant Size Operand -- prefetch Variant, addr size, address to prefetch
-- variant can be NTA, Lvl0, Lvl1, or Lvl2
- | LOCK -- lock prefix
- | XADD Size Operand Operand -- src (r), dst (r/m)
- | CMPXCHG Size Operand Operand -- src (r), dst (r/m), eax implicit
-
data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2
@@ -341,8 +337,6 @@ data Operand
--- | Returns which registers are read and written as a (read, written)
--- pair.
x86_regUsageOfInstr :: Platform -> Instr -> RegUsage
x86_regUsageOfInstr platform instr
= case instr of
@@ -434,21 +428,10 @@ x86_regUsageOfInstr platform instr
-- note: might be a better way to do this
PREFETCH _ _ src -> mkRU (use_R src []) []
- LOCK -> noUsage
- XADD _ src dst -> usageMM src dst
- CMPXCHG _ src dst -> usageRMM src dst (OpReg eax)
_other -> panic "regUsage: unrecognised instr"
- where
- -- # Definitions
- --
- -- Written: If the operand is a register, it's written. If it's an
- -- address, registers mentioned in the address are read.
- --
- -- Modified: If the operand is a register, it's both read and
- -- written. If it's an address, registers mentioned in the address
- -- are read.
+ where
-- 2 operand form; first operand Read; second Written
usageRW :: Operand -> Operand -> RegUsage
usageRW op (OpReg reg) = mkRU (use_R op []) [reg]
@@ -461,18 +444,6 @@ x86_regUsageOfInstr platform instr
usageRM op (OpAddr ea) = mkRUR (use_R op $! use_EA ea [])
usageRM _ _ = panic "X86.RegInfo.usageRM: no match"
- -- 2 operand form; first operand Modified; second Modified
- 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 _ _ = panic "X86.RegInfo.usageMM: no match"
-
- -- 3 operand form; first operand Read; second Modified; third Modified
- usageRMM :: Operand -> Operand -> Operand -> RegUsage
- usageRMM (OpReg src) (OpReg dst) (OpReg reg) = mkRU [src, dst, reg] [dst, reg]
- usageRMM (OpReg src) (OpAddr ea) (OpReg reg) = mkRU (use_EA ea [src, reg]) [reg]
- usageRMM _ _ _ = panic "X86.RegInfo.usageRMM: no match"
-
-- 1 operand form; operand Modified
usageM :: Operand -> RegUsage
usageM (OpReg reg) = mkRU [reg] [reg]
@@ -505,7 +476,6 @@ x86_regUsageOfInstr platform instr
where src' = filter (interesting platform) src
dst' = filter (interesting platform) dst
--- | Is this register interesting for the register allocator?
interesting :: Platform -> Reg -> Bool
interesting _ (RegVirtual _) = True
interesting platform (RegReal (RealRegSingle i)) = isFastTrue (freeReg platform i)
@@ -513,8 +483,6 @@ interesting _ (RegReal (RealRegPair{})) = panic "X86.interesting: no re
--- | Applies the supplied function to all registers in instructions.
--- Typically used to change virtual registers to real registers.
x86_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
x86_patchRegsOfInstr instr env
= case instr of
@@ -603,10 +571,6 @@ x86_patchRegsOfInstr instr env
PREFETCH lvl size src -> PREFETCH lvl size (patchOp src)
- LOCK -> instr
- XADD sz src dst -> patch2 (XADD sz) src dst
- CMPXCHG sz src dst -> patch2 (CMPXCHG sz) src dst
-
_other -> panic "patchRegs: unrecognised instr"
where
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 7771c02512..459c041ba5 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -886,14 +886,6 @@ pprInstr GFREE
ptext (sLit "\tffree %st(4) ;ffree %st(5)")
]
--- Atomics
-
-pprInstr LOCK = ptext (sLit "\tlock")
-
-pprInstr (XADD size src dst) = pprSizeOpOp (sLit "xadd") size src dst
-
-pprInstr (CMPXCHG size src dst) = pprSizeOpOp (sLit "cmpxchg") size src dst
-
pprInstr _
= panic "X86.Ppr.pprInstr: no match"
View Lorry Controller Status