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