#define CASTFUN
module Data.Atomics.Internal
(
#if MIN_VERSION_base(4,7,0)
#else
casIntArray#, fetchAddIntArray#,
#endif
readForCAS#, casMutVarTicketed#, casArrayTicketed#,
Ticket,
stg_storeLoadBarrier#, stg_loadLoadBarrier#, stg_writeBarrier# )
where
import GHC.Base (Int(I#))
import GHC.Word (Word(W#))
import GHC.Prim (RealWorld, Int#, Word#, State#, MutableArray#, MutVar#,
MutableByteArray#,
unsafeCoerce#, reallyUnsafePtrEquality#)
#if MIN_VERSION_base(4,7,0)
import GHC.Prim (casArray#, casIntArray#, fetchAddIntArray#)
#endif
#if MIN_VERSION_base(4,5,0)
import GHC.Prim (readMutVar#, casMutVar#, Any)
#else
#error "Need to figure out how to emulate Any () in GHC < 7.4 !"
#endif
#if MIN_VERSION_base(4,7,0)
#else
#ifdef DEBUG_ATOMICS
#else
#endif
#endif
casArrayTicketed# :: MutableArray# RealWorld a -> Int# -> Ticket a -> Ticket a
-> State# RealWorld -> (# State# RealWorld, Int#, Ticket a #)
casArrayTicketed# = unsafeCoerce#
#if MIN_VERSION_base(4,7,0)
casArray#
#else
casArrayTypeErased#
#endif
type Ticket a = Any a
instance Show (Ticket a) where
show _ = "<CAS_ticket>"
ptrEq :: a -> a -> Bool
ptrEq !x !y = I# (reallyUnsafePtrEquality# x y) == 1
instance Eq (Ticket a) where
(==) = ptrEq
readForCAS# :: MutVar# RealWorld a ->
State# RealWorld -> (# State# RealWorld, Ticket a #)
#ifdef CASTFUN
readForCAS# = unsafeCoerce# readMutVar#
#else
readForCAS# mv rw =
case readMutVar# mv rw of
(# rw', a #) -> (# rw', unsafeCoerce# a #)
#endif
casMutVarTicketed# :: MutVar# RealWorld a -> Ticket a -> Ticket a ->
State# RealWorld -> (# State# RealWorld, Int#, Ticket a #)
casMutVarTicketed# =
#if MIN_VERSION_base(4,7,0)
unsafeCoerce# casMutVar#
#else
unsafeCoerce# casMutVar_TypeErased#
#endif
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# #)
#if MIN_VERSION_base(4,7,0)
#else
foreign import prim "stg_casArrayzh" casArrayTypeErased#
:: MutableArray# RealWorld () -> Int# -> Any () -> Any () ->
State# RealWorld -> (# State# RealWorld, Int#, Any () #)
foreign import prim "stg_casMutVar2zh" casMutVar_TypeErased#
:: MutVar# RealWorld () -> Any () -> Any () ->
State# RealWorld -> (# State# RealWorld, Int#, Any () #)
foreign import prim "stg_casByteArrayIntzh" casIntArray#
:: MutableByteArray# s -> Int# -> Int# -> Int# ->
State# s -> (# State# s, Int# #)
foreign import prim "stg_fetchAddByteArrayIntzh" fetchAddIntArray#
:: MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
#endif