Mark the DB lock as high priority: try to avoid voluntary Thread.yiel…

…d while we hold it

We'd still yield when the tick thread yields, or on syscalls.

ocaml/database/db_cache_types.ml

@@ -367,7 +367,12 @@ module Database = struct
   let unregister_callback name x =
     {x with callbacks= List.filter (fun (x, _) -> x <> name) x.callbacks}
 
+  let[@inline never] [@specialize never] notify_begin () = ()
+
+  let[@inline never] [@specialize never] notify_end () = ()
+
   let notify e db =
+    notify_begin () ;
     List.iter
       (fun (name, f) ->
         try f e db
@@ -376,7 +381,8 @@ module Database = struct
             (Printexc.to_string e) name ;
           ()
       )
-      db.callbacks
+      db.callbacks ;
+    notify_end ()
 
   let reindex x =
     let g = x.manifest.Manifest.generation_count in

ocaml/database/db_lock.ml

@@ -79,6 +79,12 @@ module ReentrantLock : REENTRANT_LOCK = struct
 
   let current_tid () = Thread.(self () |> id)
 
+  let[@inline never] [@specialize never] lock_acquired () =
+    Xapi_timeslice.Timeslice.lock_acquired ()
+
+  let[@inline never] [@specialize never] lock_released () =
+    Xapi_timeslice.Timeslice.lock_released ()
+
   let lock l =
     let me = current_tid () in
     match Atomic.get l.holder with
@@ -91,6 +97,7 @@ module ReentrantLock : REENTRANT_LOCK = struct
         while not (Atomic.compare_and_set l.holder None intended) do
           Condition.wait l.condition l.lock
         done ;
+        lock_acquired () ;
         let stats = l.statistics in
         let delta = Clock.Timer.span_to_s (Mtime_clock.count counter) in
         stats.total_time <- stats.total_time +. delta ;
@@ -109,7 +116,8 @@ module ReentrantLock : REENTRANT_LOCK = struct
           let () = Atomic.set l.holder None in
           Mutex.lock l.lock ;
           Condition.signal l.condition ;
-          Mutex.unlock l.lock
+          Mutex.unlock l.lock ;
+          lock_released ()
         )
     | _ ->
         failwith

ocaml/database/dune

@@ -48,6 +48,7 @@
     xapi-stdext-std
     xapi-stdext-threads
     xapi-stdext-unix
+    xapi_timeslice
     xml-light2
     xmlm
   )