| Message ID | c43ff9e8a95a73dadcd5db6ad10340a45592dd01.1669978356.git.edvin.torok@citrix.com (mailing list archive) |
|---|---|
| State | New, archived |
| Headers | show |
| Series | OCaml bindings for hvm_param_get and xc_evtchn_status | expand |
On 02/12/2022 10:55, Edwin Török wrote: > diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c b/tools/ocaml/libs/xc/xenctrl_stubs.c > index d30585f21c..a492ea17fd 100644 > --- a/tools/ocaml/libs/xc/xenctrl_stubs.c > +++ b/tools/ocaml/libs/xc/xenctrl_stubs.c > @@ -641,6 +645,69 @@ CAMLprim value stub_xc_evtchn_reset(value xch, value domid) > CAMLreturn(Val_unit); > } > > +CAMLprim value stub_xc_evtchn_status(value xch, value domid, value port) > +{ > + CAMLparam3(xch, domid, port); > + CAMLlocal4(result, result_status, stat, interdomain); > + xc_evtchn_status_t status = { > + .dom = _D(domid), > + .port = Int_val(port), > + }; > + int rc; > + > + caml_enter_blocking_section(); > + rc = xc_evtchn_status(_H(xch), &status); > + caml_leave_blocking_section(); > + > + if ( rc < 0 ) > + failwith_xc(_H(xch)); > + > + if ( status.status == EVTCHNSTAT_closed ) > + CAMLreturn(Val_none); > + > + switch ( status.status ) > + { The EVTCHNSTAT_closed wants to be a case here, otherwise it's really weird to read from a C point of view. It would be fine to have a comment like this: case EVTCHNSTAT_closed: CAMLreturn(Val_none); /* Early exit, no allocations needed. */ to help identify more clearly that this a bit of a special case. > + case EVTCHNSTAT_unbound: > + stat = caml_alloc(1, 0); /* 1st non-constant constructor */ > + Store_field(stat, 0, Val_int(status.u.unbound.dom)); > + break; > + > + case EVTCHNSTAT_interdomain: > + interdomain = caml_alloc_tuple(2); > + Store_field(interdomain, 0, Val_int(status.u.interdomain.dom)); > + Store_field(interdomain, 1, Val_int(status.u.interdomain.port)); > + stat = caml_alloc(1, 1); /* 2nd non-constant constructor */ > + Store_field(stat, 0, interdomain); > + break; Newline here. > + case EVTCHNSTAT_pirq: > + stat = caml_alloc(1, 2); /* 3rd non-constant constructor */ > + Store_field(stat, 0, Val_int(status.u.pirq)); > + break; > + > + case EVTCHNSTAT_virq: > + stat = caml_alloc(1, 3); /* 4th non-constant constructor */ > + Store_field(stat, 0, Val_int(status.u.virq)); > + break; > + > + case EVTCHNSTAT_ipi: > + stat = Val_int(0); /* 1st constant constructor */ > + break; > + > + default: > + caml_failwith("Unknown evtchn status"); > + > + } > + result_status = caml_alloc_tuple(2); > + Store_field(result_status, 0, Val_int(status.vcpu)); > + Store_field(result_status, 1, stat); > + > + /* caml_alloc_some is missing in older versions of OCaml > + */ I'd just drop this comment. It's going to be many many years before Ocaml 4.12 drops off the bottom of the support list, so this observation is unactionable. All 3 of these are trivial to fix on commit, so Reviewed-by: Andrew Cooper <andrew.cooper3@citrix.com> otherwise. ~Andrew
> On 2 Dec 2022, at 10:55, Edwin Török <edvin.torok@citrix.com> wrote: > > There is no API or ioctl to query event channel status, it is only > present in xenctrl.h > > The C union is mapped to an OCaml variant exposing just the value from the > correct union tag. > > The information provided here is similar to 'lsevtchn', but rather than > parsing its output it queries the underlying API directly. > > Signed-off-by: Edwin Török <edvin.torok@citrix.com> Acked-by: Christian Lindig <christian.lindig@citrix.com> > --- > Changes since v1: > * drop paragraph about where this is used > * add comment about max port > * use Xeneventchn.virq_t instead of int, add a dependency: xc -> eventchn > * initialize struct without memset-ing first > * use 2 CAMLreturn, I found an example in the OCaml stdlib that does that so should be future-proof https://nam04.safelinks.protection.outlook.com/?url=https%3A%2F%2Fgithub.com%2Focaml%2Focaml%2Fblob%2F663e8d219f566095e3a9497c5bae07b6a95cae39%2Fotherlibs%2Funix%2Fdup_win32.c%23L52-L77&data=05%7C01%7Cchristian.lindig%40citrix.com%7C7d476fd71ea14746b08f08dad453d946%7C335836de42ef43a2b145348c2ee9ca5b%7C0%7C0%7C638055753844059822%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000%7C%7C%7C&sdata=c97tdCv0VPS7UBPoLJXf3geZKQq0AkhjWuA1wq2ZUW0%3D&reserved=0 > * use Tag_some, defining it if needed > * fix typo on failwith > --- > tools/ocaml/libs/Makefile | 2 +- > tools/ocaml/libs/xc/META.in | 2 +- > tools/ocaml/libs/xc/Makefile | 2 +- > tools/ocaml/libs/xc/xenctrl.ml | 15 +++++++ > tools/ocaml/libs/xc/xenctrl.mli | 15 +++++++ > tools/ocaml/libs/xc/xenctrl_stubs.c | 67 +++++++++++++++++++++++++++++ > 6 files changed, 100 insertions(+), 3 deletions(-) > > diff --git a/tools/ocaml/libs/Makefile b/tools/ocaml/libs/Makefile > index 7e7c27e2d5..15f45a6d66 100644 > --- a/tools/ocaml/libs/Makefile > +++ b/tools/ocaml/libs/Makefile > @@ -4,7 +4,7 @@ include $(XEN_ROOT)/tools/Rules.mk > SUBDIRS= \ > mmap \ > xentoollog \ > - xc eventchn \ > + eventchn xc\ > xb xs xl > > .PHONY: all > diff --git a/tools/ocaml/libs/xc/META.in b/tools/ocaml/libs/xc/META.in > index 2ff4dcb6bf..6a273936a3 100644 > --- a/tools/ocaml/libs/xc/META.in > +++ b/tools/ocaml/libs/xc/META.in > @@ -1,5 +1,5 @@ > version = "@VERSION@" > description = "Xen Control Interface" > -requires = "unix,xenmmap" > +requires = "unix,xenmmap,xeneventchn" > archive(byte) = "xenctrl.cma" > archive(native) = "xenctrl.cmxa" > diff --git a/tools/ocaml/libs/xc/Makefile b/tools/ocaml/libs/xc/Makefile > index 3b76e9ad7b..1d9fecb06e 100644 > --- a/tools/ocaml/libs/xc/Makefile > +++ b/tools/ocaml/libs/xc/Makefile > @@ -4,7 +4,7 @@ include $(OCAML_TOPLEVEL)/common.make > > CFLAGS += -I../mmap $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest) > CFLAGS += $(APPEND_CFLAGS) > -OCAMLINCLUDE += -I ../mmap > +OCAMLINCLUDE += -I ../mmap -I ../eventchn > > OBJS = xenctrl > INTF = xenctrl.cmi > diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml > index 2ed7454b16..5dac47991e 100644 > --- a/tools/ocaml/libs/xc/xenctrl.ml > +++ b/tools/ocaml/libs/xc/xenctrl.ml > @@ -267,6 +267,21 @@ external evtchn_alloc_unbound: handle -> domid -> domid -> int > = "stub_xc_evtchn_alloc_unbound" > external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset" > > +(* FIFO has theoretical maximum of 2^28 ports, fits in an int *) > +type evtchn_interdomain = { dom: domid; port: int} > + > +type evtchn_stat = > + | EVTCHNSTAT_unbound of domid > + | EVTCHNSTAT_interdomain of evtchn_interdomain > + | EVTCHNSTAT_pirq of int > + | EVTCHNSTAT_virq of Xeneventchn.virq_t > + | EVTCHNSTAT_ipi > + > +type evtchn_status = { vcpu: int; status: evtchn_stat } > + > +external evtchn_status: handle -> domid -> int -> evtchn_status option = > + "stub_xc_evtchn_status" > + > external readconsolering: handle -> string = "stub_xc_readconsolering" > > external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys" > diff --git a/tools/ocaml/libs/xc/xenctrl.mli b/tools/ocaml/libs/xc/xenctrl.mli > index 0f80aafea0..6c9206bc74 100644 > --- a/tools/ocaml/libs/xc/xenctrl.mli > +++ b/tools/ocaml/libs/xc/xenctrl.mli > @@ -206,6 +206,21 @@ external shadow_allocation_get : handle -> domid -> int > external evtchn_alloc_unbound : handle -> domid -> domid -> int > = "stub_xc_evtchn_alloc_unbound" > external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset" > + > +type evtchn_interdomain = { dom: domid; port: int} > + > +type evtchn_stat = > + | EVTCHNSTAT_unbound of domid > + | EVTCHNSTAT_interdomain of evtchn_interdomain > + | EVTCHNSTAT_pirq of int > + | EVTCHNSTAT_virq of Xeneventchn.virq_t > + | EVTCHNSTAT_ipi > + > +type evtchn_status = { vcpu: int; status: evtchn_stat } > + > +external evtchn_status: handle -> domid -> int -> evtchn_status option = > + "stub_xc_evtchn_status" > + > external readconsolering : handle -> string = "stub_xc_readconsolering" > external send_debug_keys : handle -> string -> unit = "stub_xc_send_debug_keys" > external physinfo : handle -> physinfo = "stub_xc_physinfo" > diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c b/tools/ocaml/libs/xc/xenctrl_stubs.c > index d30585f21c..a492ea17fd 100644 > --- a/tools/ocaml/libs/xc/xenctrl_stubs.c > +++ b/tools/ocaml/libs/xc/xenctrl_stubs.c > @@ -44,6 +44,10 @@ > #define Val_none (Val_int(0)) > #endif > > +#ifndef Tag_some > +#define Tag_some 0 > +#endif > + > #define string_of_option_array(array, index) \ > ((Field(array, index) == Val_none) ? NULL : String_val(Field(Field(array, index), 0))) > > @@ -641,6 +645,69 @@ CAMLprim value stub_xc_evtchn_reset(value xch, value domid) > CAMLreturn(Val_unit); > } > > +CAMLprim value stub_xc_evtchn_status(value xch, value domid, value port) > +{ > + CAMLparam3(xch, domid, port); > + CAMLlocal4(result, result_status, stat, interdomain); > + xc_evtchn_status_t status = { > + .dom = _D(domid), > + .port = Int_val(port), > + }; > + int rc; > + > + caml_enter_blocking_section(); > + rc = xc_evtchn_status(_H(xch), &status); > + caml_leave_blocking_section(); > + > + if ( rc < 0 ) > + failwith_xc(_H(xch)); > + > + if ( status.status == EVTCHNSTAT_closed ) > + CAMLreturn(Val_none); Could this case be handled in the switch, too? > + > + switch ( status.status ) > + { > + case EVTCHNSTAT_unbound: > + stat = caml_alloc(1, 0); /* 1st non-constant constructor */ > + Store_field(stat, 0, Val_int(status.u.unbound.dom)); > + break; > + > + case EVTCHNSTAT_interdomain: > + interdomain = caml_alloc_tuple(2); > + Store_field(interdomain, 0, Val_int(status.u.interdomain.dom)); > + Store_field(interdomain, 1, Val_int(status.u.interdomain.port)); > + stat = caml_alloc(1, 1); /* 2nd non-constant constructor */ > + Store_field(stat, 0, interdomain); > + break; > + case EVTCHNSTAT_pirq: > + stat = caml_alloc(1, 2); /* 3rd non-constant constructor */ > + Store_field(stat, 0, Val_int(status.u.pirq)); > + break; > + > + case EVTCHNSTAT_virq: > + stat = caml_alloc(1, 3); /* 4th non-constant constructor */ > + Store_field(stat, 0, Val_int(status.u.virq)); > + break; > + > + case EVTCHNSTAT_ipi: > + stat = Val_int(0); /* 1st constant constructor */ > + break; > + > + default: > + caml_failwith("Unknown evtchn status"); > + > + } > + result_status = caml_alloc_tuple(2); > + Store_field(result_status, 0, Val_int(status.vcpu)); > + Store_field(result_status, 1, stat); > + > + /* caml_alloc_some is missing in older versions of OCaml > + */ > + result = caml_alloc_small(1, Tag_some); > + Store_field(result, 0, result_status); > + > + CAMLreturn(result); > +} > > CAMLprim value stub_xc_readconsolering(value xch) > { > -- > 2.34.1 >
diff --git a/tools/ocaml/libs/Makefile b/tools/ocaml/libs/Makefile index 7e7c27e2d5..15f45a6d66 100644 --- a/tools/ocaml/libs/Makefile +++ b/tools/ocaml/libs/Makefile @@ -4,7 +4,7 @@ include $(XEN_ROOT)/tools/Rules.mk SUBDIRS= \ mmap \ xentoollog \ - xc eventchn \ + eventchn xc\ xb xs xl .PHONY: all diff --git a/tools/ocaml/libs/xc/META.in b/tools/ocaml/libs/xc/META.in index 2ff4dcb6bf..6a273936a3 100644 --- a/tools/ocaml/libs/xc/META.in +++ b/tools/ocaml/libs/xc/META.in @@ -1,5 +1,5 @@ version = "@VERSION@" description = "Xen Control Interface" -requires = "unix,xenmmap" +requires = "unix,xenmmap,xeneventchn" archive(byte) = "xenctrl.cma" archive(native) = "xenctrl.cmxa" diff --git a/tools/ocaml/libs/xc/Makefile b/tools/ocaml/libs/xc/Makefile index 3b76e9ad7b..1d9fecb06e 100644 --- a/tools/ocaml/libs/xc/Makefile +++ b/tools/ocaml/libs/xc/Makefile @@ -4,7 +4,7 @@ include $(OCAML_TOPLEVEL)/common.make CFLAGS += -I../mmap $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest) CFLAGS += $(APPEND_CFLAGS) -OCAMLINCLUDE += -I ../mmap +OCAMLINCLUDE += -I ../mmap -I ../eventchn OBJS = xenctrl INTF = xenctrl.cmi diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml index 2ed7454b16..5dac47991e 100644 --- a/tools/ocaml/libs/xc/xenctrl.ml +++ b/tools/ocaml/libs/xc/xenctrl.ml @@ -267,6 +267,21 @@ external evtchn_alloc_unbound: handle -> domid -> domid -> int = "stub_xc_evtchn_alloc_unbound" external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset" +(* FIFO has theoretical maximum of 2^28 ports, fits in an int *) +type evtchn_interdomain = { dom: domid; port: int} + +type evtchn_stat = + | EVTCHNSTAT_unbound of domid + | EVTCHNSTAT_interdomain of evtchn_interdomain + | EVTCHNSTAT_pirq of int + | EVTCHNSTAT_virq of Xeneventchn.virq_t + | EVTCHNSTAT_ipi + +type evtchn_status = { vcpu: int; status: evtchn_stat } + +external evtchn_status: handle -> domid -> int -> evtchn_status option = + "stub_xc_evtchn_status" + external readconsolering: handle -> string = "stub_xc_readconsolering" external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys" diff --git a/tools/ocaml/libs/xc/xenctrl.mli b/tools/ocaml/libs/xc/xenctrl.mli index 0f80aafea0..6c9206bc74 100644 --- a/tools/ocaml/libs/xc/xenctrl.mli +++ b/tools/ocaml/libs/xc/xenctrl.mli @@ -206,6 +206,21 @@ external shadow_allocation_get : handle -> domid -> int external evtchn_alloc_unbound : handle -> domid -> domid -> int = "stub_xc_evtchn_alloc_unbound" external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset" + +type evtchn_interdomain = { dom: domid; port: int} + +type evtchn_stat = + | EVTCHNSTAT_unbound of domid + | EVTCHNSTAT_interdomain of evtchn_interdomain + | EVTCHNSTAT_pirq of int + | EVTCHNSTAT_virq of Xeneventchn.virq_t + | EVTCHNSTAT_ipi + +type evtchn_status = { vcpu: int; status: evtchn_stat } + +external evtchn_status: handle -> domid -> int -> evtchn_status option = + "stub_xc_evtchn_status" + external readconsolering : handle -> string = "stub_xc_readconsolering" external send_debug_keys : handle -> string -> unit = "stub_xc_send_debug_keys" external physinfo : handle -> physinfo = "stub_xc_physinfo" diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c b/tools/ocaml/libs/xc/xenctrl_stubs.c index d30585f21c..a492ea17fd 100644 --- a/tools/ocaml/libs/xc/xenctrl_stubs.c +++ b/tools/ocaml/libs/xc/xenctrl_stubs.c @@ -44,6 +44,10 @@ #define Val_none (Val_int(0)) #endif +#ifndef Tag_some +#define Tag_some 0 +#endif + #define string_of_option_array(array, index) \ ((Field(array, index) == Val_none) ? NULL : String_val(Field(Field(array, index), 0))) @@ -641,6 +645,69 @@ CAMLprim value stub_xc_evtchn_reset(value xch, value domid) CAMLreturn(Val_unit); } +CAMLprim value stub_xc_evtchn_status(value xch, value domid, value port) +{ + CAMLparam3(xch, domid, port); + CAMLlocal4(result, result_status, stat, interdomain); + xc_evtchn_status_t status = { + .dom = _D(domid), + .port = Int_val(port), + }; + int rc; + + caml_enter_blocking_section(); + rc = xc_evtchn_status(_H(xch), &status); + caml_leave_blocking_section(); + + if ( rc < 0 ) + failwith_xc(_H(xch)); + + if ( status.status == EVTCHNSTAT_closed ) + CAMLreturn(Val_none); + + switch ( status.status ) + { + case EVTCHNSTAT_unbound: + stat = caml_alloc(1, 0); /* 1st non-constant constructor */ + Store_field(stat, 0, Val_int(status.u.unbound.dom)); + break; + + case EVTCHNSTAT_interdomain: + interdomain = caml_alloc_tuple(2); + Store_field(interdomain, 0, Val_int(status.u.interdomain.dom)); + Store_field(interdomain, 1, Val_int(status.u.interdomain.port)); + stat = caml_alloc(1, 1); /* 2nd non-constant constructor */ + Store_field(stat, 0, interdomain); + break; + case EVTCHNSTAT_pirq: + stat = caml_alloc(1, 2); /* 3rd non-constant constructor */ + Store_field(stat, 0, Val_int(status.u.pirq)); + break; + + case EVTCHNSTAT_virq: + stat = caml_alloc(1, 3); /* 4th non-constant constructor */ + Store_field(stat, 0, Val_int(status.u.virq)); + break; + + case EVTCHNSTAT_ipi: + stat = Val_int(0); /* 1st constant constructor */ + break; + + default: + caml_failwith("Unknown evtchn status"); + + } + result_status = caml_alloc_tuple(2); + Store_field(result_status, 0, Val_int(status.vcpu)); + Store_field(result_status, 1, stat); + + /* caml_alloc_some is missing in older versions of OCaml + */ + result = caml_alloc_small(1, Tag_some); + Store_field(result, 0, result_status); + + CAMLreturn(result); +} CAMLprim value stub_xc_readconsolering(value xch) {
There is no API or ioctl to query event channel status, it is only present in xenctrl.h The C union is mapped to an OCaml variant exposing just the value from the correct union tag. The information provided here is similar to 'lsevtchn', but rather than parsing its output it queries the underlying API directly. Signed-off-by: Edwin Török <edvin.torok@citrix.com> --- Changes since v1: * drop paragraph about where this is used * add comment about max port * use Xeneventchn.virq_t instead of int, add a dependency: xc -> eventchn * initialize struct without memset-ing first * use 2 CAMLreturn, I found an example in the OCaml stdlib that does that so should be future-proof https://github.com/ocaml/ocaml/blob/663e8d219f566095e3a9497c5bae07b6a95cae39/otherlibs/unix/dup_win32.c#L52-L77 * use Tag_some, defining it if needed * fix typo on failwith --- tools/ocaml/libs/Makefile | 2 +- tools/ocaml/libs/xc/META.in | 2 +- tools/ocaml/libs/xc/Makefile | 2 +- tools/ocaml/libs/xc/xenctrl.ml | 15 +++++++ tools/ocaml/libs/xc/xenctrl.mli | 15 +++++++ tools/ocaml/libs/xc/xenctrl_stubs.c | 67 +++++++++++++++++++++++++++++ 6 files changed, 100 insertions(+), 3 deletions(-)