[commit: ghc] master: Add missing memory fence to atomicWriteIntArray# (fc53ed5)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/fc53ed5da1a2455b0da2f8ef3ec317e1a96ed83d/ghc

>---------------------------------------------------------------

commit fc53ed5da1a2455b0da2f8ef3ec317e1a96ed83d
Author: Johan Tibell <johan.tibell at gmail.com>
Date:   Wed Jul 23 13:12:10 2014 +0200

    Add missing memory fence to atomicWriteIntArray#


>---------------------------------------------------------------

fc53ed5da1a2455b0da2f8ef3ec317e1a96ed83d
 compiler/nativeGen/X86/CodeGen.hs | 3 ++-
 compiler/nativeGen/X86/Instr.hs   | 3 +++
 compiler/nativeGen/X86/Ppr.hs     | 2 ++
 3 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 867dbfd..a9ff8f2 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1838,7 +1838,8 @@ genCCall dflags _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] = do
   return (load_code (getRegisterReg platform use_sse2 (CmmLocal dst)))
 
 genCCall _ _ (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do
-    assignMem_IntCode (intSize width) addr val
+    code <- assignMem_IntCode (intSize width) addr val
+    return $ code `snocOL` MFENCE
 
 genCCall dflags is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] = do
     -- On x86 we don't have enough registers to use cmpxchg with a
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index 82e52df..172ce93 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -330,6 +330,7 @@ data Instr
         | LOCK        Instr -- lock prefix
         | XADD        Size Operand Operand  -- src (r), dst (r/m)
         | CMPXCHG     Size Operand Operand  -- src (r), dst (r/m), eax implicit
+        | MFENCE
 
 data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2
 
@@ -437,6 +438,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)
+    MFENCE -> noUsage
 
     _other              -> panic "regUsage: unrecognised instr"
  where
@@ -606,6 +608,7 @@ x86_patchRegsOfInstr instr env
     LOCK i              -> LOCK (x86_patchRegsOfInstr i env)
     XADD sz src dst     -> patch2 (XADD sz) src dst
     CMPXCHG sz src dst  -> patch2 (CMPXCHG sz) src dst
+    MFENCE              -> instr
 
     _other              -> panic "patchRegs: unrecognised instr"
 
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 5ae1b54..15d2967 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -890,6 +890,8 @@ pprInstr GFREE
 
 pprInstr (LOCK i) = ptext (sLit "\tlock") $$ pprInstr i
 
+pprInstr MFENCE = ptext (sLit "\tmfence")
+
 pprInstr (XADD size src dst) = pprSizeOpOp (sLit "xadd") size src dst
 
 pprInstr (CMPXCHG size src dst) = pprSizeOpOp (sLit "cmpxchg") size src dst