[PATCH v7 3/3] tools/ocaml: Add OCaml binding for NUMA claim sets

[Bernhard Kaindl <bernhard.kaindl@xxxxxxxxxx>]

Add an OCaml binding for xc_domain_claim_memory():

- tools/ocaml/libs/xc/xenctrl.ml/mli:
  Add claim record type and domain_claim_memory external.

- tools/ocaml/libs/xc/xenctrl_stubs.c:
  Marshal the OCaml claim array into a xen_memory_claim_t array.
  Map nodes of -1 to XEN_DOMCTL_CLAIM_MEMORY_HOST for host-wide claims.

Acked-by: Christian Lindig <christian.lindig@xxxxxxxxx>
Requested-by: Andrew Cooper <andrew.cooper3@xxxxxxxxxx>
Signed-off-by: Bernhard Kaindl <bernhard.kaindl@xxxxxxxxxx>
---
 tools/ocaml/libs/xc/xenctrl.ml      | 10 ++++++
 tools/ocaml/libs/xc/xenctrl.mli     | 10 ++++++
 tools/ocaml/libs/xc/xenctrl_stubs.c | 50 +++++++++++++++++++++++++++++
 3 files changed, 70 insertions(+)

diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml
index 97108b9d861a..8dd0c932e3ee 100644
--- a/tools/ocaml/libs/xc/xenctrl.ml
+++ b/tools/ocaml/libs/xc/xenctrl.ml
@@ -370,6 +370,16 @@ external domain_deassign_device: handle -> domid -> (int * 
int * int * int) -> u
 external domain_test_assign_device: handle -> domid -> (int * int * int * int) 
-> bool
   = "stub_xc_domain_test_assign_device"
 
+(* OCaml binding for xc_domain_claim_memory() to claim memory for a domain *)
+
+type claim =
+  {
+    pages: int64; (* Number of pages to claim *)
+    node: int32;  (* NUMA node ID, or -1 for host-wide claims *)
+  }
+external domain_claim_memory: handle -> domid -> claim array -> unit
+  = "stub_xc_domain_claim_memory"
+
 external version: handle -> version = "stub_xc_version_version"
 external version_compile_info: handle -> compile_info
   = "stub_xc_version_compile_info"
diff --git a/tools/ocaml/libs/xc/xenctrl.mli b/tools/ocaml/libs/xc/xenctrl.mli
index 9fccb2c2c287..e78ea0dfe6c4 100644
--- a/tools/ocaml/libs/xc/xenctrl.mli
+++ b/tools/ocaml/libs/xc/xenctrl.mli
@@ -297,6 +297,16 @@ external domain_deassign_device: handle -> domid -> (int * 
int * int * int) -> u
 external domain_test_assign_device: handle -> domid -> (int * int * int * int) 
-> bool
   = "stub_xc_domain_test_assign_device"
 
+(* OCaml binding for xc_domain_claim_memory() to claim memory for a domain *)
+
+type claim =
+  {
+    pages: int64; (* Number of pages to claim *)
+    node: int32;  (* NUMA node ID, or -1 for host-wide claims *)
+  }
+external domain_claim_memory: handle -> domid -> claim array -> unit
+  = "stub_xc_domain_claim_memory"
+
 external version : handle -> version = "stub_xc_version_version"
 external version_compile_info : handle -> compile_info
   = "stub_xc_version_compile_info"
diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c 
b/tools/ocaml/libs/xc/xenctrl_stubs.c
index c55f73b265b2..e91bebf5a4ed 100644
--- a/tools/ocaml/libs/xc/xenctrl_stubs.c
+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
@@ -1435,6 +1435,56 @@ CAMLprim value stub_xc_watchdog(value xch_val, value 
domid, value timeout)
        CAMLreturn(Val_int(ret));
 }
 
+/* OCaml binding for xc_domain_claim_memory() to claim memory for a domain */
+CAMLprim value stub_xc_domain_claim_memory(value xch_val, value domid,
+                                           value claim_set)
+{
+       CAMLparam3(xch_val, domid, claim_set);
+       xc_interface *xch = xch_of_val(xch_val);
+       mlsize_t nr_entries = Wosize_val(claim_set);
+       uint32_t c_domid = (uint32_t)Int_val(domid);
+       uint32_t c_nr_entries = (uint32_t)nr_entries;
+       xen_memory_claim_t *c_claim_set;
+
+       if (!nr_entries)
+               caml_invalid_argument("domain_claim_memory: claim_set cannot be 
empty");
+
+       c_claim_set = calloc(c_nr_entries, sizeof(*c_claim_set));
+       if (c_claim_set == NULL)
+               caml_raise_out_of_memory();
+
+       /* The entries of the claim_set are claim entries with {pages, node} */
+       for (mlsize_t i = 0; i < nr_entries; i++) {
+               value claim_entry = Field(claim_set, i);
+               int64_t pages = Int64_val(Field(claim_entry, 0));
+               int32_t node = Int32_val(Field(claim_entry, 1));
+
+               if (pages < 0 || node < -1) {
+                       free(c_claim_set);
+                       caml_invalid_argument("domain_claim_memory: invalid 
pages or node");
+               }
+               c_claim_set[i] = (xen_memory_claim_t) {
+                       .pages = (uint64_t)pages,
+                       .target = (node == -1)
+                               ? XEN_DOMCTL_CLAIM_MEMORY_HOST
+                               : (uint32_t)node
+               };
+       }
+
+       /* May have to wait for the domctl lock, release the OCaml runtime 
lock. */
+       caml_enter_blocking_section();
+       int retval = xc_domain_claim_memory(xch, c_domid,
+                                           XEN_DOMCTL_CLAIM_MEMORY_SET,
+                                           &c_nr_entries, c_claim_set);
+       caml_leave_blocking_section();
+
+       free(c_claim_set);
+       if (retval < 0)
+               failwith_xc(xch);
+
+       CAMLreturn(Val_unit);
+}
+
 /*
  * Local variables:
  *  indent-tabs-mode: t
-- 
2.39.5