Use MO_Cmpxchg in Primops.cmm instead of ccall cas(..)
authoralexbiehl <alex.biehl@gmail.com>
Mon, 1 Aug 2016 08:46:29 +0000 (18:46 +1000)
committerErik de Castro Lopo <erikd@mega-nerd.com>
Mon, 1 Aug 2016 08:46:30 +0000 (18:46 +1000)
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

compiler/cmm/CmmParse.y
includes/Cmm.h
rts/PrimOps.cmm

index 128cc4e..b8c100a 100644 (file)
@@ -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?
index 3b9a5a6..9b7a4e4 100644 (file)
 #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.
    -------------------------------------------------------------------------- */
 
index 60d8106..b468c33 100644 (file)
@@ -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;