Source file `atomic.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*             Gabriel Scherer, projet Partout, INRIA Paris-Saclay        *)
(*                                                                        *)
(*   Copyright 2020 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

external ( == ) : 'a -> 'a -> bool = "%eq"
external ( + ) : int -> int -> int = "%addint"
external ignore : 'a -> unit = "%ignore"

type 'a t = { mutable v : 'a }

let make v = { v }
let get r = r.v
let set r v = r.v <- v

let[@inline never] exchange r v =
  (* BEGIN ATOMIC *)
  let cur = r.v in
  r.v <- v;
  (* END ATOMIC *)
  cur

let[@inline never] compare_and_set r seen v =
  (* BEGIN ATOMIC *)
  let cur = r.v in
  if cur == seen then (
    r.v <- v;
    (* END ATOMIC *)
    true)
  else false

let[@inline never] fetch_and_add r n =
  (* BEGIN ATOMIC *)
  let cur = r.v in
  r.v <- cur + n;
  (* END ATOMIC *)
  cur

let incr r = ignore (fetch_and_add r 1)
let decr r = ignore (fetch_and_add r (-1))