CP-52821: Xapi_periodic_scheduler: introduce add_to_queue_span

Signed-off-by: Edwin Török <[email protected]>

ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/dune

@@ -18,7 +18,7 @@
   (public_name xapi-stdext-threads.scheduler)
   (name xapi_stdext_threads_scheduler)
   (modules ipq scheduler)
-  (libraries mtime mtime.clock.os threads.posix unix xapi-log xapi-stdext-threads)
+  (libraries mtime mtime.clock.os threads.posix unix xapi-log xapi-stdext-threads clock)
 )
 
 (tests

ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/scheduler.ml

@@ -31,34 +31,27 @@ let (queue : t Ipq.t) = Ipq.create 50 queue_default
 
 let lock = Mutex.create ()
 
-module Clock = struct
-  let span s = Mtime.Span.of_uint64_ns (Int64.of_float (s *. 1e9))
+let add_span clock span =
+  (* return max value if the add overflows: spans are unsigned integers *)
+  match Mtime.add_span clock span with Some t -> t | None -> Mtime.max_stamp
 
-  let span_to_s span =
-    Mtime.Span.to_uint64_ns span |> Int64.to_float |> fun ns -> ns /. 1e9
-
-  let add_span clock secs =
-    (* return mix or max available value if the add overflows *)
-    match Mtime.add_span clock (span secs) with
-    | Some t ->
-        t
-    | None when secs > 0. ->
-        Mtime.max_stamp
-    | None ->
-        Mtime.min_stamp
-end
-
-let add_to_queue ?(signal = true) name ty start newfunc =
+let add_to_queue_span ?(signal = true) name ty start_span newfunc =
   with_lock lock (fun () ->
-      let ( ++ ) = Clock.add_span in
+      let ( ++ ) = add_span in
       Ipq.add queue
         {
           Ipq.ev= {func= newfunc; ty; name}
-        ; Ipq.time= Mtime_clock.now () ++ start
+        ; Ipq.time= Mtime_clock.now () ++ start_span
         }
   ) ;
   if signal then Delay.signal delay
 
+let add_to_queue ?signal name ty start newfunc =
+  let start_span =
+    Clock.Timer.s_to_span start |> Option.value ~default:Mtime.Span.max_span
+  in
+  add_to_queue_span ?signal name ty start_span newfunc
+
 let remove_from_queue name =
   let index = Ipq.find_p queue (fun {name= n; _} -> name = n) in
   if index > -1 then
@@ -105,7 +98,7 @@ let loop () =
           let sleep =
             Mtime.(span next.Ipq.time now)
             |> Mtime.Span.(add ms)
-            |> Clock.span_to_s
+            |> Clock.Timer.span_to_s
           in
           wait_next sleep
     done

ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/scheduler.mli

@@ -18,6 +18,10 @@ type func_ty =
   | OneShot  (** Fire just once *)
   | Periodic of float  (** Fire periodically with a given period in seconds *)
 
+val add_to_queue_span :
+  ?signal:bool -> string -> func_ty -> Mtime.span -> (unit -> unit) -> unit
+(** Start a new timer. *)
+
 val add_to_queue :
   ?signal:bool -> string -> func_ty -> float -> (unit -> unit) -> unit
 (** Start a new timer. *)