Skip to content

Commit

Permalink
Expose Backoff
Browse files Browse the repository at this point in the history
  • Loading branch information
kayceesrk committed Dec 6, 2016
1 parent 025eac5 commit 754642a
Show file tree
Hide file tree
Showing 4 changed files with 61 additions and 17 deletions.
7 changes: 5 additions & 2 deletions src/kcas.ml
Original file line number Diff line number Diff line change
Expand Up @@ -118,11 +118,14 @@ let try_map r f =
| None -> Aborted
| Some v -> if cas r s v then Success s else Failed

module type Backoff = Kcas_backoff.S
module Backoff = Kcas_backoff.M

let map r f =
let b = Kcas_backoff.create () in
let b = Backoff.create () in
let rec loop () =
match try_map r f with
| Failed -> Kcas_backoff.once b; loop ()
| Failed -> Backoff.once b; loop ()
| v -> v
in loop ()

Expand Down
30 changes: 30 additions & 0 deletions src/kcas.mli
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,8 @@
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
---------------------------------------------------------------------------*)

(** {2 References} *)

type 'a ref
(** The type of shared memory reference. *)

Expand All @@ -38,6 +40,9 @@ val get : 'a ref -> 'a
(** Get the value of the reference. *)

val get_id : 'a ref -> int
(** Get the unique identity of the reference. *)

(** {2 Compare-and-swap} *)

type t
(** The type of compare-and-swap value. *)
Expand Down Expand Up @@ -82,3 +87,28 @@ val incr : int ref -> unit

val decr : int ref -> unit
(** [decr r] atomically decrements [r] *)

(** {2 Backoff}
Suspend domains with exponential backoff. *)

module type Backoff = sig
type t
(** The type of backoff value *)

val create : ?max:int -> unit -> t
(** [create ~max:maxv ()] returns a backoff value, which when waited upon,
suspends the calling domain for [x] milliseconds, where [x] is the
current value of the backoff. The backoff value [x] is doubled after
every wait upto a maximum of [maxv] milliseconds. The default maximum is
32 milliseconds. The initial backoff is 1 millisecond. *)

val once : t -> unit
(** [once b] suspends the current domain for [x] milliseconds, where [x] is
the current value of the backoff. *)

val reset : t -> unit
(** Resets the backoff clock to 1 millisecond. *)
end

module Backoff : Backoff
28 changes: 19 additions & 9 deletions src/kcas_backoff.ml
Original file line number Diff line number Diff line change
Expand Up @@ -15,17 +15,27 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)

module type S = sig
type t
val create : ?max:int -> unit -> t
val once : t -> unit
val reset : t -> unit
end

type t = int * int ref
module M : S = struct

let _ = Random.self_init ()
type t = int * int ref

let create ?(max=32) () = (max, ref 1)
let _ = Random.self_init ()

let once (maxv, r) =
let t = Random.int (!r) in
r := min (2 * !r) maxv;
if t = 0 then ()
else ignore (Unix.select [] [] [] (0.001 *. (float_of_int t)))
let create ?(max=32) () = (max, ref 1)

let reset (_,r) = r := 1
let once (maxv, r) =
let t = Random.int (!r) in
r := min (2 * !r) maxv;
if t = 0 then ()
else ignore (Unix.select [] [] [] (0.001 *. (float_of_int t)))

let reset (_,r) = r := 1

end
13 changes: 7 additions & 6 deletions src/kcas_backoff.mli
Original file line number Diff line number Diff line change
Expand Up @@ -15,10 +15,11 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)

type t
module type S = sig
type t
val create : ?max:int -> unit -> t
val once : t -> unit
val reset : t -> unit
end

val create : ?max:int -> unit -> t

val once : t -> unit

val reset : t -> unit
module M : S

0 comments on commit 754642a

Please sign in to comment.