simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 03:05:28 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

fix(atomic): prevent race conditions under flambda, for now

Browse source
This commit is contained in:
Simon Cruanes 2022-03-22 21:34:46 -04:00
parent 7f4c87cfb9
commit 54201a4e28
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
1 changed files with 18 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
src/core/CCAtomic.ml
View file

@ -12,24 +12,37 @@ type 'a t = {mutable x: 'a}
let[@inline] make x = {x}
let[@inline] get {x} = x
let[@inline] set r x = r.x <- x
let[@inline] exchange r x =
let[@inline never] exchange r x =
(* atomic *)
let y = r.x in
r.x <- x;
(* atomic *)
y
let[@inline] compare_and_set r seen v =
let[@inline never] compare_and_set r seen v =
(* atomic *)
if r.x == seen then (
r.x <- v;
(* atomic *)
true
) else false
let[@inline] fetch_and_add r x =
let[@inline never] fetch_and_add r x =
(* atomic *)
let v = r.x in
r.x <- x + r.x;
(* atomic *)
v
let[@inline] incr r = r.x <- 1 + r.x
let[@inline] decr r = r.x <- r.x - 1
let[@inline never] incr r =
(* atomic *)
r.x <- 1 + r.x
(* atomic *)
let[@inline never] decr r =
(* atomic *)
r.x <- r.x - 1
(* atomic *)
[@@@endif]