[Git][ghc/ghc][wip/andreask/xchg_primop] Make exchange an IO action as it should be.

[Andreas Klebinger]

Andreas Klebinger pushed to branch wip/andreask/xchg_primop at Glasgow Haskell Compiler / GHC


Commits:
c9a41cf4 by Andreas Klebinger at 2020-05-19T16:48:57+02:00
Make exchange an IO action as it should be.

- - - - -


4 changed files:

- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Cmm/MachOp.hs
- compiler/GHC/StgToCmm/Prim.hs
- libraries/base/GHC/Ptr.hs


Changes:

=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -2473,14 +2473,14 @@ primop  WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
    with has_side_effects = True
         can_fail         = True
 
-primop  InterlockedExchangeAddr "interlockedExchangeAddr#" GenPrimOp
-   Addr# -> Addr# -> Addr#
+primop  InterlockedExchange_Addr "interlockedExchangeAddr#" GenPrimOp
+   Addr# -> Addr# -> State# s -> (# State# s, Addr# #)
    {The atomic exchange operation. Atomically exchanges the value at the first address
     with the Addr# given as second argument. Implies a read barrier.}
    with has_side_effects = True
 
-primop  InterlockedExchangeInt "interlockedExchangeInt#" GenPrimOp
-   Addr# -> Int# -> Int#
+primop  InterlockedExchange_Int "interlockedExchangeInt#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Int# #)
    {The atomic exchange operation. Atomically exchanges the value at the address
     with the given value. Returns the old value. Implies a read barrier.}
    with has_side_effects = True


=====================================
compiler/GHC/Cmm/MachOp.hs
=====================================
@@ -633,7 +633,7 @@ data CallishMachOp
   | MO_AtomicWrite Width
   | MO_Cmpxchg Width
   -- Should be an AtomicRMW variant eventually.
-  -- Has at least aquire semantics.
+  -- Has at least acquire semantics.
   | MO_Xchg Width
   deriving (Eq, Show)
 


=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -857,9 +857,9 @@ emitPrimOp dflags = \case
     emitPrimCall [res] (MO_UF_Conv W64) [w]
 
 -- Atomic operations
-  InterlockedExchangeAddr -> \[src, value] -> opAllDone $ \[res] ->
+  InterlockedExchange_Addr -> \[src, value] -> opAllDone $ \[res] ->
     emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value]
-  InterlockedExchangeInt -> \[src, value] -> opAllDone $ \[res] ->
+  InterlockedExchange_Int -> \[src, value] -> opAllDone $ \[res] ->
     emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value]
 
 -- SIMD primops


=====================================
libraries/base/GHC/Ptr.hs
=====================================
@@ -1,5 +1,6 @@
 {-# LANGUAGE Unsafe #-}
 {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, RoleAnnotations #-}
+{-# LANGUAGE UnboxedTuples #-}
 {-# OPTIONS_HADDOCK not-home #-}
 
 -----------------------------------------------------------------------------
@@ -169,9 +170,11 @@ castPtrToFunPtr (Ptr addr) = FunPtr addr
 -- Atomic operations for Ptr
 
 {-# INLINE exchangePtr #-}
-exchangePtr :: Ptr (Ptr a) -> Ptr b -> Ptr c
-exchangePtr (Ptr dst) (Ptr val)
-  = Ptr (interlockedExchangeAddr# dst val)
+exchangePtr :: Ptr (Ptr a) -> Ptr b -> IO (Ptr c)
+exchangePtr (Ptr dst) (Ptr val) =
+  IO $ \s ->
+      case (interlockedExchangeAddr# dst val s) of
+        (# s2, old_val #) -> (# s2, Ptr old_val #)
 
 ------------------------------------------------------------------------
 -- Show instances for Ptr and FunPtr



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c9a41cf4add38fd82706dc15204628835cae9ede

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c9a41cf4add38fd82706dc15204628835cae9ede
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200519/e8439eeb/attachment-0001.html>