git.iko.soy/streamly
on aa2b166 help sign in
streamly/src/Streamly/Internal/Data/Atomics.hs
80 lines 2.0 kB history raw
1-- |
2-- Module : Streamly.Internal.Data.Atomics
3-- Copyright : (c) 2018-2019 Composewell Technologies
4--
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
8-- Portability : GHC
10module Streamly.Internal.Data.Atomics
11 (
12 atomicModifyIORefCAS
13 , atomicModifyIORefCAS_
14 , writeBarrier
15 , storeLoadBarrier
16 )
17where
19import Data.IORef (IORef, atomicModifyIORef)
20#ifdef ghcjs_HOST_OS
21import Data.IORef (modifyIORef)
22#else
23import qualified Data.Atomics as A
24#endif
26#ifndef ghcjs_HOST_OS
28-- XXX Does it make sense to have replacements for atomicModifyIORef etc. on a
29-- single threaded system.
30--
31-- Slightly faster version of CAS. Gained some improvement by avoiding the use
32-- of "evaluate" because we know we do not have exceptions in fn.
33{-# INLINE atomicModifyIORefCAS #-}
34atomicModifyIORefCAS :: IORef a -> (a -> (a,b)) -> IO b
35atomicModifyIORefCAS ref fn = do
36 tkt <- A.readForCAS ref
37 loop tkt retries
39 where
41 retries = 25 :: Int
42 loop _ 0 = atomicModifyIORef ref fn
43 loop old tries = do
44 let (new, result) = fn $ A.peekTicket old
45 (success, tkt) <- A.casIORef ref old new
46 if success
47 then return result
48 else loop tkt (tries - 1)
50{-# INLINE atomicModifyIORefCAS_ #-}
51atomicModifyIORefCAS_ :: IORef t -> (t -> t) -> IO ()
52atomicModifyIORefCAS_ = A.atomicModifyIORefCAS_
54{-# INLINE writeBarrier #-}
55writeBarrier :: IO ()
56writeBarrier = A.writeBarrier
58{-# INLINE storeLoadBarrier #-}
59storeLoadBarrier :: IO ()
60storeLoadBarrier = A.storeLoadBarrier
62#else
64{-# INLINE atomicModifyIORefCAS #-}
65atomicModifyIORefCAS :: IORef a -> (a -> (a,b)) -> IO b
66atomicModifyIORefCAS = atomicModifyIORef
68{-# INLINE atomicModifyIORefCAS_ #-}
69atomicModifyIORefCAS_ :: IORef a -> (a -> a) -> IO ()
70atomicModifyIORefCAS_ = modifyIORef
72{-# INLINE writeBarrier #-}
73writeBarrier :: IO ()
74writeBarrier = return ()
76{-# INLINE storeLoadBarrier #-}
77storeLoadBarrier :: IO ()
78storeLoadBarrier = return ()
80#endif