[PATCH v6 6/7] tools/ocaml/libs/xc: Add an OCaml binding for NUMA-aware claims

[Bernhard Kaindl <bernhard.kaindl@xxxxxxxxxx>]

Add an OCaml binding for xc_domain_claim_memory() so the
XEN_DOMCTL_claim_memory hypercall can be used from OCaml.

This allows OCaml toolstacks to place NUMA-aware memory
claims for domains as well as host-wide claims.

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

tools/ocaml/libs/xc/xenctrl_stubs.c:
- Validate claim count and arguments.
- Marshal the OCaml claim array to memory_claim_t[].
- Map node/target of -1 to XEN_DOMCTL_CLAIM_MEMORY_GLOBAL.

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      | 11 +++++++
 tools/ocaml/libs/xc/xenctrl.mli     | 11 +++++++
 tools/ocaml/libs/xc/xenctrl_stubs.c | 47 +++++++++++++++++++++++++++++
 3 files changed, 69 insertions(+)

diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml
index 97108b9d861a..680cd8ec5449 100644
--- a/tools/ocaml/libs/xc/xenctrl.ml
+++ b/tools/ocaml/libs/xc/xenctrl.ml
@@ -370,6 +370,17 @@ 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(): Install claim sets for a domain,
+   target is either a NUMA node or -1 for no node - memory from any node). *)
+
+type claim =
+  {
+    pages: int64;   (* Number of pages to claim *)
+    target: int32;  (* Target: NUMA node ID, or -1 for a flexible claim *)
+  }
+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..8a7c53a09d97 100644
--- a/tools/ocaml/libs/xc/xenctrl.mli
+++ b/tools/ocaml/libs/xc/xenctrl.mli
@@ -297,6 +297,17 @@ 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(): Install claim sets for a domain,
+   target is either a NUMA node or -1 for no node - memory from any node). *)
+
+type claim =
+  {
+    pages: int64;   (* Number of pages to claim *)
+    target: int32;  (* Target: NUMA node ID, or -1 for a flexible claim *)
+  }
+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..90464f718df0 100644
--- a/tools/ocaml/libs/xc/xenctrl_stubs.c
+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
@@ -1435,6 +1435,53 @@ CAMLprim value stub_xc_watchdog(value xch_val, value 
domid, value timeout)
        CAMLreturn(Val_int(ret));
 }
 
+CAMLprim value stub_xc_domain_claim_memory(value xch_val, value domid,
+                                           value claims)
+{
+       CAMLparam3(xch_val, domid, claims);
+       xc_interface *xch = xch_of_val(xch_val);
+       mlsize_t nr_claims = Wosize_val(claims);
+       memory_claim_t *claim;
+       uint32_t c_domid = (uint32_t)Int_val(domid);
+       int retval;
+
+       claim = calloc(nr_claims, sizeof(*claim));
+       if (claim == NULL && nr_claims != 0)
+               caml_raise_out_of_memory();
+
+       for (mlsize_t i = 0; i < nr_claims; i++) {
+               value claim_rec = Field(claims, i);
+               int64_t pages = Int64_val(Field(claim_rec, 0));
+               int32_t target = Int32_val(Field(claim_rec, 1));
+               uint32_t c_target;
+
+               if (pages < 0 || target < -1 ) {
+                       free(claim);
+                       caml_invalid_argument("domain_claim_memory: invalid 
pages or node");
+               }
+
+               if (target == -1)
+                       c_target = XEN_DOMCTL_CLAIM_MEMORY_GLOBAL;
+               else
+                       c_target = (uint32_t)target;
+
+               claim[i] = (memory_claim_t) {
+                       .pages = (uint64_t)pages, .target = c_target
+               };
+       }
+
+       /* May have to wait for the domctl lock, release the OCaml runtime 
lock. */
+       caml_enter_blocking_section();
+       retval = xc_domain_claim_memory(xch, c_domid, nr_claims, claim);
+       caml_leave_blocking_section();
+
+       free(claim);
+       if (retval < 0)
+               failwith_xc(xch);
+
+       CAMLreturn(Val_unit);
+}
+
 /*
  * Local variables:
  *  indent-tabs-mode: t
-- 
2.39.5