Improve OCaml 5 compatibility

Makefile

@@ -2,6 +2,11 @@ DUNE 	= dune
 JOBS    = $(shell getconf _NPROCESSORS_ONLN)
 PROFILE = release
 
+# K&R style indentation, could use in format target below
+INDENT += -nbad -bap -nbc -br -brs -c33 -cd33 -ncdb -ce -ci4 -cli0
+INDENT += -d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs
+INDENT += -npsl -nsc -nsob
+
 .PHONY: build check test clean format install
 
 build:

mmap/xenmmap_stubs.c

@@ -30,6 +30,7 @@
 #include <caml/fail.h>
 #include <caml/callback.h>
 #include <caml/unixsupport.h>
+#include <caml/threads.h>
 
 #define Intf_val(a) ((struct mmap_interface *)Data_abstract_val(a))
 #define Wsize_bsize_round(n) (Wsize_bsize( (n) + sizeof(value) - 1 ))
@@ -91,8 +92,13 @@ stub_mmap_init (value fd, value pflag, value mflag, value len, value offset)
                 caml_invalid_argument ("negative offset");
         length = Int_val (len);
 
-        addr = mmap (NULL, length, c_pflag, c_mflag, Int_val (fd),
-                     Int_val (offset));
+        int c_fd = Int_val (fd);
+        int c_offset = Int_val (offset);
+
+        caml_release_runtime_system ();
+        addr = mmap (NULL, length, c_pflag, c_mflag, c_fd, c_offset);
+        caml_acquire_runtime_system ();
+
         if (MAP_FAILED == addr)
                 uerror ("mmap", Nothing);
 
@@ -104,9 +110,16 @@ CAMLprim value
 stub_mmap_final (value intf)
 {
         CAMLparam1 (intf);
+        void *addr = Intf_val (intf)->addr;
+
+        if (addr != MAP_FAILED)
+          {
+                  int len = Intf_val (intf)->len;
+                  caml_release_runtime_system ();
+                  munmap (addr, len);
+                  caml_acquire_runtime_system ();
+          }
 
-        if (Intf_val (intf)->addr != MAP_FAILED)
-                munmap (Intf_val (intf)->addr, Intf_val (intf)->len);
         Intf_val (intf)->addr = MAP_FAILED;
 
         CAMLreturn (Val_unit);

oxenstored/config.ml

@@ -65,7 +65,9 @@ let parse_line stream =
     try
       let line = trim_spaces (input_line stream) in
       if String.length line > 0 && line.[0] <> '#' then
-        match to_config line with
+        match
+          to_config line
+        with
         | None ->
             read_filter_line ()
         | Some x ->

oxenstored/connection.ml

@@ -433,10 +433,9 @@ let lookup_watch_perm path = function
     try
       Store.Path.apply root path @@ fun parent name ->
       Store.Node.get_perms parent
-      ::
-      ( try [Store.Node.get_perms (Store.Node.find parent name)]
-        with Not_found -> []
-      )
+      :: ( try [Store.Node.get_perms (Store.Node.find parent name)]
+           with Not_found -> []
+        )
     with Define.Invalid_path | Not_found -> []
   )
 
@@ -491,7 +490,9 @@ let fire_single_watch source (oldroot, root) depth watch =
     if watch.path.[0] = '@' then
       true
     else
-      match watch.depth with
+      match
+        watch.depth
+      with
       | None ->
           true
       | Some x when x >= depth - watch.path_depth ->
@@ -523,14 +524,14 @@ let fire_watch source roots watch path depth =
 (* Search for a valid unused transaction id. *)
 let rec valid_transaction_id con proposed_id =
   (*
-	 * Clip proposed_id to the range [1, 0x3ffffffe]
-	 *
-	 * The chosen id must not trucate when written into the uint32_t tx_id
-	 * field, and needs to fit within the positive range of a 31 bit ocaml
-	 * integer to function when compiled as 32bit.
-	 *
-	 * Oxenstored therefore supports only 1 billion open transactions.
-	 *)
+   * Clip proposed_id to the range [1, 0x3ffffffe]
+   *
+   * The chosen id must not trucate when written into the uint32_t tx_id
+   * field, and needs to fit within the positive range of a 31 bit ocaml
+   * integer to function when compiled as 32bit.
+   *
+   * Oxenstored therefore supports only 1 billion open transactions.
+   *)
   let id =
     if proposed_id <= 0 || proposed_id >= 0x3fffffff then 1 else proposed_id
   in

oxenstored/connections.ml

@@ -178,7 +178,9 @@ let add_watch cons con path token depth =
   ( if is_special_watch then
       (* No depth can be specified for @releaseDomain/domid watches.
          Only depth=1 can be specified for other special watches *)
-      match depth with
+        match
+          depth
+        with
       | Some _ when String.starts_with ~prefix:"@releaseDomain/" apath ->
           raise
             (Invalid_argument

oxenstored/domains.ml

@@ -24,7 +24,9 @@ let load_plug fname =
   let fail_with fmt = Printf.ksprintf failwith fmt in
   let fname = Dynlink.adapt_filename fname in
   if Sys.file_exists fname then
-    try Dynlink.loadfile fname with
+    try
+      Dynlink.loadfile fname
+    with
     | Dynlink.Error err as e ->
         error "ERROR loading plugin '%s': %s\n%!" fname
           (Dynlink.error_message err) ;

oxenstored/process.ml

@@ -232,7 +232,9 @@ module LiveUpdate = struct
   let should_run cons =
     let t = !state in
     if t.pending then (
-      match Connections.prevents_quit cons with
+      match
+        Connections.prevents_quit cons
+      with
       | [] ->
           true
       | _ when Unix.gettimeofday () < t.deadline ->
@@ -792,8 +794,9 @@ let do_introduce con t domains cons data =
     if Domains.exist domains domid then (
       let edom = Domains.find domains domid in
       if Domain.get_mfn edom = mfn && Connections.find_domain cons domid != con
-      then (* Use XS_INTRODUCE for recreating the xenbus event-channel. *)
+      then
         Domain.rebind_evtchn edom remote_port ;
+      (* Use XS_INTRODUCE for recreating the xenbus event-channel. *)
       edom
     ) else
       try

oxenstored/store.ml

@@ -152,7 +152,9 @@ module Path = struct
     else if s = "/" then
       []
     else
-      match String.split '/' s with
+      match
+        String.split '/' s
+      with
       | "" :: path when is_valid path ->
           path
       | _ ->
@@ -216,7 +218,9 @@ module Path = struct
     if path = [] then
       Some rnode
     else
-      try Some (lookup_get rnode path) with Define.Doesnt_exist -> None
+      try
+        Some (lookup_get rnode path)
+      with Define.Doesnt_exist -> None
 
   (* get the deepest existing node for this path, return the node and a flag on the existence of the full path *)
   let rec get_deepest_existing_node node = function

oxenstored/transaction.ml

@@ -83,15 +83,21 @@ let test_coalesce oldroot currentroot optpath =
 
 let can_coalesce oldroot currentroot path =
   if !do_coalesce then
-    try test_coalesce oldroot currentroot path with _ -> false
+    try
+      test_coalesce oldroot currentroot path
+    with _ -> false
   else
     false
 
 type ty =
   | No
-  | Full of (int * (* Transaction id *)
-                   Store.t * (* Original store *)
-                             Store.t)
+  | Full of
+      ( int
+      * (* Transaction id *)
+        Store.t
+      * (* Original store *)
+        Store.t
+      )
 (* A pointer to the canonical store: its root changes on each transaction-commit *)
 
 type t = {

oxenstored/trie.ml

@@ -68,8 +68,8 @@ let rec map f tree =
   tree
   |> StringMap.map aux
   |> StringMap.filter (fun _ n ->
-         n.Node.value <> None || not (StringMap.is_empty n.Node.children)
-     )
+      n.Node.value <> None || not (StringMap.is_empty n.Node.children)
+  )
 
 let rec fold f tree acc =
   let aux key node accu =

oxenstored/xenstored.ml

@@ -326,7 +326,8 @@ module DB = struct
     Event.dump evtchn chan ;
 
     (* dump connections related to domains: domid, mfn, eventchn port/ sockets, and watches *)
-    Connections.iter cons (fun con -> Connection.dump con chan) ;
+    Connections.iter cons (fun con -> Connection.dump con chan
+    ) ;
 
     (* dump the store *)
     Store.dump_fct store (fun path node ->
@@ -660,7 +661,9 @@ let main () =
     let elapsed = Unix.gettimeofday () -. now in
     debug "periodic_ops took %F seconds." elapsed ;
     ( if !quit then
-        match Connections.prevents_quit cons with
+        match
+          Connections.prevents_quit cons
+        with
         | [] ->
             ()
         | domains ->

xenbus/xb.ml

@@ -361,7 +361,9 @@ let open_mmap mmap notifyfct ~under_testing =
 
 let close con ~under_testing =
   if not under_testing then
-    match con.backend with
+    match
+      con.backend
+    with
     | Fd backend ->
         Unix.close backend.fd
     | Xenmmap backend ->

xsd_glue/domain_getinfo_plugin_v1/domain_getinfo_stubs_v1.c

@@ -44,7 +44,7 @@ static struct custom_operations xsd_glue_xenctrl_ops = {
 };
 
 CAMLnoreturn_start static void CAMLnoreturn_end
-xsd_glue_failwith (xc_interface * xch, const char *func, unsigned int line)
+xsd_glue_failwith (xc_interface *xch, const char *func, unsigned int line)
 {
         CAMLparam0 ();
         CAMLlocal1 (msg);
@@ -99,7 +99,7 @@ stub_xsd_glue_xc_interface_open (value unit)
 }
 
 static value
-xsd_glue_alloc_domaininfo (const xc_domaininfo_t * info)
+xsd_glue_alloc_domaininfo (const xc_domaininfo_t *info)
 {
         CAMLparam0 ();
         CAMLlocal1 (result);