atomic-primops 0.5 → 0.5.0.2
raw patch · 19 files changed
+517/−341 lines, 19 files
Files
- DEVLOG.md +35/−0
- Data/Atomics.hs +75/−23
- Data/Atomics/Counter.hs +30/−6
- Data/Atomics/Counter/IORef.hs +1/−1
- Data/Atomics/Counter/Reference.hs +4/−20
- Data/Atomics/Counter/Unboxed.hs +36/−6
- Data/Atomics/Internal.hs +8/−15
- atomic-primops.cabal +7/−6
- cbits/RtsDup.c +9/−15
- cbits/primops.cmm +9/−27
- testing/CommonTesting.hs +44/−6
- testing/CounterCommon.hs +139/−0
- testing/CounterIORef.hs +11/−0
- testing/CounterReference.hs +13/−0
- testing/CounterTests.hs +0/−184
- testing/CounterUnboxed.hs +11/−0
- testing/Test.hs +46/−21
- testing/ghci-test.hs +20/−0
- testing/test-atomic-primops.cabal +19/−11
DEVLOG.md view
@@ -296,6 +296,7 @@ [2013.08.02] {Just observed a failure}+---------------------------------------- On machine basalt, ghc 7.6.3. But is it reproducible? @@ -303,4 +304,38 @@ n_threads_mutate: [Failed] Did the sum end up equal to 120? run_barriers: [OK]+++[2014.01.31] {Working on debugging CAS problems wiht n_threads_mutate test}+---------------------------------------------------------------------------++Now n_threads_mutate is failing consistently. It seems that I'm+getting false POSITIVES when attempting a CAS.++ 1 0: Fail when putting 1, was already 1+ 2 3 2: Fail when putting 2, was already 3+ 4 5 6 6: Fail when putting 6, was already 6+ 7 3: Fail when putting 4, was already 5+ 8 9 10 11 12 13 14 15 15 16 14: Fail when putting 11, was already 16+ 17 18 19 20 21 22 23 24 25 26 27 28 29 31 30 33 34 35 32 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 106 105 107 108 109 110 111 112 113 114 115 116 117 118 119+ n_threads_mutate: [Failed]+ Did the 120 threads CASing all succeed?+ expected: 120+ but got: 119++Here are the "successes":++ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 15 16 17 18 19 20 21 22 23 24+ 25 26 27 28 29 31 30 33 34 35 32 36 37 38 39 40 41 42 43 44 45 46+ 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68+ 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90+ 91 92 93 94 95 96 97 98 99 100 101 102 103 104 106 105 107 108 109+ 110 111 112 113 114 115 116 117 118 119++Notice that 15 occurs TWICE. Two threads think that they successfully+incremented 14 into 15.++Could that somehow happen if there were two different (boxed) objects+representing 14? +
Data/Atomics.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns, ScopedTypeVariables, CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-} -- | Provides atomic memory operations on IORefs and Mutable Arrays. --@@ -14,16 +15,17 @@ -- * Types for atomic operations Ticket, peekTicket, -- CASResult(..), + -- * Atomic operations on IORefs+ readForCAS, casIORef, casIORef2, + -- * Atomic operations on mutable arrays casArrayElem, casArrayElem2, readArrayElem, -- * Atomic operations on byte arrays casByteArrayInt, fetchAddByteArrayInt,- - -- * Atomic operations on IORefs- readForCAS, casIORef, casIORef2, - + -- * Atomic operations on raw MutVars+ -- | A lower-level version of the IORef interface. readMutVarForCAS, casMutVar, casMutVar2, -- * Memory barriers@@ -40,7 +42,12 @@ import GHC.IORef import GHC.STRef import GHC.ST+#if MIN_VERSION_base(4,7,0)+import GHC.Prim hiding ((==#))+import qualified GHC.PrimopWrappers as GPW+#else import GHC.Prim+#endif import GHC.Arr import GHC.Base (Int(I#)) import GHC.IO (IO(IO))@@ -75,12 +82,13 @@ -- GHC 7.8 changed some primops #if MIN_VERSION_base(4,7,0) (==#) :: Int# -> Int# -> Bool-(==#) x y = case x ==$# y of { 0# -> False; _ -> True }+(==#) x y = case x GPW.==# y of { 0# -> False; _ -> True } #endif -------------------------------------------------------------------------------- --- | Compare-and-swap +-- | Compare-and-swap. Follows the same rules as `casIORef`, returning the ticket for+-- then next operation. casArrayElem :: MutableArray RealWorld a -> Int -> Ticket a -> a -> IO (Bool, Ticket a) -- casArrayElem (MutableArray arr#) (I# i#) old new = IO$ \s1# -> -- case casArray# arr# i# old new s1# of @@ -94,6 +102,7 @@ case casArrayTicketed# arr# i# old new s1# of (# s2#, x#, res #) -> (# s2#, (x# ==# 0#, res) #) +-- | Ordinary processor load instruction (non-atomic, not implying any memory barriers). readArrayElem :: forall a . MutableArray RealWorld a -> Int -> IO (Ticket a) -- readArrayElem = unsafeCoerce# readArray# readArrayElem (MutableArray arr#) (I# i#) = IO $ \ st -> unsafeCoerce# (fn st)@@ -101,6 +110,13 @@ fn :: State# RealWorld -> (# State# RealWorld, a #) fn = readArray# arr# i# +-- | Compare and swap on word-sized chunks of a byte-array. For indexing purposes+-- the bytearray is treated as an array of words (`Int`s). Note that UNLIKE+-- `casIORef` and `casArrayTicketed`, this does not need to operate on tickets.+--+-- Further, this version always returns the /old value/, that was read from the array during+-- the CAS operation. That is, it follows the normal protocol for CAS operations+-- (and matches the underlying instruction on most architectures). casByteArrayInt :: MutableByteArray RealWorld -> Int -> Int -> Int -> IO Int casByteArrayInt (MutableByteArray mba#) (I# ix#) (I# old#) (I# new#) = IO$ \s1# ->@@ -115,6 +131,11 @@ (# s2#, (I# res) #) -- I don't know if a let will mak any difference here... hopefully not. +-- | Atomically add to a word of memory within a `MutableByteArray`.+-- +-- This function returns the NEW value of the location after the increment.+-- Thus, it is a bit misnamed, and in other contexts might be called "add-and-fetch",+-- such as in GCC's `__sync_add_and_fetch`. fetchAddByteArrayInt :: MutableByteArray RealWorld -> Int -> Int -> IO Int fetchAddByteArrayInt (MutableByteArray mba#) (I# offset#) (I# incr#) = IO $ \ s1# -> let (# s2#, res #) = fetchAddIntArray# mba# offset# incr# s1# in@@ -122,19 +143,33 @@ -------------------------------------------------------------------------------- +-- | Ordinary processor load instruction (non-atomic, not implying any memory barriers).+-- +-- The difference between this function and `readIORef`, is that it returns a /ticket/,+-- for use in future compare-and-swap operations. readForCAS :: IORef a -> IO ( Ticket a ) readForCAS (IORef (STRef mv)) = readMutVarForCAS mv --- | Performs a machine-level compare and swap operation on an+-- | Performs a machine-level compare and swap (CAS) operation on an -- 'IORef'. Returns a tuple containing a 'Bool' which is 'True' when a--- swap is performed, along with the 'current' value from the 'IORef'.+-- swap is performed, along with the most 'current' value from the 'IORef'.+-- Note that this differs from the more common CAS behavior, which is to+-- return the /old/ value before the CAS occured.+--+-- The reason for the difference is the ticket API. This function always returns the+-- ticket that you should use in your next CAS attempt. In case of success, this ticket+-- corresponds to the `new` value which you yourself installed in the `IORef`, whereas+-- in the case of failure it represents the preexisting value currently in the IORef. -- -- Note \"compare\" here means pointer equality in the sense of--- 'GHC.Prim.reallyUnsafePtrEquality#'.+-- 'GHC.Prim.reallyUnsafePtrEquality#'. However, the ticket API absolves+-- the user of this module from needing to worry about the pointer equality of their+-- values, which in general requires reasoning about the details of the Haskell+-- implementation (GHC). casIORef :: IORef a -- ^ The 'IORef' containing a value 'current' -> Ticket a -- ^ A ticket for the 'old' value -> a -- ^ The 'new' value to replace 'current' if @old == current@- -> IO (Bool, Ticket a)+ -> IO (Bool, Ticket a) -- ^ Success flag, plus ticket for the NEXT operation. casIORef (IORef (STRef var)) old new = casMutVar var old new -- | This variant takes two tickets, i.e. the 'new' value is a ticket rather than an@@ -149,6 +184,7 @@ -------------------------------------------------------------------------------- -- | A ticket contains or can get the usable Haskell value.+-- This function does just that. {-# NOINLINE peekTicket #-} -- At least this function MUST remain NOINLINE. Issue5 is an example of a bug that -- ensues otherwise.@@ -160,6 +196,7 @@ seal :: a -> Ticket a seal = unsafeCoerce# +-- | Like `readForCAS`, but for `MutVar#`. readMutVarForCAS :: MutVar# RealWorld a -> IO ( Ticket a ) readMutVarForCAS !mv = IO$ \ st -> readForCAS# mv st @@ -182,21 +219,36 @@ -- Memory barriers -------------------------------------------------------------------------------- ---- | Memory barrier implemented by the GHC rts (SMP.h).+-- | Memory barrier implemented by the GHC rts (see SMP.h). storeLoadBarrier :: IO ()-storeLoadBarrier = IO$ \st ->- case stg_storeLoadBarrier# st of- (# st', _ #) -> (# st', () #) --- | Memory barrier implemented by the GHC rts (SMP.h).+-- | Memory barrier implemented by the GHC rts (see SMP.h). loadLoadBarrier :: IO ()-loadLoadBarrier = IO$ \st ->- case stg_loadLoadBarrier# st of- (# st', _ #) -> (# st', () #) --- | Memory barrier implemented by the GHC rts (SMP.h).+-- | Memory barrier implemented by the GHC rts (see SMP.h). writeBarrier :: IO ()-writeBarrier = IO$ \st ->- case stg_writeBarrier# st of- (# st', _ #) -> (# st', () #)++-- GHC 7.8 consistently exposes these symbols while linking:+#if MIN_VERSION_base(4,7,0) +foreign import ccall unsafe "store_load_barrier" storeLoadBarrier+ :: IO () ++foreign import ccall unsafe "load_load_barrier" loadLoadBarrier+ :: IO ()++foreign import ccall unsafe "write_barrier" writeBarrier+ :: IO ()++#else+-- GHC 7.6 did not consistently expose them (e.g. in the non-threaded RTS),+-- so rather we grab this functionality from RtsDup.c:+foreign import ccall unsafe "DUP_store_load_barrier" storeLoadBarrier+ :: IO () ++foreign import ccall unsafe "DUP_load_load_barrier" loadLoadBarrier+ :: IO ()++foreign import ccall unsafe "DUP_write_barrier" writeBarrier+ :: IO ()+#endif+
Data/Atomics/Counter.hs view
@@ -1,12 +1,36 @@ +-- | Integer counters providing thread-safe, lock-free mutation functions.+--+-- While this package provides multiple implementations, this module will always+-- expose the default (best) implementation. Atomic counters are represented by a+-- single memory location, such that built-in processor instructions are sufficient+-- to perform fetch-and-add or compare-and-swap.+-- +-- Remember, contention on such counters should still be minimized!+ module Data.Atomics.Counter+ -- Reexport to get all the docs. (--- module Data.Atomics.Counter.IORef--- module Data.Atomics.Counter.Foreign- module Data.Atomics.Counter.Unboxed- ) where+ -- * Type of counters of counters and tickets+ AtomicCounter, + + -- * Creating counters+ newCounter, --- import Data.Atomics.Counter.IORef--- import Data.Atomics.Counter.Foreign+ -- * Tickets, used for compare-and-swap + -- | See the documentation for "Data.Atomics" for more explanation of the+ -- ticket abstraction. The same ideas apply here for counters as for+ -- general mutable locations (IORefs).+ CTicket, peekCTicket,++ -- * Atomic memory operations+ casCounter, incrCounter, incrCounter_,+ + -- * Non-atomic operations+ readCounter, readCounterForCAS,+ writeCounter+ )+ where+-- This module reexports the default implementation of atomic counters: import Data.Atomics.Counter.Unboxed
Data/Atomics/Counter/IORef.hs view
@@ -65,6 +65,6 @@ writeCounter (AtomicCounter r) !new = writeIORef r new {-# INLINE casCounter #-}--- | Compare and swap for the counter ADT.+-- | Compare and swap for the counter ADT. Similar behavior to `casIORef`. casCounter :: AtomicCounter -> CTicket -> Int -> IO (Bool, CTicket) casCounter (AtomicCounter r) tick !new = casIORef r tick new
Data/Atomics/Counter/Reference.hs view
@@ -64,31 +64,15 @@ writeCounter (AtomicCounter r) !new = writeIORef r new {-# INLINE casCounter #-}--- | Compare and swap for the counter ADT.+-- | Compare and swap for the counter ADT. Similar behavior to `casIORef`. casCounter :: AtomicCounter -> CTicket -> Int -> IO (Bool, CTicket) casCounter (AtomicCounter r) oldT !new =-- -- This approach for faking it requires proper equality, it doesn't use pointer- -- equality at all. That makes it not a true substitute but useful for some- -- debugging.- -- fakeCAS :: Eq a => IORef a -> Ticket a -> a -> IO (Bool,Ticket a)- - -- let old = peekTicket oldT let old = oldT in - atomicModifyIORef r $ \val -> -{-- trace (" DBG: INSIDE ATOMIC MODIFY, ptr eqs found/expected: " ++ - show [ptrEq val old, ptrEq val old, ptrEq val old] ++ - " ptr eq self: " ++ - show [ptrEq val val, ptrEq old old] ++- " names: " ++ show (unsafeName old, unsafeName old, unsafeName val, unsafeName val)- ) $--}+ atomicModifyIORef' r $ \val -> if (val == old)- then (new, (True, val))+ then (new, (True, new)) else (val, (False,val))- -- then (new, (True, unsafeCoerce# val))- -- else (val, (False,unsafeCoerce# val))+ {- {-# NOINLINE unsafeName #-}
Data/Atomics/Counter/Unboxed.hs view
@@ -1,18 +1,36 @@ {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, CPP #-} +-- | This should be the most efficient implementation of atomic counters.+-- You probably don't need the others! (Except for testing/debugging.)+ module Data.Atomics.Counter.Unboxed (AtomicCounter, CTicket, newCounter, readCounterForCAS, readCounter, peekCTicket, writeCounter, casCounter, incrCounter, incrCounter_) where -import GHC.Base import GHC.Ptr import Data.Atomics (casByteArrayInt) -- import Data.Atomics.Internal (casIntArray#, fetchAddIntArray#) import Data.Atomics.Internal+#if MIN_VERSION_base(4,7,0)+import GHC.Base hiding ((==#))+import GHC.Prim hiding ((==#))+import qualified GHC.PrimopWrappers as GPW+#else+import GHC.Base import GHC.Prim+#endif ++-- GHC 7.8 changed some primops+#if MIN_VERSION_base(4,7,0)+(==#) :: Int# -> Int# -> Bool+(==#) x y = case x GPW.==# y of { 0# -> False; _ -> True }+#endif+++ #ifndef __GLASGOW_HASKELL__ #error "Unboxed Counter: this library is not portable to other Haskell's" #endif@@ -22,15 +40,20 @@ #define SIZEOF_HSINT INT_SIZE_IN_BYTES #endif +-- | The type of mutable atomic counters. data AtomicCounter = AtomicCounter (MutableByteArray# RealWorld)++-- | You should not depend on this type. It varies between different implementations+-- of atomic counters. type CTicket = Int+-- TODO: Could newtype this. -- | Create a new counter initialized to the given value. {-# INLINE newCounter #-} newCounter :: Int -> IO AtomicCounter newCounter n = do c <- newRawCounter- writeCounter c n+ writeCounter c n -- Non-atomic is ok; it hasn't been released into the wild. return c -- | Create a new, uninitialized counter.@@ -57,7 +80,8 @@ {-# INLINE readCounterForCAS #-} -- | Just like the "Data.Atomics" CAS interface, this routine returns an opaque--- ticket that can be used in CAS operations.+-- ticket that can be used in CAS operations. Except for the difference in return+-- type, the semantics of this are the same as `readCounter`. readCounterForCAS :: AtomicCounter -> IO CTicket readCounterForCAS = readCounter @@ -67,12 +91,18 @@ peekCTicket !x = x {-# INLINE casCounter #-}--- | Compare and swap for the counter ADT.+-- | Compare and swap for the counter ADT. Similar behavior to+-- `Data.Atomics.casIORef`, in particular, in both success and failure cases it+-- returns a ticket that you should use for the next attempt. (That is, in the+-- success case, it actually returns the new value that you provided as input, but in+-- ticket form.) casCounter :: AtomicCounter -> CTicket -> Int -> IO (Bool, CTicket) -- casCounter (AtomicCounter barr) !old !new =-casCounter (AtomicCounter mba#) (I# old#) (I# new#) = IO$ \s1# ->+casCounter (AtomicCounter mba#) (I# old#) newBox@(I# new#) = IO$ \s1# -> let (# s2#, res# #) = casIntArray# mba# 0# old# new# s1# in- (# s2#, (res# ==# old#, I# res#) #)+ case res# ==# old# of + False -> (# s2#, (False, I# res# ) #) -- Failure+ True -> (# s2#, (True , newBox ) #) -- Success {-# INLINE sameCTicket #-} sameCTicket :: CTicket -> CTicket -> Bool
Data/Atomics/Internal.hs view
@@ -13,8 +13,8 @@ casIntArray#, fetchAddIntArray#, #endif readForCAS#, casMutVarTicketed#, casArrayTicketed#, - Ticket,- stg_storeLoadBarrier#, stg_loadLoadBarrier#, stg_writeBarrier# )+ Ticket+ ) where import GHC.Base (Int(I#))@@ -72,11 +72,16 @@ -- that a thread observed a specific previous value of a mutable -- variable. It is provided in lieu of the "old" value to -- compare-and-swap.+--+-- Design note: `Ticket`s exist to hide objects from the GHC compiler, which+-- can normally perform many optimizations that change pointer equality. A Ticket,+-- on the other hand, is a first-class object that can be handled by the user,+-- but will not have its pointer identity changed by compiler optimizations+-- (but will of course, change addresses during garbage collection). type Ticket a = Any a -- If we allow tickets to be a pointer type, then the garbage collector will update -- the pointer when the object moves. - instance Show (Ticket a) where show _ = "<CAS_ticket>" @@ -112,18 +117,6 @@ unsafeCoerce# casMutVar_TypeErased# #endif ------------------------------------------------------------------------------------ Memory barriers-----------------------------------------------------------------------------------foreign import prim "stg_store_load_barrier" stg_storeLoadBarrier#- :: State# RealWorld -> (# State# RealWorld, Int# #)--foreign import prim "stg_load_load_barrier" stg_loadLoadBarrier#- :: State# RealWorld -> (# State# RealWorld, Int# #)--foreign import prim "stg_write_barrier" stg_writeBarrier#- :: State# RealWorld -> (# State# RealWorld, Int# #) -------------------------------------------------------------------------------- -- Type-erased versions that call the raw foreign primops:
atomic-primops.cabal view
@@ -1,5 +1,5 @@ Name: atomic-primops-Version: 0.5+Version: 0.5.0.2 License: BSD3 License-file: LICENSE Author: Ryan Newton@@ -22,6 +22,7 @@ -- 0.4 -- Duplicate 'cas' as well as barriers. Add fetchAdd on ByteArray, Counter.Unboxed. -- 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. Synopsis: A safe approach to CAS and other atomic ops in Haskell. @@ -55,9 +56,9 @@ Extra-Source-Files: DEVLOG.md,- testing/Test.hs, testing/test-atomic-primops.cabal,- testing/Makefile, testing/CommonTesting.hs, testing/CounterTests.hs, testing/hello.hs--- Makefile, Test.hs, README.md+ testing/Test.hs, testing/test-atomic-primops.cabal, testing/ghci-test.hs+ testing/Makefile, testing/CommonTesting.hs, testing/CounterCommon.hs, testing/hello.hs+ testing/CounterReference.hs testing/CounterUnboxed.hs testing/CounterIORef.hs Flag debug Description: Enable extra internal checks.@@ -94,7 +95,7 @@ if impl(ghc < 7.7) { Include-Dirs: cbits C-Sources: cbits/primops.cmm- -- Duplicate RTS functionality: + -- Duplicate RTS functionality for GHC 7.6: C-Sources: cbits/RtsDup.c } CC-Options: -Wall @@ -106,7 +107,7 @@ -- } if flag(debug)- cpp-options: -DDEBUG_ATOMICS+ cpp-options: -DDEBUG_ATOMICS -- -- [2013.04.08] This isn't working presently:
cbits/RtsDup.c view
@@ -3,28 +3,24 @@ // NOTE: We only use this file for GHC < 7.8. // ============================================================ -// This file duplicates certain functionality from the GHC runtime system (SMP.h).+// If I #include "stg/SMP.h", then in I get duplicated symbols.+// Rather, instead this file duplicates certain functionality from the+// GHC runtime system (SMP.h). #define THREADED_RTS+#define WITHSMP #undef KEEP_INLINES -// Stg.h will pull in SMP.h:-// #include "Stg.h"-// Also having some problems with Regs.h.-// This is probably too big a chunk to suck in.- //-------------------------------------------------------------------------------- // #define EXTERN_INLINE inline #define EXTERN_INLINE +// These are includes from the GHC implementation: #include "MachDeps.h" #include "stg/Types.h"--// Force the GHC RTS code to provide the desired symbols:-// #define IN_STGCRUN 1+// Grab the HOST_ARCH from here:+#include "ghcplatform.h" -// If I pull this in I get duplicated symbols:-// #include "stg/SMP.h" //-------------------------------------------------------------------------------- /*@@ -99,7 +95,6 @@ // #define VOLATILE_LOAD(p) (*((StgVolatilePtr)(p))) - /* * CMPXCHG - the single-word atomic compare-and-exchange instruction. Used * in the STM implementation.@@ -109,8 +104,8 @@ { #if i386_HOST_ARCH || x86_64_HOST_ARCH __asm__ __volatile__ (- "lock\ncmpxchg %3,%1"- :"=a"(o), "=m" (*(volatile unsigned int *)p) + "lock\ncmpxchg %3,%1"+ :"=a"(o), "=m" (*(volatile unsigned int *)p) :"0" (o), "r" (n)); return o; #elif powerpc_HOST_ARCH@@ -173,7 +168,6 @@ #error cas() unimplemented on this architecture #endif }- // Copied from atomic_inc in the GHC RTS, except tweaked to allow
cbits/primops.cmm view
@@ -11,6 +11,7 @@ #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 */@@ -38,7 +39,6 @@ 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);@@ -87,21 +87,22 @@ stg_casMutVar2zh /* MutVar# s a -> Word# -> a -> State# s -> (# State#, Int#, a #) */ {- W_ mv, old, new, h;+ 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,- // which, if equal to "old", means success.- (h) = foreign "C" WHICH_CAS(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var,- old, new) [];+ // 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 {+ 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") [];@@ -124,23 +125,4 @@ } /* emitPrimOp [res] ReadMutVarOp [mutv] _ */ /* = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord)) */---// This is already existing functionality in the RTS (SMP.h). It-// handles the complexity of architecture-portability. We just need-// to expose it here.-stg_store_load_barrier {- foreign "C" WHICH_SLBARRIER();- RET_N(0);-}--stg_load_load_barrier {- foreign "C" WHICH_LLBARRIER();- RET_N(0);-}--stg_write_barrier {- foreign "C" WHICH_WBARRIER();- RET_N(0);-}
testing/CommonTesting.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns, ScopedTypeVariables, NamedFieldPuns, CPP #-} +-- Various utilities used during testing.+ module CommonTesting where import Control.Monad@@ -8,6 +10,7 @@ import Data.Time.Clock import Text.Printf import GHC.IO (unsafePerformIO)+import System.CPUTime import System.Mem.StableName (makeStableName, hashStableName) import System.Environment (getEnvironment) import System.IO (stdout, stderr, hPutStrLn, hFlush)@@ -57,7 +60,15 @@ | Sequence (Forkable a) (Forkable a) -- Sequential compositon, with barrier -- | Barrier Forkable +-- | Grab a GC-invariant stable "address" for any value.+{-# NOINLINE unsafeName #-}+unsafeName :: a -> Int+unsafeName x = unsafePerformIO $ do + sn <- makeStableName x+ return (hashStableName sn) ++-- | Measure realtime timeit :: IO a -> IO a timeit ioact = do start <- getCurrentTime@@ -66,14 +77,40 @@ putStrLn$ " Time elapsed: " ++ show (diffUTCTime end start) return res -{-# NOINLINE unsafeName #-}-unsafeName :: a -> Int-unsafeName x = unsafePerformIO $ do - sn <- makeStableName x- return (hashStableName sn) +-- | Measure CPU time rather than realtime...+cputime :: IO t -> IO t+cputime a = do+ start <- getCPUTime+ v <- a+ end <- getCPUTime+ let diff = (fromIntegral (end - start)) / (10^12)+ printf "SELFTIMED: %0.3f sec\n" (diff :: Double)+ return v +-- | To make sure we get a simple loop...+nTimes :: Int -> IO () -> IO ()+-- nTimes :: Int -> IO a -> IO ()+-- Note: starting out I would get 163Mb allocation for 10M sequential incrs (on unboxed).+-- The problem was that the "Int" result from each incr was being allocated.+-- Weird thing is that inlining nTimes reduces the allocation to 323Mb.+-- But forcing it to take an (IO ()) gets rid of the allocation.+-- Egad, wait, no, I have to NOT inline nTimes to get rid of the allocation!?!?+-- Otherwise I'm still stuck with at least 163Mb of allocation.+-- In fact... the allocation is still there even if we use incrCounter_ !!+-- If we leave nTimes uninlined, we can get down to 3Mb allocation with either incrCounter or incrCounter_.+-------------------------+-- UPDATE:+-- As per http://www.haskell.org/pipermail/glasgow-haskell-users/2011-June/020472.html+--+-- INLINE should not affect recursive functions. But here it seems to have a+-- deleterious effect!+nTimes 0 !c = return ()+nTimes !n !c = c >> nTimes (n-1) c+++ ---------------------------------------------------------------------------------------------------- -- DEBUGGING ----------------------------------------------------------------------------------------------------@@ -94,7 +131,7 @@ -- | How many elements or iterations should the test use? numElems :: Int numElems = case lookup "NUMELEMS" unsafeEnv of - Nothing -> 1000 * 1000 + Nothing -> 1000 * 1000 -- A million by default. Just str -> warnUsing ("NUMELEMS = "++str) $ read str @@ -122,3 +159,4 @@ where loop !i | i == end = return () | otherwise = do fn i; loop (i+1)+
+ testing/CounterCommon.hs view
@@ -0,0 +1,139 @@++-- Common tests to the different counter implementations.++import Control.Monad+import GHC.Conc+import System.CPUTime+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion, assertEqual, assertBool)+import Text.Printf+import Data.IORef ++import Data.Atomics+import CommonTesting (numElems, forkJoin, timeit, nTimes)++--------------------------------------------------------------------------------+-- Test the basics++case_basic1 = do + r <- C.newCounter 0+ ret <- C.incrCounter 10 r+ assertEqual "incrCounter returns the NEW value" 10 ret++case_basic2 = do + r <- C.newCounter 0+ t <- C.readCounterForCAS r+ (True,newt) <- C.casCounter r t 10+ assertEqual "casCounter returns new val/ticket on success" 10 (C.peekCTicket newt)++case_basic3 = do + r <- C.newCounter 0+ t <- C.readCounterForCAS r+ _ <- C.incrCounter 1 r+ (False,oldt) <- C.casCounter r t 10+ assertEqual "casCounter returns read val on failure" 1 (C.peekCTicket oldt)++case_basic4 = do + let tries = numElems `quot` 100+ r <- C.newCounter 0+ nTimes tries $ do+ t <- C.readCounterForCAS r+ (True,_) <- C.casCounter r t (C.peekCTicket t + 1)+ return ()+ cnt <- C.readCounter r+ assertEqual "Every CAS should succeed on one thread" tries cnt ++--------------------------------------------------------------------------------+-- Repeated increments++incrloop tries = do r <- C.newCounter 0; nTimes tries $ void$ C.incrCounter 1 r+ C.readCounter r+case_incrloop = do + cnt <- incrloop default_seq_tries+ assertEqual "incrloop sum" default_seq_tries cnt++-- | Here we do a loop to test the unboxing of results from incrCounter:+-- As of now [2013.07.19], it is successfully unboxing the results +-- for Data.Atomics.Counter.Unboxed.+incrloop4B tries = do+ putStrLn " [incrloop4B] A test where we use the result of each incr."+ r <- C.newCounter 1+ loop r tries 1+ where+ loop :: C.AtomicCounter -> Int -> Int -> IO ()+ loop r 0 _ = do v <- C.readCounter r+ putStrLn$"Final value: "++show v+ return ()+ loop r tries last = do+ n <- C.incrCounter last r+ if n == 2+ then loop r (tries-1) 2+ else loop r (tries-1) 1++-- | Here we let the counter overflow, which seems to be causing problems.+overflowTest tries = do+ putStrLn " [incrloop4B] A test where we use the result of each incr."+ r <- C.newCounter 1+ loop r tries 1+ where+ loop :: C.AtomicCounter -> Int -> Int -> IO ()+ loop r 0 _ = do v <- C.readCounter r+ putStrLn$"Final value: "++show v+ return ()+ loop r tries last = do+ putStrLn$ " [incrloop4B] Looping with tries left "++show tries + n <- C.incrCounter last r+ -- This is HANGING afer passing 2,147,483,648. (using Unboxed)+ -- Is there some defect wrt overflow?+ putStrLn$ " [incrloop4B] Done incr, received "++show n+ loop r (tries-1) n++--------------------------------------------------------------------------------+-- Parallel repeated increments+++{-# INLINE parIncrloop #-} +parIncrloop new incr iters = do+ numcap <- getNumCapabilities+ let (each,left) = iters `quotRem` numcap+ putStrLn$ "Concurrently incrementing counter from all "++show numcap++" threads, incrs per thread: "++show each+ r <- new 0+ forkJoin numcap $ \ ix -> do+ let mine = if ix==0 then each+left else each+ nTimes mine $ void $ incr 1 r+ C.readCounter r++case_parincrloop = do + cnt <- parIncrloop C.newCounter C.incrCounter default_conc_tries+ assertEqual "incrloop sum" default_conc_tries cnt++-- | Use CAS instead of the real incr so we can compare the overhead.+case_parincrloop_wCAS = do + cnt <- parIncrloop C.newCounter fakeIncr default_conc_tries+ assertEqual "incrloop sum" default_conc_tries cnt+ where+ fakeIncr delt r = do tick <- C.readCounterForCAS r+ loop r delt tick+ loop r delt tick = do x <- C.casCounter r tick (C.peekCTicket tick + delt)+ case x of + (True, newtick) -> return (C.peekCTicket newtick)+ (False,newtick) -> loop r delt newtick+ ++--------------------------------------------------------------------------------++tests = + [+ testCase (name++"basic1_incrCounter") $ case_basic1+ , testCase (name++"basic2_casCounter") $ case_basic2+ , testCase (name++"basic3_casCounter") $ case_basic3+ , testCase (name++"basic4_casCounter") $ case_basic4+ ----------------------------------------+ , testCase (name++"_single_thread_repeat_incr") $ timeit case_incrloop+ , testCase (name++"_incr_with_result_feedback") $ timeit (incrloop4B default_seq_tries)+ ----------------------------------------++ -- Parallel versions:+ , testCase (name++"_concurrent_repeat_incr") $ void$ timeit case_parincrloop+ , testCase (name++"_concurrent_repeat_incrCAS") $ void$ timeit case_parincrloop_wCAS+ ]
+ testing/CounterIORef.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP, BangPatterns #-}+module CounterIORef (tests) where+import qualified Data.Atomics.Counter.IORef as C++#include "CounterCommon.hs"++name = "IORef"++default_seq_tries = 10 * numElems+-- Things are MUCH slower with contention:+default_conc_tries = numElems
+ testing/CounterReference.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP, BangPatterns #-}+module CounterReference (tests) where+import qualified Data.Atomics.Counter.Reference as C++#include "CounterCommon.hs"++name = "Reference"++-- This version is much slower than some of the others:+default_seq_tries = 10 * base +default_conc_tries = base++base = numElems `quot` 15
− testing/CounterTests.hs
@@ -1,184 +0,0 @@-{-# LANGUAGE BangPatterns #-}---- | Test the counter implementation alternatives.--module CounterTests where--import Control.Monad-import GHC.Conc-import System.CPUTime-import Test.Framework.Providers.HUnit (testCase)-import Text.Printf-import Data.IORef --import Data.Atomics-import qualified Data.Atomics.Counter.Reference as C1 -import qualified Data.Atomics.Counter.IORef as C2-import qualified Data.Atomics.Counter.Foreign as C3-import qualified Data.Atomics.Counter.Unboxed as C4--import CommonTesting (numElems, forkJoin, timeit)-------------------------------------------------------------------------------------- {-# INLINE nTimes #-}--- | To make sure we get a simple loop...-nTimes :: Int -> IO () -> IO ()--- nTimes :: Int -> IO a -> IO ()--- Note: starting out I would get 163Mb allocation for 10M sequential incrs (on unboxed).--- The problem was that the "Int" result from each incr was being allocated.--- Weird thing is that inlining nTimes reduces the allocation to 323Mb.--- But forcing it to take an (IO ()) gets rid of the allocation.--- Egad, wait, no, I have to NOT inline nTimes to get rid of the allocation!?!?--- Otherwise I'm still stuck with at least 163Mb of allocation.--- In fact... the allocation is still there even if we use incrCounter_ !!--- If we leave nTimes uninlined, we can get down to 3Mb allocation with either incrCounter or incrCounter_.----------------------------- UPDATE:--- As per http://www.haskell.org/pipermail/glasgow-haskell-users/2011-June/020472.html------ INLINE should not affect recursive functions. But here it seems to have a--- deleterious effect!-nTimes 0 !c = return ()-nTimes !n !c = c >> nTimes (n-1) c---- {-# INLINE vd #-}--- vd = void--- vd x = x--cputime :: IO t -> IO t-cputime a = do- start <- getCPUTime- v <- a- end <- getCPUTime- let diff = (fromIntegral (end - start)) / (10^12)- printf "SELFTIMED: %0.3f sec\n" (diff :: Double)- return v--normal tries = do- r <- newIORef True- nTimes tries $ do- x <- readIORef r- writeIORef r $! not x---- This is not allocating per-iteration currently, which is rather amazing given what--- casIORef returns.-casBased tries = do - r <- newIORef True- nTimes tries $ do- t <- readForCAS r- casIORef r t (not $ peekTicket t)- return ()- readIORef r--normalIncr tries = do- r <- newIORef 0- nTimes tries $ do- x <- readIORef r- writeIORef r $! 1 + x- readIORef r--casBasedIncr tries = do - r <- newIORef 0- nTimes tries $ do- t <- readForCAS r- casIORef r t $! (1 + peekTicket t)- return ()- readIORef r--incrloop1 tries = do r <- C1.newCounter 0; nTimes tries $ void$ C1.incrCounter 1 r-incrloop2 tries = do r <- C2.newCounter 0; nTimes tries $ void$ C2.incrCounter 1 r-incrloop3 tries = do r <- C3.newCounter 0; nTimes tries $ void$ C3.incrCounter 1 r-incrloop4 tries = do r <- C4.newCounter 0; nTimes tries $ C4.incrCounter_ 1 r---- | Here we do a loop to test the unboxing of results from incrCounter:--- As of now [2013.07.19], it is successfully unboxing the results.-incrloop4B tries = do- putStrLn " [incrloop4B] A test where we use the result of each incr."- r <- C4.newCounter 1- loop r tries 1- where- loop :: C4.AtomicCounter -> Int -> Int -> IO ()- loop r 0 _ = do v <- C4.readCounter r- putStrLn$"Final value: "++show v- return ()- loop r tries last = do- n <- C4.incrCounter last r- if n == 2- then loop r (tries-1) 2- else loop r (tries-1) 1---- | Here we let the counter overflow, which seems to be causing problems.-overflowTest tries = do- putStrLn " [incrloop4B] A test where we use the result of each incr."- r <- C4.newCounter 1- loop r tries 1- where- loop :: C4.AtomicCounter -> Int -> Int -> IO ()- loop r 0 _ = do v <- C4.readCounter r- putStrLn$"Final value: "++show v- return ()- loop r tries last = do- putStrLn$ " [incrloop4B] Looping with tries left "++show tries - n <- C4.incrCounter last r- -- This is HANGING afer passing 2,147,483,648.- -- Is there some defect wrt overflow?- putStrLn$ " [incrloop4B] Done incr, received "++show n- loop r (tries-1) n----{-# INLINE parIncrloop #-} -parIncrloop new incr iters = do- numcap <- getNumCapabilities- let each = iters `quot` numcap- putStrLn$ "Concurrently incrementing counter from all "++show numcap++" threads, incrs per thread: "++show each- r <- new 0- forkJoin numcap $ \ _ -> - nTimes each $ void $ incr 1 r- return r--parIncrloop1 = parIncrloop C1.newCounter C1.incrCounter-parIncrloop2 = parIncrloop C2.newCounter C2.incrCounter-parIncrloop3 = parIncrloop C3.newCounter C3.incrCounter-parIncrloop4 = parIncrloop C4.newCounter C4.incrCounter------------------------------------------------------------------------------------default_seq_tries = 10 * numElems--- Things are MUCH slower with contention:-default_conc_tries = numElems--counterTests = - [- ----------------------------------------- testCase "RAW_single_thread_repeat_flip" $ do - putStrLn "Timing readIORef/writeIORef on one thread"- timeit (normal default_seq_tries) - , testCase "CAS_single_thread_repeat_flip" $ do - putStrLn "Timing CAS boolean flips on one thread without retries"- fin <- timeit (casBased default_seq_tries)- putStrLn$"Final value: "++show fin- ----------------------------------------- , testCase "RAW_single_thread_repeat_incr" $ do - putStrLn "Timing readIORef/writeIORef on one thread"- fin <- timeit (normalIncr default_seq_tries)- putStrLn$"Final value: "++show fin - , testCase "CAS_single_thread_repeat_incr" $ do - putStrLn "Timing CAS increments on one thread without retries"- fin <- timeit (casBasedIncr default_seq_tries)- putStrLn$"Final value: "++show fin - ----------------------------------------- , testCase "CounterReference_single_thread_repeat_incr" $ timeit (incrloop1 default_seq_tries)- , testCase "CounterIORef_single_thread_repeat_incr" $ timeit (incrloop2 default_seq_tries) - , testCase "CounterForeign_single_thread_repeat_incr" $ timeit (incrloop3 default_seq_tries)- , testCase "CounterUnboxed_single_thread_repeat_incr" $ timeit (incrloop4 default_seq_tries)- , testCase "CounterUnboxed_incr_with_result_feedback" $ timeit (incrloop4B default_seq_tries)- ------------------------------------------ -- Parallel versions:- , testCase "CounterReference_concurrent_repeat_incr" $ void$ timeit (parIncrloop1 default_conc_tries)- , testCase "CounterIORef_concurrent_repeat_incr" $ void$ timeit (parIncrloop2 default_conc_tries)- , testCase "CounterForeign_concurrent_repeat_incr" $ void$ timeit (parIncrloop3 default_conc_tries)- , testCase "CounterUnboxed_concurrent_repeat_incr" $ void$ timeit (parIncrloop4 default_conc_tries)- ]
+ testing/CounterUnboxed.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP, BangPatterns #-}+module CounterUnboxed (tests) where+import qualified Data.Atomics.Counter.Unboxed as C++#include "CounterCommon.hs"++name = "Unboxed"++default_seq_tries = 10 * numElems+-- Things are MUCH slower with contention:+default_conc_tries = numElems
testing/Test.hs view
@@ -7,35 +7,37 @@ -- import Control.Monad.ST (stToIO) import Control.Exception (evaluate) import Control.Concurrent.MVar-import GHC.Conc import Data.IORef (modifyIORef') import Data.Int import Data.Time.Clock+import Data.Primitive.Array+import Data.Word+import qualified Data.Set as S+import Data.List ((\\)) import Text.Printf+import GHC.Conc import GHC.STRef import GHC.IORef import GHC.Stats (getGCStats, GCStats(..))-import Data.Primitive.Array-import Data.Word-import qualified Data.Set as S+import GHC.IO (unsafePerformIO) import System.Random (randomIO, randomRIO)--import Data.Atomics as A-import Data.Atomics (casArrayElem, readArrayElem)- import Test.HUnit (Assertion, assertEqual, assertBool) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.HUnit (testCase)--import GHC.IO (unsafePerformIO) import System.Mem (performGC)-import System.Mem.StableName (makeStableName, hashStableName)+import System.Mem.StableName (makeStableName, hashStableName, StableName) import System.Environment (getEnvironment) import System.IO (stdout, stderr, hPutStrLn, hFlush) import Debug.Trace (trace) +----------------------------------------+import Data.Atomics as A+import Data.Atomics (casArrayElem, readArrayElem)+ import CommonTesting -import CounterTests (counterTests)+import qualified CounterReference +import qualified CounterUnboxed+import qualified CounterIORef ------------------------------------------------------------------------ @@ -54,7 +56,7 @@ -- It does 248 test cases and takes 55s at -N16... -- numcap <- getNumProcessors let numcap = 4- setNumCapabilities numcap+ when (numCapabilities /= numcap) $ setNumCapabilities numcap defaultMain $ [ testCase "casTicket1" case_casTicket1@@ -87,8 +89,11 @@ [1, numcap `quot` 2, numcap, 2*numcap] , size <- [1, 10, 100] , iters <- [10000]]- ++ counterTests + ++ CounterReference.tests+ ++ CounterUnboxed.tests+ ++ CounterIORef.tests+ setify :: [Int] -> [Int] setify = S.toList . S.fromList @@ -247,18 +252,38 @@ -- [2013.07.19] I just saw an isolated failure of this one:+-- [2014.01.31] I saw another failure of this on -N1 (0e0d64c3d7), observing 118 sum. case_n_threads_mutate :: Assertion case_n_threads_mutate = do dbgPrint 1$ " Creating 120 threads and having each increment a counter value." counter <- newIORef (0::Int)- let work :: IORef Int -> IO ()- work = (\counter -> do- tick <- A.readForCAS(counter)- (b,_) <- A.casIORef counter tick (peekTicket tick + 1)- unless b $ work counter)- arr <- forkJoin 120 (\_ -> work counter) +-- let work :: Int -> IORef Int -> IO (Int,StableName Int,Int,StableName Int,Int)+ let work :: Int -> IORef Int -> IO (Int,Int,Int,Int,Int)+ work ix counter = do+ tick <- A.readForCAS(counter)+ let nxt = peekTicket tick + 1+ (b,was) <- A.casIORef counter tick nxt+ if b then do + putStr $ show (peekTicket was) ++ "_"+ assertEqual "Check that the value written was the one we put in." nxt (peekTicket was)+ return (ix, unsafeName tick, unsafeName was, peekTicket tick, nxt)+ else do + when (peekTicket was == peekTicket tick) $ + putStrLn ("(Spoofed by boxing, old val was indeed "++show was++")")+ putStr "!"+-- putStrLn $ "("++ show ix ++ ": Fail when putting "++show nxt+-- ++", was already "++show (peekTicket was) ++")"+ work ix counter+ arr <- forkJoin 120 (\i -> work i counter) ans <- readIORef counter- assertBool "Did the sum end up equal to 120?" (ans == 120)++ let dups = [ n | (_,_,_,_,n) <- arr] \\ [1..120]+ putStrLn $ "\n Duplicates were "++show dups++", Array:"+ print arr++ -- assertBool "Did the 120 threads CASing yield a valid sum" (1 <= ans && ans <= 120)+ -- The retry loop should ensure that each thread increments ONCE:+ assertEqual "Did the 120 threads CASing all succeed?" 120 ans -- | Just make sure these link and run properly: case_run_barriers :: Assertion
+ testing/ghci-test.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Test the invocation of the GHCi bytecode intepreter with atomic-primops.++module Main where++import Data.Atomics -- import needed to test whether ghci linking error occurs+import TemplateHaskellSplices (tmap)+import Test.Framework (defaultMain)+import Test.Framework.Providers.HUnit (testCase)++main :: IO ()+main = defaultMain+ [+ ----------------------------------------+ testCase "Template_Haskell_invocation" $ do+ putStrLn "Attempting Template Haskell implementation of map operation"+ print $ $(tmap 3 4) (+ 1) (1,2,3,4) -- comment out for compilation to succeed+ ----------------------------------------+ ]
testing/test-atomic-primops.cabal view
@@ -2,7 +2,7 @@ -- Trying a completely separate .cabal for testing. Name: test-atomic-primops-Version: 0.1.0.0+Version: 0.5.0.2 Build-type: Simple Cabal-version: >=1.8 @@ -27,25 +27,33 @@ ghc-options: -O2 -funbox-strict-fields if flag(threaded) ghc-options: -threaded ++ -- Set it to always run with some parallelism.+ ghc-options: -rtsopts -with-rtsopts=-N4 - build-depends: base, ghc-prim, primitive, containers, random, atomic-primops >= 0.4,+ build-depends: base, ghc-prim, primitive, containers, random, atomic-primops >= 0.5, -- For Testing: time, HUnit, test-framework, test-framework-hunit - -- 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+ -- 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 +-- 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 -Executable template-haskell-atomic-primops+-- 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- if flag(withTH)+ if flag(withTH) { Buildable: True- else+ build-depends: base >= 4.5, atomic-primops >= 0.5, template-haskell,+ -- For Testing:+ test-framework, test-framework-hunit+ } else { Buildable: False- build-depends: base >= 4.5, atomic-primops >= 0.4, template-haskell,- -- For Testing:- test-framework, test-framework-hunit+ }