diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## 0.8.3 [2019.05.02] +* Allow the tests to build with `base-4.13` (GHC 8.8). +* Require GHC 7.10 or later. + ## 0.8.2 [2018.03.08] * Allow building with `base-4.11`. diff --git a/Data/Atomics.hs b/Data/Atomics.hs --- a/Data/Atomics.hs +++ b/Data/Atomics.hs @@ -446,11 +446,7 @@ -- | Memory barrier implemented by the GHC rts (see SMP.h). -- writeBarrier :: IO () --- GHC 7.8 consistently exposes these symbols while linking: - -#if MIN_VERSION_base(4,7,0) && !(defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ < 802) -#warning "Assuming that store_load_barrier and friends are defined in the GHC RTS." - +#if !(defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ < 802) -- | Memory barrier implemented by the GHC rts (see SMP.h). foreign import ccall unsafe "store_load_barrier" storeLoadBarrier :: IO () @@ -462,12 +458,10 @@ -- | Memory barrier implemented by the GHC rts (see SMP.h). foreign import ccall unsafe "write_barrier" writeBarrier :: IO () - #else #warning "importing store_load_barrier and friends from the package's C code." --- GHC 7.6 did not consistently expose them (e.g. in the non-threaded RTS), --- so rather we grab this functionality from RtsDup.c: +-- Workaround for Trac #12846, which affects old GHCs on Windows foreign import ccall unsafe "DUP_store_load_barrier" storeLoadBarrier :: IO () @@ -477,7 +471,6 @@ foreign import ccall unsafe "DUP_write_barrier" writeBarrier :: IO () #endif - -------------------------------------------------------------------------------- diff --git a/atomic-primops.cabal b/atomic-primops.cabal --- a/atomic-primops.cabal +++ b/atomic-primops.cabal @@ -1,5 +1,5 @@ Name: atomic-primops -Version: 0.8.2 +Version: 0.8.3 License: BSD3 License-file: LICENSE Author: Ryan Newton @@ -8,13 +8,13 @@ -- Portability: non-portabile (x86_64) Build-type: Simple Cabal-version: >=1.18 +tested-with: GHC == 8.4.3, GHC == 8.2.2, GHC == 8.0.2, GHC == 7.10.3 HomePage: https://github.com/rrnewton/haskell-lockfree/wiki Bug-Reports: https://github.com/rrnewton/haskell-lockfree/issues Synopsis: A safe approach to CAS and other atomic ops in Haskell. Description: - After GHC 7.4 a new `casMutVar#` primop became available, but it's difficult to use safely, because pointer equality is a highly unstable property in Haskell. This library provides a safer method @@ -47,43 +47,18 @@ ghc-options: -O2 -funbox-strict-fields ghc-options: -Wall - -- 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.6.0.0 && < 4.12, ghc-prim, primitive - - -- 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 + build-depends: base >= 4.8 && < 5 + , ghc-prim + , primitive - if impl(ghc < 7.7) { - Include-Dirs: cbits - C-Sources: cbits/primops.cmm - -- Duplicate RTS functionality for GHC 7.6: - C-Sources: cbits/RtsDup.c - } else { - if os(windows) { - Include-Dirs: cbits - C-Sources: cbits/RtsDup.c - } + if os(windows) { + Include-Dirs: cbits + C-Sources: cbits/RtsDup.c } CC-Options: -Wall - -- if( cabal-version < 1.17 ) { - -- ghc-prof-options: ERROR_DO_NOT_BUILD_THIS_WITH_PROFILING_YET__SEE_CABAL_ISSUE_1284 - -- } - if flag(debug) cpp-options: -DDEBUG_ATOMICS - - --- -- [2013.04.08] This isn't working presently: --- -- I'm having problems with building it along with the library; see DEVLOG. --- -- Switching to a separate package in ./testing/ --- Test-Suite test-atomic-primops --- type: exitcode-stdio-1.0 --- ... Source-Repository head Type: git diff --git a/cbits/primops.cmm b/cbits/primops.cmm deleted file mode 100644 --- a/cbits/primops.cmm +++ /dev/null @@ -1,128 +0,0 @@ - -// ============================================================ -// NOTE: We only use this file for GHC < 7.8. -// ============================================================ - -#include "Cmm.h" - -#warning "Duplicating functionality from the GHC RTS..." -#define WHICH_CAS DUP_cas -#define WHICH_SLBARRIER DUP_store_load_barrier -#define WHICH_LLBARRIER DUP_load_load_barrier -#define WHICH_WBARRIER DUP_write_barrier - -// These versions are linked directly from the RTS: -/* #define WHICH_CAS cas */ -/* #define WHICH_SLBARRIER store_load_barrier */ -/* #define WHICH_LLBARRIER load_load_barrier */ -/* #define WHICH_WBARRIER write_barrier */ - -// ================================================================================ - -add1Op -/* Int# -> Int# */ -{ - W_ num; - num = R1 + 1; - RET_P(num); -} - - -stg_casArrayzh -/* MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #) */ -{ - W_ arr, p, ind, old, new, h, len; - arr = R1; // anything else? - ind = R2; - old = R3; - new = R4; - - p = arr + SIZEOF_StgMutArrPtrs + WDS(ind); - (h) = foreign "C" WHICH_CAS(p, old, new) []; - if (h != old) { - // Failure, return what was there instead of 'old': - RET_NP(1,h); - } else { - // Compare and Swap Succeeded: - SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS); - len = StgMutArrPtrs_ptrs(arr); - // The write barrier. We must write a byte into the mark table: - I8[arr + SIZEOF_StgMutArrPtrs + WDS(len) + (ind >> MUT_ARR_PTRS_CARD_BITS )] = 1; - RET_NP(0,new); - } -} - - -stg_casByteArrayIntzh -/* MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #) */ -{ - W_ arr, p, ind, old, new, h, len; - arr = R1; - ind = R2; - old = R3; - new = R4; - - p = arr + SIZEOF_StgArrWords + WDS(ind); - (h) = foreign "C" WHICH_CAS(p, old, new) []; - - RET_N(h); -} - -stg_fetchAddByteArrayIntzh -/* MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) */ -{ - W_ arr, p, ind, incr, h, len; - arr = R1; - ind = R2; - incr = R3; - - p = arr + SIZEOF_StgArrWords + WDS(ind); - (h) = foreign "C" atomic_inc_with(incr, p) []; - - RET_N(h); -} - -// One difference from casMutVar# is that this version returns the NEW -// pointer in the case of success, NOT the old one. -stg_casMutVar2zh - /* MutVar# s a -> Word# -> a -> State# s -> (# State#, Int#, a #) */ -{ - W_ mv, old, new, h, addr; - // Calling convention: Up to 8 registers contain arguments. - mv = R1; - old = R2; - new = R3; - addr = mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var; - - // The "cas" function from the C runtime abstracts over - // platform/architecture differences. It returns the old value. - (h) = foreign "C" WHICH_CAS(addr, old, new) []; - if (h != old) { - // Failure: - RET_NP(1, h); - } - else - { - // Success means a mutation and thus GC write barrier: - if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) { - foreign "C" dirty_MUT_VAR(BaseReg "ptr", mv "ptr") []; - } - // Return the NEW value as the ticket for next time. - RET_NP(0,new); - } -} - - -// Takes a single input argument in R1: -stg_readMutVar2zh -/* MutVar# RealWorld a -> State# RealWorld -> (# State# RealWorld, Word#, a #) */ -{ - W_ mv, res; - mv = R1; - // Do the actual read: - res = W_[mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var]; - RET_NP(res, res); -} -/* emitPrimOp [res] ReadMutVarOp [mutv] _ */ -/* = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord)) */ - diff --git a/testing/Fetch.hs b/testing/Fetch.hs --- a/testing/Fetch.hs +++ b/testing/Fetch.hs @@ -2,7 +2,6 @@ -- tests for our fetch-and-* family of functions. import Control.Monad -import Control.Applicative import System.Random import Test.Framework.Providers.HUnit (testCase) import Test.Framework (Test) diff --git a/testing/Test.hs b/testing/Test.hs --- a/testing/Test.hs +++ b/testing/Test.hs @@ -9,7 +9,7 @@ import Control.Monad -- import Control.Monad.ST (stToIO) import Control.Exception (evaluate) -import Data.IORef (modifyIORef') +import Data.IORef import Data.Int import Data.Primitive.Array import Data.Word @@ -18,7 +18,7 @@ import Text.Printf import GHC.Conc import GHC.STRef -import GHC.IORef +import GHC.IORef (IORef(..)) #if MIN_VERSION_base(4,10,0) import GHC.Stats (getRTSStats, RTSStats(..)) #else diff --git a/testing/test-atomic-primops.cabal b/testing/test-atomic-primops.cabal --- a/testing/test-atomic-primops.cabal +++ b/testing/test-atomic-primops.cabal @@ -4,9 +4,10 @@ Name: test-atomic-primops Version: 0.6.0.5 Build-type: Simple -Cabal-version: >=1.8 - +Cabal-version: >=1.18 -- This is generally controled by the continuous integration script at a more granular level: +tested-with: GHC == 8.4.3, GHC == 8.2.2, GHC == 8.0.2, GHC == 7.10.3 + Flag opt Description: Enable GHC optimization. Default: False @@ -33,58 +34,74 @@ ghc-options: -rtsopts -with-rtsopts=-N4 -- Set it to always run with some parallelism. - build-depends: base, ghc-prim, primitive, containers, random, atomic-primops >= 0.6.0.5, + build-depends: base >= 4.8 && < 5 + , ghc-prim + , primitive + , containers + , random + , atomic-primops >= 0.6.0.5 -- For Testing: - time, HUnit, test-framework, test-framework-hunit + , time + , HUnit + , test-framework + , test-framework-hunit -- Optional: Debugging generated code: -- ghc-options: -keep-tmp-files -dsuppress-module-prefixes -ddump-to-file -ddump-core-stats -ddump-simpl-stats -dcore-lint -dcmm-lint -- ghc-options: -ddump-ds -ddump-simpl -ddump-stg -ddump-asm -ddump-bcos -ddump-cmm -ddump-opt-cmm -ddump-inlinings + default-language: Haskell2010 -- Cabal can get confused if there is no executable or library... so here's a dummy executable. -- Also it provides a good test of compile/link issues, apart from everything else. Executable hello-world-atomic-primops main-is: hello.hs - build-depends: base >= 4.5, atomic-primops + build-depends: base >= 4.8 && < 5 + , atomic-primops + default-language: Haskell2010 -- This is separated out, because a bug in GHC 7.6 make this fail on Linux. Test-suite template-haskell-atomic-primops type: exitcode-stdio-1.0 main-is: ghci-test.hs other-modules: TemplateHaskellSplices - if impl(ghc >= 7.8) { - Buildable: True - build-depends: base >= 4.5, atomic-primops >= 0.6.0.5, template-haskell, - -- For Testing: - test-framework, test-framework-hunit - } else { - Buildable: False - } - + Buildable: True + build-depends: base >= 4.8 && < 5 + , atomic-primops >= 0.6.0.5 + , template-haskell + , test-framework + , test-framework-hunit + default-language: Haskell2010 -- A very simple test of one primop included in GHC 7.8: Test-suite raw_CAS type: exitcode-stdio-1.0 - build-depends: base, ghc-prim, atomic-primops >= 0.6.0.5 + build-depends: base >= 4.8 && < 5 + , ghc-prim + , atomic-primops >= 0.6.0.5 -- ghc-prim, primitive, containers, random, atomic-primops >= 0.5.0.2, main-is: Raw781_test.hs - if impl(ghc < 7.7) { - Buildable: False - } - + default-language: Haskell2010 Test-suite Issue28 type: exitcode-stdio-1.0 - build-depends: base, ghc-prim, atomic-primops >= 0.6.0.5 + build-depends: base >= 4.8 && < 5 + , ghc-prim + , atomic-primops >= 0.6.0.5 main-is: Issue28.hs ghc-options: -main-is Issue28.main - -- if impl(ghc < 7.7) { - -- Buildable: False - -- } + default-language: Haskell2010 Benchmark atomic-primops-MicroBench type: exitcode-stdio-1.0 - build-depends: base, ghc-prim, primitive, containers, random, - atomic-primops >= 0.6.0.5, - deepseq >= 1.3, - time, HUnit, test-framework, test-framework-hunit - build-depends: criterion >= 1.2.1 + build-depends: base >= 4.8 && < 5 + , ghc-prim + , primitive + , containers + , random + , atomic-primops >= 0.6.0.5 + , deepseq >= 1.3 + , time + , HUnit + , test-framework + , test-framework-hunit + , criterion >= 1.2.1 main-is: MicroBench.hs + default-language: Haskell2010