From mboxrd@z Thu Jan 1 00:00:00 1970 From: David Scott Subject: Re: [PATCH v6 06/11] libxl: ocaml: add VM lifecycle operations Date: Tue, 10 Dec 2013 16:13:21 +0000 Message-ID: <52A73DA1.2090606@eu.citrix.com> References: <1386602250-29866-1-git-send-email-rob.hoes@citrix.com> <1386602250-29866-7-git-send-email-rob.hoes@citrix.com> Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii"; Format="flowed" Content-Transfer-Encoding: 7bit Return-path: In-Reply-To: <1386602250-29866-7-git-send-email-rob.hoes@citrix.com> List-Unsubscribe: , List-Post: List-Help: List-Subscribe: , Sender: xen-devel-bounces@lists.xen.org Errors-To: xen-devel-bounces@lists.xen.org To: Rob Hoes , xen-devel@lists.xen.org Cc: ian.jackson@eu.citrix.com, ian.campbell@citrix.com List-Id: xen-devel@lists.xenproject.org Also fine by me Acked-by: David Scott On 09/12/13 15:17, Rob Hoes wrote: > Also, reorganise toplevel OCaml functions into modules of Xenlight. > > Signed-off-by: Rob Hoes > CC: David Scott > CC: Ian Campbell > > --- > v6: Updated aohow_val to register for_callback with the OCaml GC. > --- > tools/ocaml/libs/xl/xenlight.ml.in | 21 ++++- > tools/ocaml/libs/xl/xenlight.mli.in | 21 ++++- > tools/ocaml/libs/xl/xenlight_stubs.c | 167 ++++++++++++++++++++++++++++++++-- > tools/ocaml/test/send_debug_keys.ml | 2 +- > 4 files changed, 194 insertions(+), 17 deletions(-) > > diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in > index 46106b5..fc05112 100644 > --- a/tools/ocaml/libs/xl/xenlight.ml.in > +++ b/tools/ocaml/libs/xl/xenlight.ml.in > @@ -33,9 +33,24 @@ type event = > | POLLHUP (* Device has been disconnected (revents only) *) > | POLLNVAL (* Invalid request: fd not open (revents only). *) > > -external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" > -external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" > -external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" > +module Domain = struct > + external create_new : ctx -> Domain_config.t -> ?async:'a -> unit -> domid = "stub_libxl_domain_create_new" > + external create_restore : ctx -> Domain_config.t -> (Unix.file_descr * Domain_restore_params.t) -> > + ?async:'a -> unit -> domid = "stub_libxl_domain_create_restore" > + external shutdown : ctx -> domid -> unit = "stub_libxl_domain_shutdown" > + external reboot : ctx -> domid -> unit = "stub_libxl_domain_reboot" > + external destroy : ctx -> domid -> ?async:'a -> unit -> unit = "stub_libxl_domain_destroy" > + external suspend : ctx -> domid -> Unix.file_descr -> ?async:'a -> unit -> unit = "stub_libxl_domain_suspend" > + external pause : ctx -> domid -> unit = "stub_libxl_domain_pause" > + external unpause : ctx -> domid -> unit = "stub_libxl_domain_unpause" > + > + external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" > + external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" > +end > + > +module Host = struct > + external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" > +end > > module Async = struct > type for_libxl > diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in > index 170e0e0..ee4efd8 100644 > --- a/tools/ocaml/libs/xl/xenlight.mli.in > +++ b/tools/ocaml/libs/xl/xenlight.mli.in > @@ -35,9 +35,24 @@ type event = > | POLLHUP (* Device has been disconnected (revents only) *) > | POLLNVAL (* Invalid request: fd not open (revents only). *) > > -external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" > -external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" > -external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" > +module Domain : sig > + external create_new : ctx -> Domain_config.t -> ?async:'a -> unit -> domid = "stub_libxl_domain_create_new" > + external create_restore : ctx -> Domain_config.t -> (Unix.file_descr * Domain_restore_params.t) -> > + ?async:'a -> unit -> domid = "stub_libxl_domain_create_restore" > + external shutdown : ctx -> domid -> unit = "stub_libxl_domain_shutdown" > + external reboot : ctx -> domid -> unit = "stub_libxl_domain_reboot" > + external destroy : ctx -> domid -> ?async:'a -> unit -> unit = "stub_libxl_domain_destroy" > + external suspend : ctx -> domid -> Unix.file_descr -> ?async:'a -> unit -> unit = "stub_libxl_domain_suspend" > + external pause : ctx -> domid -> unit = "stub_libxl_domain_pause" > + external unpause : ctx -> domid -> unit = "stub_libxl_domain_unpause" > + > + external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" > + external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" > +end > + > +module Host : sig > + external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" > +end > > module Async : sig > type for_libxl > diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c > index 2195632..b03fd93 100644 > --- a/tools/ocaml/libs/xl/xenlight_stubs.c > +++ b/tools/ocaml/libs/xl/xenlight_stubs.c > @@ -397,6 +397,162 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback) > free(p); > } > > +static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how *ao_how) > +{ > + CAMLparam1(async); > + value *p; > + > + if (async != Val_none) { > + p = malloc(sizeof(value)); > + if (!p) > + failwith_xl(ERROR_NOMEM, "cannot allocate value"); > + *p = Some_val(async); > + caml_register_global_root(p); > + ao_how->callback = async_callback; > + ao_how->u.for_callback = (void *) p; > + CAMLreturnT(libxl_asyncop_how *, ao_how); > + } > + else > + CAMLreturnT(libxl_asyncop_how *, NULL); > +} > + > +value stub_libxl_domain_create_new(value ctx, value domain_config, value async, value unit) > +{ > + CAMLparam4(ctx, async, domain_config, unit); > + int ret; > + libxl_domain_config c_dconfig; > + uint32_t c_domid; > + libxl_asyncop_how ao_how; > + > + libxl_domain_config_init(&c_dconfig); > + ret = domain_config_val(CTX, &c_dconfig, domain_config); > + if (ret != 0) { > + libxl_domain_config_dispose(&c_dconfig); > + failwith_xl(ret, "domain_create_new"); > + } > + > + ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid, > + aohow_val(async, &ao_how), NULL); > + > + libxl_domain_config_dispose(&c_dconfig); > + > + if (ret != 0) > + failwith_xl(ret, "domain_create_new"); > + > + CAMLreturn(Val_int(c_domid)); > +} > + > +value stub_libxl_domain_create_restore(value ctx, value domain_config, value params, > + value async, value unit) > +{ > + CAMLparam5(ctx, domain_config, params, async, unit); > + int ret; > + libxl_domain_config c_dconfig; > + libxl_domain_restore_params c_params; > + uint32_t c_domid; > + libxl_asyncop_how ao_how; > + > + libxl_domain_config_init(&c_dconfig); > + ret = domain_config_val(CTX, &c_dconfig, domain_config); > + if (ret != 0) { > + libxl_domain_config_dispose(&c_dconfig); > + failwith_xl(ret, "domain_create_restore"); > + } > + > + libxl_domain_restore_params_init(&c_params); > + ret = domain_restore_params_val(CTX, &c_params, Field(params, 1)); > + if (ret != 0) { > + libxl_domain_restore_params_dispose(&c_params); > + failwith_xl(ret, "domain_create_restore"); > + } > + > + ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, Int_val(Field(params, 0)), > + &c_params, aohow_val(async, &ao_how), NULL); > + > + libxl_domain_config_dispose(&c_dconfig); > + libxl_domain_restore_params_dispose(&c_params); > + > + if (ret != 0) > + failwith_xl(ret, "domain_create_restore"); > + > + CAMLreturn(Val_int(c_domid)); > +} > + > +value stub_libxl_domain_shutdown(value ctx, value domid) > +{ > + CAMLparam2(ctx, domid); > + int ret; > + > + ret = libxl_domain_shutdown(CTX, Int_val(domid)); > + if (ret != 0) > + failwith_xl(ret, "domain_shutdown"); > + > + CAMLreturn(Val_unit); > +} > + > +value stub_libxl_domain_reboot(value ctx, value domid) > +{ > + CAMLparam2(ctx, domid); > + int ret; > + > + ret = libxl_domain_reboot(CTX, Int_val(domid)); > + if (ret != 0) > + failwith_xl(ret, "domain_reboot"); > + > + CAMLreturn(Val_unit); > +} > + > +value stub_libxl_domain_destroy(value ctx, value domid, value async, value unit) > +{ > + CAMLparam4(ctx, domid, async, unit); > + int ret; > + libxl_asyncop_how ao_how; > + > + ret = libxl_domain_destroy(CTX, Int_val(domid), aohow_val(async, &ao_how)); > + if (ret != 0) > + failwith_xl(ret, "domain_destroy"); > + > + CAMLreturn(Val_unit); > +} > + > +value stub_libxl_domain_suspend(value ctx, value domid, value fd, value async, value unit) > +{ > + CAMLparam5(ctx, domid, fd, async, unit); > + int ret; > + libxl_asyncop_how ao_how; > + > + ret = libxl_domain_suspend(CTX, Int_val(domid), Int_val(fd), 0, > + aohow_val(async, &ao_how)); > + if (ret != 0) > + failwith_xl(ret, "domain_suspend"); > + > + CAMLreturn(Val_unit); > +} > + > +value stub_libxl_domain_pause(value ctx, value domid) > +{ > + CAMLparam2(ctx, domid); > + int ret; > + > + ret = libxl_domain_pause(CTX, Int_val(domid)); > + if (ret != 0) > + failwith_xl(ret, "domain_pause"); > + > + CAMLreturn(Val_unit); > +} > + > +value stub_libxl_domain_unpause(value ctx, value domid) > +{ > + CAMLparam2(ctx, domid); > + int ret; > + > + ret = libxl_domain_unpause(CTX, Int_val(domid)); > + if (ret != 0) > + failwith_xl(ret, "domain_unpause"); > + > + CAMLreturn(Val_unit); > +} > + > #define _STRINGIFY(x) #x > #define STRINGIFY(x) _STRINGIFY(x) > > @@ -408,20 +564,11 @@ value stub_xl_device_##type##_##op(value ctx, value info, value domid, \ > libxl_device_##type c_info; \ > int ret, marker_var; \ > libxl_asyncop_how ao_how; \ > - value *p; \ > \ > device_##type##_val(CTX, &c_info, info); \ > \ > - if (async != Val_none) { \ > - p = malloc(sizeof(value)); \ > - *p = Some_val(async); \ > - caml_register_global_root(p); \ > - ao_how.callback = async_callback; \ > - ao_how.u.for_callback = (void *) p; \ > - } \ > - \ > ret = libxl_##fn##_##op(CTX, Int_val(domid), &c_info, \ > - async != Val_none ? &ao_how : NULL); \ > + aohow_val(async, &ao_how)); \ > \ > libxl_device_##type##_dispose(&c_info); \ > \ > diff --git a/tools/ocaml/test/send_debug_keys.ml b/tools/ocaml/test/send_debug_keys.ml > index b9cd61e..2cca322 100644 > --- a/tools/ocaml/test/send_debug_keys.ml > +++ b/tools/ocaml/test/send_debug_keys.ml > @@ -4,7 +4,7 @@ open Xenlight > > let send_keys ctx s = > printf "Sending debug key %s\n" s; > - Xenlight.send_debug_keys ctx s; > + Xenlight.Host.send_debug_keys ctx s; > () > > let _ = >