Commit 8750d549 authored by rrnewton's avatar rrnewton

Add PrimOp fetchAddIntArray# plus supporting C function atomic_inc_by.

parent fa278381
......@@ -1125,6 +1125,13 @@ primop CasByteArrayOp_Int "casIntArray#" GenPrimOp
out_of_line = True
has_side_effects = True
primop FetchAddByteArrayOp_Int "fetchAddIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
{Machine-level word-sized fetch-and-add within a ByteArray.}
with
out_of_line = True
has_side_effects = True
------------------------------------------------------------------------
section "Arrays of arrays"
......
......@@ -369,6 +369,7 @@ RTS_FUN_DECL(stg_newByteArrayzh);
RTS_FUN_DECL(stg_newPinnedByteArrayzh);
RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
RTS_FUN_DECL(stg_casIntArrayzh);
RTS_FUN_DECL(stg_fetchAddIntArrayzh);
RTS_FUN_DECL(stg_newArrayzh);
RTS_FUN_DECL(stg_newArrayArrayzh);
......
......@@ -60,6 +60,16 @@ EXTERN_INLINE StgWord cas(StgVolatilePtr p, StgWord o, StgWord n);
*/
EXTERN_INLINE StgWord atomic_inc(StgVolatilePtr p);
/*
* Atomic addition by the provided quantity
*
* atomic_inc_by(p, n) {
* return ((*p) += n);
* }
*/
EXTERN_INLINE StgWord atomic_inc_by(StgVolatilePtr p, StgWord n);
/*
* Atomic decrement
*
......@@ -236,27 +246,34 @@ cas(StgVolatilePtr p, StgWord o, StgWord n)
#endif
}
// RRN: Added to enable general fetch-and-add in Haskell code (fetchAddIntArray#).
EXTERN_INLINE StgWord
atomic_inc(StgVolatilePtr p)
atomic_inc_by(StgVolatilePtr p, StgWord incr)
{
#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)
StgWord r;
r = 1;
r = incr;
__asm__ __volatile__ (
"lock\nxadd %0,%1":
"+r" (r), "+m" (*p):
);
return r+1;
return r + incr;
#else
StgWord old, new;
do {
old = *p;
new = old + 1;
new = old + incr;
} while (cas(p, old, new) != old);
return new;
#endif
}
EXTERN_INLINE StgWord
atomic_inc(StgVolatilePtr p)
{
return atomic_inc_by(p, 1);
}
EXTERN_INLINE StgWord
atomic_dec(StgVolatilePtr p)
{
......@@ -396,6 +413,13 @@ atomic_inc(StgVolatilePtr p)
return ++(*p);
}
INLINE_HEADER StgWord
atomic_inc_by(StgVolatilePtr p, StgWord incr)
{
return ((*p) += incr);
}
INLINE_HEADER StgWord
atomic_dec(StgVolatilePtr p)
{
......
......@@ -1148,6 +1148,7 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(stg_newBCOzh) \
SymI_HasProto(stg_newByteArrayzh) \
SymI_HasProto(stg_casIntArrayzh) \
SymI_HasProto(stg_fetchAddIntArrayzh) \
SymI_HasProto_redirect(newCAF, newDynCAF) \
SymI_HasProto(stg_newMVarzh) \
SymI_HasProto(stg_newMutVarzh) \
......
......@@ -142,7 +142,6 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new )
/* MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #) */
{
W_ len;
gcptr p,h;
p = arr + SIZEOF_StgArrWords + WDS(ind);
......@@ -151,6 +150,19 @@ stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new )
return(h);
}
stg_fetchAddIntArrayzh( gcptr arr, W_ ind, W_ incr )
/* MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) */
{
gcptr p, h;
p = arr + SIZEOF_StgArrWords + WDS(ind);
(h) = ccall atomic_inc_by(p, incr);
return(h);
}
stg_newArrayzh ( W_ n /* words */, gcptr init )
{
W_ words, size;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment