Add OCaml bindings for xc_domain_claim_memory(), for using the XEN_DOMCTL_claim_memory hypercall 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 = -1 to XEN_DOMCTL_CLAIM_MEMORY_NO_NODE. Signed-off-by: Bernhard Kaindl <[email protected]> --- tools/ocaml/libs/xc/xenctrl.ml | 11 ++++++++ tools/ocaml/libs/xc/xenctrl.mli | 11 ++++++++ tools/ocaml/libs/xc/xenctrl_stubs.c | 43 +++++++++++++++++++++++++++++ 3 files changed, 65 insertions(+) diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml index 97108b9d861a..a1a05dcaede3 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(): claim pages for a domain, + optionally per NUMA node (node = -1 means no specific node). *) + +type claim = + { + pages: int64; (* Number of pages to claim *) + node: int32; (* NUMA node ID, or -1 for no specific node *) + } +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..1781c89258fe 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(): claim pages for a domain, + optionally per NUMA node (node = -1 means no specific node). *) + +type claim = + { + pages: int64; (* Number of pages to claim *) + node: int32; (* NUMA node ID, or -1 for no specific node *) + } +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..a77d7dac58e8 100644 --- a/tools/ocaml/libs/xc/xenctrl_stubs.c +++ b/tools/ocaml/libs/xc/xenctrl_stubs.c @@ -1435,6 +1435,49 @@ 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; + int retval; + + if (nr_claims > XEN_DOMCTL_MAX_CLAIMS) + caml_invalid_argument("domain_claim_memory: too many claims"); + + 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 node = Int32_val(Field(claim_rec, 1)); + uint32_t c_node; + + if (pages < 0 || node < -1 ) { + free(claim); + caml_invalid_argument("domain_claim_memory: invalid pages or node"); + } + + if (node == -1) + c_node = XEN_DOMCTL_CLAIM_MEMORY_NO_NODE; + else + c_node = node; + + claim[i] = (memory_claim_t)XEN_NODE_CLAIM_INIT((uint64_t)pages, c_node); + } + + retval = xc_domain_claim_memory(xch, Int_val(domid), nr_claims, claim); + free(claim); + if (retval < 0) + failwith_xc(xch); + + CAMLreturn(Val_unit); +} + /* * Local variables: * indent-tabs-mode: t -- 2.39.5
