CP-52709: use timeslices shorter than 50ms (xapi-project#6177)

# Changing the default OCaml thread switch timeslice from 50ms

The default OCaml 4.x timeslice for switching between threads is 50ms:
if there is more than 1 active OCaml threads each one is let to run up
to 50ms, and then (at various safepoints) it can switch to another
running thread.
When the runtime lock is released (and C code or syscalls run) then
another OCaml thread is immediately let to run if any.

However 50ms is too long, and it inserts large latencies into the
handling of API calls.

OTOH if a timeslice is too short then we waste CPU time:
* overhead of Thread.yield system call, and the cost of switching
threads at the OS level
* potentially higher L1/L2 cache misses if we switch on the same CPU
between multiple OCaml threads
* potentially losing branch predictor history
* potentially higher L3 cache misses (but on a hypervisor with VMs
running L3 will be mostly taken up by VMs anyway, we can only rely on
L1/L2 staying with us)

A microbenchmark has shown that timeslices as small as 0.5ms might
strike an optimal balance between latency and overhead: values lower
than that lose performance due to increased overhead, and values higher
than that lose performance due to increased latency:


![auto_p](https://github.com/user-attachments/assets/3751291b-8f64-4d70-9a65-9c3fdb053955)

![auto_pr](https://github.com/user-attachments/assets/3b710484-87ba-488a-9507-7916c85aab20)

(the microbenchmark measures the number of CPU cycles spent simulating
an API call with various working set sizes and timeslice settings)

This is all hardware dependent though, and a future PR will introduce an
autotune service that measures the yield overhead and L1/L2 cache refill
overhead and calculates an optimal timeslice for that particular
hardware/Xen/kernel combination.
(and while we're at it, we can also tweak the minor heap size to match
~half of CPU L2 cache).

# Timeslice change mechanism

Initially I used `Unix.set_itimer` using virtual timers, to switch a
thread only when it has been actively using CPU for too long. However
that relies on delivering a signal to the process, and XAPI is very bad
at handling signals.
In fact XAPI is not allowed to receive any signals, because it doesn't
handle EINTR well (a typical problem, that affects C programs too
sometimes). Although this is a well understood problem (described in the
[OCaml Unix
book](https://ocaml.github.io/ocamlunix/ocamlunix.html#sec88), and some
areas of XAPI make an effort to handle it, others just assert that they
never receive one. Fixing that would require changes in all of XAPI (and
its dependencies).

So instead I don't use signals at all, but rely on Statmemprof to
trigger a hook to be executed "periodically", but not based purely on
time, but on allocation activity (i.e. at places the GC could run). The
hook checks the elapsed time since the last time it got called, and if
too much then calls Thread.yield.
Yield is smart enough to be a no-op if there aren't any other runnable
OCaml threads.

Yield isn't always beneficial though at reducing latencies, e.g. if we
are holding locks then we're just increasing latency for everyone who
waits for that lock.
So a mechanism is introduced to notify the periodic function when any
highly contended locks are held, and the yield is skipped in this
instance (e.g. the XAPI DB lock).

# Plotting code

This PR only includes a very simplified version of the microbenchmark, a
separate one will introduce the full cache plotting code (which is
useful for development/troubleshooting purposes but won't be needed at
runtime).

# Default timeslice value

Set to 5ms for now, just a bit above 4ms = 1/HZ in our Dom0 kernel, the
autotuner from a future PR can change this to a more appropriate value.
(the autotuner needs more validation on a wider range of hardware)

# Results

The cache measurements needs to be repeated on a wider variety of
hardware, but the timeslice changes here have already proven useful in
reducing XAPI DB lock hold times (together with other optimizations).

ocaml/libs/timeslice/dune

@@ -0,0 +1,5 @@
+(library
+	(name xapi_timeslice)
+	(package xapi-idl)
+ 	(libraries threads.posix mtime mtime.clock.os xapi-log)
+)

ocaml/libs/timeslice/recommended.ml

@@ -0,0 +1,48 @@
+(*
+ * Copyright (C) Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+module D = Debug.Make (struct let name = "timeslice_recommended" end)
+
+let yield_stop = Atomic.make false
+
+let yield_worker () =
+  while not (Atomic.get yield_stop) do
+    Thread.yield ()
+  done
+
+let yield_overhead () =
+  (* Thread.yield only has an effect if another thread exists,
+     so create one that yields back immediately *)
+  D.debug "Measuring Thread.yield overhead" ;
+  Atomic.set yield_stop false ;
+  let t = Thread.create yield_worker () in
+  let measured = Simple_measure.measure Thread.yield in
+  D.debug "Thread.yield overhead: %.6fs <= %.6fs <= %.6fs" measured.low
+    measured.median measured.high ;
+  D.debug "Waiting for worker thread to stop" ;
+  Atomic.set yield_stop true ;
+  Thread.join t ;
+  measured.median
+
+let measure ?(max_overhead_percentage = 1.0) () =
+  let overhead = yield_overhead () in
+  let interval = overhead /. (max_overhead_percentage /. 100.) in
+  D.debug "Recommended timeslice interval = %.4fs" interval ;
+  (* Avoid too high or too low intervals:
+     do not go below 1ms (our HZ is 250, and max is 1000, the kernel would round up anyway)
+     do not go above 50ms (the current default in OCaml 4.14)
+  *)
+  let interval = interval |> Float.max 0.001 |> Float.min 0.050 in
+  D.debug "Final recommeded timeslice interval = %.4fs" interval ;
+  interval

ocaml/libs/timeslice/recommended.mli

@@ -0,0 +1,22 @@
+(*
+ * Copyright (C) Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+val measure : ?max_overhead_percentage:float -> unit -> float
+(** [measure  ?max_overhead_percentage ()] returns the recommended timeslice for the current system.
+
+  The returned value should be used in a call to {!val:Timeslice.set}.
+
+  @param max_overhead_percentage default 1%
+  @returns [interval] such that [overhead / interval <= max_overhead_percentage / 100]
+ *)

ocaml/libs/timeslice/simple_measure.ml

@@ -0,0 +1,61 @@
+(*
+ * Copyright (C) Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(** 95% confidence interval, and median value *)
+type t = {low: float; median: float; high: float}
+
+let span_to_s s = Mtime.Span.to_float_ns s *. 1e-9
+
+let ci95 measurements =
+  let n = Array.length measurements in
+  Array.sort Float.compare measurements ;
+  let median = measurements.(n / 2) in
+  (* "Performance Evaluation of Computer and Communication Systems", Table A. 1 *)
+  let n = float n in
+  let d = 0.98 *. sqrt n in
+  let lo = (n /. 2.) -. d |> Float.to_int
+  and hi = (n /. 2.) +. 1. +. d |> Float.ceil |> Float.to_int in
+  {low= measurements.(lo - 1); median; high= measurements.(hi - 1)}
+
+let measure ?(n = 1001) ?(inner = 10) f =
+  if n <= 70 then (* some of the formulas below are not valid for smaller [n] *)
+    invalid_arg (Printf.sprintf "n must be at least 70: %d" n) ;
+  (* warmup *)
+  Sys.opaque_identity (f ()) ;
+
+  let measure_inner _ =
+    let m = Mtime_clock.counter () in
+    for _ = 1 to inner do
+      (* opaque_identity prevents the call from being optimized away *)
+      Sys.opaque_identity (f ())
+    done ;
+    let elapsed = Mtime_clock.count m in
+    span_to_s elapsed /. float inner
+  in
+  let measurements = Array.init n measure_inner in
+  ci95 measurements
+
+let measure_min ?(n = 1001) f arg =
+  (* warmup *)
+  Sys.opaque_identity (f arg) ;
+  let measure_one _ =
+    let m = Mtime_clock.counter () in
+    Sys.opaque_identity (f arg) ;
+    let elapsed = Mtime_clock.count m in
+    span_to_s elapsed
+  in
+  Seq.ints 0
+  |> Seq.take n
+  |> Seq.map measure_one
+  |> Seq.fold_left Float.min Float.max_float

ocaml/libs/timeslice/simple_measure.mli

@@ -0,0 +1,47 @@
+(*
+ * Copyright (C) Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(** Measure the speed of an operation in a very simple and robust way.
+    More detailed measurements can be dune using [Bechamel].
+*)
+
+(** 95% confidence interval, and median value *)
+type t = {low: float; median: float; high: float}
+
+val measure : ?n:int -> ?inner:int -> (unit -> unit) -> t
+(** [measure ?n ?inner f] measures [n] times the duration of [inner] iterations of [f ()].
+
+    Returns the median of the inner measurements, and a 95% confidence interval.
+    The median is used, because it makes no assumptions about the distribution of the samples,
+    i.e. it doesn't require a normal (Gaussian) distribution.
+
+    The inner measurements use a simple average, because we only know the duration of [inner] iterations,
+    not the duration of each individual call to [f ()].
+    The purpose of the [inner] iterations is to reduce measurement overhead.
+
+    @param n iteration count for the outer loop, must be more than [70].
+    @param n iteration count for the inner loop
+    @param f function to measure
+
+    @raises Invalid_argument if [n<70]
+ *)
+
+val measure_min : ?n:int -> ('a -> unit) -> 'a -> float
+(** [measure_min ?n:int f arg] is the minimum amount of time that [f arg] takes.
+
+    This should be used when we try to measure the maximum speed of some operation (e.g. cached memory accesses),
+    while ignoring latencies/hickups introduced by other processes on the system.
+
+    It shouldn't be used for measuring the overhead of an operation, because the hickups may be part of that overhead.
+ *)

ocaml/libs/timeslice/timeslice.ml

@@ -0,0 +1,72 @@
+(*
+ * Copyright (C) Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(* avoid allocating an extra option every time *)
+let invalid_holder = -1
+
+let last_lock_holder = Atomic.make invalid_holder
+
+let me () = Thread.self () |> Thread.id
+
+let lock_acquired () =
+  (* these need to be very low overhead, so just keep track of the last lock holder,
+     i.e. track only one high-priority lock at a time
+  *)
+  Atomic.set last_lock_holder (me ())
+
+let lock_released () = Atomic.set last_lock_holder invalid_holder
+
+let[@inline always] am_i_holding_locks () =
+  let last = Atomic.get last_lock_holder in
+  last <> invalid_holder && last = me ()
+
+let yield_interval = Atomic.make Mtime.Span.zero
+
+(* TODO: use bechamel.monotonic-clock instead, which has lower overhead,
+   but not in the right place in xs-opam yet
+*)
+let last_yield = Atomic.make (Mtime_clock.counter ())
+
+let failures = Atomic.make 0
+
+let periodic_hook (_ : Gc.Memprof.allocation) =
+  let () =
+    try
+      if not (am_i_holding_locks ()) then
+        let elapsed = Mtime_clock.count (Atomic.get last_yield) in
+        if Mtime.Span.compare elapsed (Atomic.get yield_interval) > 0 then (
+          let now = Mtime_clock.counter () in
+          Atomic.set last_yield now ; Thread.yield ()
+        )
+    with _ ->
+      (* It is not safe to raise exceptions here, it'd require changing all code to be safe to asynchronous interrupts/exceptions,
+         see https://guillaume.munch.name/software/ocaml/memprof-limits/index.html#isolation
+         Because this is just a performance optimization, we fall back to safe behaviour: do nothing, and just keep track that we failed
+      *)
+      Atomic.incr failures
+  in
+  None
+
+let periodic =
+  Gc.Memprof.
+    {null_tracker with alloc_minor= periodic_hook; alloc_major= periodic_hook}
+
+let set ?(sampling_rate = 1e-4) interval =
+  Atomic.set yield_interval
+    (Mtime.Span.of_float_ns @@ (interval *. 1e9) |> Option.get) ;
+  Gc.Memprof.start ~sampling_rate ~callstack_size:0 periodic
+
+let clear () =
+  Gc.Memprof.stop () ;
+  Atomic.set yield_interval Mtime.Span.zero

ocaml/libs/timeslice/timeslice.mli

@@ -0,0 +1,44 @@
+(*
+ * Copyright (C) Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+val set : ?sampling_rate:float -> float -> unit
+(** [set ?sampling_rate interval] calls [Thread.yield ()] at most [interval] seconds.
+
+  The implementation of [Thread.yield] guarantees since OCaml 4.09 that we'll switch to a different OCaml thread,
+  if one exists that is not blocked (i.e. it doesn't rely on [sched_yield] which may run the same thread again,
+  but uses pthread mutexes and condition variables to ensure the current thread isn't immediately runnable).
+
+  The setting is global for the entire process, and currently uses [Gc.Memprof] to ensure that a hook function is called periodically,
+  although it depends on the allocation rate of the program whether it gets called at all.
+
+  Another alternative would be to use {!val:Unix.set_itimer}, but XAPI doesn't cope with [EINTR] in a lot of places,
+  and POSIX interval timers rely on signals to notify of elapsed time.
+
+  We could also have a dedicated thread that sleeps for a certain amount of time, but if it is an OCaml thread,
+  we'd have no guarantees it'd get scheduled often enough (and it couldn't interrupt other threads anyway,
+  by the time you'd be running the handler you already gave up running something else).
+
+  It may be desirable to avoid yielding if we are currently holding a lock, see {!val:lock_acquired}, and {!val:lock_released}
+  to notify this module when that happens.
+*)
+
+val clear : unit -> unit
+(** [clear ()] undoes the changes made by [set].
+  This is useful for testing multiple timeslices in the same program. *)
+
+val lock_acquired : unit -> unit
+(** [lock_acquired ()] notifies about lock acquisition. *)
+
+val lock_released : unit -> unit
+(** [lock_acquired ()] notifies about lock release. *)

ocaml/tests/common/dune

@@ -28,6 +28,7 @@
     xapi-stdext-date
     xapi-stdext-threads.scheduler
     xapi-stdext-unix
+    xapi_timeslice
   )
 )
 

ocaml/tests/common/suite_init.ml

@@ -11,4 +11,6 @@ let harness_init () =
     Filename.concat Test_common.working_area "xapi-inventory" ;
   Xcp_client.use_switch := false ;
   Pool_role.set_pool_role_for_test () ;
-  Message_forwarding.register_callback_fns ()
+  Message_forwarding.register_callback_fns () ;
+  (* for unit tests use a fixed value *)
+  Xapi_timeslice.Timeslice.set 0.004

ocaml/xapi-idl/lib/dune

@@ -26,6 +26,7 @@
    unix
    uri
    uuidm
+   xapi_timeslice
    xapi-backtrace
    xapi-consts
    xapi-log

ocaml/xapi-idl/lib/xcp_service.ml

@@ -163,6 +163,26 @@ let setify =
   in
   loop []
 
+(** How long to let an OCaml thread run, before
+    switching to another thread.
+    This needs to be as small as possible to reduce latency.
+
+    Too small values reduce performance due to context switching overheads
+  
+    4ms = 1/HZ in Dom0 seems like a good default,
+    a better value will be written by a boot time service.
+ *)
+let timeslice = ref 0.05
+
+let adjust_timeslice () =
+  let interval = !timeslice in
+  D.debug "%s: Setting timeslice to %.3fs" __FUNCTION__ interval ;
+  if interval >= 0.05 then
+    D.debug "%s: Timeslice same as or larger than OCaml's default: not setting"
+      __FUNCTION__
+  else
+    Xapi_timeslice.Timeslice.set interval
+
 let common_options =
   [
     ( "use-switch"
@@ -236,6 +256,11 @@ let common_options =
     , (fun () -> !config_dir)
     , "Location of directory containing configuration file fragments"
     )
+  ; ( "timeslice"
+    , Arg.Set_float timeslice
+    , (fun () -> Printf.sprintf "%.3f" !timeslice)
+    , "timeslice in seconds"
+    )
   ]
 
 let loglevel () = !log_level
@@ -454,6 +479,7 @@ let configure_common ~options ~resources arg_parse_fn =
         failwith (String.concat "\n" lines)
     )
     resources ;
+  adjust_timeslice () ;
   Sys.set_signal Sys.sigpipe Sys.Signal_ignore
 
 let configure ?(argv = Sys.argv) ?(options = []) ?(resources = []) () =