[commit: ghc] master: Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..) (750553a)

[git at git.haskell.org]

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

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

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

commit 750553a68c126bdbee3d325a606a9537a8d53141
Author: alexbiehl <alex.biehl at gmail.com>
Date:   Mon Aug 1 18:46:29 2016 +1000

    Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..)
    
    Adjust `CmmParse.y` to parse the `cmpxchg{8, 16, 32, 64}` instructions
    and use the 32 respectively the 64 bit variant in `Primops.cmm`. This
    effectively eliminates the compare-and-swap ccall to the rts.
    
    Based off the mailing list question from @osa1
    (https://mail.haskell.org/pipermail/ghc-devs/2016-July/012506.html).
    
    Reviewers: simonmar, austin, erikd, bgamari, trommler
    
    Reviewed By: erikd, bgamari, trommler
    
    Subscribers: carter, trommler, osa1, thomie
    
    Differential Revision: https://phabricator.haskell.org/D2431


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

750553a68c126bdbee3d325a606a9537a8d53141
 compiler/cmm/CmmParse.y |  7 ++++++-
 includes/Cmm.h          | 10 ++++++++++
 rts/PrimOps.cmm         | 10 +++++-----
 3 files changed, 21 insertions(+), 6 deletions(-)

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 128cc4e..b8c100a 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -987,7 +987,12 @@ callishMachOps = listToUFM $
         ( "popcnt8",  (,) $ MO_PopCnt W8  ),
         ( "popcnt16", (,) $ MO_PopCnt W16 ),
         ( "popcnt32", (,) $ MO_PopCnt W32 ),
-        ( "popcnt64", (,) $ MO_PopCnt W64 )
+        ( "popcnt64", (,) $ MO_PopCnt W64 ),
+
+        ( "cmpxchg8",  (,) $ MO_Cmpxchg W8  ),
+        ( "cmpxchg16", (,) $ MO_Cmpxchg W16 ),
+        ( "cmpxchg32", (,) $ MO_Cmpxchg W32 ),
+        ( "cmpxchg64", (,) $ MO_Cmpxchg W64 )
 
         -- ToDo: the rest, maybe
         -- edit: which rest?
diff --git a/includes/Cmm.h b/includes/Cmm.h
index 3b9a5a6..9b7a4e4 100644
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -179,6 +179,16 @@
 #endif
 
 /* -----------------------------------------------------------------------------
+   Atomic memory operations.
+   -------------------------------------------------------------------------- */
+
+#if SIZEOF_W == 4
+#define cmpxchgW cmpxchg32
+#elif SIZEOF_W == 8
+#define cmpxchgW cmpxchg64
+#endif
+
+/* -----------------------------------------------------------------------------
    Heap/stack access, and adjusting the heap/stack pointers.
    -------------------------------------------------------------------------- */
 
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 60d8106..b468c33 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -221,7 +221,7 @@ stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new )
     W_ p, h;
 
     p = arr + SIZEOF_StgArrBytes + WDS(ind);
-    (h) = ccall cas(p, old, new);
+    (h) = prim %cmpxchgW(p, old, new);
 
     return(h);
 }
@@ -338,7 +338,7 @@ stg_casArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
     W_ p, len;
 
     p = arr + SIZEOF_StgMutArrPtrs + WDS(ind);
-    (h) = ccall cas(p, old, new);
+    (h) = prim %cmpxchgW(p, old, new);
 
     if (h != old) {
         // Failure, return what was there instead of 'old':
@@ -490,7 +490,7 @@ stg_casSmallArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
     W_ p, len;
 
     p = arr + SIZEOF_StgSmallMutArrPtrs + WDS(ind);
-    (h) = ccall cas(p, old, new);
+    (h) = prim %cmpxchgW(p, old, new);
 
     if (h != old) {
         // Failure, return what was there instead of 'old':
@@ -530,7 +530,7 @@ stg_casMutVarzh ( gcptr mv, gcptr old, gcptr new )
 {
     gcptr h;
 
-    (h) = ccall cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, old, new);
+    (h) = prim %cmpxchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, old, new);
     if (h != old) {
         return (1,h);
     } else {
@@ -606,7 +606,7 @@ stg_atomicModifyMutVarzh ( gcptr mv, gcptr f )
     x = StgMutVar_var(mv);
     StgThunk_payload(z,1) = x;
 #ifdef THREADED_RTS
-    (h) = ccall cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y);
+    (h) = prim %cmpxchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y);
     if (h != x) { goto retry; }
 #else
     StgMutVar_var(mv) = y;