CA-423204: use xen field meminfo.claimed to calculate available memory in node for new VM (#6867)

The available memory in the node that can actually be further claimed in
the node for a new VM needs to be calculated as
(meminfo.memfree - meminfo.claimed). Considering only meminfo.memfree
does not consider VMs that may have claimed in the node but not yet
finished allocating the claimed amount.

A new debug line during the calculation makes it easier to understand
the different node memory values being considered and calculated for the
VMs being created, eg:
```
2026-01-27T00:03:44.788754+00:00 orca xenopsd-xc: [debug||22 |Async.VM.start_on R:4533f11cb6bf|xenops]
mem_claimable_for_new_vm: NUMA nodeid=0, domid=69: memfree=281696272384 memsize=825707462656 claimed=249459507200: available=32236765184
2026-01-27T00:03:44.788770+00:00 orca xenopsd-xc: [debug||22 |Async.VM.start_on R:4533f11cb6bf|xenops]
mem_claimable_for_new_vm: NUMA nodeid=1, domid=69: memfree=336155111424 memsize=824633720832 claimed=303146598400: available=33008513024
...
```

Tested with:
* SR-233407 (xs9 numa functional regression test)
* job 4541679, where this change calculates the correct nodes to start
the VMs in a host with 8 nodes and high contention of VMs starting
simultaneously.

Author: edwintorok

ocaml/libs/xenctrl-ext/xenctrlext.ml

@@ -126,9 +126,18 @@ exception Not_available
 let domain_claim_pages handle domid ?(numa_node = NumaNode.none) nr_pages =
   stub_domain_claim_pages handle domid numa_node nr_pages
 
+module HostNuma = struct
+  (* Numa state of a host *)
+
+  type node_meminfo = {size: int64; free: int64; claimed: int64}
+
+  external numa_get_meminfo : handle -> node_meminfo array
+    = "stub_xenctrlext_numa_meminfo"
+end
+
 let get_nr_nodes handle =
-  let info = numainfo handle in
-  Array.length info.memory
+  let meminfo = HostNuma.numa_get_meminfo handle in
+  Array.length meminfo
 
 module DomainNuma = struct
   (* Numa state of a domain *)

ocaml/libs/xenctrl-ext/xenctrlext.mli

@@ -121,3 +121,9 @@ module DomainNuma : sig
 
   val state : handle -> domid:int -> t
 end
+
+module HostNuma : sig
+  type node_meminfo = {size: int64; free: int64; claimed: int64}
+
+  val numa_get_meminfo : handle -> node_meminfo array
+end

ocaml/libs/xenctrl-ext/xenctrlext_stubs.c

@@ -715,6 +715,104 @@ CAMLprim value stub_xc_domain_numa_get_node_pages_wrapper(value xch_val, value d
 #endif
 }
 
+/*
+ * Get NUMA memory info with claimed memory support
+ *
+ * Falls back to previous xc_numainfo with claimed=0
+ * if XEN_SYSCTL_numa_meminfo is not available at compile time or runtime
+ */
+CAMLprim value stub_xenctrlext_numa_meminfo(value xch_val)
+{
+	CAMLparam1(xch_val);
+	CAMLlocal2(result, info);
+	xc_interface *xch = xch_of_val(xch_val);
+	unsigned int max_nodes = 0;
+	unsigned int i;
+	int ret;
+
+#ifdef XEN_SYSCTL_numa_meminfo
+	xen_sysctl_node_meminfo_t *meminfo = NULL;
+
+	/* First call to get node count */
+	caml_release_runtime_system();
+	ret = xc_numa_meminfo(xch, &max_nodes, NULL);
+	caml_acquire_runtime_system();
+
+	if (ret == 0) {
+		/* New hypercall available, use it */
+		meminfo = calloc(max_nodes, sizeof(*meminfo));
+		if (!meminfo)
+			caml_raise_out_of_memory();
+
+		caml_release_runtime_system();
+		ret = xc_numa_meminfo(xch, &max_nodes, meminfo);
+		caml_acquire_runtime_system();
+
+		if (ret < 0) {
+			int err = errno;
+			free(meminfo);
+			errno = err;
+			failwith_xc(xch);
+		}
+
+		result = caml_alloc_tuple(max_nodes);
+		for (i = 0; i < max_nodes; i++) {
+			info = caml_alloc_tuple(3);
+			Store_field(info, 0, caml_copy_int64(meminfo[i].size));
+			Store_field(info, 1, caml_copy_int64(meminfo[i].free));
+			Store_field(info, 2, caml_copy_int64(meminfo[i].claimed));
+			Store_field(result, i, info);
+		}
+
+		free(meminfo);
+		CAMLreturn(result);
+	}
+
+	/* If we get ENOSYS or EOPNOTSUPP, fall back to old hypercall */
+	if (errno != ENOSYS && errno != EOPNOTSUPP)
+		failwith_xc(xch);
+#endif
+
+	/* Fallback: use xc_numainfo with claimed=0 */
+	{
+		xc_meminfo_t *old_meminfo = NULL;
+
+		caml_release_runtime_system();
+		ret = xc_numainfo(xch, &max_nodes, NULL, NULL);
+		caml_acquire_runtime_system();
+
+		if (ret < 0)
+			failwith_xc(xch);
+
+		old_meminfo = calloc(max_nodes, sizeof(*old_meminfo));
+		if (!old_meminfo)
+			caml_raise_out_of_memory();
+
+		caml_release_runtime_system();
+		ret = xc_numainfo(xch, &max_nodes, old_meminfo, NULL);
+		caml_acquire_runtime_system();
+
+		if (ret < 0) {
+			int err = errno;
+			free(old_meminfo);
+			errno = err;
+			failwith_xc(xch);
+		}
+
+		result = caml_alloc_tuple(max_nodes);
+		for (i = 0; i < max_nodes; i++) {
+			info = caml_alloc_tuple(3);
+			Store_field(info, 0, caml_copy_int64(old_meminfo[i].memsize));
+			Store_field(info, 1, caml_copy_int64(old_meminfo[i].memfree));
+			Store_field(info, 2, caml_copy_int64(0));  /* claimed=0 */
+			Store_field(result, i, info);
+		}
+
+		free(old_meminfo);
+		CAMLreturn(result);
+	}
+}
+
 
 /*
 * Local variables:

ocaml/xenopsd/xc/domain.ml

@@ -995,16 +995,26 @@ let numa_hierarchy =
 
 let numa_mutex = Mutex.create ()
 
+let node_mem_claimable_for_new_vm ~node ~domid m =
+  let open Xenctrlext.HostNuma in
+  let nodeid = Fmt.str "%a" Topology.NUMA.pp_dump_node node in
+  let available = Int64.sub m.free m.claimed in
+  D.debug
+    "mem_claimable_for_new_vm: NUMA nodeid=%s, domid=%d: memfree=%Ld \
+     memsize=%Ld claimed=%Ld: available=%Ld"
+    nodeid domid m.free m.size m.claimed available ;
+  available
+
 let numa_init () =
   let xcext = Xenctrlext.get_handle () in
   let host = Lazy.force numa_hierarchy in
-  let mem = (Xenctrlext.numainfo xcext).memory in
+  let mem = Xenctrlext.HostNuma.numa_get_meminfo xcext in
   D.debug "Host NUMA information: %s"
     (Fmt.to_to_string (Fmt.Dump.option Topology.NUMA.pp_dump) host) ;
   Array.iteri
     (fun i m ->
-      let open Xenctrlext in
-      D.debug "NUMA node %d: %Ld/%Ld memory free" i m.memfree m.memsize
+      let open Xenctrlext.HostNuma in
+      D.debug "NUMA node %d: %Ld/%Ld/%Ld memory free" i m.free m.size m.claimed
     )
     mem
 
@@ -1021,10 +1031,13 @@ let numa_placement domid ~vcpus ~cores ~memory affinity =
       let ( let* ) = Option.bind in
       let xcext = get_handle () in
       let* host = Lazy.force numa_hierarchy in
-      let numa_meminfo = (numainfo xcext).memory |> Array.to_seq in
+      let numa_meminfo = HostNuma.numa_get_meminfo xcext |> Array.to_seq in
       let nodes =
         Seq.map2
-          (fun node m -> NUMA.resource host node ~memory:m.memfree)
+          (fun node m ->
+            NUMA.resource host node
+              ~memory:(node_mem_claimable_for_new_vm ~node ~domid m)
+          )
           (NUMA.nodes host) numa_meminfo
       in
       let vm = NUMARequest.make ~memory ~vcpus ~cores in

ocaml/xenopsd/xc/numa.ml

@@ -49,17 +49,17 @@ let human_readable_bytes quantity =
   else
     loop [] quantity binary_prefixes |> String.concat ", "
 
-let get_memory () =
-  let {memory; _} = numainfo xc in
-  memory
+let get_memory () = HostNuma.numa_get_meminfo xc
 
 let print_mem c mem =
   for i = 0 to Array.length mem - 1 do
-    let {memfree; memsize} = mem.(i) in
-    let memfree = human_readable_bytes memfree in
-    let memsize = human_readable_bytes memsize in
+    let {HostNuma.size; free; claimed} = mem.(i) in
+    let memfree = human_readable_bytes free in
+    let memsize = human_readable_bytes size in
+    let memclaimed = human_readable_bytes claimed in
     Logs.app (fun m ->
-        m "\t%d: %s free out of %s" i memfree memsize ~tags:(stamp c)
+        m "\t%d: %s free / %s claimed out of %s" i memfree memclaimed memsize
+          ~tags:(stamp c)
     )
   done
 
@@ -72,7 +72,9 @@ let print_diff_mem before after =
 let diff c old cur =
   let changed_yet = ref false in
   for i = 0 to Int.min (Array.length old) (Array.length cur) - 1 do
-    let {memfree= a_free; _}, {memfree= b_free; _} = (old.(i), cur.(i)) in
+    let {HostNuma.free= a_free; _}, {HostNuma.free= b_free; _} =
+      (old.(i), cur.(i))
+    in
     if a_free <> b_free then (
       if not !changed_yet then changed_yet := true ;
       let free = human_readable_bytes b_free in