diff options
| -rw-r--r-- | compiler/prelude/primops.txt.pp | 8 | ||||
| -rw-r--r-- | includes/stg/MiscClosures.h | 1 | ||||
| -rw-r--r-- | rts/Linker.c | 1 | ||||
| -rw-r--r-- | rts/PrimOps.cmm | 27 |
4 files changed, 37 insertions, 0 deletions
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index e275b23778..6e25d65488 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -794,6 +794,14 @@ primop ThawArrayOp "thawArray#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall + 4 } +primop CasArrayOp "casArray#" GenPrimOp + MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #) + {Unsafe, machine-level atomic compare and swap on an element within an Array.} + with + out_of_line = True + has_side_effects = True + + ------------------------------------------------------------------------ section "Byte Arrays" {Operations on {\tt ByteArray\#}. A {\tt ByteArray\#} is a just a region of diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index b0ed03b814..de5d32262c 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -364,6 +364,7 @@ RTS_FUN_DECL(stg_word64ToIntegerzh); #endif RTS_FUN_DECL(stg_unsafeThawArrayzh); +RTS_FUN_DECL(stg_casArrayzh); RTS_FUN_DECL(stg_newByteArrayzh); RTS_FUN_DECL(stg_newPinnedByteArrayzh); RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh); diff --git a/rts/Linker.c b/rts/Linker.c index 0c7dfd2d40..1cb9b1f849 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1144,6 +1144,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(stg_labelThreadzh) \ SymI_HasProto(stg_newArrayzh) \ SymI_HasProto(stg_newArrayArrayzh) \ + SymI_HasProto(stg_casArrayzh) \ SymI_HasProto(stg_newBCOzh) \ SymI_HasProto(stg_newByteArrayzh) \ SymI_HasProto_redirect(newCAF, newDynCAF) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index ced15eec99..3bf5f37a00 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -206,6 +206,33 @@ stg_unsafeThawArrayzh ( gcptr arr ) } } +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" cas(p, old, new) []; + + if (h != old) { + // Failure, return what was there instead of 'old': + RET_NP(1,h); + } else { + // Compare and Swap Succeeded: + if (GET_INFO(arr) == stg_MUT_ARR_PTRS_CLEAN_info) { + 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,h); + } +} + stg_newArrayArrayzh ( W_ n /* words */ ) { W_ words, size; |