From 0b59969d71369cb27f39e2ff1bef56e8e31b2953 Mon Sep 17 00:00:00 2001 From: Vesa Karvonen Date: Fri, 4 Aug 2023 02:17:20 +0300 Subject: [PATCH] Use `backoff` library --- CHANGES.md | 1 + dune-project | 1 + kcas.opam | 1 + src/kcas/backoff.ml | 54 --------------------------------------- src/kcas/backoff.mli | 48 ---------------------------------- src/kcas/domain.ocaml4.ml | 2 -- src/kcas/dune | 13 ++-------- src/kcas/kcas.ml | 2 -- src/kcas/kcas.mli | 2 -- test/kcas/test.ml | 13 ---------- 10 files changed, 5 insertions(+), 132 deletions(-) delete mode 100644 src/kcas/backoff.ml delete mode 100644 src/kcas/backoff.mli delete mode 100644 src/kcas/domain.ocaml4.ml diff --git a/CHANGES.md b/CHANGES.md index 94ce01e3..6cfa6e88 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,7 @@ All notable changes to this project will be documented in this file. Next version: +- Move `Backoff` module to its own `backoff` package (@lyrm, @polytypic) - Support padding to avoid false sharing (@polytypic) - Pass through `?timeoutf` to blocking operations on data structures (@polytypic) diff --git a/dune-project b/dune-project index 80230ea7..911388aa 100644 --- a/dune-project +++ b/dune-project @@ -11,6 +11,7 @@ (description "A software transactional memory (STM) implementation based on an atomic lock-free multi-word compare-and-set (MCAS) algorithm enhanced with read-only compare operations and ability to block awaiting for changes.") (depends (ocaml (>= 4.13.0)) + (backoff (>= 0.1.0)) (domain-local-await (>= 0.2.0)) (domain-local-timeout (>= 0.1.0)) (multicore-magic (>= 1.0.0)) diff --git a/kcas.opam b/kcas.opam index e17f9158..7f46e2a0 100644 --- a/kcas.opam +++ b/kcas.opam @@ -15,6 +15,7 @@ bug-reports: "https://github.com/ocaml-multicore/kcas/issues" depends: [ "dune" {>= "3.3"} "ocaml" {>= "4.13.0"} + "backoff" {>= "0.1.0"} "domain-local-await" {>= "0.2.0"} "domain-local-timeout" {>= "0.1.0"} "multicore-magic" {>= "1.0.0"} diff --git a/src/kcas/backoff.ml b/src/kcas/backoff.ml deleted file mode 100644 index cd8d06fe..00000000 --- a/src/kcas/backoff.ml +++ /dev/null @@ -1,54 +0,0 @@ -(* - * Copyright (c) 2015, Théo Laurent - * Copyright (c) 2015, KC Sivaramakrishnan - * Copyright (c) 2021, Sudha Parimala - * Copyright (c) 2023, Vesa Karvonen - * - * Permission to use, copy, modify, and/or distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - *) - -type t = int - -let single_mask = Bool.to_int (Domain.recommended_domain_count () = 1) - 1 -let bits = 5 -let max_wait_log = 30 (* [Random.bits] returns 30 random bits. *) -let mask = (1 lsl bits) - 1 - -let create ?(lower_wait_log = 4) ?(upper_wait_log = 17) () = - assert ( - 0 <= lower_wait_log - && lower_wait_log <= upper_wait_log - && upper_wait_log <= max_wait_log); - (upper_wait_log lsl (bits * 2)) - lor (lower_wait_log lsl bits) lor lower_wait_log - -let get_upper_wait_log backoff = backoff lsr (bits * 2) -let get_lower_wait_log backoff = (backoff lsr bits) land mask -let get_wait_log backoff = backoff land mask - -let reset backoff = - let lower_wait_log = get_lower_wait_log backoff in - backoff land lnot mask lor lower_wait_log - -let once backoff = - let wait_log = get_wait_log backoff in - let wait_mask = (1 lsl wait_log) - 1 in - let t = Random.bits () land wait_mask land single_mask in - for _ = 0 to t do - Domain.cpu_relax () - done; - let upper_wait_log = get_upper_wait_log backoff in - let next_wait_log = Int.min upper_wait_log (wait_log + 1) in - backoff lxor wait_log lor next_wait_log - -let default = create () diff --git a/src/kcas/backoff.mli b/src/kcas/backoff.mli deleted file mode 100644 index f032c4bf..00000000 --- a/src/kcas/backoff.mli +++ /dev/null @@ -1,48 +0,0 @@ -(* - * Copyright (c) 2015, Théo Laurent - * Copyright (c) 2015, KC Sivaramakrishnan - * Copyright (c) 2023, Vesa Karvonen - * - * Permission to use, copy, modify, and/or distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - *) - -(** Randomized exponential backoff mechanism. *) - -type t [@@immediate] -(** Type of backoff values. *) - -val max_wait_log : int -(** Logarithm of the maximum allowed value for wait. *) - -val create : ?lower_wait_log:int -> ?upper_wait_log:int -> unit -> t -(** [create] creates a backoff value. [upper_wait_log], [lower_wait_log] - override the logarithmic upper and lower bound on the number of spins - executed by {!once}. *) - -val default : t -(** [default] is equivalent to [create ()]. *) - -val once : t -> t -(** [once b] executes one random wait and returns a new backoff with logarithm - of the current maximum value incremented unless it is already at - [upper_wait_log] of [b]. - - Note that this uses the default Stdlib [Random] per-domain generator. *) - -val reset : t -> t -(** [reset b] returns a backoff equivalent to [b] except with current value set - to the [lower_wait_log] of [b]. *) - -val get_wait_log : t -> int -(** [get_wait_log b] returns logarithm of the maximum value of wait for next - {!once}. *) diff --git a/src/kcas/domain.ocaml4.ml b/src/kcas/domain.ocaml4.ml deleted file mode 100644 index 80b8159f..00000000 --- a/src/kcas/domain.ocaml4.ml +++ /dev/null @@ -1,2 +0,0 @@ -let cpu_relax = Thread.yield -let recommended_domain_count () = 1 diff --git a/src/kcas/dune b/src/kcas/dune index 867b4566..6005ea2d 100644 --- a/src/kcas/dune +++ b/src/kcas/dune @@ -1,21 +1,12 @@ (library (name kcas) (public_name kcas) - (libraries domain-local-await domain-local-timeout multicore-magic)) - -(rule - (targets domain.ml) - (deps domain.ocaml4.ml) - (enabled_if - (< %{ocaml_version} 5.0.0)) - (action - (progn - (copy domain.ocaml4.ml domain.ml)))) + (libraries domain-local-await domain-local-timeout backoff multicore-magic)) (mdx (package kcas) (deps (package kcas)) (preludes kcas.prelude.ml) - (libraries kcas domain_shims) + (libraries kcas backoff domain_shims) (files kcas.mli)) diff --git a/src/kcas/kcas.ml b/src/kcas/kcas.ml index 1d97b678..e73f2a70 100644 --- a/src/kcas/kcas.ml +++ b/src/kcas/kcas.ml @@ -17,8 +17,6 @@ let fenceless_get = Atomic.get let fenceless_set = Atomic.set *) -module Backoff = Backoff - module Timeout = struct exception Timeout diff --git a/src/kcas/kcas.mli b/src/kcas/kcas.mli index cd911122..6fe0ebd0 100644 --- a/src/kcas/kcas.mli +++ b/src/kcas/kcas.mli @@ -101,8 +101,6 @@ can skip over these. The documentation links back to these modules where appropriate. *) -module Backoff : module type of Backoff - (** Timeout support. *) module Timeout : sig exception Timeout diff --git a/test/kcas/test.ml b/test/kcas/test.ml index 2a1f68d4..5830bfeb 100644 --- a/test/kcas/test.ml +++ b/test/kcas/test.ml @@ -348,18 +348,6 @@ let test_post_commit () = (* *) -let test_backoff () = - let b = Backoff.create ~lower_wait_log:5 ~upper_wait_log:6 () in - assert (Backoff.get_wait_log b = 5); - let b = Backoff.once b in - assert (Backoff.get_wait_log b = 6); - let b = Backoff.once b in - assert (Backoff.get_wait_log b = 6); - let b = Backoff.reset b in - assert (Backoff.get_wait_log b = 5) - -(* *) - let test_blocking () = let state = Loc.make `Spawned in let await state' = @@ -674,7 +662,6 @@ let () = [ Alcotest.test_case "" `Quick test_presort_and_is_in_log_xt ] ); ("updates", [ Alcotest.test_case "" `Quick test_updates ]); ("post commit", [ Alcotest.test_case "" `Quick test_post_commit ]); - ("backoff", [ Alcotest.test_case "" `Quick test_backoff ]); ("blocking", [ Alcotest.test_case "" `Quick test_blocking ]); ( "no unnecessary wakeups", [ Alcotest.test_case "" `Quick test_no_unnecessary_wakeups ] );