atomic-primops 0.5.0.2 → 0.6
raw patch · 6 files changed
+86/−99 lines, 6 filesdep −bits-atomicsetup-changed
Dependencies removed: bits-atomic
Files
- DEVLOG.md +2/−1
- Data/Atomics.hs +55/−2
- Data/Atomics/Counter/Foreign.hs +0/−74
- Setup.hs +2/−0
- atomic-primops.cabal +27/−21
- testing/CounterCommon.hs +0/−1
DEVLOG.md view
@@ -1,6 +1,7 @@ [2013.04.07] {Figuring out install methods, linking, and segfaults}+------------------------------------------------------------------- Ok, here's the weird state of affairs at the moment. @@ -44,7 +45,7 @@ cabal install --disable-library-profiling --disable-documentation -But NOT with a vanially cabal install (profiling and documentation).+But NOT with a vanilla cabal install (profiling and documentation). As expected, it is the profiling that makes the difference. Note that I am NOT building the test with profiling. The profiling version should be IRRELEVANT. Why does this cause the segfault?
Data/Atomics.hs view
@@ -17,6 +17,7 @@ -- * Atomic operations on IORefs readForCAS, casIORef, casIORef2, + atomicModifyIORefCAS, atomicModifyIORefCAS_, -- * Atomic operations on mutable arrays casArrayElem, casArrayElem2, readArrayElem, @@ -33,13 +34,14 @@ ) where import Control.Monad.ST (stToIO)+import Control.Exception (evaluate) import Data.Primitive.Array (MutableArray(MutableArray)) import Data.Primitive.ByteArray (MutableByteArray(MutableByteArray)) import Data.Atomics.Internal import Data.Int -- TEMPORARY -import Data.IORef-import GHC.IORef+import Data.IORef +import GHC.IORef hiding (atomicModifyIORef) import GHC.STRef import GHC.ST #if MIN_VERSION_base(4,7,0)@@ -251,4 +253,55 @@ foreign import ccall unsafe "DUP_write_barrier" writeBarrier :: IO () #endif+++--------------------------------------------------------------------------------+++-- | A drop-in replacement for `atomicModifyIORefCAS` that+-- optimistically attempts to compute the new value and CAS it into+-- place without introducing new thunks or locking anything. Note+-- that this is more STRICT than its standard counterpart and will only+-- place evaluated (WHNF) values in the IORef.+-- +-- The upside is that sometimes we see a performance benefit. +-- The downside is that this version is speculative -- when it +-- retries, it must reexecute the compution.+atomicModifyIORefCAS :: IORef a -- ^ Mutable location to modify+ -> (a -> (a,b)) -- ^ Computation runs one or more times (speculation)+ -> IO b+atomicModifyIORefCAS ref fn = do+ -- TODO: Should handle contention in a better way...+ tick <- readForCAS ref+ loop tick effort+ where + effort = 30 :: Int -- TODO: Tune this.+ loop old 0 = atomicModifyIORef ref fn -- Fall back to the regular version.+ loop old tries = do + (new,result) <- evaluate $ fn $ peekTicket old+ (b,tick) <- casIORef ref old new+ if b + then return result+ else loop tick (tries-1)+++-- | A simpler version that modifies the state but does not return anything.+atomicModifyIORefCAS_ :: IORef t -> (t -> t) -> IO ()+-- atomicModifyIORefCAS_ ref fn = atomicModifyIORefCAS ref (\ x -> (fn x, ()))+-- Can't inline a function with a loop so we duplicate this:+-- <duplicated code>+atomicModifyIORefCAS_ ref fn = do+ tick <- readForCAS ref+ loop tick effort+ where + effort = 30 :: Int -- TODO: Tune this.+ loop old 0 = atomicModifyIORef_ ref fn+ loop old tries = do + new <- evaluate $ fn $ peekTicket old+ (b,val) <- casIORef ref old new+ if b + then return ()+ else loop val (tries-1)+ atomicModifyIORef_ ref fn = atomicModifyIORef ref (\ x -> (fn x, ()))+-- </duplicated code>
− Data/Atomics/Counter/Foreign.hs
@@ -1,74 +0,0 @@-{-# LANGUAGE BangPatterns #-}---- | This implementation stores an unboxed counter and uses FFI operations to modify--- its contents. It has the advantage that it can use true fetch-and-add operations.--- It has the disadvantage of extra overhead due to FFI calls.--module Data.Atomics.Counter.Foreign- (AtomicCounter, CTicket,- newCounter, readCounterForCAS, readCounter, peekCTicket,- writeCounter, casCounter, incrCounter, incrCounter_)- where-import Control.Monad (void)-import Data.Bits.Atomic-import Foreign.ForeignPtr-import Foreign.Storable---- newtype AtomicCounter = AtomicCounter (ForeignPtr Int)-type AtomicCounter = ForeignPtr Int--type CTicket = Int--{-# INLINE newCounter #-}--- | Create a new counter initialized to the given value.-newCounter :: Int -> IO AtomicCounter-newCounter n = do x <- mallocForeignPtr- writeCounter x n- -- Do we need a write barrier here?- return x--{-# INLINE incrCounter #-}--- | Increment the counter by a given amount.--- Returns the original value before the increment.--- --- Note that UNLIKE with boxed implementations of counters, where increment is--- based on CAS, this increment is /O(1)/. Fetch-and-add does not require a retry--- loop like CAS.-incrCounter :: Int -> AtomicCounter -> IO Int-incrCounter bump r = withForeignPtr r$ \r' -> fetchAndAdd r' bump--{-# INLINE incrCounter_ #-}--- | An alternate version for when you don't care about the old value.-incrCounter_ :: Int -> AtomicCounter -> IO ()-incrCounter_ bump r = withForeignPtr r$ \r' -> void (fetchAndAdd r' bump)--{-# INLINE readCounterForCAS #-}--- | Just like the "Data.Atomics" CAS interface, this routine returns an opaque--- ticket that can be used in CAS operations.-readCounterForCAS :: AtomicCounter -> IO CTicket-readCounterForCAS = readCounter--{-# INLINE peekCTicket #-}--- | Opaque tickets cannot be constructed, but they can be destructed into values.-peekCTicket :: CTicket -> Int-peekCTicket x = x--{-# INLINE readCounter #-}--- | Equivalent to `readCounterForCAS` followed by `peekCTicket`.-readCounter :: AtomicCounter -> IO Int-readCounter r = withForeignPtr r peek --{-# INLINE writeCounter #-}--- | Make a non-atomic write to the counter. No memory-barrier.-writeCounter :: AtomicCounter -> Int -> IO ()-writeCounter r !new = withForeignPtr r $ \r' -> poke r' new--{-# INLINE casCounter #-}--- | Compare and swap for the counter ADT.-casCounter :: AtomicCounter -> CTicket -> Int -> IO (Bool, CTicket)-casCounter r !tick !new = withForeignPtr r $ \r' -> do- b <- compareAndSwap r' tick new- -- if b then return (True,new)- -- else do x <- peek r'- -- return (False,x)- return (b==tick, b)
Setup.hs view
@@ -9,6 +9,8 @@ import Distribution.PackageDescription (PackageDescription) import Debug.Trace +-- I couldn't figure out a way to do this check from the cabal file, so we drop down+-- here to do it instead: checkGoodVersion :: IO () checkGoodVersion = if cabalVersion >= Version [1,17,0] []
atomic-primops.cabal view
@@ -1,5 +1,5 @@ Name: atomic-primops-Version: 0.5.0.2+Version: 0.6 License: BSD3 License-file: LICENSE Author: Ryan Newton@@ -9,9 +9,15 @@ Build-type: Custom -- TODO: This requirement needs to be bumped to 1.17 when the latest cabal is -- released. This package triggers issue #1284:-Cabal-version: >=1.8-HomePage: https://github.com/rrnewton/haskell-lockfree-queue/wiki+-- Cabal-version: >=1.18+Cabal-version: >=1.10+-- Egad! Requiring cabal version 1.18 triggers a seemingly spurious failure on Mac OS:+-- http://tester-lin.soic.indiana.edu:8080/job/Haskell-LockFree_master/JENKINS_GHC=7.6.3,label=macos/346/console+-- So for now I'm backing off about the cabal requirement. Setup.hs will catch it later IF an early version+-- of cabal is used WITH profiling mode. +HomePage: https://github.com/rrnewton/haskell-lockfree/wiki+ -- Version History: -- 0.1.0.0 -- initial release -- 0.1.0.2 -- disable profiling@@ -23,6 +29,7 @@ -- 0.4.1 -- Add advance support for GHC 7.8 -- 0.5 -- Nix Data.Atomics.Counter.Foreign and the bits-atomic dependency. -- 0.5.0.2 -- IMPORTANT Bugfix release.+-- 0.6 -- add atomicModifyIORefCAS, and bump due to prev bugfixes Synopsis: A safe approach to CAS and other atomic ops in Haskell. @@ -37,6 +44,10 @@ add access to other variants that may be of interest, specifically, compare and swap inside an array. .+ Note that as of GHC 7.8, the relevant primops have been included in GHC itself.+ This library is engineered to work pre- and post-GHC-7.8, while exposing the + same interface.+ . Changes in 0.3: . * Major internal change. Duplicate the barrier code from the GHC RTS and thus @@ -53,8 +64,14 @@ Changes in 0.5: . * Remove dependency on bits-atomic unless a flag is turned on.+ . + Changes in 0.5.0.2:+ .+ * IMPORTANT BUGFIXES - don't use earlier versions. They have been marked deprecated. ++ Extra-Source-Files: DEVLOG.md, testing/Test.hs, testing/test-atomic-primops.cabal, testing/ghci-test.hs testing/Makefile, testing/CommonTesting.hs, testing/CounterCommon.hs, testing/hello.hs@@ -64,13 +81,8 @@ Description: Enable extra internal checks. Default: False --- The bits-atomic based modules are causing problems [2014.01.23] -Flag foreign- Description: Enable a dependency on bits-atomic and in turn provide a - foreign implementation of Counter.- Default: False- Library+ Default-Language: Haskell2010 exposed-modules: Data.Atomics Data.Atomics.Internal Data.Atomics.Counter@@ -79,16 +91,13 @@ Data.Atomics.Counter.Unboxed ghc-options: -O2 -funbox-strict-fields - if flag (foreign) { - exposed-modules: Data.Atomics.Counter.Foreign- build-depends: bits-atomic- }- -- casMutVar# had a bug in GHC 7.2, thus we require GHC 7.4 or greater -- (base 4.5 or greater). We also need the "Any" kind. build-depends: base >= 4.5.0.0 && <= 4.7.0.0, ghc-prim, primitive, Cabal - -- TODO: Try to push support back to 7.0:+ -- TODO: Try to push support back to 7.0, but make it default to an implementation+ -- other than Unboxed.+ -- Ah, but if we don't USE casMutVar# in this package we are ok: -- build-depends: base >= 4.3, ghc-prim, primitive @@ -99,8 +108,6 @@ C-Sources: cbits/RtsDup.c } CC-Options: -Wall - -- Let the code know that profiling is on:- ghc-prof-options: -DGHC_PROFILING_ON -- if( cabal-version < 1.17 ) { -- ghc-prof-options: ERROR_DO_NOT_BUILD_THIS_WITH_PROFILING_YET__SEE_CABAL_ISSUE_1284@@ -115,10 +122,9 @@ -- -- Switching to a separate package in ./testing/ -- Test-Suite test-atomic-primops -- type: exitcode-stdio-1.0-+-- ... Source-Repository head Type: git- Location: git://github.com/rrnewton/haskell-lockfree-queue.git--+ Location: git://github.com/rrnewton/haskell-lockfree.git+ Subdir: atomic-primops/
testing/CounterCommon.hs view
@@ -9,7 +9,6 @@ import Text.Printf import Data.IORef -import Data.Atomics import CommonTesting (numElems, forkJoin, timeit, nTimes) --------------------------------------------------------------------------------