From 754642a93aa380f3c893acd044e9396c8f21dc4b Mon Sep 17 00:00:00 2001
From: KC Sivaramakrishnan <sk826@cl.cam.ac.uk>
Date: Tue, 6 Dec 2016 16:43:30 +0000
Subject: [PATCH] Expose Backoff

---
 src/kcas.ml          |  7 +++++--
 src/kcas.mli         | 30 ++++++++++++++++++++++++++++++
 src/kcas_backoff.ml  | 28 +++++++++++++++++++---------
 src/kcas_backoff.mli | 13 +++++++------
 4 files changed, 61 insertions(+), 17 deletions(-)

diff --git a/src/kcas.ml b/src/kcas.ml
index 541b5981..a57e4b20 100644
--- a/src/kcas.ml
+++ b/src/kcas.ml
@@ -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 ()
 
diff --git a/src/kcas.mli b/src/kcas.mli
index 81f0dec4..5059dce5 100644
--- a/src/kcas.mli
+++ b/src/kcas.mli
@@ -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. *)
 
@@ -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. *)
@@ -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
diff --git a/src/kcas_backoff.ml b/src/kcas_backoff.ml
index 2ae7b989..2e8c5cfc 100644
--- a/src/kcas_backoff.ml
+++ b/src/kcas_backoff.ml
@@ -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
diff --git a/src/kcas_backoff.mli b/src/kcas_backoff.mli
index 9e3acd2c..30e29e34 100644
--- a/src/kcas_backoff.mli
+++ b/src/kcas_backoff.mli
@@ -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