Import kcas_data into saturn

dune-project

@@ -4,7 +4,7 @@
 (source (github ocaml-multicore/saturn))
 (license ISC)
 (authors "KC Sivaramakrishnan")
-(maintainers "Carine Morel" "KC Sivaramakrishnan" "Sudha Parimala")
+(maintainers "Carine Morel" "KC Sivaramakrishnan" "Sudha Parimala" "Vesa Karvonen")
 (documentation "https://ocaml-multicore.github.io/saturn/")
 (package
  (name saturn)
@@ -29,3 +29,17 @@
   (qcheck-alcotest (and (>= 0.18.1) :with-test))
   (yojson (and (>= 2.0.2) :with-test))
   (dscheck (and (>= 0.1.0) :with-test))))
+(package (name kcas_data)
+ (synopsis "Compositional lock-free data structures and primitives for communication and synchronization")
+ (description "A library of compositional lock-free data structures and primitives for communication and synchronization implemented using kcas.")
+ (depends
+  (kcas (= :version))
+  (multicore-magic (>= 2.0.0))
+  (domain-local-await (and (>= 1.0.0) :with-test))
+  (domain_shims (and (>= 0.1.0) :with-test))
+  (mtime (and (>= 2.0.0) :with-test))
+  (alcotest (and (>= 1.7.0) :with-test))
+  (mdx (and (>= 2.3.0) :with-test))
+  (yojson (and (>= 2.1.0) :with-test))
+  (odoc (and (>= 2.2.0) :with-doc))))
+(using mdx 0.3)

kcas_data.opam

@@ -0,0 +1,41 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis:
+  "Compositional lock-free data structures and primitives for communication and synchronization"
+description:
+  "A library of compositional lock-free data structures and primitives for communication and synchronization implemented using kcas."
+maintainer: [
+  "Carine Morel" "KC Sivaramakrishnan" "Sudha Parimala" "Vesa Karvonen"
+]
+authors: ["KC Sivaramakrishnan"]
+license: "ISC"
+homepage: "https://github.com/ocaml-multicore/saturn"
+doc: "https://ocaml-multicore.github.io/saturn/"
+bug-reports: "https://github.com/ocaml-multicore/saturn/issues"
+depends: [
+  "dune" {>= "3.2"}
+  "kcas" {= version}
+  "multicore-magic" {>= "2.0.0"}
+  "domain-local-await" {>= "1.0.0" & with-test}
+  "domain_shims" {>= "0.1.0" & with-test}
+  "mtime" {>= "2.0.0" & with-test}
+  "alcotest" {>= "1.7.0" & with-test}
+  "mdx" {>= "2.3.0" & with-test}
+  "yojson" {>= "2.1.0" & with-test}
+  "odoc" {>= "2.2.0" & with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/ocaml-multicore/saturn.git"

kcas_data/accumulator.ml

@@ -0,0 +1,46 @@
+open Kcas
+
+let n_way_max = Domain.recommended_domain_count () |> Bits.ceil_pow_2
+let n_way_default = n_way_max |> Int.min 8
+
+type t = int Loc.t array
+
+let make ?n_way n =
+  let n_way =
+    match n_way with
+    | None -> n_way_default
+    | Some n_way -> n_way |> Int.min n_way_max |> Bits.ceil_pow_2
+  in
+  let a = Loc.make_array ~mode:Mode.lock_free n_way 0 in
+  Loc.set (Array.unsafe_get a 0) n;
+  a
+
+let n_way_of = Array.length
+
+let get_self a =
+  let h = (Domain.self () :> int) in
+  (* TODO: Consider mixing the bits of [h] to get better distribution *)
+  Array.unsafe_get a (h land (Array.length a - 1))
+
+module Xt = struct
+  let add ~xt a n = if n <> 0 then Xt.fetch_and_add ~xt (get_self a) n |> ignore
+  let incr ~xt a = Xt.incr ~xt (get_self a)
+  let decr ~xt a = Xt.decr ~xt (get_self a)
+
+  let rec get ~xt a s i =
+    let s = s + Xt.get ~xt (Array.unsafe_get a i) in
+    if i = 0 then s else get ~xt a s (i - 1)
+
+  let get ~xt a =
+    let i = Array.length a - 1 in
+    let s = Xt.get ~xt (Array.unsafe_get a i) in
+    if i = 0 then s else get ~xt a s (i - 1)
+
+  let set ~xt a n = add ~xt a (n - get ~xt a)
+end
+
+let add a n = if n <> 0 then Loc.fetch_and_add (get_self a) n |> ignore
+let incr a = Loc.incr (get_self a)
+let decr a = Loc.decr (get_self a)
+let get a = Kcas.Xt.commit { tx = Xt.get a }
+let set a n = Kcas.Xt.commit { tx = Xt.set a n }

kcas_data/accumulator.mli

@@ -0,0 +1,37 @@
+open Kcas
+
+(** Scalable accumulator.
+
+    A scalable accumulator can be used to scalably accumulate an integer value
+    in parallel as long as the accumulated value is read infrequently. *)
+
+(** {1 Common interface} *)
+
+type t
+(** The type of a scalable accumulator. *)
+
+val make : ?n_way:int -> int -> t
+(** [make n] returns a new accumulator whose initial value is [n].
+
+    The optional [n_way] argument can be used to specify a desired level of
+    parallelism, i.e. maximum number of non-interfering parallel updates.  The
+    default value is chosen to strike a balance between scalability and memory
+    use and a given value may be adjusted by the implementation. *)
+
+val n_way_of : t -> int
+(** [n_way_of a] returns the maximum number of non-interfering parallel updates
+    supported by the accumulator [a].
+
+    {b NOTE}: The returned value may not be the same as given to {!make}. *)
+
+(** {1 Compositional interface} *)
+
+module Xt :
+  Accumulator_intf.Ops
+    with type t := t
+    with type ('x, 'fn) fn := xt:'x Xt.t -> 'fn
+(** Explicit transaction log passing on accumulators. *)
+
+(** {1 Non-compositional interface} *)
+
+include Accumulator_intf.Ops with type t := t with type ('x, 'fn) fn := 'fn

kcas_data/accumulator_intf.ml

@@ -0,0 +1,22 @@
+module type Ops = sig
+  type t
+  type ('x, 'fn) fn
+
+  val add : ('x, t -> int -> unit) fn
+  (** [add a n] increments the value of the accumulator [a] by [n].  [add]
+      operations can be performed scalably in parallel. *)
+
+  val incr : ('x, t -> unit) fn
+  (** [incr a] is equivalent to [add a 1]. *)
+
+  val decr : ('x, t -> unit) fn
+  (** [decr a] is equivalent to [add a (-1)]. *)
+
+  val get : ('x, t -> int) fn
+  (** [get a] returns the current value of the accumulator.
+
+      {b CAUTION}: Performing a [get] is expensive and can limit scalability. *)
+
+  val set : ('x, t -> int -> unit) fn
+  (** [set a n] sets the current value of the accumulator [a] to [n]. *)
+end

kcas_data/bits.ml

@@ -0,0 +1,20 @@
+let is_pow_2 n = n land (n - 1) = 0
+
+let max_0 n =
+  let m = n asr (Sys.int_size - 1) in
+  n land lnot m
+
+let ceil_pow_2_minus_1 n =
+  let n = n lor (n lsr 1) in
+  let n = n lor (n lsr 2) in
+  let n = n lor (n lsr 4) in
+  let n = n lor (n lsr 8) in
+  let n = n lor (n lsr 16) in
+  if Sys.int_size > 32 then n lor (n lsr 32) else n
+
+let ceil_pow_2 n =
+  if n <= 1 then 1
+  else
+    let n = n - 1 in
+    let n = ceil_pow_2_minus_1 n in
+    n + 1

kcas_data/bits.mli

@@ -0,0 +1,9 @@
+val max_0 : int -> int
+(** [max_0 n] is equivalent to [Int.max 0 n]. *)
+
+val is_pow_2 : int -> bool
+(** [is_pow_2 n] determines [n] is zero or of the form [1 lsl i] for some
+    [i]. *)
+
+val ceil_pow_2_minus_1 : int -> int
+val ceil_pow_2 : int -> int