Commit fa278381 authored by rrnewton's avatar rrnewton

Add PrimOp: casIntArray#. Modify casMutVar# for 'ticketed' style.

parent 4b4c944b
......@@ -1118,6 +1118,14 @@ primop SetByteArrayOp "setByteArray#" GenPrimOp
code_size = { primOpCodeSizeForeignCall + 4 }
can_fail = True
primop CasByteArrayOp_Int "casIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #)
{Machine-level atomic compare and swap on a word within a ByteArray.}
with
out_of_line = True
has_side_effects = True
------------------------------------------------------------------------
section "Arrays of arrays"
{Operations on {\tt ArrayArray\#}. An {\tt ArrayArray\#} contains references to {\em unpointed}
......
......@@ -368,6 +368,7 @@ RTS_FUN_DECL(stg_casArrayzh);
RTS_FUN_DECL(stg_newByteArrayzh);
RTS_FUN_DECL(stg_newPinnedByteArrayzh);
RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
RTS_FUN_DECL(stg_casIntArrayzh);
RTS_FUN_DECL(stg_newArrayzh);
RTS_FUN_DECL(stg_newArrayArrayzh);
......
......@@ -1147,6 +1147,7 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(stg_casArrayzh) \
SymI_HasProto(stg_newBCOzh) \
SymI_HasProto(stg_newByteArrayzh) \
SymI_HasProto(stg_casIntArrayzh) \
SymI_HasProto_redirect(newCAF, newDynCAF) \
SymI_HasProto(stg_newMVarzh) \
SymI_HasProto(stg_newMutVarzh) \
......
......@@ -137,6 +137,20 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
return (p);
}
// RRN: This one does not use the "ticketing" approach because it
// deals in unboxed scalars, not heap pointers.
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);
(h) = ccall cas(p, old, new);
return(h);
}
stg_newArrayzh ( W_ n /* words */, gcptr init )
{
W_ words, size;
......@@ -206,6 +220,7 @@ stg_unsafeThawArrayzh ( gcptr arr )
}
}
// RRN: Uses the ticketed approach; see casMutVar
stg_casArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
/* MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #) */
{
......@@ -224,7 +239,7 @@ stg_casArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
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;
return (0,h);
return (0,new);
}
}
......@@ -284,6 +299,11 @@ stg_newMutVarzh ( gcptr init )
return (mv);
}
// RRN: To support the "ticketed" approach, we return the NEW rather
// than old value if the CAS is successful. This is received in an
// opaque form in the Haskell code, preventing the compiler from
// changing its pointer identity. The ticket can then be safely used
// in future CAS operations.
stg_casMutVarzh ( gcptr mv, gcptr old, gcptr new )
/* MutVar# s a -> a -> a -> State# s -> (# State#, Int#, a #) */
{
......@@ -297,7 +317,7 @@ stg_casMutVarzh ( gcptr mv, gcptr old, gcptr new )
if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) {
ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr");
}
return (0,h);
return (0,new);
}
}
......
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