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