On Fri, 2011-10-07 at 11:25 +0100, Jon Ludlam wrote:
> ocamlfind does not support namespaces, so to avoid
> name clashes the module names have become longer.
> Additionally, the xenstore and xenbus subdirs, which
> contain several modules each, have been packed into
> toplevel Xenstore and Xenbus modules.
>
> xb becomes xenbus, xc becomes xenctrl, xl becomes xenlight,
> xs becomes xenstore, eventchn becomes xeneventchn and
> mmap becomes xenmmap.
>
> Signed-off-by: Jon Ludlam <jonathan.ludlam@xxxxxxxxxxxxx>
I only skimmed the changes (rather than the moves which I assume are
basically identical code).
Acked-by: Ian Campbell <ian.campbell@xxxxxxxxxx>
>
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/eventchn/META.in
> --- a/tools/ocaml/libs/eventchn/META.in
> +++ b/tools/ocaml/libs/eventchn/META.in
> @@ -1,5 +1,5 @@
> version = "@VERSION@"
> description = "Eventchn interface extension"
> requires = "unix"
> -archive(byte) = "eventchn.cma"
> -archive(native) = "eventchn.cmxa"
> +archive(byte) = "xeneventchn.cma"
> +archive(native) = "xeneventchn.cmxa"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/eventchn/Makefile
> --- a/tools/ocaml/libs/eventchn/Makefile
> +++ b/tools/ocaml/libs/eventchn/Makefile
> @@ -4,11 +4,11 @@
>
> CFLAGS += $(CFLAGS_libxenctrl) $(CFLAGS_xeninclude)
>
> -OBJS = eventchn
> +OBJS = xeneventchn
> INTF = $(foreach obj, $(OBJS),$(obj).cmi)
> -LIBS = eventchn.cma eventchn.cmxa
> +LIBS = xeneventchn.cma xeneventchn.cmxa
>
> -LIBS_evtchn = $(LDLIBS_libxenctrl)
> +LIBS_xeneventchn = $(LDLIBS_libxenctrl)
>
> all: $(INTF) $(LIBS) $(PROGRAMS)
>
> @@ -16,20 +16,20 @@
>
> libs: $(LIBS)
>
> -eventchn_OBJS = $(OBJS)
> -eventchn_C_OBJS = eventchn_stubs
> +xeneventchn_OBJS = $(OBJS)
> +xeneventchn_C_OBJS = xeneventchn_stubs
>
> -OCAML_LIBRARY = eventchn
> +OCAML_LIBRARY = xeneventchn
>
> .PHONY: install
> install: $(LIBS) META
> mkdir -p $(OCAMLDESTDIR)
> - ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn
> - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore eventchn
> META $(INTF) $(LIBS) *.a *.so *.cmx
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn
> + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xeneventchn
> META $(INTF) $(LIBS) *.a *.so *.cmx
>
> .PHONY: uninstall
> uninstall:
> - ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn
>
> include $(TOPLEVEL)/Makefile.rules
>
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/eventchn/eventchn.ml
> --- a/tools/ocaml/libs/eventchn/eventchn.ml
> +++ /dev/null
> @@ -1,30 +0,0 @@
> -(*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - *)
> -
> -exception Error of string
> -
> -type handle
> -
> -external init: unit -> handle = "stub_eventchn_init"
> -external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
> -external notify: handle -> int -> unit = "stub_eventchn_notify"
> -external bind_interdomain: handle -> int -> int -> int =
> "stub_eventchn_bind_interdomain"
> -external bind_dom_exc_virq: handle -> int = "stub_eventchn_bind_dom_exc_virq"
> -external unbind: handle -> int -> unit = "stub_eventchn_unbind"
> -external pending: handle -> int = "stub_eventchn_pending"
> -external unmask: handle -> int -> unit = "stub_eventchn_unmask"
> -
> -let _ = Callback.register_exception "eventchn.error" (Error
> "register_callback")
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/eventchn/eventchn.mli
> --- a/tools/ocaml/libs/eventchn/eventchn.mli
> +++ /dev/null
> @@ -1,31 +0,0 @@
> -(*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - *)
> -
> -exception Error of string
> -
> -type handle
> -
> -external init : unit -> handle = "stub_eventchn_init"
> -external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
> -
> -external notify : handle -> int -> unit = "stub_eventchn_notify"
> -external bind_interdomain : handle -> int -> int -> int
> - = "stub_eventchn_bind_interdomain"
> -external bind_dom_exc_virq : handle -> int =
> "stub_eventchn_bind_dom_exc_virq"
> -external unbind : handle -> int -> unit = "stub_eventchn_unbind"
> -external pending : handle -> int = "stub_eventchn_pending"
> -external unmask : handle -> int -> unit
> - = "stub_eventchn_unmask"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5
> tools/ocaml/libs/eventchn/eventchn_stubs.c
> --- a/tools/ocaml/libs/eventchn/eventchn_stubs.c
> +++ /dev/null
> @@ -1,143 +0,0 @@
> -/*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - */
> -
> -#include <sys/types.h>
> -#include <sys/stat.h>
> -#include <fcntl.h>
> -#include <unistd.h>
> -#include <errno.h>
> -#include <stdint.h>
> -#include <sys/ioctl.h>
> -#include <xen/sysctl.h>
> -#include <xen/xen.h>
> -#include <xen/sys/evtchn.h>
> -#include <xenctrl.h>
> -
> -#define CAML_NAME_SPACE
> -#include <caml/mlvalues.h>
> -#include <caml/memory.h>
> -#include <caml/alloc.h>
> -#include <caml/custom.h>
> -#include <caml/callback.h>
> -#include <caml/fail.h>
> -
> -#define _H(__h) ((xc_interface *)(__h))
> -
> -CAMLprim value stub_eventchn_init(void)
> -{
> - CAMLparam0();
> - CAMLlocal1(result);
> -
> - xc_interface *xce = xc_evtchn_open(NULL, XC_OPENFLAG_NON_REENTRANT);
> - if (xce == NULL)
> - caml_failwith("open failed");
> -
> - result = (value)xce;
> - CAMLreturn(result);
> -}
> -
> -CAMLprim value stub_eventchn_fd(value xce)
> -{
> - CAMLparam1(xce);
> - CAMLlocal1(result);
> - int fd;
> -
> - fd = xc_evtchn_fd(_H(xce));
> - if (fd == -1)
> - caml_failwith("evtchn fd failed");
> -
> - result = Val_int(fd);
> -
> - CAMLreturn(result);
> -}
> -
> -CAMLprim value stub_eventchn_notify(value xce, value port)
> -{
> - CAMLparam2(xce, port);
> - int rc;
> -
> - rc = xc_evtchn_notify(_H(xce), Int_val(port));
> - if (rc == -1)
> - caml_failwith("evtchn notify failed");
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_eventchn_bind_interdomain(value xce, value domid,
> - value remote_port)
> -{
> - CAMLparam3(xce, domid, remote_port);
> - CAMLlocal1(port);
> - evtchn_port_or_error_t rc;
> -
> - rc = xc_evtchn_bind_interdomain(_H(xce), Int_val(domid),
> Int_val(remote_port));
> - if (rc == -1)
> - caml_failwith("evtchn bind_interdomain failed");
> - port = Val_int(rc);
> -
> - CAMLreturn(port);
> -}
> -
> -CAMLprim value stub_eventchn_bind_dom_exc_virq(value xce)
> -{
> - CAMLparam1(xce);
> - CAMLlocal1(port);
> - evtchn_port_or_error_t rc;
> -
> - rc = xc_evtchn_bind_virq(_H(xce), VIRQ_DOM_EXC);
> - if (rc == -1)
> - caml_failwith("evtchn bind_dom_exc_virq failed");
> - port = Val_int(rc);
> -
> - CAMLreturn(port);
> -}
> -
> -CAMLprim value stub_eventchn_unbind(value xce, value port)
> -{
> - CAMLparam2(xce, port);
> - int rc;
> -
> - rc = xc_evtchn_unbind(_H(xce), Int_val(port));
> - if (rc == -1)
> - caml_failwith("evtchn unbind failed");
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_eventchn_pending(value xce)
> -{
> - CAMLparam1(xce);
> - CAMLlocal1(result);
> - evtchn_port_or_error_t port;
> -
> - port = xc_evtchn_pending(_H(xce));
> - if (port == -1)
> - caml_failwith("evtchn pending failed");
> - result = Val_int(port);
> -
> - CAMLreturn(result);
> -}
> -
> -CAMLprim value stub_eventchn_unmask(value xce, value _port)
> -{
> - CAMLparam2(xce, _port);
> - evtchn_port_t port;
> -
> - port = Int_val(_port);
> - if (xc_evtchn_unmask(_H(xce), port))
> - caml_failwith("evtchn unmask failed");
> - CAMLreturn(Val_unit);
> -}
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/eventchn/xeneventchn.ml
> --- /dev/null
> +++ b/tools/ocaml/libs/eventchn/xeneventchn.ml
> @@ -0,0 +1,30 @@
> +(*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + *)
> +
> +exception Error of string
> +
> +type handle
> +
> +external init: unit -> handle = "stub_eventchn_init"
> +external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
> +external notify: handle -> int -> unit = "stub_eventchn_notify"
> +external bind_interdomain: handle -> int -> int -> int =
> "stub_eventchn_bind_interdomain"
> +external bind_dom_exc_virq: handle -> int = "stub_eventchn_bind_dom_exc_virq"
> +external unbind: handle -> int -> unit = "stub_eventchn_unbind"
> +external pending: handle -> int = "stub_eventchn_pending"
> +external unmask: handle -> int -> unit = "stub_eventchn_unmask"
> +
> +let _ = Callback.register_exception "eventchn.error" (Error
> "register_callback")
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/eventchn/xeneventchn.mli
> --- /dev/null
> +++ b/tools/ocaml/libs/eventchn/xeneventchn.mli
> @@ -0,0 +1,31 @@
> +(*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + *)
> +
> +exception Error of string
> +
> +type handle
> +
> +external init : unit -> handle = "stub_eventchn_init"
> +external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
> +
> +external notify : handle -> int -> unit = "stub_eventchn_notify"
> +external bind_interdomain : handle -> int -> int -> int
> + = "stub_eventchn_bind_interdomain"
> +external bind_dom_exc_virq : handle -> int =
> "stub_eventchn_bind_dom_exc_virq"
> +external unbind : handle -> int -> unit = "stub_eventchn_unbind"
> +external pending : handle -> int = "stub_eventchn_pending"
> +external unmask : handle -> int -> unit
> + = "stub_eventchn_unmask"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5
> tools/ocaml/libs/eventchn/xeneventchn_stubs.c
> --- /dev/null
> +++ b/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
> @@ -0,0 +1,143 @@
> +/*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + */
> +
> +#include <sys/types.h>
> +#include <sys/stat.h>
> +#include <fcntl.h>
> +#include <unistd.h>
> +#include <errno.h>
> +#include <stdint.h>
> +#include <sys/ioctl.h>
> +#include <xen/sysctl.h>
> +#include <xen/xen.h>
> +#include <xen/sys/evtchn.h>
> +#include <xenctrl.h>
> +
> +#define CAML_NAME_SPACE
> +#include <caml/mlvalues.h>
> +#include <caml/memory.h>
> +#include <caml/alloc.h>
> +#include <caml/custom.h>
> +#include <caml/callback.h>
> +#include <caml/fail.h>
> +
> +#define _H(__h) ((xc_interface *)(__h))
> +
> +CAMLprim value stub_eventchn_init(void)
> +{
> + CAMLparam0();
> + CAMLlocal1(result);
> +
> + xc_interface *xce = xc_evtchn_open(NULL, XC_OPENFLAG_NON_REENTRANT);
> + if (xce == NULL)
> + caml_failwith("open failed");
> +
> + result = (value)xce;
> + CAMLreturn(result);
> +}
> +
> +CAMLprim value stub_eventchn_fd(value xce)
> +{
> + CAMLparam1(xce);
> + CAMLlocal1(result);
> + int fd;
> +
> + fd = xc_evtchn_fd(_H(xce));
> + if (fd == -1)
> + caml_failwith("evtchn fd failed");
> +
> + result = Val_int(fd);
> +
> + CAMLreturn(result);
> +}
> +
> +CAMLprim value stub_eventchn_notify(value xce, value port)
> +{
> + CAMLparam2(xce, port);
> + int rc;
> +
> + rc = xc_evtchn_notify(_H(xce), Int_val(port));
> + if (rc == -1)
> + caml_failwith("evtchn notify failed");
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_eventchn_bind_interdomain(value xce, value domid,
> + value remote_port)
> +{
> + CAMLparam3(xce, domid, remote_port);
> + CAMLlocal1(port);
> + evtchn_port_or_error_t rc;
> +
> + rc = xc_evtchn_bind_interdomain(_H(xce), Int_val(domid),
> Int_val(remote_port));
> + if (rc == -1)
> + caml_failwith("evtchn bind_interdomain failed");
> + port = Val_int(rc);
> +
> + CAMLreturn(port);
> +}
> +
> +CAMLprim value stub_eventchn_bind_dom_exc_virq(value xce)
> +{
> + CAMLparam1(xce);
> + CAMLlocal1(port);
> + evtchn_port_or_error_t rc;
> +
> + rc = xc_evtchn_bind_virq(_H(xce), VIRQ_DOM_EXC);
> + if (rc == -1)
> + caml_failwith("evtchn bind_dom_exc_virq failed");
> + port = Val_int(rc);
> +
> + CAMLreturn(port);
> +}
> +
> +CAMLprim value stub_eventchn_unbind(value xce, value port)
> +{
> + CAMLparam2(xce, port);
> + int rc;
> +
> + rc = xc_evtchn_unbind(_H(xce), Int_val(port));
> + if (rc == -1)
> + caml_failwith("evtchn unbind failed");
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_eventchn_pending(value xce)
> +{
> + CAMLparam1(xce);
> + CAMLlocal1(result);
> + evtchn_port_or_error_t port;
> +
> + port = xc_evtchn_pending(_H(xce));
> + if (port == -1)
> + caml_failwith("evtchn pending failed");
> + result = Val_int(port);
> +
> + CAMLreturn(result);
> +}
> +
> +CAMLprim value stub_eventchn_unmask(value xce, value _port)
> +{
> + CAMLparam2(xce, _port);
> + evtchn_port_t port;
> +
> + port = Int_val(_port);
> + if (xc_evtchn_unmask(_H(xce), port))
> + caml_failwith("evtchn unmask failed");
> + CAMLreturn(Val_unit);
> +}
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/mmap/META.in
> --- a/tools/ocaml/libs/mmap/META.in
> +++ b/tools/ocaml/libs/mmap/META.in
> @@ -1,4 +1,4 @@
> version = "@VERSION@"
> description = "Mmap interface extension"
> -archive(byte) = "mmap.cma"
> -archive(native) = "mmap.cmxa"
> +archive(byte) = "xenmmap.cma"
> +archive(native) = "xenmmap.cmxa"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/mmap/Makefile
> --- a/tools/ocaml/libs/mmap/Makefile
> +++ b/tools/ocaml/libs/mmap/Makefile
> @@ -2,9 +2,9 @@
> XEN_ROOT=$(TOPLEVEL)/../..
> include $(TOPLEVEL)/common.make
>
> -OBJS = mmap
> +OBJS = xenmmap
> INTF = $(foreach obj, $(OBJS),$(obj).cmi)
> -LIBS = mmap.cma mmap.cmxa
> +LIBS = xenmmap.cma xenmmap.cmxa
>
> all: $(INTF) $(LIBS) $(PROGRAMS)
>
> @@ -12,19 +12,19 @@
>
> libs: $(LIBS)
>
> -mmap_OBJS = $(OBJS)
> -mmap_C_OBJS = mmap_stubs
> -OCAML_LIBRARY = mmap
> +xenmmap_OBJS = $(OBJS)
> +xenmmap_C_OBJS = xenmmap_stubs
> +OCAML_LIBRARY = xenmmap
>
> .PHONY: install
> install: $(LIBS) META
> mkdir -p $(OCAMLDESTDIR)
> - ocamlfind remove -destdir $(OCAMLDESTDIR) mmap
> - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore mmap META
> $(INTF) $(LIBS) *.a *.so *.cmx
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenmmap
> + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenmmap
> META $(INTF) $(LIBS) *.a *.so *.cmx
>
> .PHONY: uninstall
> uninstall:
> - ocamlfind remove -destdir $(OCAMLDESTDIR) mmap
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenmmap
>
> include $(TOPLEVEL)/Makefile.rules
>
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/mmap/mmap.ml
> --- a/tools/ocaml/libs/mmap/mmap.ml
> +++ /dev/null
> @@ -1,31 +0,0 @@
> -(*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - *)
> -
> -type mmap_interface
> -
> -type mmap_prot_flag = RDONLY | WRONLY | RDWR
> -type mmap_map_flag = SHARED | PRIVATE
> -
> -(* mmap: fd -> prot_flag -> map_flag -> length -> offset -> interface *)
> -external mmap: Unix.file_descr -> mmap_prot_flag -> mmap_map_flag
> - -> int -> int -> mmap_interface = "stub_mmap_init"
> -external unmap: mmap_interface -> unit = "stub_mmap_final"
> -(* read: interface -> start -> length -> data *)
> -external read: mmap_interface -> int -> int -> string = "stub_mmap_read"
> -(* write: interface -> data -> start -> length -> unit *)
> -external write: mmap_interface -> string -> int -> int -> unit =
> "stub_mmap_write"
> -(* getpagesize: unit -> size of page *)
> -external getpagesize: unit -> int = "stub_mmap_getpagesize"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/mmap/mmap.mli
> --- a/tools/ocaml/libs/mmap/mmap.mli
> +++ /dev/null
> @@ -1,28 +0,0 @@
> -(*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - *)
> -
> -type mmap_interface
> -type mmap_prot_flag = RDONLY | WRONLY | RDWR
> -type mmap_map_flag = SHARED | PRIVATE
> -
> -external mmap : Unix.file_descr -> mmap_prot_flag -> mmap_map_flag -> int ->
> int
> - -> mmap_interface = "stub_mmap_init"
> -external unmap : mmap_interface -> unit = "stub_mmap_final"
> -external read : mmap_interface -> int -> int -> string = "stub_mmap_read"
> -external write : mmap_interface -> string -> int -> int -> unit
> - = "stub_mmap_write"
> -
> -external getpagesize : unit -> int = "stub_mmap_getpagesize"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/mmap/mmap_stubs.c
> --- a/tools/ocaml/libs/mmap/mmap_stubs.c
> +++ /dev/null
> @@ -1,136 +0,0 @@
> -/*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - */
> -
> -#include <unistd.h>
> -#include <stdlib.h>
> -#include <sys/mman.h>
> -#include <string.h>
> -#include <errno.h>
> -#include "mmap_stubs.h"
> -
> -#include <caml/mlvalues.h>
> -#include <caml/memory.h>
> -#include <caml/alloc.h>
> -#include <caml/custom.h>
> -#include <caml/fail.h>
> -#include <caml/callback.h>
> -
> -#define GET_C_STRUCT(a) ((struct mmap_interface *) a)
> -
> -static int mmap_interface_init(struct mmap_interface *intf,
> - int fd, int pflag, int mflag,
> - int len, int offset)
> -{
> - intf->len = len;
> - intf->addr = mmap(NULL, len, pflag, mflag, fd, offset);
> - return (intf->addr == MAP_FAILED) ? errno : 0;
> -}
> -
> -CAMLprim value stub_mmap_init(value fd, value pflag, value mflag,
> - value len, value offset)
> -{
> - CAMLparam5(fd, pflag, mflag, len, offset);
> - CAMLlocal1(result);
> - int c_pflag, c_mflag;
> -
> - switch (Int_val(pflag)) {
> - case 0: c_pflag = PROT_READ; break;
> - case 1: c_pflag = PROT_WRITE; break;
> - case 2: c_pflag = PROT_READ|PROT_WRITE; break;
> - default: caml_invalid_argument("protectiontype");
> - }
> -
> - switch (Int_val(mflag)) {
> - case 0: c_mflag = MAP_SHARED; break;
> - case 1: c_mflag = MAP_PRIVATE; break;
> - default: caml_invalid_argument("maptype");
> - }
> -
> - result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
> -
> - if (mmap_interface_init(GET_C_STRUCT(result), Int_val(fd),
> - c_pflag, c_mflag,
> - Int_val(len), Int_val(offset)))
> - caml_failwith("mmap");
> - CAMLreturn(result);
> -}
> -
> -CAMLprim value stub_mmap_final(value interface)
> -{
> - CAMLparam1(interface);
> - struct mmap_interface *intf;
> -
> - intf = GET_C_STRUCT(interface);
> - if (intf->addr != MAP_FAILED)
> - munmap(intf->addr, intf->len);
> - intf->addr = MAP_FAILED;
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_mmap_read(value interface, value start, value len)
> -{
> - CAMLparam3(interface, start, len);
> - CAMLlocal1(data);
> - struct mmap_interface *intf;
> - int c_start;
> - int c_len;
> -
> - c_start = Int_val(start);
> - c_len = Int_val(len);
> - intf = GET_C_STRUCT(interface);
> -
> - if (c_start > intf->len)
> - caml_invalid_argument("start invalid");
> - if (c_start + c_len > intf->len)
> - caml_invalid_argument("len invalid");
> -
> - data = caml_alloc_string(c_len);
> - memcpy((char *) data, intf->addr + c_start, c_len);
> -
> - CAMLreturn(data);
> -}
> -
> -CAMLprim value stub_mmap_write(value interface, value data,
> - value start, value len)
> -{
> - CAMLparam4(interface, data, start, len);
> - struct mmap_interface *intf;
> - int c_start;
> - int c_len;
> -
> - c_start = Int_val(start);
> - c_len = Int_val(len);
> - intf = GET_C_STRUCT(interface);
> -
> - if (c_start > intf->len)
> - caml_invalid_argument("start invalid");
> - if (c_start + c_len > intf->len)
> - caml_invalid_argument("len invalid");
> -
> - memcpy(intf->addr + c_start, (char *) data, c_len);
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_mmap_getpagesize(value unit)
> -{
> - CAMLparam1(unit);
> - CAMLlocal1(data);
> -
> - data = Val_int(getpagesize());
> - CAMLreturn(data);
> -}
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/mmap/xenmmap.ml
> --- /dev/null
> +++ b/tools/ocaml/libs/mmap/xenmmap.ml
> @@ -0,0 +1,31 @@
> +(*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + *)
> +
> +type mmap_interface
> +
> +type mmap_prot_flag = RDONLY | WRONLY | RDWR
> +type mmap_map_flag = SHARED | PRIVATE
> +
> +(* mmap: fd -> prot_flag -> map_flag -> length -> offset -> interface *)
> +external mmap: Unix.file_descr -> mmap_prot_flag -> mmap_map_flag
> + -> int -> int -> mmap_interface = "stub_mmap_init"
> +external unmap: mmap_interface -> unit = "stub_mmap_final"
> +(* read: interface -> start -> length -> data *)
> +external read: mmap_interface -> int -> int -> string = "stub_mmap_read"
> +(* write: interface -> data -> start -> length -> unit *)
> +external write: mmap_interface -> string -> int -> int -> unit =
> "stub_mmap_write"
> +(* getpagesize: unit -> size of page *)
> +external getpagesize: unit -> int = "stub_mmap_getpagesize"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/mmap/xenmmap.mli
> --- /dev/null
> +++ b/tools/ocaml/libs/mmap/xenmmap.mli
> @@ -0,0 +1,28 @@
> +(*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + *)
> +
> +type mmap_interface
> +type mmap_prot_flag = RDONLY | WRONLY | RDWR
> +type mmap_map_flag = SHARED | PRIVATE
> +
> +external mmap : Unix.file_descr -> mmap_prot_flag -> mmap_map_flag -> int ->
> int
> + -> mmap_interface = "stub_mmap_init"
> +external unmap : mmap_interface -> unit = "stub_mmap_final"
> +external read : mmap_interface -> int -> int -> string = "stub_mmap_read"
> +external write : mmap_interface -> string -> int -> int -> unit
> + = "stub_mmap_write"
> +
> +external getpagesize : unit -> int = "stub_mmap_getpagesize"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/mmap/xenmmap_stubs.c
> --- /dev/null
> +++ b/tools/ocaml/libs/mmap/xenmmap_stubs.c
> @@ -0,0 +1,136 @@
> +/*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + */
> +
> +#include <unistd.h>
> +#include <stdlib.h>
> +#include <sys/mman.h>
> +#include <string.h>
> +#include <errno.h>
> +#include "mmap_stubs.h"
> +
> +#include <caml/mlvalues.h>
> +#include <caml/memory.h>
> +#include <caml/alloc.h>
> +#include <caml/custom.h>
> +#include <caml/fail.h>
> +#include <caml/callback.h>
> +
> +#define GET_C_STRUCT(a) ((struct mmap_interface *) a)
> +
> +static int mmap_interface_init(struct mmap_interface *intf,
> + int fd, int pflag, int mflag,
> + int len, int offset)
> +{
> + intf->len = len;
> + intf->addr = mmap(NULL, len, pflag, mflag, fd, offset);
> + return (intf->addr == MAP_FAILED) ? errno : 0;
> +}
> +
> +CAMLprim value stub_mmap_init(value fd, value pflag, value mflag,
> + value len, value offset)
> +{
> + CAMLparam5(fd, pflag, mflag, len, offset);
> + CAMLlocal1(result);
> + int c_pflag, c_mflag;
> +
> + switch (Int_val(pflag)) {
> + case 0: c_pflag = PROT_READ; break;
> + case 1: c_pflag = PROT_WRITE; break;
> + case 2: c_pflag = PROT_READ|PROT_WRITE; break;
> + default: caml_invalid_argument("protectiontype");
> + }
> +
> + switch (Int_val(mflag)) {
> + case 0: c_mflag = MAP_SHARED; break;
> + case 1: c_mflag = MAP_PRIVATE; break;
> + default: caml_invalid_argument("maptype");
> + }
> +
> + result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
> +
> + if (mmap_interface_init(GET_C_STRUCT(result), Int_val(fd),
> + c_pflag, c_mflag,
> + Int_val(len), Int_val(offset)))
> + caml_failwith("mmap");
> + CAMLreturn(result);
> +}
> +
> +CAMLprim value stub_mmap_final(value interface)
> +{
> + CAMLparam1(interface);
> + struct mmap_interface *intf;
> +
> + intf = GET_C_STRUCT(interface);
> + if (intf->addr != MAP_FAILED)
> + munmap(intf->addr, intf->len);
> + intf->addr = MAP_FAILED;
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_mmap_read(value interface, value start, value len)
> +{
> + CAMLparam3(interface, start, len);
> + CAMLlocal1(data);
> + struct mmap_interface *intf;
> + int c_start;
> + int c_len;
> +
> + c_start = Int_val(start);
> + c_len = Int_val(len);
> + intf = GET_C_STRUCT(interface);
> +
> + if (c_start > intf->len)
> + caml_invalid_argument("start invalid");
> + if (c_start + c_len > intf->len)
> + caml_invalid_argument("len invalid");
> +
> + data = caml_alloc_string(c_len);
> + memcpy((char *) data, intf->addr + c_start, c_len);
> +
> + CAMLreturn(data);
> +}
> +
> +CAMLprim value stub_mmap_write(value interface, value data,
> + value start, value len)
> +{
> + CAMLparam4(interface, data, start, len);
> + struct mmap_interface *intf;
> + int c_start;
> + int c_len;
> +
> + c_start = Int_val(start);
> + c_len = Int_val(len);
> + intf = GET_C_STRUCT(interface);
> +
> + if (c_start > intf->len)
> + caml_invalid_argument("start invalid");
> + if (c_start + c_len > intf->len)
> + caml_invalid_argument("len invalid");
> +
> + memcpy(intf->addr + c_start, (char *) data, c_len);
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_mmap_getpagesize(value unit)
> +{
> + CAMLparam1(unit);
> + CAMLlocal1(data);
> +
> + data = Val_int(getpagesize());
> + CAMLreturn(data);
> +}
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xb/META.in
> --- a/tools/ocaml/libs/xb/META.in
> +++ b/tools/ocaml/libs/xb/META.in
> @@ -1,5 +1,5 @@
> version = "@VERSION@"
> description = "XenBus Interface"
> -requires = "unix,mmap"
> -archive(byte) = "xb.cma"
> -archive(native) = "xb.cmxa"
> +requires = "unix,xenmmap"
> +archive(byte) = "xenbus.cma"
> +archive(native) = "xenbus.cmxa"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xb/Makefile
> --- a/tools/ocaml/libs/xb/Makefile
> +++ b/tools/ocaml/libs/xb/Makefile
> @@ -6,6 +6,7 @@
> CFLAGS += $(CFLAGS_libxenctrl) # For xen_mb()
> CFLAGS += $(CFLAGS_xeninclude)
> OCAMLINCLUDE += -I ../mmap
> +OCAMLOPTFLAGS += -for-pack Xenbus
>
> .NOTPARALLEL:
> # Ocaml is such a PITA!
> @@ -15,7 +16,7 @@
> PRELIBS = $(foreach obj, $(PREOBJS),$(obj).cmo) $(foreach
> obj,$(PREOJBS),$(obj).cmx)
> OBJS = op partial packet xs_ring xb
> INTF = op.cmi packet.cmi xb.cmi
> -LIBS = xb.cma xb.cmxa
> +LIBS = xenbus.cma xenbus.cmxa
>
> ALL_OCAML_OBJS = $(OBJS) $(PREOJBS)
>
> @@ -25,22 +26,30 @@
>
> libs: $(LIBS)
>
> -xb_OBJS = $(OBJS)
> -xb_C_OBJS = xs_ring_stubs xb_stubs
> -OCAML_LIBRARY = xb
> +xenbus_OBJS = xenbus
> +xenbus_C_OBJS = xs_ring_stubs xenbus_stubs
> +OCAML_LIBRARY = xenbus
> +
> +xenbus.cmx : $(foreach obj, $(OBJS), $(obj).cmx)
> + $(E) " CMX $@"
> + $(OCAMLOPT) -pack -o $@ $^
> +
> +xenbus.cmo : $(foreach obj, $(OBJS), $(obj).cmo)
> + $(E) " CMO $@"
> + $(OCAMLC) -pack -o $@ $^
>
> %.mli: %.ml
> $(E) " MLI $@"
> - $(Q)$(OCAMLC) -i $< $o
> + $(Q)$(OCAMLC) $(OCAMLINCLUDE) -i $< $o
>
> .PHONY: install
> install: $(LIBS) META
> mkdir -p $(OCAMLDESTDIR)
> - ocamlfind remove -destdir $(OCAMLDESTDIR) xb
> - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xb META
> $(INTF) $(LIBS) *.a *.so *.cmx
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus
> + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenbus META
> $(LIBS) xenbus.cmo xenbus.cmi xenbus.cmx *.a *.so
>
> .PHONY: uninstall
> uninstall:
> - ocamlfind remove -destdir $(OCAMLDESTDIR) xb
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus
>
> include $(TOPLEVEL)/Makefile.rules
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xb/xb.ml
> --- a/tools/ocaml/libs/xb/xb.ml
> +++ b/tools/ocaml/libs/xb/xb.ml
> @@ -24,7 +24,7 @@
>
> type backend_mmap =
> {
> - mmap: Mmap.mmap_interface; (* mmaped interface = xs_ring *)
> + mmap: Xenmmap.mmap_interface; (* mmaped interface = xs_ring *)
> eventchn_notify: unit -> unit; (* function to notify through eventchn
> *)
> mutable work_again: bool;
> }
> @@ -34,7 +34,7 @@
> fd: Unix.file_descr;
> }
>
> -type backend = Fd of backend_fd | Mmap of backend_mmap
> +type backend = Fd of backend_fd | Xenmmap of backend_mmap
>
> type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string
>
> @@ -68,7 +68,7 @@
> let read con s len =
> match con.backend with
> | Fd backfd -> read_fd backfd con s len
> - | Mmap backmmap -> read_mmap backmmap con s len
> + | Xenmmap backmmap -> read_mmap backmmap con s len
>
> let write_fd back con s len =
> Unix.write back.fd s 0 len
> @@ -82,7 +82,7 @@
> let write con s len =
> match con.backend with
> | Fd backfd -> write_fd backfd con s len
> - | Mmap backmmap -> write_mmap backmmap con s len
> + | Xenmmap backmmap -> write_mmap backmmap con s len
>
> let output con =
> (* get the output string from a string_of(packet) or partial_out *)
> @@ -145,7 +145,7 @@
> let open_fd fd = newcon (Fd { fd = fd; })
>
> let open_mmap mmap notifyfct =
> - newcon (Mmap {
> + newcon (Xenmmap {
> mmap = mmap;
> eventchn_notify = notifyfct;
> work_again = false; })
> @@ -153,12 +153,12 @@
> let close con =
> match con.backend with
> | Fd backend -> Unix.close backend.fd
> - | Mmap backend -> Mmap.unmap backend.mmap
> + | Xenmmap backend -> Xenmmap.unmap backend.mmap
>
> let is_fd con =
> match con.backend with
> | Fd _ -> true
> - | Mmap _ -> false
> + | Xenmmap _ -> false
>
> let is_mmap con = not (is_fd con)
>
> @@ -176,14 +176,14 @@
> let has_more_input con =
> match con.backend with
> | Fd _ -> false
> - | Mmap backend -> backend.work_again
> + | Xenmmap backend -> backend.work_again
>
> let is_selectable con =
> match con.backend with
> | Fd _ -> true
> - | Mmap _ -> false
> + | Xenmmap _ -> false
>
> let get_fd con =
> match con.backend with
> | Fd backend -> backend.fd
> - | Mmap _ -> raise (Failure "get_fd")
> + | Xenmmap _ -> raise (Failure "get_fd")
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xb/xb.mli
> --- a/tools/ocaml/libs/xb/xb.mli
> +++ b/tools/ocaml/libs/xb/xb.mli
> @@ -1,83 +1,103 @@
> -module Op:
> -sig
> - type operation = Op.operation =
> - | Debug
> - | Directory
> - | Read
> - | Getperms
> - | Watch
> - | Unwatch
> - | Transaction_start
> - | Transaction_end
> - | Introduce
> - | Release
> - | Getdomainpath
> - | Write
> - | Mkdir
> - | Rm
> - | Setperms
> - | Watchevent
> - | Error
> - | Isintroduced
> - | Resume
> - | Set_target
> - | Restrict
> - val to_string : operation -> string
> -end
> -
> -module Packet:
> -sig
> - type t
> -
> - exception Error of string
> - exception DataError of string
> -
> - val create : int -> int -> Op.operation -> string -> t
> - val unpack : t -> int * int * Op.operation * string
> -
> - val get_tid : t -> int
> - val get_ty : t -> Op.operation
> - val get_data : t -> string
> - val get_rid: t -> int
> -end
> -
> +module Op :
> + sig
> + type operation =
> + Op.operation =
> + Debug
> + | Directory
> + | Read
> + | Getperms
> + | Watch
> + | Unwatch
> + | Transaction_start
> + | Transaction_end
> + | Introduce
> + | Release
> + | Getdomainpath
> + | Write
> + | Mkdir
> + | Rm
> + | Setperms
> + | Watchevent
> + | Error
> + | Isintroduced
> + | Resume
> + | Set_target
> + | Restrict
> + val operation_c_mapping : operation array
> + val size : int
> + val offset_pq : int
> + val operation_c_mapping_pq : 'a array
> + val size_pq : int
> + val array_search : 'a -> 'a array -> int
> + val of_cval : int -> operation
> + val to_cval : operation -> int
> + val to_string : operation -> string
> + end
> +module Packet :
> + sig
> + type t =
> + Packet.t = {
> + tid : int;
> + rid : int;
> + ty : Op.operation;
> + data : string;
> + }
> + exception Error of string
> + exception DataError of string
> + external string_of_header : int -> int -> int -> int -> string
> + = "stub_string_of_header"
> + val create : int -> int -> Op.operation -> string -> t
> + val of_partialpkt : Partial.pkt -> t
> + val to_string : t -> string
> + val unpack : t -> int * int * Op.operation * string
> + val get_tid : t -> int
> + val get_ty : t -> Op.operation
> + val get_data : t -> string
> + val get_rid : t -> int
> + end
> exception End_of_file
> exception Eagain
> exception Noent
> exception Invalid
> -
> -type t
> -
> -(** queue a packet into the output queue for later sending *)
> +type backend_mmap = {
> + mmap : Xenmmap.mmap_interface;
> + eventchn_notify : unit -> unit;
> + mutable work_again : bool;
> +}
> +type backend_fd = { fd : Unix.file_descr; }
> +type backend = Fd of backend_fd | Xenmmap of backend_mmap
> +type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string
> +type t = {
> + backend : backend;
> + pkt_in : Packet.t Queue.t;
> + pkt_out : Packet.t Queue.t;
> + mutable partial_in : partial_buf;
> + mutable partial_out : string;
> +}
> +val init_partial_in : unit -> partial_buf
> val queue : t -> Packet.t -> unit
> -
> -(** process the output queue, return if a packet has been totally sent *)
> +val read_fd : backend_fd -> 'a -> string -> int -> int
> +val read_mmap : backend_mmap -> 'a -> string -> int -> int
> +val read : t -> string -> int -> int
> +val write_fd : backend_fd -> 'a -> string -> int -> int
> +val write_mmap : backend_mmap -> 'a -> string -> int -> int
> +val write : t -> string -> int -> int
> val output : t -> bool
> -
> -(** process the input queue, return if a packet has been totally received *)
> val input : t -> bool
> -
> -(** create new connection using a fd interface *)
> +val newcon : backend -> t
> val open_fd : Unix.file_descr -> t
> -(** create new connection using a mmap intf and a function to notify
> eventchn *)
> -val open_mmap : Mmap.mmap_interface -> (unit -> unit) -> t
> -
> -(* close a connection *)
> +val open_mmap : Xenmmap.mmap_interface -> (unit -> unit) -> t
> val close : t -> unit
> -
> val is_fd : t -> bool
> val is_mmap : t -> bool
> -
> val output_len : t -> int
> val has_new_output : t -> bool
> val has_old_output : t -> bool
> val has_output : t -> bool
> val peek_output : t -> Packet.t
> -
> val input_len : t -> int
> val has_in_packet : t -> bool
> val get_in_packet : t -> Packet.t
> val has_more_input : t -> bool
> -
> val is_selectable : t -> bool
> val get_fd : t -> Unix.file_descr
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xb/xb_stubs.c
> --- a/tools/ocaml/libs/xb/xb_stubs.c
> +++ /dev/null
> @@ -1,71 +0,0 @@
> -/*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - */
> -
> -#include <unistd.h>
> -#include <stdlib.h>
> -#include <sys/mman.h>
> -#include <string.h>
> -#include <errno.h>
> -
> -#include <caml/mlvalues.h>
> -#include <caml/memory.h>
> -#include <caml/alloc.h>
> -#include <caml/custom.h>
> -#include <caml/fail.h>
> -#include <caml/callback.h>
> -
> -#include <xenctrl.h>
> -#include <xen/io/xs_wire.h>
> -
> -CAMLprim value stub_header_size(void)
> -{
> - CAMLparam0();
> - CAMLreturn(Val_int(sizeof(struct xsd_sockmsg)));
> -}
> -
> -CAMLprim value stub_header_of_string(value s)
> -{
> - CAMLparam1(s);
> - CAMLlocal1(ret);
> - struct xsd_sockmsg *hdr;
> -
> - if (caml_string_length(s) != sizeof(struct xsd_sockmsg))
> - caml_failwith("xb header incomplete");
> - ret = caml_alloc_tuple(4);
> - hdr = (struct xsd_sockmsg *) String_val(s);
> - Store_field(ret, 0, Val_int(hdr->tx_id));
> - Store_field(ret, 1, Val_int(hdr->req_id));
> - Store_field(ret, 2, Val_int(hdr->type));
> - Store_field(ret, 3, Val_int(hdr->len));
> - CAMLreturn(ret);
> -}
> -
> -CAMLprim value stub_string_of_header(value tid, value rid, value ty, value
> len)
> -{
> - CAMLparam4(tid, rid, ty, len);
> - CAMLlocal1(ret);
> - struct xsd_sockmsg xsd = {
> - .type = Int_val(ty),
> - .tx_id = Int_val(tid),
> - .req_id = Int_val(rid),
> - .len = Int_val(len),
> - };
> -
> - ret = caml_alloc_string(sizeof(struct xsd_sockmsg));
> - memcpy(String_val(ret), &xsd, sizeof(struct xsd_sockmsg));
> -
> - CAMLreturn(ret);
> -}
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xb/xenbus_stubs.c
> --- /dev/null
> +++ b/tools/ocaml/libs/xb/xenbus_stubs.c
> @@ -0,0 +1,71 @@
> +/*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + */
> +
> +#include <unistd.h>
> +#include <stdlib.h>
> +#include <sys/mman.h>
> +#include <string.h>
> +#include <errno.h>
> +
> +#include <caml/mlvalues.h>
> +#include <caml/memory.h>
> +#include <caml/alloc.h>
> +#include <caml/custom.h>
> +#include <caml/fail.h>
> +#include <caml/callback.h>
> +
> +#include <xenctrl.h>
> +#include <xen/io/xs_wire.h>
> +
> +CAMLprim value stub_header_size(void)
> +{
> + CAMLparam0();
> + CAMLreturn(Val_int(sizeof(struct xsd_sockmsg)));
> +}
> +
> +CAMLprim value stub_header_of_string(value s)
> +{
> + CAMLparam1(s);
> + CAMLlocal1(ret);
> + struct xsd_sockmsg *hdr;
> +
> + if (caml_string_length(s) != sizeof(struct xsd_sockmsg))
> + caml_failwith("xb header incomplete");
> + ret = caml_alloc_tuple(4);
> + hdr = (struct xsd_sockmsg *) String_val(s);
> + Store_field(ret, 0, Val_int(hdr->tx_id));
> + Store_field(ret, 1, Val_int(hdr->req_id));
> + Store_field(ret, 2, Val_int(hdr->type));
> + Store_field(ret, 3, Val_int(hdr->len));
> + CAMLreturn(ret);
> +}
> +
> +CAMLprim value stub_string_of_header(value tid, value rid, value ty, value
> len)
> +{
> + CAMLparam4(tid, rid, ty, len);
> + CAMLlocal1(ret);
> + struct xsd_sockmsg xsd = {
> + .type = Int_val(ty),
> + .tx_id = Int_val(tid),
> + .req_id = Int_val(rid),
> + .len = Int_val(len),
> + };
> +
> + ret = caml_alloc_string(sizeof(struct xsd_sockmsg));
> + memcpy(String_val(ret), &xsd, sizeof(struct xsd_sockmsg));
> +
> + CAMLreturn(ret);
> +}
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xb/xs_ring.ml
> --- a/tools/ocaml/libs/xb/xs_ring.ml
> +++ b/tools/ocaml/libs/xb/xs_ring.ml
> @@ -14,5 +14,5 @@
> * GNU Lesser General Public License for more details.
> *)
>
> -external read: Mmap.mmap_interface -> string -> int -> int =
> "ml_interface_read"
> -external write: Mmap.mmap_interface -> string -> int -> int =
> "ml_interface_write"
> +external read: Xenmmap.mmap_interface -> string -> int -> int =
> "ml_interface_read"
> +external write: Xenmmap.mmap_interface -> string -> int -> int =
> "ml_interface_write"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xc/META.in
> --- 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 = "mmap,uuid"
> -archive(byte) = "xc.cma"
> -archive(native) = "xc.cmxa"
> +requires = "xenmmap,uuid"
> +archive(byte) = "xenctrl.cma"
> +archive(native) = "xenctrl.cmxa"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xc/Makefile
> --- a/tools/ocaml/libs/xc/Makefile
> +++ b/tools/ocaml/libs/xc/Makefile
> @@ -5,16 +5,16 @@
> CFLAGS += -I../mmap $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest)
> OCAMLINCLUDE += -I ../mmap -I ../uuid
>
> -OBJS = xc
> -INTF = xc.cmi
> -LIBS = xc.cma xc.cmxa
> +OBJS = xenctrl
> +INTF = xenctrl.cmi
> +LIBS = xenctrl.cma xenctrl.cmxa
>
> -LIBS_xc = $(LDLIBS_libxenctrl) $(LDLIBS_libxenguest)
> +LIBS_xenctrl = $(LDLIBS_libxenctrl) $(LDLIBS_libxenguest)
>
> -xc_OBJS = $(OBJS)
> -xc_C_OBJS = xc_stubs
> +xenctrl_OBJS = $(OBJS)
> +xenctrl_C_OBJS = xenctrl_stubs
>
> -OCAML_LIBRARY = xc
> +OCAML_LIBRARY = xenctrl
>
> all: $(INTF) $(LIBS)
>
> @@ -23,11 +23,11 @@
> .PHONY: install
> install: $(LIBS) META
> mkdir -p $(OCAMLDESTDIR)
> - ocamlfind remove -destdir $(OCAMLDESTDIR) xc
> - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xc META
> $(INTF) $(LIBS) *.a *.so *.cmx
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl
> + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenctrl
> META $(INTF) $(LIBS) *.a *.so *.cmx
>
> .PHONY: uninstall
> uninstall:
> - ocamlfind remove -destdir $(OCAMLDESTDIR) xc
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl
>
> include $(TOPLEVEL)/Makefile.rules
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xc/xc.ml
> --- a/tools/ocaml/libs/xc/xc.ml
> +++ /dev/null
> @@ -1,326 +0,0 @@
> -(*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - *)
> -
> -(** *)
> -type domid = int
> -
> -(* ** xenctrl.h ** *)
> -
> -type vcpuinfo =
> -{
> - online: bool;
> - blocked: bool;
> - running: bool;
> - cputime: int64;
> - cpumap: int32;
> -}
> -
> -type domaininfo =
> -{
> - domid : domid;
> - dying : bool;
> - shutdown : bool;
> - paused : bool;
> - blocked : bool;
> - running : bool;
> - hvm_guest : bool;
> - shutdown_code : int;
> - total_memory_pages: nativeint;
> - max_memory_pages : nativeint;
> - shared_info_frame : int64;
> - cpu_time : int64;
> - nr_online_vcpus : int;
> - max_vcpu_id : int;
> - ssidref : int32;
> - handle : int array;
> -}
> -
> -type sched_control =
> -{
> - weight : int;
> - cap : int;
> -}
> -
> -type physinfo_cap_flag =
> - | CAP_HVM
> - | CAP_DirectIO
> -
> -type physinfo =
> -{
> - threads_per_core : int;
> - cores_per_socket : int;
> - nr_cpus : int;
> - max_node_id : int;
> - cpu_khz : int;
> - total_pages : nativeint;
> - free_pages : nativeint;
> - scrub_pages : nativeint;
> - (* XXX hw_cap *)
> - capabilities : physinfo_cap_flag list;
> -}
> -
> -type version =
> -{
> - major : int;
> - minor : int;
> - extra : string;
> -}
> -
> -
> -type compile_info =
> -{
> - compiler : string;
> - compile_by : string;
> - compile_domain : string;
> - compile_date : string;
> -}
> -
> -type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt
> -
> -type domain_create_flag = CDF_HVM | CDF_HAP
> -
> -exception Error of string
> -
> -type handle
> -
> -(* this is only use by coredumping *)
> -external sizeof_core_header: unit -> int
> - = "stub_sizeof_core_header"
> -external sizeof_vcpu_guest_context: unit -> int
> - = "stub_sizeof_vcpu_guest_context"
> -external sizeof_xen_pfn: unit -> int = "stub_sizeof_xen_pfn"
> -(* end of use *)
> -
> -external interface_open: unit -> handle = "stub_xc_interface_open"
> -external interface_close: handle -> unit = "stub_xc_interface_close"
> -
> -external is_fake: unit -> bool = "stub_xc_interface_is_fake"
> -
> -let with_intf f =
> - let xc = interface_open () in
> - let r = try f xc with exn -> interface_close xc; raise exn in
> - interface_close xc;
> - r
> -
> -external _domain_create: handle -> int32 -> domain_create_flag list -> int
> array -> domid
> - = "stub_xc_domain_create"
> -
> -let domain_create handle n flags uuid =
> - _domain_create handle n flags (Uuid.int_array_of_uuid uuid)
> -
> -external _domain_sethandle: handle -> domid -> int array -> unit
> - = "stub_xc_domain_sethandle"
> -
> -let domain_sethandle handle n uuid =
> - _domain_sethandle handle n (Uuid.int_array_of_uuid uuid)
> -
> -external domain_max_vcpus: handle -> domid -> int -> unit
> - = "stub_xc_domain_max_vcpus"
> -
> -external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause"
> -external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause"
> -external domain_resume_fast: handle -> domid -> unit =
> "stub_xc_domain_resume_fast"
> -external domain_destroy: handle -> domid -> unit = "stub_xc_domain_destroy"
> -
> -external domain_shutdown: handle -> domid -> shutdown_reason -> unit
> - = "stub_xc_domain_shutdown"
> -
> -external _domain_getinfolist: handle -> domid -> int -> domaininfo list
> - = "stub_xc_domain_getinfolist"
> -
> -let domain_getinfolist handle first_domain =
> - let nb = 2 in
> - let last_domid l = (List.hd l).domid + 1 in
> - let rec __getlist from =
> - let l = _domain_getinfolist handle from nb in
> - (if List.length l = nb then __getlist (last_domid l) else [])
> @ l
> - in
> - List.rev (__getlist first_domain)
> -
> -external domain_getinfo: handle -> domid -> domaininfo=
> "stub_xc_domain_getinfo"
> -
> -external domain_get_vcpuinfo: handle -> int -> int -> vcpuinfo
> - = "stub_xc_vcpu_getinfo"
> -
> -external domain_ioport_permission: handle -> domid -> int -> int -> bool ->
> unit
> - = "stub_xc_domain_ioport_permission"
> -external domain_iomem_permission: handle -> domid -> nativeint -> nativeint
> -> bool -> unit
> - = "stub_xc_domain_iomem_permission"
> -external domain_irq_permission: handle -> domid -> int -> bool -> unit
> - = "stub_xc_domain_irq_permission"
> -
> -external vcpu_affinity_set: handle -> domid -> int -> bool array -> unit
> - = "stub_xc_vcpu_setaffinity"
> -external vcpu_affinity_get: handle -> domid -> int -> bool array
> - = "stub_xc_vcpu_getaffinity"
> -
> -external vcpu_context_get: handle -> domid -> int -> string
> - = "stub_xc_vcpu_context_get"
> -
> -external sched_id: handle -> int = "stub_xc_sched_id"
> -
> -external sched_credit_domain_set: handle -> domid -> sched_control -> unit
> - = "stub_sched_credit_domain_set"
> -external sched_credit_domain_get: handle -> domid -> sched_control
> - = "stub_sched_credit_domain_get"
> -
> -external shadow_allocation_set: handle -> domid -> int -> unit
> - = "stub_shadow_allocation_set"
> -external shadow_allocation_get: handle -> domid -> int
> - = "stub_shadow_allocation_get"
> -
> -external evtchn_alloc_unbound: handle -> domid -> domid -> int
> - = "stub_xc_evtchn_alloc_unbound"
> -external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset"
> -
> -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"
> -external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
> -
> -external domain_setmaxmem: handle -> domid -> int64 -> unit
> - = "stub_xc_domain_setmaxmem"
> -external domain_set_memmap_limit: handle -> domid -> int64 -> unit
> - = "stub_xc_domain_set_memmap_limit"
> -external domain_memory_increase_reservation: handle -> domid -> int64 -> unit
> - = "stub_xc_domain_memory_increase_reservation"
> -
> -external domain_set_machine_address_size: handle -> domid -> int -> unit
> - = "stub_xc_domain_set_machine_address_size"
> -external domain_get_machine_address_size: handle -> domid -> int
> - = "stub_xc_domain_get_machine_address_size"
> -
> -external domain_cpuid_set: handle -> domid -> (int64 * (int64 option))
> - -> string option array
> - -> string option array
> - = "stub_xc_domain_cpuid_set"
> -external domain_cpuid_apply_policy: handle -> domid -> unit
> - = "stub_xc_domain_cpuid_apply_policy"
> -external cpuid_check: handle -> (int64 * (int64 option)) -> string option
> array -> (bool * string option array)
> - = "stub_xc_cpuid_check"
> -
> -external map_foreign_range: handle -> domid -> int
> - -> nativeint -> Mmap.mmap_interface
> - = "stub_map_foreign_range"
> -
> -external domain_get_pfn_list: handle -> domid -> nativeint -> nativeint array
> - = "stub_xc_domain_get_pfn_list"
> -
> -external domain_assign_device: handle -> domid -> (int * int * int * int) ->
> unit
> - = "stub_xc_domain_assign_device"
> -external domain_deassign_device: handle -> domid -> (int * int * int * int)
> -> unit
> - = "stub_xc_domain_deassign_device"
> -external domain_test_assign_device: handle -> domid -> (int * int * int *
> int) -> bool
> - = "stub_xc_domain_test_assign_device"
> -
> -external version: handle -> version = "stub_xc_version_version"
> -external version_compile_info: handle -> compile_info
> - = "stub_xc_version_compile_info"
> -external version_changeset: handle -> string = "stub_xc_version_changeset"
> -external version_capabilities: handle -> string =
> - "stub_xc_version_capabilities"
> -
> -external watchdog : handle -> int -> int32 -> int
> - = "stub_xc_watchdog"
> -
> -(* core dump structure *)
> -type core_magic = Magic_hvm | Magic_pv
> -
> -type core_header = {
> - xch_magic: core_magic;
> - xch_nr_vcpus: int;
> - xch_nr_pages: nativeint;
> - xch_index_offset: int64;
> - xch_ctxt_offset: int64;
> - xch_pages_offset: int64;
> -}
> -
> -external marshall_core_header: core_header -> string =
> "stub_marshall_core_header"
> -
> -(* coredump *)
> -let coredump xch domid fd =
> - let dump s =
> - let wd = Unix.write fd s 0 (String.length s) in
> - if wd <> String.length s then
> - failwith "error while writing";
> - in
> -
> - let info = domain_getinfo xch domid in
> -
> - let nrpages = info.total_memory_pages in
> - let ctxt = Array.make info.max_vcpu_id None in
> - let nr_vcpus = ref 0 in
> - for i = 0 to info.max_vcpu_id - 1
> - do
> - ctxt.(i) <- try
> - let v = vcpu_context_get xch domid i in
> - incr nr_vcpus;
> - Some v
> - with _ -> None
> - done;
> -
> - (* FIXME page offset if not rounded to sup *)
> - let page_offset =
> - Int64.add
> - (Int64.of_int (sizeof_core_header () +
> - (sizeof_vcpu_guest_context () * !nr_vcpus)))
> - (Int64.of_nativeint (
> - Nativeint.mul
> - (Nativeint.of_int (sizeof_xen_pfn ()))
> - nrpages)
> - )
> - in
> -
> - let header = {
> - xch_magic = if info.hvm_guest then Magic_hvm else Magic_pv;
> - xch_nr_vcpus = !nr_vcpus;
> - xch_nr_pages = nrpages;
> - xch_ctxt_offset = Int64.of_int (sizeof_core_header ());
> - xch_index_offset = Int64.of_int (sizeof_core_header ()
> - + sizeof_vcpu_guest_context ());
> - xch_pages_offset = page_offset;
> - } in
> -
> - dump (marshall_core_header header);
> - for i = 0 to info.max_vcpu_id - 1
> - do
> - match ctxt.(i) with
> - | None -> ()
> - | Some ctxt_i -> dump ctxt_i
> - done;
> - let pfns = domain_get_pfn_list xch domid nrpages in
> - if Array.length pfns <> Nativeint.to_int nrpages then
> - failwith "could not get the page frame list";
> -
> - let page_size = Mmap.getpagesize () in
> - for i = 0 to Nativeint.to_int nrpages - 1
> - do
> - let page = map_foreign_range xch domid page_size pfns.(i) in
> - let data = Mmap.read page 0 page_size in
> - Mmap.unmap page;
> - dump data
> - done
> -
> -(* ** Misc ** *)
> -
> -(**
> - Convert the given number of pages to an amount in KiB, rounded up.
> - *)
> -external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
> -let pages_to_mib pages = Int64.div (pages_to_kib pages) 1024L
> -
> -let _ = Callback.register_exception "xc.error" (Error "register_callback")
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xc/xc.mli
> --- a/tools/ocaml/libs/xc/xc.mli
> +++ /dev/null
> @@ -1,184 +0,0 @@
> -(*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - *)
> -
> -type domid = int
> -type vcpuinfo = {
> - online : bool;
> - blocked : bool;
> - running : bool;
> - cputime : int64;
> - cpumap : int32;
> -}
> -type domaininfo = {
> - domid : domid;
> - dying : bool;
> - shutdown : bool;
> - paused : bool;
> - blocked : bool;
> - running : bool;
> - hvm_guest : bool;
> - shutdown_code : int;
> - total_memory_pages : nativeint;
> - max_memory_pages : nativeint;
> - shared_info_frame : int64;
> - cpu_time : int64;
> - nr_online_vcpus : int;
> - max_vcpu_id : int;
> - ssidref : int32;
> - handle : int array;
> -}
> -type sched_control = { weight : int; cap : int; }
> -type physinfo_cap_flag = CAP_HVM | CAP_DirectIO
> -type physinfo = {
> - threads_per_core : int;
> - cores_per_socket : int;
> - nr_cpus : int;
> - max_node_id : int;
> - cpu_khz : int;
> - total_pages : nativeint;
> - free_pages : nativeint;
> - scrub_pages : nativeint;
> - capabilities : physinfo_cap_flag list;
> -}
> -type version = { major : int; minor : int; extra : string; }
> -type compile_info = {
> - compiler : string;
> - compile_by : string;
> - compile_domain : string;
> - compile_date : string;
> -}
> -type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt
> -
> -type domain_create_flag = CDF_HVM | CDF_HAP
> -
> -exception Error of string
> -type handle
> -external sizeof_core_header : unit -> int = "stub_sizeof_core_header"
> -external sizeof_vcpu_guest_context : unit -> int
> - = "stub_sizeof_vcpu_guest_context"
> -external sizeof_xen_pfn : unit -> int = "stub_sizeof_xen_pfn"
> -external interface_open : unit -> handle = "stub_xc_interface_open"
> -external is_fake : unit -> bool = "stub_xc_interface_is_fake"
> -external interface_close : handle -> unit = "stub_xc_interface_close"
> -val with_intf : (handle -> 'a) -> 'a
> -external _domain_create : handle -> int32 -> domain_create_flag list -> int
> array -> domid
> - = "stub_xc_domain_create"
> -val domain_create : handle -> int32 -> domain_create_flag list -> 'a Uuid.t
> -> domid
> -external _domain_sethandle : handle -> domid -> int array -> unit
> - = "stub_xc_domain_sethandle"
> -val domain_sethandle : handle -> domid -> 'a Uuid.t -> unit
> -external domain_max_vcpus : handle -> domid -> int -> unit
> - = "stub_xc_domain_max_vcpus"
> -external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause"
> -external domain_unpause : handle -> domid -> unit = "stub_xc_domain_unpause"
> -external domain_resume_fast : handle -> domid -> unit
> - = "stub_xc_domain_resume_fast"
> -external domain_destroy : handle -> domid -> unit = "stub_xc_domain_destroy"
> -external domain_shutdown : handle -> domid -> shutdown_reason -> unit
> - = "stub_xc_domain_shutdown"
> -external _domain_getinfolist : handle -> domid -> int -> domaininfo list
> - = "stub_xc_domain_getinfolist"
> -val domain_getinfolist : handle -> domid -> domaininfo list
> -external domain_getinfo : handle -> domid -> domaininfo
> - = "stub_xc_domain_getinfo"
> -external domain_get_vcpuinfo : handle -> int -> int -> vcpuinfo
> - = "stub_xc_vcpu_getinfo"
> -external domain_ioport_permission: handle -> domid -> int -> int -> bool ->
> unit
> - = "stub_xc_domain_ioport_permission"
> -external domain_iomem_permission: handle -> domid -> nativeint -> nativeint
> -> bool -> unit
> - = "stub_xc_domain_iomem_permission"
> -external domain_irq_permission: handle -> domid -> int -> bool -> unit
> - = "stub_xc_domain_irq_permission"
> -external vcpu_affinity_set : handle -> domid -> int -> bool array -> unit
> - = "stub_xc_vcpu_setaffinity"
> -external vcpu_affinity_get : handle -> domid -> int -> bool array
> - = "stub_xc_vcpu_getaffinity"
> -external vcpu_context_get : handle -> domid -> int -> string
> - = "stub_xc_vcpu_context_get"
> -external sched_id : handle -> int = "stub_xc_sched_id"
> -external sched_credit_domain_set : handle -> domid -> sched_control -> unit
> - = "stub_sched_credit_domain_set"
> -external sched_credit_domain_get : handle -> domid -> sched_control
> - = "stub_sched_credit_domain_get"
> -external shadow_allocation_set : handle -> domid -> int -> unit
> - = "stub_shadow_allocation_set"
> -external shadow_allocation_get : handle -> domid -> int
> - = "stub_shadow_allocation_get"
> -external evtchn_alloc_unbound : handle -> domid -> domid -> int
> - = "stub_xc_evtchn_alloc_unbound"
> -external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset"
> -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"
> -external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
> -external domain_setmaxmem : handle -> domid -> int64 -> unit
> - = "stub_xc_domain_setmaxmem"
> -external domain_set_memmap_limit : handle -> domid -> int64 -> unit
> - = "stub_xc_domain_set_memmap_limit"
> -external domain_memory_increase_reservation :
> - handle -> domid -> int64 -> unit
> - = "stub_xc_domain_memory_increase_reservation"
> -external map_foreign_range :
> - handle -> domid -> int -> nativeint -> Mmap.mmap_interface
> - = "stub_map_foreign_range"
> -external domain_get_pfn_list :
> - handle -> domid -> nativeint -> nativeint array
> - = "stub_xc_domain_get_pfn_list"
> -
> -external domain_assign_device: handle -> domid -> (int * int * int * int) ->
> unit
> - = "stub_xc_domain_assign_device"
> -external domain_deassign_device: handle -> domid -> (int * int * int * int)
> -> unit
> - = "stub_xc_domain_deassign_device"
> -external domain_test_assign_device: handle -> domid -> (int * int * int *
> int) -> bool
> - = "stub_xc_domain_test_assign_device"
> -
> -external version : handle -> version = "stub_xc_version_version"
> -external version_compile_info : handle -> compile_info
> - = "stub_xc_version_compile_info"
> -external version_changeset : handle -> string = "stub_xc_version_changeset"
> -external version_capabilities : handle -> string
> - = "stub_xc_version_capabilities"
> -type core_magic = Magic_hvm | Magic_pv
> -type core_header = {
> - xch_magic : core_magic;
> - xch_nr_vcpus : int;
> - xch_nr_pages : nativeint;
> - xch_index_offset : int64;
> - xch_ctxt_offset : int64;
> - xch_pages_offset : int64;
> -}
> -external marshall_core_header : core_header -> string
> - = "stub_marshall_core_header"
> -val coredump : handle -> domid -> Unix.file_descr -> unit
> -external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
> -val pages_to_mib : int64 -> int64
> -external watchdog : handle -> int -> int32 -> int
> - = "stub_xc_watchdog"
> -
> -external domain_set_machine_address_size: handle -> domid -> int -> unit
> - = "stub_xc_domain_set_machine_address_size"
> -external domain_get_machine_address_size: handle -> domid -> int
> - = "stub_xc_domain_get_machine_address_size"
> -
> -external domain_cpuid_set: handle -> domid -> (int64 * (int64 option))
> - -> string option array
> - -> string option array
> - = "stub_xc_domain_cpuid_set"
> -external domain_cpuid_apply_policy: handle -> domid -> unit
> - = "stub_xc_domain_cpuid_apply_policy"
> -external cpuid_check: handle -> (int64 * (int64 option)) -> string option
> array -> (bool * string option array)
> - = "stub_xc_cpuid_check"
> -
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xc/xc_stubs.c
> --- a/tools/ocaml/libs/xc/xc_stubs.c
> +++ /dev/null
> @@ -1,1161 +0,0 @@
> -/*
> - * Copyright (C) 2006-2007 XenSource Ltd.
> - * Copyright (C) 2008 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - */
> -
> -#define _XOPEN_SOURCE 600
> -#include <stdlib.h>
> -#include <errno.h>
> -
> -#define CAML_NAME_SPACE
> -#include <caml/alloc.h>
> -#include <caml/memory.h>
> -#include <caml/signals.h>
> -#include <caml/fail.h>
> -#include <caml/callback.h>
> -
> -#include <sys/mman.h>
> -#include <stdint.h>
> -#include <string.h>
> -
> -#include <xenctrl.h>
> -
> -#include "mmap_stubs.h"
> -
> -#define PAGE_SHIFT 12
> -#define PAGE_SIZE (1UL << PAGE_SHIFT)
> -#define PAGE_MASK (~(PAGE_SIZE-1))
> -
> -#define _H(__h) ((xc_interface *)(__h))
> -#define _D(__d) ((uint32_t)Int_val(__d))
> -
> -#define Val_none (Val_int(0))
> -
> -#define string_of_option_array(array, index) \
> - ((Field(array, index) == Val_none) ? NULL :
> String_val(Field(Field(array, index), 0)))
> -
> -/* maybe here we should check the range of the input instead of blindly
> - * casting it to uint32 */
> -#define cpuid_input_of_val(i1, i2, input) \
> - i1 = (uint32_t) Int64_val(Field(input, 0)); \
> - i2 = ((Field(input, 1) == Val_none) ? 0xffffffff : (uint32_t)
> Int64_val(Field(Field(input, 1), 0)));
> -
> -#define ERROR_STRLEN 1024
> -void failwith_xc(xc_interface *xch)
> -{
> - static char error_str[ERROR_STRLEN];
> - if (xch) {
> - const xc_error *error = xc_get_last_error(xch);
> - if (error->code == XC_ERROR_NONE)
> - snprintf(error_str, ERROR_STRLEN, "%d: %s", errno,
> strerror(errno));
> - else
> - snprintf(error_str, ERROR_STRLEN, "%d: %s: %s",
> - error->code,
> - xc_error_code_to_desc(error->code),
> - error->message);
> - } else {
> - snprintf(error_str, ERROR_STRLEN, "Unable to open XC
> interface");
> - }
> - caml_raise_with_string(*caml_named_value("xc.error"), error_str);
> -}
> -
> -CAMLprim value stub_sizeof_core_header(value unit)
> -{
> - CAMLparam1(unit);
> - CAMLreturn(Val_int(sizeof(struct xc_core_header)));
> -}
> -
> -CAMLprim value stub_sizeof_vcpu_guest_context(value unit)
> -{
> - CAMLparam1(unit);
> - CAMLreturn(Val_int(sizeof(struct vcpu_guest_context)));
> -}
> -
> -CAMLprim value stub_sizeof_xen_pfn(value unit)
> -{
> - CAMLparam1(unit);
> - CAMLreturn(Val_int(sizeof(xen_pfn_t)));
> -}
> -
> -#define XC_CORE_MAGIC 0xF00FEBED
> -#define XC_CORE_MAGIC_HVM 0xF00FEBEE
> -
> -CAMLprim value stub_marshall_core_header(value header)
> -{
> - CAMLparam1(header);
> - CAMLlocal1(s);
> - struct xc_core_header c_header;
> -
> - c_header.xch_magic = (Field(header, 0))
> - ? XC_CORE_MAGIC
> - : XC_CORE_MAGIC_HVM;
> - c_header.xch_nr_vcpus = Int_val(Field(header, 1));
> - c_header.xch_nr_pages = Nativeint_val(Field(header, 2));
> - c_header.xch_ctxt_offset = Int64_val(Field(header, 3));
> - c_header.xch_index_offset = Int64_val(Field(header, 4));
> - c_header.xch_pages_offset = Int64_val(Field(header, 5));
> -
> - s = caml_alloc_string(sizeof(c_header));
> - memcpy(String_val(s), (char *) &c_header, sizeof(c_header));
> - CAMLreturn(s);
> -}
> -
> -CAMLprim value stub_xc_interface_open(void)
> -{
> - CAMLparam0();
> - xc_interface *xch;
> - xch = xc_interface_open(NULL, NULL, XC_OPENFLAG_NON_REENTRANT);
> - if (xch == NULL)
> - failwith_xc(NULL);
> - CAMLreturn((value)xch);
> -}
> -
> -
> -CAMLprim value stub_xc_interface_is_fake(void)
> -{
> - CAMLparam0();
> - int is_fake = xc_interface_is_fake();
> - CAMLreturn(Val_int(is_fake));
> -}
> -
> -CAMLprim value stub_xc_interface_close(value xch)
> -{
> - CAMLparam1(xch);
> -
> - // caml_enter_blocking_section();
> - xc_interface_close(_H(xch));
> - // caml_leave_blocking_section();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -static int domain_create_flag_table[] = {
> - XEN_DOMCTL_CDF_hvm_guest,
> - XEN_DOMCTL_CDF_hap,
> -};
> -
> -CAMLprim value stub_xc_domain_create(value xch, value ssidref,
> - value flags, value handle)
> -{
> - CAMLparam4(xch, ssidref, flags, handle);
> -
> - uint32_t domid = 0;
> - xen_domain_handle_t h = { 0 };
> - int result;
> - int i;
> - uint32_t c_ssidref = Int32_val(ssidref);
> - unsigned int c_flags = 0;
> - value l;
> -
> - if (Wosize_val(handle) != 16)
> - caml_invalid_argument("Handle not a 16-integer array");
> -
> - for (i = 0; i < sizeof(h); i++) {
> - h[i] = Int_val(Field(handle, i)) & 0xff;
> - }
> -
> - for (l = flags; l != Val_none; l = Field(l, 1)) {
> - int v = Int_val(Field(l, 0));
> - c_flags |= domain_create_flag_table[v];
> - }
> -
> - // caml_enter_blocking_section();
> - result = xc_domain_create(_H(xch), c_ssidref, h, c_flags, &domid);
> - // caml_leave_blocking_section();
> -
> - if (result < 0)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_int(domid));
> -}
> -
> -CAMLprim value stub_xc_domain_max_vcpus(value xch, value domid,
> - value max_vcpus)
> -{
> - CAMLparam3(xch, domid, max_vcpus);
> - int r;
> -
> - r = xc_domain_max_vcpus(_H(xch), _D(domid), Int_val(max_vcpus));
> - if (r)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -
> -value stub_xc_domain_sethandle(value xch, value domid, value handle)
> -{
> - CAMLparam3(xch, domid, handle);
> - xen_domain_handle_t h = { 0 };
> - int i;
> -
> - if (Wosize_val(handle) != 16)
> - caml_invalid_argument("Handle not a 16-integer array");
> -
> - for (i = 0; i < sizeof(h); i++) {
> - h[i] = Int_val(Field(handle, i)) & 0xff;
> - }
> -
> - i = xc_domain_sethandle(_H(xch), _D(domid), h);
> - if (i)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -static value dom_op(value xch, value domid, int (*fn)(xc_interface *,
> uint32_t))
> -{
> - CAMLparam2(xch, domid);
> -
> - uint32_t c_domid = _D(domid);
> -
> - // caml_enter_blocking_section();
> - int result = fn(_H(xch), c_domid);
> - // caml_leave_blocking_section();
> - if (result)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_pause(value xch, value domid)
> -{
> - return dom_op(xch, domid, xc_domain_pause);
> -}
> -
> -
> -CAMLprim value stub_xc_domain_unpause(value xch, value domid)
> -{
> - return dom_op(xch, domid, xc_domain_unpause);
> -}
> -
> -CAMLprim value stub_xc_domain_destroy(value xch, value domid)
> -{
> - return dom_op(xch, domid, xc_domain_destroy);
> -}
> -
> -CAMLprim value stub_xc_domain_resume_fast(value xch, value domid)
> -{
> - CAMLparam2(xch, domid);
> -
> - uint32_t c_domid = _D(domid);
> -
> - // caml_enter_blocking_section();
> - int result = xc_domain_resume(_H(xch), c_domid, 1);
> - // caml_leave_blocking_section();
> - if (result)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_shutdown(value xch, value domid, value reason)
> -{
> - CAMLparam3(xch, domid, reason);
> - int ret;
> -
> - ret = xc_domain_shutdown(_H(xch), _D(domid), Int_val(reason));
> - if (ret < 0)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -static value alloc_domaininfo(xc_domaininfo_t * info)
> -{
> - CAMLparam0();
> - CAMLlocal2(result, tmp);
> - int i;
> -
> - result = caml_alloc_tuple(16);
> -
> - Store_field(result, 0, Val_int(info->domain));
> - Store_field(result, 1, Val_bool(info->flags & XEN_DOMINF_dying));
> - Store_field(result, 2, Val_bool(info->flags & XEN_DOMINF_shutdown));
> - Store_field(result, 3, Val_bool(info->flags & XEN_DOMINF_paused));
> - Store_field(result, 4, Val_bool(info->flags & XEN_DOMINF_blocked));
> - Store_field(result, 5, Val_bool(info->flags & XEN_DOMINF_running));
> - Store_field(result, 6, Val_bool(info->flags & XEN_DOMINF_hvm_guest));
> - Store_field(result, 7, Val_int((info->flags >>
> XEN_DOMINF_shutdownshift)
> - & XEN_DOMINF_shutdownmask));
> - Store_field(result, 8, caml_copy_nativeint(info->tot_pages));
> - Store_field(result, 9, caml_copy_nativeint(info->max_pages));
> - Store_field(result, 10, caml_copy_int64(info->shared_info_frame));
> - Store_field(result, 11, caml_copy_int64(info->cpu_time));
> - Store_field(result, 12, Val_int(info->nr_online_vcpus));
> - Store_field(result, 13, Val_int(info->max_vcpu_id));
> - Store_field(result, 14, caml_copy_int32(info->ssidref));
> -
> - tmp = caml_alloc_small(16, 0);
> - for (i = 0; i < 16; i++) {
> - Field(tmp, i) = Val_int(info->handle[i]);
> - }
> -
> - Store_field(result, 15, tmp);
> -
> - CAMLreturn(result);
> -}
> -
> -CAMLprim value stub_xc_domain_getinfolist(value xch, value first_domain,
> value nb)
> -{
> - CAMLparam3(xch, first_domain, nb);
> - CAMLlocal2(result, temp);
> - xc_domaininfo_t * info;
> - int i, ret, toalloc, retval;
> - unsigned int c_max_domains;
> - uint32_t c_first_domain;
> -
> - /* get the minimum number of allocate byte we need and bump it up to
> page boundary */
> - toalloc = (sizeof(xc_domaininfo_t) * Int_val(nb)) | 0xfff;
> - ret = posix_memalign((void **) ((void *) &info), 4096, toalloc);
> - if (ret)
> - caml_raise_out_of_memory();
> -
> - result = temp = Val_emptylist;
> -
> - c_first_domain = _D(first_domain);
> - c_max_domains = Int_val(nb);
> - // caml_enter_blocking_section();
> - retval = xc_domain_getinfolist(_H(xch), c_first_domain,
> - c_max_domains, info);
> - // caml_leave_blocking_section();
> -
> - if (retval < 0) {
> - free(info);
> - failwith_xc(_H(xch));
> - }
> - for (i = 0; i < retval; i++) {
> - result = caml_alloc_small(2, Tag_cons);
> - Field(result, 0) = Val_int(0);
> - Field(result, 1) = temp;
> - temp = result;
> -
> - Store_field(result, 0, alloc_domaininfo(info + i));
> - }
> -
> - free(info);
> - CAMLreturn(result);
> -}
> -
> -CAMLprim value stub_xc_domain_getinfo(value xch, value domid)
> -{
> - CAMLparam2(xch, domid);
> - CAMLlocal1(result);
> - xc_domaininfo_t info;
> - int ret;
> -
> - ret = xc_domain_getinfolist(_H(xch), _D(domid), 1, &info);
> - if (ret != 1)
> - failwith_xc(_H(xch));
> - if (info.domain != _D(domid))
> - failwith_xc(_H(xch));
> -
> - result = alloc_domaininfo(&info);
> - CAMLreturn(result);
> -}
> -
> -CAMLprim value stub_xc_vcpu_getinfo(value xch, value domid, value vcpu)
> -{
> - CAMLparam3(xch, domid, vcpu);
> - CAMLlocal1(result);
> - xc_vcpuinfo_t info;
> - int retval;
> -
> - uint32_t c_domid = _D(domid);
> - uint32_t c_vcpu = Int_val(vcpu);
> - // caml_enter_blocking_section();
> - retval = xc_vcpu_getinfo(_H(xch), c_domid,
> - c_vcpu, &info);
> - // caml_leave_blocking_section();
> - if (retval < 0)
> - failwith_xc(_H(xch));
> -
> - result = caml_alloc_tuple(5);
> - Store_field(result, 0, Val_bool(info.online));
> - Store_field(result, 1, Val_bool(info.blocked));
> - Store_field(result, 2, Val_bool(info.running));
> - Store_field(result, 3, caml_copy_int64(info.cpu_time));
> - Store_field(result, 4, caml_copy_int32(info.cpu));
> -
> - CAMLreturn(result);
> -}
> -
> -CAMLprim value stub_xc_vcpu_context_get(value xch, value domid,
> - value cpu)
> -{
> - CAMLparam3(xch, domid, cpu);
> - CAMLlocal1(context);
> - int ret;
> - vcpu_guest_context_any_t ctxt;
> -
> - ret = xc_vcpu_getcontext(_H(xch), _D(domid), Int_val(cpu), &ctxt);
> -
> - context = caml_alloc_string(sizeof(ctxt));
> - memcpy(String_val(context), (char *) &ctxt.c, sizeof(ctxt.c));
> -
> - CAMLreturn(context);
> -}
> -
> -static int get_cpumap_len(value xch, value cpumap)
> -{
> - int ml_len = Wosize_val(cpumap);
> - int xc_len = xc_get_max_cpus(_H(xch));
> -
> - if (ml_len < xc_len)
> - return ml_len;
> - else
> - return xc_len;
> -}
> -
> -CAMLprim value stub_xc_vcpu_setaffinity(value xch, value domid,
> - value vcpu, value cpumap)
> -{
> - CAMLparam4(xch, domid, vcpu, cpumap);
> - int i, len = get_cpumap_len(xch, cpumap);
> - xc_cpumap_t c_cpumap;
> - int retval;
> -
> - c_cpumap = xc_cpumap_alloc(_H(xch));
> - if (c_cpumap == NULL)
> - failwith_xc(_H(xch));
> -
> - for (i=0; i<len; i++) {
> - if (Bool_val(Field(cpumap, i)))
> - c_cpumap[i/8] |= i << (i&7);
> - }
> - retval = xc_vcpu_setaffinity(_H(xch), _D(domid),
> - Int_val(vcpu), c_cpumap);
> - free(c_cpumap);
> -
> - if (retval < 0)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_vcpu_getaffinity(value xch, value domid,
> - value vcpu)
> -{
> - CAMLparam3(xch, domid, vcpu);
> - CAMLlocal1(ret);
> - xc_cpumap_t c_cpumap;
> - int i, len = xc_get_max_cpus(_H(xch));
> - int retval;
> -
> - c_cpumap = xc_cpumap_alloc(_H(xch));
> - if (c_cpumap == NULL)
> - failwith_xc(_H(xch));
> -
> - retval = xc_vcpu_getaffinity(_H(xch), _D(domid),
> - Int_val(vcpu), c_cpumap);
> - free(c_cpumap);
> -
> - if (retval < 0) {
> - free(c_cpumap);
> - failwith_xc(_H(xch));
> - }
> -
> - ret = caml_alloc(len, 0);
> -
> - for (i=0; i<len; i++) {
> - if (c_cpumap[i%8] & 1 << (i&7))
> - Store_field(ret, i, Val_true);
> - else
> - Store_field(ret, i, Val_false);
> - }
> -
> - free(c_cpumap);
> -
> - CAMLreturn(ret);
> -}
> -
> -CAMLprim value stub_xc_sched_id(value xch)
> -{
> - CAMLparam1(xch);
> - int sched_id;
> -
> - if (xc_sched_id(_H(xch), &sched_id))
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_int(sched_id));
> -}
> -
> -CAMLprim value stub_xc_evtchn_alloc_unbound(value xch,
> - value local_domid,
> - value remote_domid)
> -{
> - CAMLparam3(xch, local_domid, remote_domid);
> -
> - uint32_t c_local_domid = _D(local_domid);
> - uint32_t c_remote_domid = _D(remote_domid);
> -
> - // caml_enter_blocking_section();
> - int result = xc_evtchn_alloc_unbound(_H(xch), c_local_domid,
> - c_remote_domid);
> - // caml_leave_blocking_section();
> -
> - if (result < 0)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_int(result));
> -}
> -
> -CAMLprim value stub_xc_evtchn_reset(value xch, value domid)
> -{
> - CAMLparam2(xch, domid);
> - int r;
> -
> - r = xc_evtchn_reset(_H(xch), _D(domid));
> - if (r < 0)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -
> -#define RING_SIZE 32768
> -static char ring[RING_SIZE];
> -
> -CAMLprim value stub_xc_readconsolering(value xch)
> -{
> - unsigned int size = RING_SIZE;
> - char *ring_ptr = ring;
> -
> - CAMLparam1(xch);
> -
> - // caml_enter_blocking_section();
> - int retval = xc_readconsolering(_H(xch), ring_ptr, &size, 0, 0, NULL);
> - // caml_leave_blocking_section();
> -
> - if (retval)
> - failwith_xc(_H(xch));
> - ring[size] = '\0';
> - CAMLreturn(caml_copy_string(ring));
> -}
> -
> -CAMLprim value stub_xc_send_debug_keys(value xch, value keys)
> -{
> - CAMLparam2(xch, keys);
> - int r;
> -
> - r = xc_send_debug_keys(_H(xch), String_val(keys));
> - if (r)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_physinfo(value xch)
> -{
> - CAMLparam1(xch);
> - CAMLlocal3(physinfo, cap_list, tmp);
> - xc_physinfo_t c_physinfo;
> - int r;
> -
> - // caml_enter_blocking_section();
> - r = xc_physinfo(_H(xch), &c_physinfo);
> - // caml_leave_blocking_section();
> -
> - if (r)
> - failwith_xc(_H(xch));
> -
> - tmp = cap_list = Val_emptylist;
> - for (r = 0; r < 2; r++) {
> - if ((c_physinfo.capabilities >> r) & 1) {
> - tmp = caml_alloc_small(2, Tag_cons);
> - Field(tmp, 0) = Val_int(r);
> - Field(tmp, 1) = cap_list;
> - cap_list = tmp;
> - }
> - }
> -
> - physinfo = caml_alloc_tuple(9);
> - Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core));
> - Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket));
> - Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus));
> - Store_field(physinfo, 3, Val_int(c_physinfo.max_node_id));
> - Store_field(physinfo, 4, Val_int(c_physinfo.cpu_khz));
> - Store_field(physinfo, 5, caml_copy_nativeint(c_physinfo.total_pages));
> - Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages));
> - Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages));
> - Store_field(physinfo, 8, cap_list);
> -
> - CAMLreturn(physinfo);
> -}
> -
> -CAMLprim value stub_xc_pcpu_info(value xch, value nr_cpus)
> -{
> - CAMLparam2(xch, nr_cpus);
> - CAMLlocal2(pcpus, v);
> - xc_cpuinfo_t *info;
> - int r, size;
> -
> - if (Int_val(nr_cpus) < 1)
> - caml_invalid_argument("nr_cpus");
> -
> - info = calloc(Int_val(nr_cpus) + 1, sizeof(*info));
> - if (!info)
> - caml_raise_out_of_memory();
> -
> - // caml_enter_blocking_section();
> - r = xc_getcpuinfo(_H(xch), Int_val(nr_cpus), info, &size);
> - // caml_leave_blocking_section();
> -
> - if (r) {
> - free(info);
> - failwith_xc(_H(xch));
> - }
> -
> - if (size > 0) {
> - int i;
> - pcpus = caml_alloc(size, 0);
> - for (i = 0; i < size; i++) {
> - v = caml_copy_int64(info[i].idletime);
> - caml_modify(&Field(pcpus, i), v);
> - }
> - } else
> - pcpus = Atom(0);
> - free(info);
> - CAMLreturn(pcpus);
> -}
> -
> -CAMLprim value stub_xc_domain_setmaxmem(value xch, value domid,
> - value max_memkb)
> -{
> - CAMLparam3(xch, domid, max_memkb);
> -
> - uint32_t c_domid = _D(domid);
> - unsigned int c_max_memkb = Int64_val(max_memkb);
> - // caml_enter_blocking_section();
> - int retval = xc_domain_setmaxmem(_H(xch), c_domid,
> - c_max_memkb);
> - // caml_leave_blocking_section();
> - if (retval)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_set_memmap_limit(value xch, value domid,
> - value map_limitkb)
> -{
> - CAMLparam3(xch, domid, map_limitkb);
> - unsigned long v;
> - int retval;
> -
> - v = Int64_val(map_limitkb);
> - retval = xc_domain_set_memmap_limit(_H(xch), _D(domid), v);
> - if (retval)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_memory_increase_reservation(value xch,
> - value domid,
> - value mem_kb)
> -{
> - CAMLparam3(xch, domid, mem_kb);
> -
> - unsigned long nr_extents = ((unsigned long)(Int64_val(mem_kb))) >>
> (PAGE_SHIFT - 10);
> -
> - uint32_t c_domid = _D(domid);
> - // caml_enter_blocking_section();
> - int retval = xc_domain_increase_reservation_exact(_H(xch), c_domid,
> - nr_extents, 0, 0,
> NULL);
> - // caml_leave_blocking_section();
> -
> - if (retval)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_set_machine_address_size(value xch,
> - value domid,
> - value width)
> -{
> - CAMLparam3(xch, domid, width);
> - uint32_t c_domid = _D(domid);
> - int c_width = Int_val(width);
> -
> - int retval = xc_domain_set_machine_address_size(_H(xch), c_domid,
> c_width);
> - if (retval)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_get_machine_address_size(value xch,
> - value domid)
> -{
> - CAMLparam2(xch, domid);
> - int retval;
> -
> - retval = xc_domain_get_machine_address_size(_H(xch), _D(domid));
> - if (retval < 0)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_int(retval));
> -}
> -
> -CAMLprim value stub_xc_domain_cpuid_set(value xch, value domid,
> - value input,
> - value config)
> -{
> - CAMLparam4(xch, domid, input, config);
> - CAMLlocal2(array, tmp);
> - int r;
> - unsigned int c_input[2];
> - char *c_config[4], *out_config[4];
> -
> - c_config[0] = string_of_option_array(config, 0);
> - c_config[1] = string_of_option_array(config, 1);
> - c_config[2] = string_of_option_array(config, 2);
> - c_config[3] = string_of_option_array(config, 3);
> -
> - cpuid_input_of_val(c_input[0], c_input[1], input);
> -
> - array = caml_alloc(4, 0);
> - for (r = 0; r < 4; r++) {
> - tmp = Val_none;
> - if (c_config[r]) {
> - tmp = caml_alloc_small(1, 0);
> - Field(tmp, 0) = caml_alloc_string(32);
> - }
> - Store_field(array, r, tmp);
> - }
> -
> - for (r = 0; r < 4; r++)
> - out_config[r] = (c_config[r]) ? String_val(Field(Field(array,
> r), 0)) : NULL;
> -
> - r = xc_cpuid_set(_H(xch), _D(domid),
> - c_input, (const char **)c_config, out_config);
> - if (r < 0)
> - failwith_xc(_H(xch));
> - CAMLreturn(array);
> -}
> -
> -CAMLprim value stub_xc_domain_cpuid_apply_policy(value xch, value domid)
> -{
> - CAMLparam2(xch, domid);
> - int r;
> -
> - r = xc_cpuid_apply_policy(_H(xch), _D(domid));
> - if (r < 0)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_cpuid_check(value xch, value input, value config)
> -{
> - CAMLparam3(xch, input, config);
> - CAMLlocal3(ret, array, tmp);
> - int r;
> - unsigned int c_input[2];
> - char *c_config[4], *out_config[4];
> -
> - c_config[0] = string_of_option_array(config, 0);
> - c_config[1] = string_of_option_array(config, 1);
> - c_config[2] = string_of_option_array(config, 2);
> - c_config[3] = string_of_option_array(config, 3);
> -
> - cpuid_input_of_val(c_input[0], c_input[1], input);
> -
> - array = caml_alloc(4, 0);
> - for (r = 0; r < 4; r++) {
> - tmp = Val_none;
> - if (c_config[r]) {
> - tmp = caml_alloc_small(1, 0);
> - Field(tmp, 0) = caml_alloc_string(32);
> - }
> - Store_field(array, r, tmp);
> - }
> -
> - for (r = 0; r < 4; r++)
> - out_config[r] = (c_config[r]) ? String_val(Field(Field(array,
> r), 0)) : NULL;
> -
> - r = xc_cpuid_check(_H(xch), c_input, (const char **)c_config,
> out_config);
> - if (r < 0)
> - failwith_xc(_H(xch));
> -
> - ret = caml_alloc_tuple(2);
> - Store_field(ret, 0, Val_bool(r));
> - Store_field(ret, 1, array);
> -
> - CAMLreturn(ret);
> -}
> -
> -CAMLprim value stub_xc_version_version(value xch)
> -{
> - CAMLparam1(xch);
> - CAMLlocal1(result);
> - xen_extraversion_t extra;
> - long packed;
> - int retval;
> -
> - // caml_enter_blocking_section();
> - packed = xc_version(_H(xch), XENVER_version, NULL);
> - retval = xc_version(_H(xch), XENVER_extraversion, &extra);
> - // caml_leave_blocking_section();
> -
> - if (retval)
> - failwith_xc(_H(xch));
> -
> - result = caml_alloc_tuple(3);
> -
> - Store_field(result, 0, Val_int(packed >> 16));
> - Store_field(result, 1, Val_int(packed & 0xffff));
> - Store_field(result, 2, caml_copy_string(extra));
> -
> - CAMLreturn(result);
> -}
> -
> -
> -CAMLprim value stub_xc_version_compile_info(value xch)
> -{
> - CAMLparam1(xch);
> - CAMLlocal1(result);
> - xen_compile_info_t ci;
> - int retval;
> -
> - // caml_enter_blocking_section();
> - retval = xc_version(_H(xch), XENVER_compile_info, &ci);
> - // caml_leave_blocking_section();
> -
> - if (retval)
> - failwith_xc(_H(xch));
> -
> - result = caml_alloc_tuple(4);
> -
> - Store_field(result, 0, caml_copy_string(ci.compiler));
> - Store_field(result, 1, caml_copy_string(ci.compile_by));
> - Store_field(result, 2, caml_copy_string(ci.compile_domain));
> - Store_field(result, 3, caml_copy_string(ci.compile_date));
> -
> - CAMLreturn(result);
> -}
> -
> -
> -static value xc_version_single_string(value xch, int code, void *info)
> -{
> - CAMLparam1(xch);
> - int retval;
> -
> - // caml_enter_blocking_section();
> - retval = xc_version(_H(xch), code, info);
> - // caml_leave_blocking_section();
> -
> - if (retval)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(caml_copy_string((char *)info));
> -}
> -
> -
> -CAMLprim value stub_xc_version_changeset(value xch)
> -{
> - xen_changeset_info_t ci;
> -
> - return xc_version_single_string(xch, XENVER_changeset, &ci);
> -}
> -
> -
> -CAMLprim value stub_xc_version_capabilities(value xch)
> -{
> - xen_capabilities_info_t ci;
> -
> - return xc_version_single_string(xch, XENVER_capabilities, &ci);
> -}
> -
> -
> -CAMLprim value stub_pages_to_kib(value pages)
> -{
> - CAMLparam1(pages);
> -
> - CAMLreturn(caml_copy_int64(Int64_val(pages) << (PAGE_SHIFT - 10)));
> -}
> -
> -
> -CAMLprim value stub_map_foreign_range(value xch, value dom,
> - value size, value mfn)
> -{
> - CAMLparam4(xch, dom, size, mfn);
> - CAMLlocal1(result);
> - struct mmap_interface *intf;
> - uint32_t c_dom;
> - unsigned long c_mfn;
> -
> - result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
> - intf = (struct mmap_interface *) result;
> -
> - intf->len = Int_val(size);
> -
> - c_dom = _D(dom);
> - c_mfn = Nativeint_val(mfn);
> - // caml_enter_blocking_section();
> - intf->addr = xc_map_foreign_range(_H(xch), c_dom,
> - intf->len, PROT_READ|PROT_WRITE,
> - c_mfn);
> - // caml_leave_blocking_section();
> - if (!intf->addr)
> - caml_failwith("xc_map_foreign_range error");
> - CAMLreturn(result);
> -}
> -
> -CAMLprim value stub_sched_credit_domain_get(value xch, value domid)
> -{
> - CAMLparam2(xch, domid);
> - CAMLlocal1(sdom);
> - struct xen_domctl_sched_credit c_sdom;
> - int ret;
> -
> - // caml_enter_blocking_section();
> - ret = xc_sched_credit_domain_get(_H(xch), _D(domid), &c_sdom);
> - // caml_leave_blocking_section();
> - if (ret != 0)
> - failwith_xc(_H(xch));
> -
> - sdom = caml_alloc_tuple(2);
> - Store_field(sdom, 0, Val_int(c_sdom.weight));
> - Store_field(sdom, 1, Val_int(c_sdom.cap));
> -
> - CAMLreturn(sdom);
> -}
> -
> -CAMLprim value stub_sched_credit_domain_set(value xch, value domid,
> - value sdom)
> -{
> - CAMLparam3(xch, domid, sdom);
> - struct xen_domctl_sched_credit c_sdom;
> - int ret;
> -
> - c_sdom.weight = Int_val(Field(sdom, 0));
> - c_sdom.cap = Int_val(Field(sdom, 1));
> - // caml_enter_blocking_section();
> - ret = xc_sched_credit_domain_set(_H(xch), _D(domid), &c_sdom);
> - // caml_leave_blocking_section();
> - if (ret != 0)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_shadow_allocation_get(value xch, value domid)
> -{
> - CAMLparam2(xch, domid);
> - CAMLlocal1(mb);
> - unsigned long c_mb;
> - int ret;
> -
> - // caml_enter_blocking_section();
> - ret = xc_shadow_control(_H(xch), _D(domid),
> - XEN_DOMCTL_SHADOW_OP_GET_ALLOCATION,
> - NULL, 0, &c_mb, 0, NULL);
> - // caml_leave_blocking_section();
> - if (ret != 0)
> - failwith_xc(_H(xch));
> -
> - mb = Val_int(c_mb);
> - CAMLreturn(mb);
> -}
> -
> -CAMLprim value stub_shadow_allocation_set(value xch, value domid,
> - value mb)
> -{
> - CAMLparam3(xch, domid, mb);
> - unsigned long c_mb;
> - int ret;
> -
> - c_mb = Int_val(mb);
> - // caml_enter_blocking_section();
> - ret = xc_shadow_control(_H(xch), _D(domid),
> - XEN_DOMCTL_SHADOW_OP_SET_ALLOCATION,
> - NULL, 0, &c_mb, 0, NULL);
> - // caml_leave_blocking_section();
> - if (ret != 0)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_get_pfn_list(value xch, value domid,
> - value nr_pfns)
> -{
> - CAMLparam3(xch, domid, nr_pfns);
> - CAMLlocal2(array, v);
> - unsigned long c_nr_pfns;
> - long ret, i;
> - uint64_t *c_array;
> -
> - c_nr_pfns = Nativeint_val(nr_pfns);
> -
> - c_array = malloc(sizeof(uint64_t) * c_nr_pfns);
> - if (!c_array)
> - caml_raise_out_of_memory();
> -
> - ret = xc_get_pfn_list(_H(xch), _D(domid),
> - c_array, c_nr_pfns);
> - if (ret < 0) {
> - free(c_array);
> - failwith_xc(_H(xch));
> - }
> -
> - array = caml_alloc(ret, 0);
> - for (i = 0; i < ret; i++) {
> - v = caml_copy_nativeint(c_array[i]);
> - Store_field(array, i, v);
> - }
> - free(c_array);
> -
> - CAMLreturn(array);
> -}
> -
> -CAMLprim value stub_xc_domain_ioport_permission(value xch, value domid,
> - value start_port, value
> nr_ports,
> - value allow)
> -{
> - CAMLparam5(xch, domid, start_port, nr_ports, allow);
> - uint32_t c_start_port, c_nr_ports;
> - uint8_t c_allow;
> - int ret;
> -
> - c_start_port = Int_val(start_port);
> - c_nr_ports = Int_val(nr_ports);
> - c_allow = Bool_val(allow);
> -
> - ret = xc_domain_ioport_permission(_H(xch), _D(domid),
> - c_start_port, c_nr_ports, c_allow);
> - if (ret < 0)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_iomem_permission(value xch, value domid,
> - value start_pfn, value nr_pfns,
> - value allow)
> -{
> - CAMLparam5(xch, domid, start_pfn, nr_pfns, allow);
> - unsigned long c_start_pfn, c_nr_pfns;
> - uint8_t c_allow;
> - int ret;
> -
> - c_start_pfn = Nativeint_val(start_pfn);
> - c_nr_pfns = Nativeint_val(nr_pfns);
> - c_allow = Bool_val(allow);
> -
> - ret = xc_domain_iomem_permission(_H(xch), _D(domid),
> - c_start_pfn, c_nr_pfns, c_allow);
> - if (ret < 0)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_irq_permission(value xch, value domid,
> - value pirq, value allow)
> -{
> - CAMLparam4(xch, domid, pirq, allow);
> - uint8_t c_pirq;
> - uint8_t c_allow;
> - int ret;
> -
> - c_pirq = Int_val(pirq);
> - c_allow = Bool_val(allow);
> -
> - ret = xc_domain_irq_permission(_H(xch), _D(domid),
> - c_pirq, c_allow);
> - if (ret < 0)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -static uint32_t pci_dev_to_bdf(int domain, int bus, int slot, int func)
> -{
> - uint32_t bdf = 0;
> - bdf |= (bus & 0xff) << 16;
> - bdf |= (slot & 0x1f) << 11;
> - bdf |= (func & 0x7) << 8;
> - return bdf;
> -}
> -
> -CAMLprim value stub_xc_domain_test_assign_device(value xch, value domid,
> value desc)
> -{
> - CAMLparam3(xch, domid, desc);
> - int ret;
> - int domain, bus, slot, func;
> - uint32_t bdf;
> -
> - domain = Int_val(Field(desc, 0));
> - bus = Int_val(Field(desc, 1));
> - slot = Int_val(Field(desc, 2));
> - func = Int_val(Field(desc, 3));
> - bdf = pci_dev_to_bdf(domain, bus, slot, func);
> -
> - ret = xc_test_assign_device(_H(xch), _D(domid), bdf);
> -
> - CAMLreturn(Val_bool(ret == 0));
> -}
> -
> -CAMLprim value stub_xc_domain_assign_device(value xch, value domid, value
> desc)
> -{
> - CAMLparam3(xch, domid, desc);
> - int ret;
> - int domain, bus, slot, func;
> - uint32_t bdf;
> -
> - domain = Int_val(Field(desc, 0));
> - bus = Int_val(Field(desc, 1));
> - slot = Int_val(Field(desc, 2));
> - func = Int_val(Field(desc, 3));
> - bdf = pci_dev_to_bdf(domain, bus, slot, func);
> -
> - ret = xc_assign_device(_H(xch), _D(domid), bdf);
> -
> - if (ret < 0)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_domain_deassign_device(value xch, value domid, value
> desc)
> -{
> - CAMLparam3(xch, domid, desc);
> - int ret;
> - int domain, bus, slot, func;
> - uint32_t bdf;
> -
> - domain = Int_val(Field(desc, 0));
> - bus = Int_val(Field(desc, 1));
> - slot = Int_val(Field(desc, 2));
> - func = Int_val(Field(desc, 3));
> - bdf = pci_dev_to_bdf(domain, bus, slot, func);
> -
> - ret = xc_deassign_device(_H(xch), _D(domid), bdf);
> -
> - if (ret < 0)
> - failwith_xc(_H(xch));
> - CAMLreturn(Val_unit);
> -}
> -
> -CAMLprim value stub_xc_watchdog(value xch, value domid, value timeout)
> -{
> - CAMLparam3(xch, domid, timeout);
> - int ret;
> - unsigned int c_timeout = Int32_val(timeout);
> -
> - ret = xc_watchdog(_H(xch), _D(domid), c_timeout);
> - if (ret < 0)
> - failwith_xc(_H(xch));
> -
> - CAMLreturn(Val_int(ret));
> -}
> -
> -/*
> - * Local variables:
> - * indent-tabs-mode: t
> - * c-basic-offset: 8
> - * tab-width: 8
> - * End:
> - */
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xc/xenctrl.ml
> --- /dev/null
> +++ b/tools/ocaml/libs/xc/xenctrl.ml
> @@ -0,0 +1,326 @@
> +(*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + *)
> +
> +(** *)
> +type domid = int
> +
> +(* ** xenctrl.h ** *)
> +
> +type vcpuinfo =
> +{
> + online: bool;
> + blocked: bool;
> + running: bool;
> + cputime: int64;
> + cpumap: int32;
> +}
> +
> +type domaininfo =
> +{
> + domid : domid;
> + dying : bool;
> + shutdown : bool;
> + paused : bool;
> + blocked : bool;
> + running : bool;
> + hvm_guest : bool;
> + shutdown_code : int;
> + total_memory_pages: nativeint;
> + max_memory_pages : nativeint;
> + shared_info_frame : int64;
> + cpu_time : int64;
> + nr_online_vcpus : int;
> + max_vcpu_id : int;
> + ssidref : int32;
> + handle : int array;
> +}
> +
> +type sched_control =
> +{
> + weight : int;
> + cap : int;
> +}
> +
> +type physinfo_cap_flag =
> + | CAP_HVM
> + | CAP_DirectIO
> +
> +type physinfo =
> +{
> + threads_per_core : int;
> + cores_per_socket : int;
> + nr_cpus : int;
> + max_node_id : int;
> + cpu_khz : int;
> + total_pages : nativeint;
> + free_pages : nativeint;
> + scrub_pages : nativeint;
> + (* XXX hw_cap *)
> + capabilities : physinfo_cap_flag list;
> +}
> +
> +type version =
> +{
> + major : int;
> + minor : int;
> + extra : string;
> +}
> +
> +
> +type compile_info =
> +{
> + compiler : string;
> + compile_by : string;
> + compile_domain : string;
> + compile_date : string;
> +}
> +
> +type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt
> +
> +type domain_create_flag = CDF_HVM | CDF_HAP
> +
> +exception Error of string
> +
> +type handle
> +
> +(* this is only use by coredumping *)
> +external sizeof_core_header: unit -> int
> + = "stub_sizeof_core_header"
> +external sizeof_vcpu_guest_context: unit -> int
> + = "stub_sizeof_vcpu_guest_context"
> +external sizeof_xen_pfn: unit -> int = "stub_sizeof_xen_pfn"
> +(* end of use *)
> +
> +external interface_open: unit -> handle = "stub_xc_interface_open"
> +external interface_close: handle -> unit = "stub_xc_interface_close"
> +
> +external is_fake: unit -> bool = "stub_xc_interface_is_fake"
> +
> +let with_intf f =
> + let xc = interface_open () in
> + let r = try f xc with exn -> interface_close xc; raise exn in
> + interface_close xc;
> + r
> +
> +external _domain_create: handle -> int32 -> domain_create_flag list -> int
> array -> domid
> + = "stub_xc_domain_create"
> +
> +let domain_create handle n flags uuid =
> + _domain_create handle n flags (Uuid.int_array_of_uuid uuid)
> +
> +external _domain_sethandle: handle -> domid -> int array -> unit
> + = "stub_xc_domain_sethandle"
> +
> +let domain_sethandle handle n uuid =
> + _domain_sethandle handle n (Uuid.int_array_of_uuid uuid)
> +
> +external domain_max_vcpus: handle -> domid -> int -> unit
> + = "stub_xc_domain_max_vcpus"
> +
> +external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause"
> +external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause"
> +external domain_resume_fast: handle -> domid -> unit =
> "stub_xc_domain_resume_fast"
> +external domain_destroy: handle -> domid -> unit = "stub_xc_domain_destroy"
> +
> +external domain_shutdown: handle -> domid -> shutdown_reason -> unit
> + = "stub_xc_domain_shutdown"
> +
> +external _domain_getinfolist: handle -> domid -> int -> domaininfo list
> + = "stub_xc_domain_getinfolist"
> +
> +let domain_getinfolist handle first_domain =
> + let nb = 2 in
> + let last_domid l = (List.hd l).domid + 1 in
> + let rec __getlist from =
> + let l = _domain_getinfolist handle from nb in
> + (if List.length l = nb then __getlist (last_domid l) else [])
> @ l
> + in
> + List.rev (__getlist first_domain)
> +
> +external domain_getinfo: handle -> domid -> domaininfo=
> "stub_xc_domain_getinfo"
> +
> +external domain_get_vcpuinfo: handle -> int -> int -> vcpuinfo
> + = "stub_xc_vcpu_getinfo"
> +
> +external domain_ioport_permission: handle -> domid -> int -> int -> bool ->
> unit
> + = "stub_xc_domain_ioport_permission"
> +external domain_iomem_permission: handle -> domid -> nativeint -> nativeint
> -> bool -> unit
> + = "stub_xc_domain_iomem_permission"
> +external domain_irq_permission: handle -> domid -> int -> bool -> unit
> + = "stub_xc_domain_irq_permission"
> +
> +external vcpu_affinity_set: handle -> domid -> int -> bool array -> unit
> + = "stub_xc_vcpu_setaffinity"
> +external vcpu_affinity_get: handle -> domid -> int -> bool array
> + = "stub_xc_vcpu_getaffinity"
> +
> +external vcpu_context_get: handle -> domid -> int -> string
> + = "stub_xc_vcpu_context_get"
> +
> +external sched_id: handle -> int = "stub_xc_sched_id"
> +
> +external sched_credit_domain_set: handle -> domid -> sched_control -> unit
> + = "stub_sched_credit_domain_set"
> +external sched_credit_domain_get: handle -> domid -> sched_control
> + = "stub_sched_credit_domain_get"
> +
> +external shadow_allocation_set: handle -> domid -> int -> unit
> + = "stub_shadow_allocation_set"
> +external shadow_allocation_get: handle -> domid -> int
> + = "stub_shadow_allocation_get"
> +
> +external evtchn_alloc_unbound: handle -> domid -> domid -> int
> + = "stub_xc_evtchn_alloc_unbound"
> +external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset"
> +
> +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"
> +external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
> +
> +external domain_setmaxmem: handle -> domid -> int64 -> unit
> + = "stub_xc_domain_setmaxmem"
> +external domain_set_memmap_limit: handle -> domid -> int64 -> unit
> + = "stub_xc_domain_set_memmap_limit"
> +external domain_memory_increase_reservation: handle -> domid -> int64 -> unit
> + = "stub_xc_domain_memory_increase_reservation"
> +
> +external domain_set_machine_address_size: handle -> domid -> int -> unit
> + = "stub_xc_domain_set_machine_address_size"
> +external domain_get_machine_address_size: handle -> domid -> int
> + = "stub_xc_domain_get_machine_address_size"
> +
> +external domain_cpuid_set: handle -> domid -> (int64 * (int64 option))
> + -> string option array
> + -> string option array
> + = "stub_xc_domain_cpuid_set"
> +external domain_cpuid_apply_policy: handle -> domid -> unit
> + = "stub_xc_domain_cpuid_apply_policy"
> +external cpuid_check: handle -> (int64 * (int64 option)) -> string option
> array -> (bool * string option array)
> + = "stub_xc_cpuid_check"
> +
> +external map_foreign_range: handle -> domid -> int
> + -> nativeint -> Xenmmap.mmap_interface
> + = "stub_map_foreign_range"
> +
> +external domain_get_pfn_list: handle -> domid -> nativeint -> nativeint array
> + = "stub_xc_domain_get_pfn_list"
> +
> +external domain_assign_device: handle -> domid -> (int * int * int * int) ->
> unit
> + = "stub_xc_domain_assign_device"
> +external domain_deassign_device: handle -> domid -> (int * int * int * int)
> -> unit
> + = "stub_xc_domain_deassign_device"
> +external domain_test_assign_device: handle -> domid -> (int * int * int *
> int) -> bool
> + = "stub_xc_domain_test_assign_device"
> +
> +external version: handle -> version = "stub_xc_version_version"
> +external version_compile_info: handle -> compile_info
> + = "stub_xc_version_compile_info"
> +external version_changeset: handle -> string = "stub_xc_version_changeset"
> +external version_capabilities: handle -> string =
> + "stub_xc_version_capabilities"
> +
> +external watchdog : handle -> int -> int32 -> int
> + = "stub_xc_watchdog"
> +
> +(* core dump structure *)
> +type core_magic = Magic_hvm | Magic_pv
> +
> +type core_header = {
> + xch_magic: core_magic;
> + xch_nr_vcpus: int;
> + xch_nr_pages: nativeint;
> + xch_index_offset: int64;
> + xch_ctxt_offset: int64;
> + xch_pages_offset: int64;
> +}
> +
> +external marshall_core_header: core_header -> string =
> "stub_marshall_core_header"
> +
> +(* coredump *)
> +let coredump xch domid fd =
> + let dump s =
> + let wd = Unix.write fd s 0 (String.length s) in
> + if wd <> String.length s then
> + failwith "error while writing";
> + in
> +
> + let info = domain_getinfo xch domid in
> +
> + let nrpages = info.total_memory_pages in
> + let ctxt = Array.make info.max_vcpu_id None in
> + let nr_vcpus = ref 0 in
> + for i = 0 to info.max_vcpu_id - 1
> + do
> + ctxt.(i) <- try
> + let v = vcpu_context_get xch domid i in
> + incr nr_vcpus;
> + Some v
> + with _ -> None
> + done;
> +
> + (* FIXME page offset if not rounded to sup *)
> + let page_offset =
> + Int64.add
> + (Int64.of_int (sizeof_core_header () +
> + (sizeof_vcpu_guest_context () * !nr_vcpus)))
> + (Int64.of_nativeint (
> + Nativeint.mul
> + (Nativeint.of_int (sizeof_xen_pfn ()))
> + nrpages)
> + )
> + in
> +
> + let header = {
> + xch_magic = if info.hvm_guest then Magic_hvm else Magic_pv;
> + xch_nr_vcpus = !nr_vcpus;
> + xch_nr_pages = nrpages;
> + xch_ctxt_offset = Int64.of_int (sizeof_core_header ());
> + xch_index_offset = Int64.of_int (sizeof_core_header ()
> + + sizeof_vcpu_guest_context ());
> + xch_pages_offset = page_offset;
> + } in
> +
> + dump (marshall_core_header header);
> + for i = 0 to info.max_vcpu_id - 1
> + do
> + match ctxt.(i) with
> + | None -> ()
> + | Some ctxt_i -> dump ctxt_i
> + done;
> + let pfns = domain_get_pfn_list xch domid nrpages in
> + if Array.length pfns <> Nativeint.to_int nrpages then
> + failwith "could not get the page frame list";
> +
> + let page_size = Xenmmap.getpagesize () in
> + for i = 0 to Nativeint.to_int nrpages - 1
> + do
> + let page = map_foreign_range xch domid page_size pfns.(i) in
> + let data = Xenmmap.read page 0 page_size in
> + Xenmmap.unmap page;
> + dump data
> + done
> +
> +(* ** Misc ** *)
> +
> +(**
> + Convert the given number of pages to an amount in KiB, rounded up.
> + *)
> +external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
> +let pages_to_mib pages = Int64.div (pages_to_kib pages) 1024L
> +
> +let _ = Callback.register_exception "xc.error" (Error "register_callback")
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xc/xenctrl.mli
> --- /dev/null
> +++ b/tools/ocaml/libs/xc/xenctrl.mli
> @@ -0,0 +1,184 @@
> +(*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + *)
> +
> +type domid = int
> +type vcpuinfo = {
> + online : bool;
> + blocked : bool;
> + running : bool;
> + cputime : int64;
> + cpumap : int32;
> +}
> +type domaininfo = {
> + domid : domid;
> + dying : bool;
> + shutdown : bool;
> + paused : bool;
> + blocked : bool;
> + running : bool;
> + hvm_guest : bool;
> + shutdown_code : int;
> + total_memory_pages : nativeint;
> + max_memory_pages : nativeint;
> + shared_info_frame : int64;
> + cpu_time : int64;
> + nr_online_vcpus : int;
> + max_vcpu_id : int;
> + ssidref : int32;
> + handle : int array;
> +}
> +type sched_control = { weight : int; cap : int; }
> +type physinfo_cap_flag = CAP_HVM | CAP_DirectIO
> +type physinfo = {
> + threads_per_core : int;
> + cores_per_socket : int;
> + nr_cpus : int;
> + max_node_id : int;
> + cpu_khz : int;
> + total_pages : nativeint;
> + free_pages : nativeint;
> + scrub_pages : nativeint;
> + capabilities : physinfo_cap_flag list;
> +}
> +type version = { major : int; minor : int; extra : string; }
> +type compile_info = {
> + compiler : string;
> + compile_by : string;
> + compile_domain : string;
> + compile_date : string;
> +}
> +type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt
> +
> +type domain_create_flag = CDF_HVM | CDF_HAP
> +
> +exception Error of string
> +type handle
> +external sizeof_core_header : unit -> int = "stub_sizeof_core_header"
> +external sizeof_vcpu_guest_context : unit -> int
> + = "stub_sizeof_vcpu_guest_context"
> +external sizeof_xen_pfn : unit -> int = "stub_sizeof_xen_pfn"
> +external interface_open : unit -> handle = "stub_xc_interface_open"
> +external is_fake : unit -> bool = "stub_xc_interface_is_fake"
> +external interface_close : handle -> unit = "stub_xc_interface_close"
> +val with_intf : (handle -> 'a) -> 'a
> +external _domain_create : handle -> int32 -> domain_create_flag list -> int
> array -> domid
> + = "stub_xc_domain_create"
> +val domain_create : handle -> int32 -> domain_create_flag list -> 'a Uuid.t
> -> domid
> +external _domain_sethandle : handle -> domid -> int array -> unit
> + = "stub_xc_domain_sethandle"
> +val domain_sethandle : handle -> domid -> 'a Uuid.t -> unit
> +external domain_max_vcpus : handle -> domid -> int -> unit
> + = "stub_xc_domain_max_vcpus"
> +external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause"
> +external domain_unpause : handle -> domid -> unit = "stub_xc_domain_unpause"
> +external domain_resume_fast : handle -> domid -> unit
> + = "stub_xc_domain_resume_fast"
> +external domain_destroy : handle -> domid -> unit = "stub_xc_domain_destroy"
> +external domain_shutdown : handle -> domid -> shutdown_reason -> unit
> + = "stub_xc_domain_shutdown"
> +external _domain_getinfolist : handle -> domid -> int -> domaininfo list
> + = "stub_xc_domain_getinfolist"
> +val domain_getinfolist : handle -> domid -> domaininfo list
> +external domain_getinfo : handle -> domid -> domaininfo
> + = "stub_xc_domain_getinfo"
> +external domain_get_vcpuinfo : handle -> int -> int -> vcpuinfo
> + = "stub_xc_vcpu_getinfo"
> +external domain_ioport_permission: handle -> domid -> int -> int -> bool ->
> unit
> + = "stub_xc_domain_ioport_permission"
> +external domain_iomem_permission: handle -> domid -> nativeint -> nativeint
> -> bool -> unit
> + = "stub_xc_domain_iomem_permission"
> +external domain_irq_permission: handle -> domid -> int -> bool -> unit
> + = "stub_xc_domain_irq_permission"
> +external vcpu_affinity_set : handle -> domid -> int -> bool array -> unit
> + = "stub_xc_vcpu_setaffinity"
> +external vcpu_affinity_get : handle -> domid -> int -> bool array
> + = "stub_xc_vcpu_getaffinity"
> +external vcpu_context_get : handle -> domid -> int -> string
> + = "stub_xc_vcpu_context_get"
> +external sched_id : handle -> int = "stub_xc_sched_id"
> +external sched_credit_domain_set : handle -> domid -> sched_control -> unit
> + = "stub_sched_credit_domain_set"
> +external sched_credit_domain_get : handle -> domid -> sched_control
> + = "stub_sched_credit_domain_get"
> +external shadow_allocation_set : handle -> domid -> int -> unit
> + = "stub_shadow_allocation_set"
> +external shadow_allocation_get : handle -> domid -> int
> + = "stub_shadow_allocation_get"
> +external evtchn_alloc_unbound : handle -> domid -> domid -> int
> + = "stub_xc_evtchn_alloc_unbound"
> +external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset"
> +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"
> +external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
> +external domain_setmaxmem : handle -> domid -> int64 -> unit
> + = "stub_xc_domain_setmaxmem"
> +external domain_set_memmap_limit : handle -> domid -> int64 -> unit
> + = "stub_xc_domain_set_memmap_limit"
> +external domain_memory_increase_reservation :
> + handle -> domid -> int64 -> unit
> + = "stub_xc_domain_memory_increase_reservation"
> +external map_foreign_range :
> + handle -> domid -> int -> nativeint -> Xenmmap.mmap_interface
> + = "stub_map_foreign_range"
> +external domain_get_pfn_list :
> + handle -> domid -> nativeint -> nativeint array
> + = "stub_xc_domain_get_pfn_list"
> +
> +external domain_assign_device: handle -> domid -> (int * int * int * int) ->
> unit
> + = "stub_xc_domain_assign_device"
> +external domain_deassign_device: handle -> domid -> (int * int * int * int)
> -> unit
> + = "stub_xc_domain_deassign_device"
> +external domain_test_assign_device: handle -> domid -> (int * int * int *
> int) -> bool
> + = "stub_xc_domain_test_assign_device"
> +
> +external version : handle -> version = "stub_xc_version_version"
> +external version_compile_info : handle -> compile_info
> + = "stub_xc_version_compile_info"
> +external version_changeset : handle -> string = "stub_xc_version_changeset"
> +external version_capabilities : handle -> string
> + = "stub_xc_version_capabilities"
> +type core_magic = Magic_hvm | Magic_pv
> +type core_header = {
> + xch_magic : core_magic;
> + xch_nr_vcpus : int;
> + xch_nr_pages : nativeint;
> + xch_index_offset : int64;
> + xch_ctxt_offset : int64;
> + xch_pages_offset : int64;
> +}
> +external marshall_core_header : core_header -> string
> + = "stub_marshall_core_header"
> +val coredump : handle -> domid -> Unix.file_descr -> unit
> +external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
> +val pages_to_mib : int64 -> int64
> +external watchdog : handle -> int -> int32 -> int
> + = "stub_xc_watchdog"
> +
> +external domain_set_machine_address_size: handle -> domid -> int -> unit
> + = "stub_xc_domain_set_machine_address_size"
> +external domain_get_machine_address_size: handle -> domid -> int
> + = "stub_xc_domain_get_machine_address_size"
> +
> +external domain_cpuid_set: handle -> domid -> (int64 * (int64 option))
> + -> string option array
> + -> string option array
> + = "stub_xc_domain_cpuid_set"
> +external domain_cpuid_apply_policy: handle -> domid -> unit
> + = "stub_xc_domain_cpuid_apply_policy"
> +external cpuid_check: handle -> (int64 * (int64 option)) -> string option
> array -> (bool * string option array)
> + = "stub_xc_cpuid_check"
> +
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xc/xenctrl_stubs.c
> --- /dev/null
> +++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
> @@ -0,0 +1,1161 @@
> +/*
> + * Copyright (C) 2006-2007 XenSource Ltd.
> + * Copyright (C) 2008 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + */
> +
> +#define _XOPEN_SOURCE 600
> +#include <stdlib.h>
> +#include <errno.h>
> +
> +#define CAML_NAME_SPACE
> +#include <caml/alloc.h>
> +#include <caml/memory.h>
> +#include <caml/signals.h>
> +#include <caml/fail.h>
> +#include <caml/callback.h>
> +
> +#include <sys/mman.h>
> +#include <stdint.h>
> +#include <string.h>
> +
> +#include <xenctrl.h>
> +
> +#include "mmap_stubs.h"
> +
> +#define PAGE_SHIFT 12
> +#define PAGE_SIZE (1UL << PAGE_SHIFT)
> +#define PAGE_MASK (~(PAGE_SIZE-1))
> +
> +#define _H(__h) ((xc_interface *)(__h))
> +#define _D(__d) ((uint32_t)Int_val(__d))
> +
> +#define Val_none (Val_int(0))
> +
> +#define string_of_option_array(array, index) \
> + ((Field(array, index) == Val_none) ? NULL :
> String_val(Field(Field(array, index), 0)))
> +
> +/* maybe here we should check the range of the input instead of blindly
> + * casting it to uint32 */
> +#define cpuid_input_of_val(i1, i2, input) \
> + i1 = (uint32_t) Int64_val(Field(input, 0)); \
> + i2 = ((Field(input, 1) == Val_none) ? 0xffffffff : (uint32_t)
> Int64_val(Field(Field(input, 1), 0)));
> +
> +#define ERROR_STRLEN 1024
> +void failwith_xc(xc_interface *xch)
> +{
> + static char error_str[ERROR_STRLEN];
> + if (xch) {
> + const xc_error *error = xc_get_last_error(xch);
> + if (error->code == XC_ERROR_NONE)
> + snprintf(error_str, ERROR_STRLEN, "%d: %s", errno,
> strerror(errno));
> + else
> + snprintf(error_str, ERROR_STRLEN, "%d: %s: %s",
> + error->code,
> + xc_error_code_to_desc(error->code),
> + error->message);
> + } else {
> + snprintf(error_str, ERROR_STRLEN, "Unable to open XC
> interface");
> + }
> + caml_raise_with_string(*caml_named_value("xc.error"), error_str);
> +}
> +
> +CAMLprim value stub_sizeof_core_header(value unit)
> +{
> + CAMLparam1(unit);
> + CAMLreturn(Val_int(sizeof(struct xc_core_header)));
> +}
> +
> +CAMLprim value stub_sizeof_vcpu_guest_context(value unit)
> +{
> + CAMLparam1(unit);
> + CAMLreturn(Val_int(sizeof(struct vcpu_guest_context)));
> +}
> +
> +CAMLprim value stub_sizeof_xen_pfn(value unit)
> +{
> + CAMLparam1(unit);
> + CAMLreturn(Val_int(sizeof(xen_pfn_t)));
> +}
> +
> +#define XC_CORE_MAGIC 0xF00FEBED
> +#define XC_CORE_MAGIC_HVM 0xF00FEBEE
> +
> +CAMLprim value stub_marshall_core_header(value header)
> +{
> + CAMLparam1(header);
> + CAMLlocal1(s);
> + struct xc_core_header c_header;
> +
> + c_header.xch_magic = (Field(header, 0))
> + ? XC_CORE_MAGIC
> + : XC_CORE_MAGIC_HVM;
> + c_header.xch_nr_vcpus = Int_val(Field(header, 1));
> + c_header.xch_nr_pages = Nativeint_val(Field(header, 2));
> + c_header.xch_ctxt_offset = Int64_val(Field(header, 3));
> + c_header.xch_index_offset = Int64_val(Field(header, 4));
> + c_header.xch_pages_offset = Int64_val(Field(header, 5));
> +
> + s = caml_alloc_string(sizeof(c_header));
> + memcpy(String_val(s), (char *) &c_header, sizeof(c_header));
> + CAMLreturn(s);
> +}
> +
> +CAMLprim value stub_xc_interface_open(void)
> +{
> + CAMLparam0();
> + xc_interface *xch;
> + xch = xc_interface_open(NULL, NULL, XC_OPENFLAG_NON_REENTRANT);
> + if (xch == NULL)
> + failwith_xc(NULL);
> + CAMLreturn((value)xch);
> +}
> +
> +
> +CAMLprim value stub_xc_interface_is_fake(void)
> +{
> + CAMLparam0();
> + int is_fake = xc_interface_is_fake();
> + CAMLreturn(Val_int(is_fake));
> +}
> +
> +CAMLprim value stub_xc_interface_close(value xch)
> +{
> + CAMLparam1(xch);
> +
> + // caml_enter_blocking_section();
> + xc_interface_close(_H(xch));
> + // caml_leave_blocking_section();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +static int domain_create_flag_table[] = {
> + XEN_DOMCTL_CDF_hvm_guest,
> + XEN_DOMCTL_CDF_hap,
> +};
> +
> +CAMLprim value stub_xc_domain_create(value xch, value ssidref,
> + value flags, value handle)
> +{
> + CAMLparam4(xch, ssidref, flags, handle);
> +
> + uint32_t domid = 0;
> + xen_domain_handle_t h = { 0 };
> + int result;
> + int i;
> + uint32_t c_ssidref = Int32_val(ssidref);
> + unsigned int c_flags = 0;
> + value l;
> +
> + if (Wosize_val(handle) != 16)
> + caml_invalid_argument("Handle not a 16-integer array");
> +
> + for (i = 0; i < sizeof(h); i++) {
> + h[i] = Int_val(Field(handle, i)) & 0xff;
> + }
> +
> + for (l = flags; l != Val_none; l = Field(l, 1)) {
> + int v = Int_val(Field(l, 0));
> + c_flags |= domain_create_flag_table[v];
> + }
> +
> + // caml_enter_blocking_section();
> + result = xc_domain_create(_H(xch), c_ssidref, h, c_flags, &domid);
> + // caml_leave_blocking_section();
> +
> + if (result < 0)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_int(domid));
> +}
> +
> +CAMLprim value stub_xc_domain_max_vcpus(value xch, value domid,
> + value max_vcpus)
> +{
> + CAMLparam3(xch, domid, max_vcpus);
> + int r;
> +
> + r = xc_domain_max_vcpus(_H(xch), _D(domid), Int_val(max_vcpus));
> + if (r)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +
> +value stub_xc_domain_sethandle(value xch, value domid, value handle)
> +{
> + CAMLparam3(xch, domid, handle);
> + xen_domain_handle_t h = { 0 };
> + int i;
> +
> + if (Wosize_val(handle) != 16)
> + caml_invalid_argument("Handle not a 16-integer array");
> +
> + for (i = 0; i < sizeof(h); i++) {
> + h[i] = Int_val(Field(handle, i)) & 0xff;
> + }
> +
> + i = xc_domain_sethandle(_H(xch), _D(domid), h);
> + if (i)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +static value dom_op(value xch, value domid, int (*fn)(xc_interface *,
> uint32_t))
> +{
> + CAMLparam2(xch, domid);
> +
> + uint32_t c_domid = _D(domid);
> +
> + // caml_enter_blocking_section();
> + int result = fn(_H(xch), c_domid);
> + // caml_leave_blocking_section();
> + if (result)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_pause(value xch, value domid)
> +{
> + return dom_op(xch, domid, xc_domain_pause);
> +}
> +
> +
> +CAMLprim value stub_xc_domain_unpause(value xch, value domid)
> +{
> + return dom_op(xch, domid, xc_domain_unpause);
> +}
> +
> +CAMLprim value stub_xc_domain_destroy(value xch, value domid)
> +{
> + return dom_op(xch, domid, xc_domain_destroy);
> +}
> +
> +CAMLprim value stub_xc_domain_resume_fast(value xch, value domid)
> +{
> + CAMLparam2(xch, domid);
> +
> + uint32_t c_domid = _D(domid);
> +
> + // caml_enter_blocking_section();
> + int result = xc_domain_resume(_H(xch), c_domid, 1);
> + // caml_leave_blocking_section();
> + if (result)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_shutdown(value xch, value domid, value reason)
> +{
> + CAMLparam3(xch, domid, reason);
> + int ret;
> +
> + ret = xc_domain_shutdown(_H(xch), _D(domid), Int_val(reason));
> + if (ret < 0)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +static value alloc_domaininfo(xc_domaininfo_t * info)
> +{
> + CAMLparam0();
> + CAMLlocal2(result, tmp);
> + int i;
> +
> + result = caml_alloc_tuple(16);
> +
> + Store_field(result, 0, Val_int(info->domain));
> + Store_field(result, 1, Val_bool(info->flags & XEN_DOMINF_dying));
> + Store_field(result, 2, Val_bool(info->flags & XEN_DOMINF_shutdown));
> + Store_field(result, 3, Val_bool(info->flags & XEN_DOMINF_paused));
> + Store_field(result, 4, Val_bool(info->flags & XEN_DOMINF_blocked));
> + Store_field(result, 5, Val_bool(info->flags & XEN_DOMINF_running));
> + Store_field(result, 6, Val_bool(info->flags & XEN_DOMINF_hvm_guest));
> + Store_field(result, 7, Val_int((info->flags >>
> XEN_DOMINF_shutdownshift)
> + & XEN_DOMINF_shutdownmask));
> + Store_field(result, 8, caml_copy_nativeint(info->tot_pages));
> + Store_field(result, 9, caml_copy_nativeint(info->max_pages));
> + Store_field(result, 10, caml_copy_int64(info->shared_info_frame));
> + Store_field(result, 11, caml_copy_int64(info->cpu_time));
> + Store_field(result, 12, Val_int(info->nr_online_vcpus));
> + Store_field(result, 13, Val_int(info->max_vcpu_id));
> + Store_field(result, 14, caml_copy_int32(info->ssidref));
> +
> + tmp = caml_alloc_small(16, 0);
> + for (i = 0; i < 16; i++) {
> + Field(tmp, i) = Val_int(info->handle[i]);
> + }
> +
> + Store_field(result, 15, tmp);
> +
> + CAMLreturn(result);
> +}
> +
> +CAMLprim value stub_xc_domain_getinfolist(value xch, value first_domain,
> value nb)
> +{
> + CAMLparam3(xch, first_domain, nb);
> + CAMLlocal2(result, temp);
> + xc_domaininfo_t * info;
> + int i, ret, toalloc, retval;
> + unsigned int c_max_domains;
> + uint32_t c_first_domain;
> +
> + /* get the minimum number of allocate byte we need and bump it up to
> page boundary */
> + toalloc = (sizeof(xc_domaininfo_t) * Int_val(nb)) | 0xfff;
> + ret = posix_memalign((void **) ((void *) &info), 4096, toalloc);
> + if (ret)
> + caml_raise_out_of_memory();
> +
> + result = temp = Val_emptylist;
> +
> + c_first_domain = _D(first_domain);
> + c_max_domains = Int_val(nb);
> + // caml_enter_blocking_section();
> + retval = xc_domain_getinfolist(_H(xch), c_first_domain,
> + c_max_domains, info);
> + // caml_leave_blocking_section();
> +
> + if (retval < 0) {
> + free(info);
> + failwith_xc(_H(xch));
> + }
> + for (i = 0; i < retval; i++) {
> + result = caml_alloc_small(2, Tag_cons);
> + Field(result, 0) = Val_int(0);
> + Field(result, 1) = temp;
> + temp = result;
> +
> + Store_field(result, 0, alloc_domaininfo(info + i));
> + }
> +
> + free(info);
> + CAMLreturn(result);
> +}
> +
> +CAMLprim value stub_xc_domain_getinfo(value xch, value domid)
> +{
> + CAMLparam2(xch, domid);
> + CAMLlocal1(result);
> + xc_domaininfo_t info;
> + int ret;
> +
> + ret = xc_domain_getinfolist(_H(xch), _D(domid), 1, &info);
> + if (ret != 1)
> + failwith_xc(_H(xch));
> + if (info.domain != _D(domid))
> + failwith_xc(_H(xch));
> +
> + result = alloc_domaininfo(&info);
> + CAMLreturn(result);
> +}
> +
> +CAMLprim value stub_xc_vcpu_getinfo(value xch, value domid, value vcpu)
> +{
> + CAMLparam3(xch, domid, vcpu);
> + CAMLlocal1(result);
> + xc_vcpuinfo_t info;
> + int retval;
> +
> + uint32_t c_domid = _D(domid);
> + uint32_t c_vcpu = Int_val(vcpu);
> + // caml_enter_blocking_section();
> + retval = xc_vcpu_getinfo(_H(xch), c_domid,
> + c_vcpu, &info);
> + // caml_leave_blocking_section();
> + if (retval < 0)
> + failwith_xc(_H(xch));
> +
> + result = caml_alloc_tuple(5);
> + Store_field(result, 0, Val_bool(info.online));
> + Store_field(result, 1, Val_bool(info.blocked));
> + Store_field(result, 2, Val_bool(info.running));
> + Store_field(result, 3, caml_copy_int64(info.cpu_time));
> + Store_field(result, 4, caml_copy_int32(info.cpu));
> +
> + CAMLreturn(result);
> +}
> +
> +CAMLprim value stub_xc_vcpu_context_get(value xch, value domid,
> + value cpu)
> +{
> + CAMLparam3(xch, domid, cpu);
> + CAMLlocal1(context);
> + int ret;
> + vcpu_guest_context_any_t ctxt;
> +
> + ret = xc_vcpu_getcontext(_H(xch), _D(domid), Int_val(cpu), &ctxt);
> +
> + context = caml_alloc_string(sizeof(ctxt));
> + memcpy(String_val(context), (char *) &ctxt.c, sizeof(ctxt.c));
> +
> + CAMLreturn(context);
> +}
> +
> +static int get_cpumap_len(value xch, value cpumap)
> +{
> + int ml_len = Wosize_val(cpumap);
> + int xc_len = xc_get_max_cpus(_H(xch));
> +
> + if (ml_len < xc_len)
> + return ml_len;
> + else
> + return xc_len;
> +}
> +
> +CAMLprim value stub_xc_vcpu_setaffinity(value xch, value domid,
> + value vcpu, value cpumap)
> +{
> + CAMLparam4(xch, domid, vcpu, cpumap);
> + int i, len = get_cpumap_len(xch, cpumap);
> + xc_cpumap_t c_cpumap;
> + int retval;
> +
> + c_cpumap = xc_cpumap_alloc(_H(xch));
> + if (c_cpumap == NULL)
> + failwith_xc(_H(xch));
> +
> + for (i=0; i<len; i++) {
> + if (Bool_val(Field(cpumap, i)))
> + c_cpumap[i/8] |= i << (i&7);
> + }
> + retval = xc_vcpu_setaffinity(_H(xch), _D(domid),
> + Int_val(vcpu), c_cpumap);
> + free(c_cpumap);
> +
> + if (retval < 0)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_vcpu_getaffinity(value xch, value domid,
> + value vcpu)
> +{
> + CAMLparam3(xch, domid, vcpu);
> + CAMLlocal1(ret);
> + xc_cpumap_t c_cpumap;
> + int i, len = xc_get_max_cpus(_H(xch));
> + int retval;
> +
> + c_cpumap = xc_cpumap_alloc(_H(xch));
> + if (c_cpumap == NULL)
> + failwith_xc(_H(xch));
> +
> + retval = xc_vcpu_getaffinity(_H(xch), _D(domid),
> + Int_val(vcpu), c_cpumap);
> + free(c_cpumap);
> +
> + if (retval < 0) {
> + free(c_cpumap);
> + failwith_xc(_H(xch));
> + }
> +
> + ret = caml_alloc(len, 0);
> +
> + for (i=0; i<len; i++) {
> + if (c_cpumap[i%8] & 1 << (i&7))
> + Store_field(ret, i, Val_true);
> + else
> + Store_field(ret, i, Val_false);
> + }
> +
> + free(c_cpumap);
> +
> + CAMLreturn(ret);
> +}
> +
> +CAMLprim value stub_xc_sched_id(value xch)
> +{
> + CAMLparam1(xch);
> + int sched_id;
> +
> + if (xc_sched_id(_H(xch), &sched_id))
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_int(sched_id));
> +}
> +
> +CAMLprim value stub_xc_evtchn_alloc_unbound(value xch,
> + value local_domid,
> + value remote_domid)
> +{
> + CAMLparam3(xch, local_domid, remote_domid);
> +
> + uint32_t c_local_domid = _D(local_domid);
> + uint32_t c_remote_domid = _D(remote_domid);
> +
> + // caml_enter_blocking_section();
> + int result = xc_evtchn_alloc_unbound(_H(xch), c_local_domid,
> + c_remote_domid);
> + // caml_leave_blocking_section();
> +
> + if (result < 0)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_int(result));
> +}
> +
> +CAMLprim value stub_xc_evtchn_reset(value xch, value domid)
> +{
> + CAMLparam2(xch, domid);
> + int r;
> +
> + r = xc_evtchn_reset(_H(xch), _D(domid));
> + if (r < 0)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +
> +#define RING_SIZE 32768
> +static char ring[RING_SIZE];
> +
> +CAMLprim value stub_xc_readconsolering(value xch)
> +{
> + unsigned int size = RING_SIZE;
> + char *ring_ptr = ring;
> +
> + CAMLparam1(xch);
> +
> + // caml_enter_blocking_section();
> + int retval = xc_readconsolering(_H(xch), ring_ptr, &size, 0, 0, NULL);
> + // caml_leave_blocking_section();
> +
> + if (retval)
> + failwith_xc(_H(xch));
> + ring[size] = '\0';
> + CAMLreturn(caml_copy_string(ring));
> +}
> +
> +CAMLprim value stub_xc_send_debug_keys(value xch, value keys)
> +{
> + CAMLparam2(xch, keys);
> + int r;
> +
> + r = xc_send_debug_keys(_H(xch), String_val(keys));
> + if (r)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_physinfo(value xch)
> +{
> + CAMLparam1(xch);
> + CAMLlocal3(physinfo, cap_list, tmp);
> + xc_physinfo_t c_physinfo;
> + int r;
> +
> + // caml_enter_blocking_section();
> + r = xc_physinfo(_H(xch), &c_physinfo);
> + // caml_leave_blocking_section();
> +
> + if (r)
> + failwith_xc(_H(xch));
> +
> + tmp = cap_list = Val_emptylist;
> + for (r = 0; r < 2; r++) {
> + if ((c_physinfo.capabilities >> r) & 1) {
> + tmp = caml_alloc_small(2, Tag_cons);
> + Field(tmp, 0) = Val_int(r);
> + Field(tmp, 1) = cap_list;
> + cap_list = tmp;
> + }
> + }
> +
> + physinfo = caml_alloc_tuple(9);
> + Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core));
> + Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket));
> + Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus));
> + Store_field(physinfo, 3, Val_int(c_physinfo.max_node_id));
> + Store_field(physinfo, 4, Val_int(c_physinfo.cpu_khz));
> + Store_field(physinfo, 5, caml_copy_nativeint(c_physinfo.total_pages));
> + Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages));
> + Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages));
> + Store_field(physinfo, 8, cap_list);
> +
> + CAMLreturn(physinfo);
> +}
> +
> +CAMLprim value stub_xc_pcpu_info(value xch, value nr_cpus)
> +{
> + CAMLparam2(xch, nr_cpus);
> + CAMLlocal2(pcpus, v);
> + xc_cpuinfo_t *info;
> + int r, size;
> +
> + if (Int_val(nr_cpus) < 1)
> + caml_invalid_argument("nr_cpus");
> +
> + info = calloc(Int_val(nr_cpus) + 1, sizeof(*info));
> + if (!info)
> + caml_raise_out_of_memory();
> +
> + // caml_enter_blocking_section();
> + r = xc_getcpuinfo(_H(xch), Int_val(nr_cpus), info, &size);
> + // caml_leave_blocking_section();
> +
> + if (r) {
> + free(info);
> + failwith_xc(_H(xch));
> + }
> +
> + if (size > 0) {
> + int i;
> + pcpus = caml_alloc(size, 0);
> + for (i = 0; i < size; i++) {
> + v = caml_copy_int64(info[i].idletime);
> + caml_modify(&Field(pcpus, i), v);
> + }
> + } else
> + pcpus = Atom(0);
> + free(info);
> + CAMLreturn(pcpus);
> +}
> +
> +CAMLprim value stub_xc_domain_setmaxmem(value xch, value domid,
> + value max_memkb)
> +{
> + CAMLparam3(xch, domid, max_memkb);
> +
> + uint32_t c_domid = _D(domid);
> + unsigned int c_max_memkb = Int64_val(max_memkb);
> + // caml_enter_blocking_section();
> + int retval = xc_domain_setmaxmem(_H(xch), c_domid,
> + c_max_memkb);
> + // caml_leave_blocking_section();
> + if (retval)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_set_memmap_limit(value xch, value domid,
> + value map_limitkb)
> +{
> + CAMLparam3(xch, domid, map_limitkb);
> + unsigned long v;
> + int retval;
> +
> + v = Int64_val(map_limitkb);
> + retval = xc_domain_set_memmap_limit(_H(xch), _D(domid), v);
> + if (retval)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_memory_increase_reservation(value xch,
> + value domid,
> + value mem_kb)
> +{
> + CAMLparam3(xch, domid, mem_kb);
> +
> + unsigned long nr_extents = ((unsigned long)(Int64_val(mem_kb))) >>
> (PAGE_SHIFT - 10);
> +
> + uint32_t c_domid = _D(domid);
> + // caml_enter_blocking_section();
> + int retval = xc_domain_increase_reservation_exact(_H(xch), c_domid,
> + nr_extents, 0, 0,
> NULL);
> + // caml_leave_blocking_section();
> +
> + if (retval)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_set_machine_address_size(value xch,
> + value domid,
> + value width)
> +{
> + CAMLparam3(xch, domid, width);
> + uint32_t c_domid = _D(domid);
> + int c_width = Int_val(width);
> +
> + int retval = xc_domain_set_machine_address_size(_H(xch), c_domid,
> c_width);
> + if (retval)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_get_machine_address_size(value xch,
> + value domid)
> +{
> + CAMLparam2(xch, domid);
> + int retval;
> +
> + retval = xc_domain_get_machine_address_size(_H(xch), _D(domid));
> + if (retval < 0)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_int(retval));
> +}
> +
> +CAMLprim value stub_xc_domain_cpuid_set(value xch, value domid,
> + value input,
> + value config)
> +{
> + CAMLparam4(xch, domid, input, config);
> + CAMLlocal2(array, tmp);
> + int r;
> + unsigned int c_input[2];
> + char *c_config[4], *out_config[4];
> +
> + c_config[0] = string_of_option_array(config, 0);
> + c_config[1] = string_of_option_array(config, 1);
> + c_config[2] = string_of_option_array(config, 2);
> + c_config[3] = string_of_option_array(config, 3);
> +
> + cpuid_input_of_val(c_input[0], c_input[1], input);
> +
> + array = caml_alloc(4, 0);
> + for (r = 0; r < 4; r++) {
> + tmp = Val_none;
> + if (c_config[r]) {
> + tmp = caml_alloc_small(1, 0);
> + Field(tmp, 0) = caml_alloc_string(32);
> + }
> + Store_field(array, r, tmp);
> + }
> +
> + for (r = 0; r < 4; r++)
> + out_config[r] = (c_config[r]) ? String_val(Field(Field(array,
> r), 0)) : NULL;
> +
> + r = xc_cpuid_set(_H(xch), _D(domid),
> + c_input, (const char **)c_config, out_config);
> + if (r < 0)
> + failwith_xc(_H(xch));
> + CAMLreturn(array);
> +}
> +
> +CAMLprim value stub_xc_domain_cpuid_apply_policy(value xch, value domid)
> +{
> + CAMLparam2(xch, domid);
> + int r;
> +
> + r = xc_cpuid_apply_policy(_H(xch), _D(domid));
> + if (r < 0)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_cpuid_check(value xch, value input, value config)
> +{
> + CAMLparam3(xch, input, config);
> + CAMLlocal3(ret, array, tmp);
> + int r;
> + unsigned int c_input[2];
> + char *c_config[4], *out_config[4];
> +
> + c_config[0] = string_of_option_array(config, 0);
> + c_config[1] = string_of_option_array(config, 1);
> + c_config[2] = string_of_option_array(config, 2);
> + c_config[3] = string_of_option_array(config, 3);
> +
> + cpuid_input_of_val(c_input[0], c_input[1], input);
> +
> + array = caml_alloc(4, 0);
> + for (r = 0; r < 4; r++) {
> + tmp = Val_none;
> + if (c_config[r]) {
> + tmp = caml_alloc_small(1, 0);
> + Field(tmp, 0) = caml_alloc_string(32);
> + }
> + Store_field(array, r, tmp);
> + }
> +
> + for (r = 0; r < 4; r++)
> + out_config[r] = (c_config[r]) ? String_val(Field(Field(array,
> r), 0)) : NULL;
> +
> + r = xc_cpuid_check(_H(xch), c_input, (const char **)c_config,
> out_config);
> + if (r < 0)
> + failwith_xc(_H(xch));
> +
> + ret = caml_alloc_tuple(2);
> + Store_field(ret, 0, Val_bool(r));
> + Store_field(ret, 1, array);
> +
> + CAMLreturn(ret);
> +}
> +
> +CAMLprim value stub_xc_version_version(value xch)
> +{
> + CAMLparam1(xch);
> + CAMLlocal1(result);
> + xen_extraversion_t extra;
> + long packed;
> + int retval;
> +
> + // caml_enter_blocking_section();
> + packed = xc_version(_H(xch), XENVER_version, NULL);
> + retval = xc_version(_H(xch), XENVER_extraversion, &extra);
> + // caml_leave_blocking_section();
> +
> + if (retval)
> + failwith_xc(_H(xch));
> +
> + result = caml_alloc_tuple(3);
> +
> + Store_field(result, 0, Val_int(packed >> 16));
> + Store_field(result, 1, Val_int(packed & 0xffff));
> + Store_field(result, 2, caml_copy_string(extra));
> +
> + CAMLreturn(result);
> +}
> +
> +
> +CAMLprim value stub_xc_version_compile_info(value xch)
> +{
> + CAMLparam1(xch);
> + CAMLlocal1(result);
> + xen_compile_info_t ci;
> + int retval;
> +
> + // caml_enter_blocking_section();
> + retval = xc_version(_H(xch), XENVER_compile_info, &ci);
> + // caml_leave_blocking_section();
> +
> + if (retval)
> + failwith_xc(_H(xch));
> +
> + result = caml_alloc_tuple(4);
> +
> + Store_field(result, 0, caml_copy_string(ci.compiler));
> + Store_field(result, 1, caml_copy_string(ci.compile_by));
> + Store_field(result, 2, caml_copy_string(ci.compile_domain));
> + Store_field(result, 3, caml_copy_string(ci.compile_date));
> +
> + CAMLreturn(result);
> +}
> +
> +
> +static value xc_version_single_string(value xch, int code, void *info)
> +{
> + CAMLparam1(xch);
> + int retval;
> +
> + // caml_enter_blocking_section();
> + retval = xc_version(_H(xch), code, info);
> + // caml_leave_blocking_section();
> +
> + if (retval)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(caml_copy_string((char *)info));
> +}
> +
> +
> +CAMLprim value stub_xc_version_changeset(value xch)
> +{
> + xen_changeset_info_t ci;
> +
> + return xc_version_single_string(xch, XENVER_changeset, &ci);
> +}
> +
> +
> +CAMLprim value stub_xc_version_capabilities(value xch)
> +{
> + xen_capabilities_info_t ci;
> +
> + return xc_version_single_string(xch, XENVER_capabilities, &ci);
> +}
> +
> +
> +CAMLprim value stub_pages_to_kib(value pages)
> +{
> + CAMLparam1(pages);
> +
> + CAMLreturn(caml_copy_int64(Int64_val(pages) << (PAGE_SHIFT - 10)));
> +}
> +
> +
> +CAMLprim value stub_map_foreign_range(value xch, value dom,
> + value size, value mfn)
> +{
> + CAMLparam4(xch, dom, size, mfn);
> + CAMLlocal1(result);
> + struct mmap_interface *intf;
> + uint32_t c_dom;
> + unsigned long c_mfn;
> +
> + result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
> + intf = (struct mmap_interface *) result;
> +
> + intf->len = Int_val(size);
> +
> + c_dom = _D(dom);
> + c_mfn = Nativeint_val(mfn);
> + // caml_enter_blocking_section();
> + intf->addr = xc_map_foreign_range(_H(xch), c_dom,
> + intf->len, PROT_READ|PROT_WRITE,
> + c_mfn);
> + // caml_leave_blocking_section();
> + if (!intf->addr)
> + caml_failwith("xc_map_foreign_range error");
> + CAMLreturn(result);
> +}
> +
> +CAMLprim value stub_sched_credit_domain_get(value xch, value domid)
> +{
> + CAMLparam2(xch, domid);
> + CAMLlocal1(sdom);
> + struct xen_domctl_sched_credit c_sdom;
> + int ret;
> +
> + // caml_enter_blocking_section();
> + ret = xc_sched_credit_domain_get(_H(xch), _D(domid), &c_sdom);
> + // caml_leave_blocking_section();
> + if (ret != 0)
> + failwith_xc(_H(xch));
> +
> + sdom = caml_alloc_tuple(2);
> + Store_field(sdom, 0, Val_int(c_sdom.weight));
> + Store_field(sdom, 1, Val_int(c_sdom.cap));
> +
> + CAMLreturn(sdom);
> +}
> +
> +CAMLprim value stub_sched_credit_domain_set(value xch, value domid,
> + value sdom)
> +{
> + CAMLparam3(xch, domid, sdom);
> + struct xen_domctl_sched_credit c_sdom;
> + int ret;
> +
> + c_sdom.weight = Int_val(Field(sdom, 0));
> + c_sdom.cap = Int_val(Field(sdom, 1));
> + // caml_enter_blocking_section();
> + ret = xc_sched_credit_domain_set(_H(xch), _D(domid), &c_sdom);
> + // caml_leave_blocking_section();
> + if (ret != 0)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_shadow_allocation_get(value xch, value domid)
> +{
> + CAMLparam2(xch, domid);
> + CAMLlocal1(mb);
> + unsigned long c_mb;
> + int ret;
> +
> + // caml_enter_blocking_section();
> + ret = xc_shadow_control(_H(xch), _D(domid),
> + XEN_DOMCTL_SHADOW_OP_GET_ALLOCATION,
> + NULL, 0, &c_mb, 0, NULL);
> + // caml_leave_blocking_section();
> + if (ret != 0)
> + failwith_xc(_H(xch));
> +
> + mb = Val_int(c_mb);
> + CAMLreturn(mb);
> +}
> +
> +CAMLprim value stub_shadow_allocation_set(value xch, value domid,
> + value mb)
> +{
> + CAMLparam3(xch, domid, mb);
> + unsigned long c_mb;
> + int ret;
> +
> + c_mb = Int_val(mb);
> + // caml_enter_blocking_section();
> + ret = xc_shadow_control(_H(xch), _D(domid),
> + XEN_DOMCTL_SHADOW_OP_SET_ALLOCATION,
> + NULL, 0, &c_mb, 0, NULL);
> + // caml_leave_blocking_section();
> + if (ret != 0)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_get_pfn_list(value xch, value domid,
> + value nr_pfns)
> +{
> + CAMLparam3(xch, domid, nr_pfns);
> + CAMLlocal2(array, v);
> + unsigned long c_nr_pfns;
> + long ret, i;
> + uint64_t *c_array;
> +
> + c_nr_pfns = Nativeint_val(nr_pfns);
> +
> + c_array = malloc(sizeof(uint64_t) * c_nr_pfns);
> + if (!c_array)
> + caml_raise_out_of_memory();
> +
> + ret = xc_get_pfn_list(_H(xch), _D(domid),
> + c_array, c_nr_pfns);
> + if (ret < 0) {
> + free(c_array);
> + failwith_xc(_H(xch));
> + }
> +
> + array = caml_alloc(ret, 0);
> + for (i = 0; i < ret; i++) {
> + v = caml_copy_nativeint(c_array[i]);
> + Store_field(array, i, v);
> + }
> + free(c_array);
> +
> + CAMLreturn(array);
> +}
> +
> +CAMLprim value stub_xc_domain_ioport_permission(value xch, value domid,
> + value start_port, value
> nr_ports,
> + value allow)
> +{
> + CAMLparam5(xch, domid, start_port, nr_ports, allow);
> + uint32_t c_start_port, c_nr_ports;
> + uint8_t c_allow;
> + int ret;
> +
> + c_start_port = Int_val(start_port);
> + c_nr_ports = Int_val(nr_ports);
> + c_allow = Bool_val(allow);
> +
> + ret = xc_domain_ioport_permission(_H(xch), _D(domid),
> + c_start_port, c_nr_ports, c_allow);
> + if (ret < 0)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_iomem_permission(value xch, value domid,
> + value start_pfn, value nr_pfns,
> + value allow)
> +{
> + CAMLparam5(xch, domid, start_pfn, nr_pfns, allow);
> + unsigned long c_start_pfn, c_nr_pfns;
> + uint8_t c_allow;
> + int ret;
> +
> + c_start_pfn = Nativeint_val(start_pfn);
> + c_nr_pfns = Nativeint_val(nr_pfns);
> + c_allow = Bool_val(allow);
> +
> + ret = xc_domain_iomem_permission(_H(xch), _D(domid),
> + c_start_pfn, c_nr_pfns, c_allow);
> + if (ret < 0)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_irq_permission(value xch, value domid,
> + value pirq, value allow)
> +{
> + CAMLparam4(xch, domid, pirq, allow);
> + uint8_t c_pirq;
> + uint8_t c_allow;
> + int ret;
> +
> + c_pirq = Int_val(pirq);
> + c_allow = Bool_val(allow);
> +
> + ret = xc_domain_irq_permission(_H(xch), _D(domid),
> + c_pirq, c_allow);
> + if (ret < 0)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +static uint32_t pci_dev_to_bdf(int domain, int bus, int slot, int func)
> +{
> + uint32_t bdf = 0;
> + bdf |= (bus & 0xff) << 16;
> + bdf |= (slot & 0x1f) << 11;
> + bdf |= (func & 0x7) << 8;
> + return bdf;
> +}
> +
> +CAMLprim value stub_xc_domain_test_assign_device(value xch, value domid,
> value desc)
> +{
> + CAMLparam3(xch, domid, desc);
> + int ret;
> + int domain, bus, slot, func;
> + uint32_t bdf;
> +
> + domain = Int_val(Field(desc, 0));
> + bus = Int_val(Field(desc, 1));
> + slot = Int_val(Field(desc, 2));
> + func = Int_val(Field(desc, 3));
> + bdf = pci_dev_to_bdf(domain, bus, slot, func);
> +
> + ret = xc_test_assign_device(_H(xch), _D(domid), bdf);
> +
> + CAMLreturn(Val_bool(ret == 0));
> +}
> +
> +CAMLprim value stub_xc_domain_assign_device(value xch, value domid, value
> desc)
> +{
> + CAMLparam3(xch, domid, desc);
> + int ret;
> + int domain, bus, slot, func;
> + uint32_t bdf;
> +
> + domain = Int_val(Field(desc, 0));
> + bus = Int_val(Field(desc, 1));
> + slot = Int_val(Field(desc, 2));
> + func = Int_val(Field(desc, 3));
> + bdf = pci_dev_to_bdf(domain, bus, slot, func);
> +
> + ret = xc_assign_device(_H(xch), _D(domid), bdf);
> +
> + if (ret < 0)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_domain_deassign_device(value xch, value domid, value
> desc)
> +{
> + CAMLparam3(xch, domid, desc);
> + int ret;
> + int domain, bus, slot, func;
> + uint32_t bdf;
> +
> + domain = Int_val(Field(desc, 0));
> + bus = Int_val(Field(desc, 1));
> + slot = Int_val(Field(desc, 2));
> + func = Int_val(Field(desc, 3));
> + bdf = pci_dev_to_bdf(domain, bus, slot, func);
> +
> + ret = xc_deassign_device(_H(xch), _D(domid), bdf);
> +
> + if (ret < 0)
> + failwith_xc(_H(xch));
> + CAMLreturn(Val_unit);
> +}
> +
> +CAMLprim value stub_xc_watchdog(value xch, value domid, value timeout)
> +{
> + CAMLparam3(xch, domid, timeout);
> + int ret;
> + unsigned int c_timeout = Int32_val(timeout);
> +
> + ret = xc_watchdog(_H(xch), _D(domid), c_timeout);
> + if (ret < 0)
> + failwith_xc(_H(xch));
> +
> + CAMLreturn(Val_int(ret));
> +}
> +
> +/*
> + * Local variables:
> + * indent-tabs-mode: t
> + * c-basic-offset: 8
> + * tab-width: 8
> + * End:
> + */
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xl/Makefile
> --- a/tools/ocaml/libs/xl/Makefile
> +++ b/tools/ocaml/libs/xl/Makefile
> @@ -6,44 +6,44 @@
> CFLAGS += -Wno-unused
> CFLAGS += $(CFLAGS_libxenlight)
>
> -OBJS = xl
> -INTF = xl.cmi
> -LIBS = xl.cma xl.cmxa
> +OBJS = xenlight
> +INTF = xenlight.cmi
> +LIBS = xenlight.cma xenlight.cmxa
>
> -LIBS_xl = $(LDLIBS_libxenlight)
> +LIBS_xenlight = $(LDLIBS_libxenlight)
>
> -xl_OBJS = $(OBJS)
> -xl_C_OBJS = xl_stubs
> +xenlight_OBJS = $(OBJS)
> +xenlight_C_OBJS = xenlight_stubs
>
> -OCAML_LIBRARY = xl
> +OCAML_LIBRARY = xenlight
>
> -GENERATED_FILES += xl.ml xl.ml.tmp xl.mli xl.mli.tmp
> +GENERATED_FILES += xenlight.ml xenlight.ml.tmp xenlight.mli xenlight.mli.tmp
> GENERATED_FILES += _libxl_types.ml.in _libxl_types.mli.in
> GENERATED_FILES += _libxl_types.inc
>
> all: $(INTF) $(LIBS)
>
> -xl.ml: xl.ml.in _libxl_types.ml.in
> +xenlight.ml: xenlight.ml.in _libxl_types.ml.in
> $(Q)sed -e '1i\
> (*\
> * AUTO-GENERATED FILE DO NOT EDIT\
> - * Generated from xl.ml.in and _libxl_types.ml.in\
> + * Generated from xenlight.ml.in and _libxl_types.ml.in\
> *)\
> ' \
> -e '/^(\* @@LIBXL_TYPES@@ \*)$$/r_libxl_types.ml.in' \
> - < xl.ml.in > xl.ml.tmp
> - $(Q)mv xl.ml.tmp xl.ml
> + < xenlight.ml.in > xenlight.ml.tmp
> + $(Q)mv xenlight.ml.tmp xenlight.ml
>
> -xl.mli: xl.mli.in _libxl_types.mli.in
> +xenlight.mli: xenlight.mli.in _libxl_types.mli.in
> $(Q)sed -e '1i\
> (*\
> * AUTO-GENERATED FILE DO NOT EDIT\
> - * Generated from xl.mli.in and _libxl_types.mli.in\
> + * Generated from xenlight.mli.in and _libxl_types.mli.in\
> *)\
> ' \
> -e '/^(\* @@LIBXL_TYPES@@ \*)$$/r_libxl_types.mli.in' \
> - < xl.mli.in > xl.mli.tmp
> - $(Q)mv xl.mli.tmp xl.mli
> + < xenlight.mli.in > xenlight.mli.tmp
> + $(Q)mv xenlight.mli.tmp xenlight.mli
>
> _libxl_types.ml.in _libxl_types.mli.in _libxl_types.inc: genwrap.py
> $(XEN_ROOT)/tools/libxl/libxl_types.idl \
> $(XEN_ROOT)/tools/libxl/libxltypes.py
> @@ -56,11 +56,11 @@
> .PHONY: install
> install: $(LIBS) META
> mkdir -p $(OCAMLDESTDIR)
> - ocamlfind remove -destdir $(OCAMLDESTDIR) xl
> - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xl META
> $(INTF) $(LIBS) *.a *.so *.cmx
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight
> + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenlight
> META $(INTF) $(LIBS) *.a *.so *.cmx
>
> .PHONY: uninstall
> uninstall:
> - ocamlfind remove -destdir $(OCAMLDESTDIR) xl
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight
>
> include $(TOPLEVEL)/Makefile.rules
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xl/xenlight.ml.in
> --- /dev/null
> +++ b/tools/ocaml/libs/xl/xenlight.ml.in
> @@ -0,0 +1,39 @@
> +(*
> + * Copyright (C) 2009-2011 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + *)
> +
> +exception Error of string
> +
> +type domid = int
> +
> +(* @@LIBXL_TYPES@@ *)
> +
> +module Topologyinfo = struct
> + type t =
> + {
> + core : int;
> + socket : int;
> + node : int;
> + }
> + external get : unit -> t = "stub_xl_topologyinfo"
> +end
> +
> +external button_press : domid -> button -> unit = "stub_xl_button_press"
> +
> +
> +external send_trigger : domid -> string -> int -> unit =
> "stub_xl_send_trigger"
> +external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
> +external send_debug_keys : domid -> string -> unit =
> "stub_xl_send_debug_keys"
> +
> +let _ = Callback.register_exception "xl.error" (Error "register_callback")
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xl/xenlight.mli.in
> --- /dev/null
> +++ b/tools/ocaml/libs/xl/xenlight.mli.in
> @@ -0,0 +1,36 @@
> +(*
> + * Copyright (C) 2009-2011 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + *)
> +
> +exception Error of string
> +
> +type domid = int
> +
> +(* @@LIBXL_TYPES@@ *)
> +
> +module Topologyinfo : sig
> + type t =
> + {
> + core : int;
> + socket : int;
> + node : int;
> + }
> + external get : unit -> t = "stub_xl_topologyinfo"
> +end
> +
> +external button_press : domid -> button -> unit = "stub_xl_button_press"
> +
> +external send_trigger : domid -> string -> int -> unit =
> "stub_xl_send_trigger"
> +external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
> +external send_debug_keys : domid -> string -> unit =
> "stub_xl_send_debug_keys"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xl/xenlight_stubs.c
> --- /dev/null
> +++ b/tools/ocaml/libs/xl/xenlight_stubs.c
> @@ -0,0 +1,596 @@
> +/*
> + * Copyright (C) 2009-2011 Citrix Ltd.
> + * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU Lesser General Public License as published
> + * by the Free Software Foundation; version 2.1 only. with the special
> + * exception on linking described in file LICENSE.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> + * GNU Lesser General Public License for more details.
> + */
> +
> +#include <stdlib.h>
> +
> +#define CAML_NAME_SPACE
> +#include <caml/alloc.h>
> +#include <caml/memory.h>
> +#include <caml/signals.h>
> +#include <caml/fail.h>
> +#include <caml/callback.h>
> +
> +#include <sys/mman.h>
> +#include <stdint.h>
> +#include <string.h>
> +
> +#include <libxl.h>
> +
> +struct caml_logger {
> + struct xentoollog_logger logger;
> + int log_offset;
> + char log_buf[2048];
> +};
> +
> +typedef struct caml_gc {
> + int offset;
> + void *ptrs[64];
> +} caml_gc;
> +
> +static void log_vmessage(struct xentoollog_logger *logger, xentoollog_level
> level,
> + int errnoval, const char *context, const char *format,
> va_list al)
> +{
> + struct caml_logger *ologger = (struct caml_logger *) logger;
> +
> + ologger->log_offset += vsnprintf(ologger->log_buf +
> ologger->log_offset,
> + 2048 - ologger->log_offset, format,
> al);
> +}
> +
> +static void log_destroy(struct xentoollog_logger *logger)
> +{
> +}
> +
> +#define INIT_STRUCT() libxl_ctx *ctx; struct caml_logger lg; struct caml_gc
> gc; gc.offset = 0;
> +
> +#define INIT_CTX() \
> + lg.logger.vmessage = log_vmessage; \
> + lg.logger.destroy = log_destroy; \
> + lg.logger.progress = NULL; \
> + caml_enter_blocking_section(); \
> + ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, (struct xentoollog_logger
> *) &lg); \
> + if (ret != 0) \
> + failwith_xl("cannot init context", &lg);
> +
> +#define FREE_CTX() \
> + gc_free(&gc); \
> + caml_leave_blocking_section(); \
> + libxl_ctx_free(ctx)
> +
> +static char * dup_String_val(caml_gc *gc, value s)
> +{
> + int len;
> + char *c;
> + len = caml_string_length(s);
> + c = calloc(len + 1, sizeof(char));
> + if (!c)
> + caml_raise_out_of_memory();
> + gc->ptrs[gc->offset++] = c;
> + memcpy(c, String_val(s), len);
> + return c;
> +}
> +
> +static void gc_free(caml_gc *gc)
> +{
> + int i;
> + for (i = 0; i < gc->offset; i++) {
> + free(gc->ptrs[i]);
> + }
> +}
> +
> +static void failwith_xl(char *fname, struct caml_logger *lg)
> +{
> + char *s;
> + s = (lg) ? lg->log_buf : fname;
> + caml_raise_with_string(*caml_named_value("xl.error"), s);
> +}
> +
> +#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed
> then */
> +static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
> +{
> + void *ptr;
> + ptr = calloc(nmemb, size);
> + if (!ptr)
> + caml_raise_out_of_memory();
> + gc->ptrs[gc->offset++] = ptr;
> + return ptr;
> +}
> +
> +static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value
> v)
> +{
> + CAMLparam1(v);
> + CAMLlocal1(a);
> + int i;
> + char **array;
> +
> + for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) {
> i++; }
> +
> + array = gc_calloc(gc, (i + 1) * 2, sizeof(char *));
> + if (!array)
> + return 1;
> + for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1),
> i++) {
> + value b = Field(a, 0);
> + array[i * 2] = dup_String_val(gc, Field(b, 0));
> + array[i * 2 + 1] = dup_String_val(gc, Field(b, 1));
> + }
> + *c_val = array;
> + CAMLreturn(0);
> +}
> +
> +#endif
> +
> +static value Val_mac (libxl_mac *c_val)
> +{
> + CAMLparam0();
> + CAMLlocal1(v);
> + int i;
> +
> + v = caml_alloc_tuple(6);
> +
> + for(i=0; i<6; i++)
> + Store_field(v, i, Val_int((*c_val)[i]));
> +
> + CAMLreturn(v);
> +}
> +
> +static int Mac_val(caml_gc *gc, struct caml_logger *lg, libxl_mac *c_val,
> value v)
> +{
> + CAMLparam1(v);
> + int i;
> +
> + for(i=0; i<6; i++)
> + (*c_val)[i] = Int_val(Field(v, i));
> +
> + CAMLreturn(0);
> +}
> +
> +static value Val_uuid (libxl_uuid *c_val)
> +{
> + CAMLparam0();
> + CAMLlocal1(v);
> + uint8_t *uuid = libxl_uuid_bytearray(c_val);
> + int i;
> +
> + v = caml_alloc_tuple(16);
> +
> + for(i=0; i<16; i++)
> + Store_field(v, i, Val_int(uuid[i]));
> +
> + CAMLreturn(v);
> +}
> +
> +static int Uuid_val(caml_gc *gc, struct caml_logger *lg, libxl_uuid *c_val,
> value v)
> +{
> + CAMLparam1(v);
> + int i;
> + uint8_t *uuid = libxl_uuid_bytearray(c_val);
> +
> + for(i=0; i<16; i++)
> + uuid[i] = Int_val(Field(v, i));
> +
> + CAMLreturn(0);
> +}
> +
> +static value Val_hwcap(libxl_hwcap *c_val)
> +{
> + CAMLparam0();
> + CAMLlocal1(hwcap);
> + int i;
> +
> + hwcap = caml_alloc_tuple(8);
> + for (i = 0; i < 8; i++)
> + Store_field(hwcap, i, caml_copy_int32((*c_val)[i]));
> +
> + CAMLreturn(hwcap);
> +}
> +
> +#include "_libxl_types.inc"
> +
> +static value Val_topologyinfo(libxl_topologyinfo *c_val)
> +{
> + CAMLparam0();
> + CAMLlocal3(v, topology, topologyinfo);
> + int i;
> +
> + topologyinfo = caml_alloc_tuple(c_val->coremap.entries);
> + for (i = 0; i < c_val->coremap.entries; i++) {
> + v = Val_int(0); /* None */
> + if (c_val->coremap.array[i] != LIBXL_CPUARRAY_INVALID_ENTRY) {
> + topology = caml_alloc_tuple(3);
> + Store_field(topology, 0,
> Val_int(c_val->coremap.array[i]));
> + Store_field(topology, 1,
> Val_int(c_val->socketmap.array[i]));
> + Store_field(topology, 2,
> Val_int(c_val->nodemap.array[i]));
> + v = caml_alloc(1, 0); /* Some */
> + Store_field(v, 0, topology);
> + }
> + Store_field(topologyinfo, i, v);
> + }
> +
> + CAMLreturn(topologyinfo);
> +}
> +
> +value stub_xl_device_disk_add(value info, value domid)
> +{
> + CAMLparam2(info, domid);
> + libxl_device_disk c_info;
> + int ret;
> + INIT_STRUCT();
> +
> + device_disk_val(&gc, &lg, &c_info, info);
> +
> + INIT_CTX();
> + ret = libxl_device_disk_add(ctx, Int_val(domid), &c_info);
> + if (ret != 0)
> + failwith_xl("disk_add", &lg);
> + FREE_CTX();
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_disk_del(value info, value domid)
> +{
> + CAMLparam2(info, domid);
> + libxl_device_disk c_info;
> + int ret;
> + INIT_STRUCT();
> +
> + device_disk_val(&gc, &lg, &c_info, info);
> +
> + INIT_CTX();
> + ret = libxl_device_disk_del(ctx, Int_val(domid), &c_info, 0);
> + if (ret != 0)
> + failwith_xl("disk_del", &lg);
> + FREE_CTX();
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_nic_add(value info, value domid)
> +{
> + CAMLparam2(info, domid);
> + libxl_device_nic c_info;
> + int ret;
> + INIT_STRUCT();
> +
> + device_nic_val(&gc, &lg, &c_info, info);
> +
> + INIT_CTX();
> + ret = libxl_device_nic_add(ctx, Int_val(domid), &c_info);
> + if (ret != 0)
> + failwith_xl("nic_add", &lg);
> + FREE_CTX();
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_nic_del(value info, value domid)
> +{
> + CAMLparam2(info, domid);
> + libxl_device_nic c_info;
> + int ret;
> + INIT_STRUCT();
> +
> + device_nic_val(&gc, &lg, &c_info, info);
> +
> + INIT_CTX();
> + ret = libxl_device_nic_del(ctx, Int_val(domid), &c_info, 0);
> + if (ret != 0)
> + failwith_xl("nic_del", &lg);
> + FREE_CTX();
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_console_add(value info, value domid)
> +{
> + CAMLparam2(info, domid);
> + libxl_device_console c_info;
> + int ret;
> + INIT_STRUCT();
> +
> + device_console_val(&gc, &lg, &c_info, info);
> +
> + INIT_CTX();
> + ret = libxl_device_console_add(ctx, Int_val(domid), &c_info);
> + if (ret != 0)
> + failwith_xl("console_add", &lg);
> + FREE_CTX();
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_vkb_add(value info, value domid)
> +{
> + CAMLparam2(info, domid);
> + libxl_device_vkb c_info;
> + int ret;
> + INIT_STRUCT();
> +
> + device_vkb_val(&gc, &lg, &c_info, info);
> +
> + INIT_CTX();
> + ret = libxl_device_vkb_add(ctx, Int_val(domid), &c_info);
> + if (ret != 0)
> + failwith_xl("vkb_add", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_vkb_clean_shutdown(value domid)
> +{
> + CAMLparam1(domid);
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_device_vkb_clean_shutdown(ctx, Int_val(domid));
> + if (ret != 0)
> + failwith_xl("vkb_clean_shutdown", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_vkb_hard_shutdown(value domid)
> +{
> + CAMLparam1(domid);
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_device_vkb_hard_shutdown(ctx, Int_val(domid));
> + if (ret != 0)
> + failwith_xl("vkb_hard_shutdown", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_vfb_add(value info, value domid)
> +{
> + CAMLparam2(info, domid);
> + libxl_device_vfb c_info;
> + int ret;
> + INIT_STRUCT();
> +
> + device_vfb_val(&gc, &lg, &c_info, info);
> +
> + INIT_CTX();
> + ret = libxl_device_vfb_add(ctx, Int_val(domid), &c_info);
> + if (ret != 0)
> + failwith_xl("vfb_add", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_vfb_clean_shutdown(value domid)
> +{
> + CAMLparam1(domid);
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_device_vfb_clean_shutdown(ctx, Int_val(domid));
> + if (ret != 0)
> + failwith_xl("vfb_clean_shutdown", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_vfb_hard_shutdown(value domid)
> +{
> + CAMLparam1(domid);
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_device_vfb_hard_shutdown(ctx, Int_val(domid));
> + if (ret != 0)
> + failwith_xl("vfb_hard_shutdown", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_pci_add(value info, value domid)
> +{
> + CAMLparam2(info, domid);
> + libxl_device_pci c_info;
> + int ret;
> + INIT_STRUCT();
> +
> + device_pci_val(&gc, &lg, &c_info, info);
> +
> + INIT_CTX();
> + ret = libxl_device_pci_add(ctx, Int_val(domid), &c_info);
> + if (ret != 0)
> + failwith_xl("pci_add", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_pci_remove(value info, value domid)
> +{
> + CAMLparam2(info, domid);
> + libxl_device_pci c_info;
> + int ret;
> + INIT_STRUCT();
> +
> + device_pci_val(&gc, &lg, &c_info, info);
> +
> + INIT_CTX();
> + ret = libxl_device_pci_remove(ctx, Int_val(domid), &c_info, 0);
> + if (ret != 0)
> + failwith_xl("pci_remove", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_device_pci_shutdown(value domid)
> +{
> + CAMLparam1(domid);
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_device_pci_shutdown(ctx, Int_val(domid));
> + if (ret != 0)
> + failwith_xl("pci_shutdown", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_button_press(value domid, value button)
> +{
> + CAMLparam2(domid, button);
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_button_press(ctx, Int_val(domid), Int_val(button) +
> LIBXL_BUTTON_POWER);
> + if (ret != 0)
> + failwith_xl("button_press", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_physinfo_get(value unit)
> +{
> + CAMLparam1(unit);
> + CAMLlocal1(physinfo);
> + libxl_physinfo c_physinfo;
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_get_physinfo(ctx, &c_physinfo);
> + if (ret != 0)
> + failwith_xl("physinfo", &lg);
> + FREE_CTX();
> +
> + physinfo = Val_physinfo(&gc, &lg, &c_physinfo);
> + CAMLreturn(physinfo);
> +}
> +
> +value stub_xl_topologyinfo(value unit)
> +{
> + CAMLparam1(unit);
> + CAMLlocal1(topologyinfo);
> + libxl_topologyinfo c_topologyinfo;
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_get_topologyinfo(ctx, &c_topologyinfo);
> + if (ret != 0)
> + failwith_xl("topologyinfo", &lg);
> + FREE_CTX();
> +
> + topologyinfo = Val_topologyinfo(&c_topologyinfo);
> + CAMLreturn(topologyinfo);
> +}
> +
> +value stub_xl_sched_credit_domain_get(value domid)
> +{
> + CAMLparam1(domid);
> + CAMLlocal1(scinfo);
> + libxl_sched_credit c_scinfo;
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_sched_credit_domain_get(ctx, Int_val(domid), &c_scinfo);
> + if (ret != 0)
> + failwith_xl("sched_credit_domain_get", &lg);
> + FREE_CTX();
> +
> + scinfo = Val_sched_credit(&gc, &lg, &c_scinfo);
> + CAMLreturn(scinfo);
> +}
> +
> +value stub_xl_sched_credit_domain_set(value domid, value scinfo)
> +{
> + CAMLparam2(domid, scinfo);
> + libxl_sched_credit c_scinfo;
> + int ret;
> + INIT_STRUCT();
> +
> + sched_credit_val(&gc, &lg, &c_scinfo, scinfo);
> +
> + INIT_CTX();
> + ret = libxl_sched_credit_domain_set(ctx, Int_val(domid), &c_scinfo);
> + if (ret != 0)
> + failwith_xl("sched_credit_domain_set", &lg);
> + FREE_CTX();
> +
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_send_trigger(value domid, value trigger, value vcpuid)
> +{
> + CAMLparam3(domid, trigger, vcpuid);
> + int ret;
> + char *c_trigger;
> + INIT_STRUCT();
> +
> + c_trigger = dup_String_val(&gc, trigger);
> +
> + INIT_CTX();
> + ret = libxl_send_trigger(ctx, Int_val(domid), c_trigger,
> Int_val(vcpuid));
> + if (ret != 0)
> + failwith_xl("send_trigger", &lg);
> + FREE_CTX();
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_send_sysrq(value domid, value sysrq)
> +{
> + CAMLparam2(domid, sysrq);
> + int ret;
> + INIT_STRUCT();
> +
> + INIT_CTX();
> + ret = libxl_send_sysrq(ctx, Int_val(domid), Int_val(sysrq));
> + if (ret != 0)
> + failwith_xl("send_sysrq", &lg);
> + FREE_CTX();
> + CAMLreturn(Val_unit);
> +}
> +
> +value stub_xl_send_debug_keys(value keys)
> +{
> + CAMLparam1(keys);
> + int ret;
> + char *c_keys;
> + INIT_STRUCT();
> +
> + c_keys = dup_String_val(&gc, keys);
> +
> + INIT_CTX();
> + ret = libxl_send_debug_keys(ctx, c_keys);
> + if (ret != 0)
> + failwith_xl("send_debug_keys", &lg);
> + FREE_CTX();
> + CAMLreturn(Val_unit);
> +}
> +
> +/*
> + * Local variables:
> + * indent-tabs-mode: t
> + * c-basic-offset: 8
> + * tab-width: 8
> + * End:
> + */
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xl/xl.ml.in
> --- a/tools/ocaml/libs/xl/xl.ml.in
> +++ /dev/null
> @@ -1,39 +0,0 @@
> -(*
> - * Copyright (C) 2009-2011 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - *)
> -
> -exception Error of string
> -
> -type domid = int
> -
> -(* @@LIBXL_TYPES@@ *)
> -
> -module Topologyinfo = struct
> - type t =
> - {
> - core : int;
> - socket : int;
> - node : int;
> - }
> - external get : unit -> t = "stub_xl_topologyinfo"
> -end
> -
> -external button_press : domid -> button -> unit = "stub_xl_button_press"
> -
> -
> -external send_trigger : domid -> string -> int -> unit =
> "stub_xl_send_trigger"
> -external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
> -external send_debug_keys : domid -> string -> unit =
> "stub_xl_send_debug_keys"
> -
> -let _ = Callback.register_exception "xl.error" (Error "register_callback")
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xl/xl.mli.in
> --- a/tools/ocaml/libs/xl/xl.mli.in
> +++ /dev/null
> @@ -1,36 +0,0 @@
> -(*
> - * Copyright (C) 2009-2011 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - *)
> -
> -exception Error of string
> -
> -type domid = int
> -
> -(* @@LIBXL_TYPES@@ *)
> -
> -module Topologyinfo : sig
> - type t =
> - {
> - core : int;
> - socket : int;
> - node : int;
> - }
> - external get : unit -> t = "stub_xl_topologyinfo"
> -end
> -
> -external button_press : domid -> button -> unit = "stub_xl_button_press"
> -
> -external send_trigger : domid -> string -> int -> unit =
> "stub_xl_send_trigger"
> -external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
> -external send_debug_keys : domid -> string -> unit =
> "stub_xl_send_debug_keys"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xl/xl_stubs.c
> --- a/tools/ocaml/libs/xl/xl_stubs.c
> +++ /dev/null
> @@ -1,596 +0,0 @@
> -/*
> - * Copyright (C) 2009-2011 Citrix Ltd.
> - * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
> - *
> - * This program is free software; you can redistribute it and/or modify
> - * it under the terms of the GNU Lesser General Public License as published
> - * by the Free Software Foundation; version 2.1 only. with the special
> - * exception on linking described in file LICENSE.
> - *
> - * This program is distributed in the hope that it will be useful,
> - * but WITHOUT ANY WARRANTY; without even the implied warranty of
> - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> - * GNU Lesser General Public License for more details.
> - */
> -
> -#include <stdlib.h>
> -
> -#define CAML_NAME_SPACE
> -#include <caml/alloc.h>
> -#include <caml/memory.h>
> -#include <caml/signals.h>
> -#include <caml/fail.h>
> -#include <caml/callback.h>
> -
> -#include <sys/mman.h>
> -#include <stdint.h>
> -#include <string.h>
> -
> -#include <libxl.h>
> -
> -struct caml_logger {
> - struct xentoollog_logger logger;
> - int log_offset;
> - char log_buf[2048];
> -};
> -
> -typedef struct caml_gc {
> - int offset;
> - void *ptrs[64];
> -} caml_gc;
> -
> -static void log_vmessage(struct xentoollog_logger *logger, xentoollog_level
> level,
> - int errnoval, const char *context, const char *format,
> va_list al)
> -{
> - struct caml_logger *ologger = (struct caml_logger *) logger;
> -
> - ologger->log_offset += vsnprintf(ologger->log_buf +
> ologger->log_offset,
> - 2048 - ologger->log_offset, format,
> al);
> -}
> -
> -static void log_destroy(struct xentoollog_logger *logger)
> -{
> -}
> -
> -#define INIT_STRUCT() libxl_ctx *ctx; struct caml_logger lg; struct caml_gc
> gc; gc.offset = 0;
> -
> -#define INIT_CTX() \
> - lg.logger.vmessage = log_vmessage; \
> - lg.logger.destroy = log_destroy; \
> - lg.logger.progress = NULL; \
> - caml_enter_blocking_section(); \
> - ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, (struct xentoollog_logger
> *) &lg); \
> - if (ret != 0) \
> - failwith_xl("cannot init context", &lg);
> -
> -#define FREE_CTX() \
> - gc_free(&gc); \
> - caml_leave_blocking_section(); \
> - libxl_ctx_free(ctx)
> -
> -static char * dup_String_val(caml_gc *gc, value s)
> -{
> - int len;
> - char *c;
> - len = caml_string_length(s);
> - c = calloc(len + 1, sizeof(char));
> - if (!c)
> - caml_raise_out_of_memory();
> - gc->ptrs[gc->offset++] = c;
> - memcpy(c, String_val(s), len);
> - return c;
> -}
> -
> -static void gc_free(caml_gc *gc)
> -{
> - int i;
> - for (i = 0; i < gc->offset; i++) {
> - free(gc->ptrs[i]);
> - }
> -}
> -
> -static void failwith_xl(char *fname, struct caml_logger *lg)
> -{
> - char *s;
> - s = (lg) ? lg->log_buf : fname;
> - caml_raise_with_string(*caml_named_value("xl.error"), s);
> -}
> -
> -#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed
> then */
> -static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
> -{
> - void *ptr;
> - ptr = calloc(nmemb, size);
> - if (!ptr)
> - caml_raise_out_of_memory();
> - gc->ptrs[gc->offset++] = ptr;
> - return ptr;
> -}
> -
> -static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value
> v)
> -{
> - CAMLparam1(v);
> - CAMLlocal1(a);
> - int i;
> - char **array;
> -
> - for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) {
> i++; }
> -
> - array = gc_calloc(gc, (i + 1) * 2, sizeof(char *));
> - if (!array)
> - return 1;
> - for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1),
> i++) {
> - value b = Field(a, 0);
> - array[i * 2] = dup_String_val(gc, Field(b, 0));
> - array[i * 2 + 1] = dup_String_val(gc, Field(b, 1));
> - }
> - *c_val = array;
> - CAMLreturn(0);
> -}
> -
> -#endif
> -
> -static value Val_mac (libxl_mac *c_val)
> -{
> - CAMLparam0();
> - CAMLlocal1(v);
> - int i;
> -
> - v = caml_alloc_tuple(6);
> -
> - for(i=0; i<6; i++)
> - Store_field(v, i, Val_int((*c_val)[i]));
> -
> - CAMLreturn(v);
> -}
> -
> -static int Mac_val(caml_gc *gc, struct caml_logger *lg, libxl_mac *c_val,
> value v)
> -{
> - CAMLparam1(v);
> - int i;
> -
> - for(i=0; i<6; i++)
> - (*c_val)[i] = Int_val(Field(v, i));
> -
> - CAMLreturn(0);
> -}
> -
> -static value Val_uuid (libxl_uuid *c_val)
> -{
> - CAMLparam0();
> - CAMLlocal1(v);
> - uint8_t *uuid = libxl_uuid_bytearray(c_val);
> - int i;
> -
> - v = caml_alloc_tuple(16);
> -
> - for(i=0; i<16; i++)
> - Store_field(v, i, Val_int(uuid[i]));
> -
> - CAMLreturn(v);
> -}
> -
> -static int Uuid_val(caml_gc *gc, struct caml_logger *lg, libxl_uuid *c_val,
> value v)
> -{
> - CAMLparam1(v);
> - int i;
> - uint8_t *uuid = libxl_uuid_bytearray(c_val);
> -
> - for(i=0; i<16; i++)
> - uuid[i] = Int_val(Field(v, i));
> -
> - CAMLreturn(0);
> -}
> -
> -static value Val_hwcap(libxl_hwcap *c_val)
> -{
> - CAMLparam0();
> - CAMLlocal1(hwcap);
> - int i;
> -
> - hwcap = caml_alloc_tuple(8);
> - for (i = 0; i < 8; i++)
> - Store_field(hwcap, i, caml_copy_int32((*c_val)[i]));
> -
> - CAMLreturn(hwcap);
> -}
> -
> -#include "_libxl_types.inc"
> -
> -static value Val_topologyinfo(libxl_topologyinfo *c_val)
> -{
> - CAMLparam0();
> - CAMLlocal3(v, topology, topologyinfo);
> - int i;
> -
> - topologyinfo = caml_alloc_tuple(c_val->coremap.entries);
> - for (i = 0; i < c_val->coremap.entries; i++) {
> - v = Val_int(0); /* None */
> - if (c_val->coremap.array[i] != LIBXL_CPUARRAY_INVALID_ENTRY) {
> - topology = caml_alloc_tuple(3);
> - Store_field(topology, 0,
> Val_int(c_val->coremap.array[i]));
> - Store_field(topology, 1,
> Val_int(c_val->socketmap.array[i]));
> - Store_field(topology, 2,
> Val_int(c_val->nodemap.array[i]));
> - v = caml_alloc(1, 0); /* Some */
> - Store_field(v, 0, topology);
> - }
> - Store_field(topologyinfo, i, v);
> - }
> -
> - CAMLreturn(topologyinfo);
> -}
> -
> -value stub_xl_device_disk_add(value info, value domid)
> -{
> - CAMLparam2(info, domid);
> - libxl_device_disk c_info;
> - int ret;
> - INIT_STRUCT();
> -
> - device_disk_val(&gc, &lg, &c_info, info);
> -
> - INIT_CTX();
> - ret = libxl_device_disk_add(ctx, Int_val(domid), &c_info);
> - if (ret != 0)
> - failwith_xl("disk_add", &lg);
> - FREE_CTX();
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_disk_del(value info, value domid)
> -{
> - CAMLparam2(info, domid);
> - libxl_device_disk c_info;
> - int ret;
> - INIT_STRUCT();
> -
> - device_disk_val(&gc, &lg, &c_info, info);
> -
> - INIT_CTX();
> - ret = libxl_device_disk_del(ctx, Int_val(domid), &c_info, 0);
> - if (ret != 0)
> - failwith_xl("disk_del", &lg);
> - FREE_CTX();
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_nic_add(value info, value domid)
> -{
> - CAMLparam2(info, domid);
> - libxl_device_nic c_info;
> - int ret;
> - INIT_STRUCT();
> -
> - device_nic_val(&gc, &lg, &c_info, info);
> -
> - INIT_CTX();
> - ret = libxl_device_nic_add(ctx, Int_val(domid), &c_info);
> - if (ret != 0)
> - failwith_xl("nic_add", &lg);
> - FREE_CTX();
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_nic_del(value info, value domid)
> -{
> - CAMLparam2(info, domid);
> - libxl_device_nic c_info;
> - int ret;
> - INIT_STRUCT();
> -
> - device_nic_val(&gc, &lg, &c_info, info);
> -
> - INIT_CTX();
> - ret = libxl_device_nic_del(ctx, Int_val(domid), &c_info, 0);
> - if (ret != 0)
> - failwith_xl("nic_del", &lg);
> - FREE_CTX();
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_console_add(value info, value domid)
> -{
> - CAMLparam2(info, domid);
> - libxl_device_console c_info;
> - int ret;
> - INIT_STRUCT();
> -
> - device_console_val(&gc, &lg, &c_info, info);
> -
> - INIT_CTX();
> - ret = libxl_device_console_add(ctx, Int_val(domid), &c_info);
> - if (ret != 0)
> - failwith_xl("console_add", &lg);
> - FREE_CTX();
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_vkb_add(value info, value domid)
> -{
> - CAMLparam2(info, domid);
> - libxl_device_vkb c_info;
> - int ret;
> - INIT_STRUCT();
> -
> - device_vkb_val(&gc, &lg, &c_info, info);
> -
> - INIT_CTX();
> - ret = libxl_device_vkb_add(ctx, Int_val(domid), &c_info);
> - if (ret != 0)
> - failwith_xl("vkb_add", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_vkb_clean_shutdown(value domid)
> -{
> - CAMLparam1(domid);
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_device_vkb_clean_shutdown(ctx, Int_val(domid));
> - if (ret != 0)
> - failwith_xl("vkb_clean_shutdown", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_vkb_hard_shutdown(value domid)
> -{
> - CAMLparam1(domid);
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_device_vkb_hard_shutdown(ctx, Int_val(domid));
> - if (ret != 0)
> - failwith_xl("vkb_hard_shutdown", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_vfb_add(value info, value domid)
> -{
> - CAMLparam2(info, domid);
> - libxl_device_vfb c_info;
> - int ret;
> - INIT_STRUCT();
> -
> - device_vfb_val(&gc, &lg, &c_info, info);
> -
> - INIT_CTX();
> - ret = libxl_device_vfb_add(ctx, Int_val(domid), &c_info);
> - if (ret != 0)
> - failwith_xl("vfb_add", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_vfb_clean_shutdown(value domid)
> -{
> - CAMLparam1(domid);
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_device_vfb_clean_shutdown(ctx, Int_val(domid));
> - if (ret != 0)
> - failwith_xl("vfb_clean_shutdown", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_vfb_hard_shutdown(value domid)
> -{
> - CAMLparam1(domid);
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_device_vfb_hard_shutdown(ctx, Int_val(domid));
> - if (ret != 0)
> - failwith_xl("vfb_hard_shutdown", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_pci_add(value info, value domid)
> -{
> - CAMLparam2(info, domid);
> - libxl_device_pci c_info;
> - int ret;
> - INIT_STRUCT();
> -
> - device_pci_val(&gc, &lg, &c_info, info);
> -
> - INIT_CTX();
> - ret = libxl_device_pci_add(ctx, Int_val(domid), &c_info);
> - if (ret != 0)
> - failwith_xl("pci_add", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_pci_remove(value info, value domid)
> -{
> - CAMLparam2(info, domid);
> - libxl_device_pci c_info;
> - int ret;
> - INIT_STRUCT();
> -
> - device_pci_val(&gc, &lg, &c_info, info);
> -
> - INIT_CTX();
> - ret = libxl_device_pci_remove(ctx, Int_val(domid), &c_info, 0);
> - if (ret != 0)
> - failwith_xl("pci_remove", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_device_pci_shutdown(value domid)
> -{
> - CAMLparam1(domid);
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_device_pci_shutdown(ctx, Int_val(domid));
> - if (ret != 0)
> - failwith_xl("pci_shutdown", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_button_press(value domid, value button)
> -{
> - CAMLparam2(domid, button);
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_button_press(ctx, Int_val(domid), Int_val(button) +
> LIBXL_BUTTON_POWER);
> - if (ret != 0)
> - failwith_xl("button_press", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_physinfo_get(value unit)
> -{
> - CAMLparam1(unit);
> - CAMLlocal1(physinfo);
> - libxl_physinfo c_physinfo;
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_get_physinfo(ctx, &c_physinfo);
> - if (ret != 0)
> - failwith_xl("physinfo", &lg);
> - FREE_CTX();
> -
> - physinfo = Val_physinfo(&gc, &lg, &c_physinfo);
> - CAMLreturn(physinfo);
> -}
> -
> -value stub_xl_topologyinfo(value unit)
> -{
> - CAMLparam1(unit);
> - CAMLlocal1(topologyinfo);
> - libxl_topologyinfo c_topologyinfo;
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_get_topologyinfo(ctx, &c_topologyinfo);
> - if (ret != 0)
> - failwith_xl("topologyinfo", &lg);
> - FREE_CTX();
> -
> - topologyinfo = Val_topologyinfo(&c_topologyinfo);
> - CAMLreturn(topologyinfo);
> -}
> -
> -value stub_xl_sched_credit_domain_get(value domid)
> -{
> - CAMLparam1(domid);
> - CAMLlocal1(scinfo);
> - libxl_sched_credit c_scinfo;
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_sched_credit_domain_get(ctx, Int_val(domid), &c_scinfo);
> - if (ret != 0)
> - failwith_xl("sched_credit_domain_get", &lg);
> - FREE_CTX();
> -
> - scinfo = Val_sched_credit(&gc, &lg, &c_scinfo);
> - CAMLreturn(scinfo);
> -}
> -
> -value stub_xl_sched_credit_domain_set(value domid, value scinfo)
> -{
> - CAMLparam2(domid, scinfo);
> - libxl_sched_credit c_scinfo;
> - int ret;
> - INIT_STRUCT();
> -
> - sched_credit_val(&gc, &lg, &c_scinfo, scinfo);
> -
> - INIT_CTX();
> - ret = libxl_sched_credit_domain_set(ctx, Int_val(domid), &c_scinfo);
> - if (ret != 0)
> - failwith_xl("sched_credit_domain_set", &lg);
> - FREE_CTX();
> -
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_send_trigger(value domid, value trigger, value vcpuid)
> -{
> - CAMLparam3(domid, trigger, vcpuid);
> - int ret;
> - char *c_trigger;
> - INIT_STRUCT();
> -
> - c_trigger = dup_String_val(&gc, trigger);
> -
> - INIT_CTX();
> - ret = libxl_send_trigger(ctx, Int_val(domid), c_trigger,
> Int_val(vcpuid));
> - if (ret != 0)
> - failwith_xl("send_trigger", &lg);
> - FREE_CTX();
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_send_sysrq(value domid, value sysrq)
> -{
> - CAMLparam2(domid, sysrq);
> - int ret;
> - INIT_STRUCT();
> -
> - INIT_CTX();
> - ret = libxl_send_sysrq(ctx, Int_val(domid), Int_val(sysrq));
> - if (ret != 0)
> - failwith_xl("send_sysrq", &lg);
> - FREE_CTX();
> - CAMLreturn(Val_unit);
> -}
> -
> -value stub_xl_send_debug_keys(value keys)
> -{
> - CAMLparam1(keys);
> - int ret;
> - char *c_keys;
> - INIT_STRUCT();
> -
> - c_keys = dup_String_val(&gc, keys);
> -
> - INIT_CTX();
> - ret = libxl_send_debug_keys(ctx, c_keys);
> - if (ret != 0)
> - failwith_xl("send_debug_keys", &lg);
> - FREE_CTX();
> - CAMLreturn(Val_unit);
> -}
> -
> -/*
> - * Local variables:
> - * indent-tabs-mode: t
> - * c-basic-offset: 8
> - * tab-width: 8
> - * End:
> - */
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xs/META.in
> --- a/tools/ocaml/libs/xs/META.in
> +++ b/tools/ocaml/libs/xs/META.in
> @@ -1,5 +1,5 @@
> version = "@VERSION@"
> description = "XenStore Interface"
> -requires = "unix,xb"
> -archive(byte) = "xs.cma"
> -archive(native) = "xs.cmxa"
> +requires = "unix,xenbus"
> +archive(byte) = "xenstore.cma"
> +archive(native) = "xenstore.cmxa"
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xs/Makefile
> --- a/tools/ocaml/libs/xs/Makefile
> +++ b/tools/ocaml/libs/xs/Makefile
> @@ -3,6 +3,7 @@
> include $(TOPLEVEL)/common.make
>
> OCAMLINCLUDE += -I ../xb/
> +OCAMLOPTFLAGS += -for-pack Xenstore
>
> .NOTPARALLEL:
> # Ocaml is such a PITA!
> @@ -12,7 +13,7 @@
> PRELIBS = $(foreach obj, $(PREOBJS),$(obj).cmo) $(foreach
> obj,$(PREOJBS),$(obj).cmx)
> OBJS = queueop xsraw xst xs
> INTF = xsraw.cmi xst.cmi xs.cmi
> -LIBS = xs.cma xs.cmxa
> +LIBS = xenstore.cma xenstore.cmxa
>
> all: $(PREINTF) $(PRELIBS) $(INTF) $(LIBS) $(PROGRAMS)
>
> @@ -20,18 +21,27 @@
>
> libs: $(LIBS)
>
> -xs_OBJS = $(OBJS)
> -OCAML_NOC_LIBRARY = xs
> +xenstore_OBJS = xenstore
> +OCAML_NOC_LIBRARY = xenstore
> +
> +xenstore.cmx : $(foreach obj, $(OBJS), $(obj).cmx)
> + $(E) " CMX $@"
> + $(Q)$(OCAMLOPT) -pack -o $@ $^
> +
> +xenstore.cmo : $(foreach obj, $(OBJS), $(obj).cmo)
> + $(E) " CMO $@"
> + $(Q)$(OCAMLC) -pack -o $@ $^
> +
>
> .PHONY: install
> install: $(LIBS) META
> mkdir -p $(OCAMLDESTDIR)
> - ocamlfind remove -destdir $(OCAMLDESTDIR) xs
> - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xs META
> $(INTF) xs.mli xst.mli xsraw.mli $(LIBS) *.a *.cmx
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore
> + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenstore
> META $(LIBS) xenstore.cmo xenstore.cmi xenstore.cmx *.a
>
> .PHONY: uninstall
> uninstall:
> - ocamlfind remove -destdir $(OCAMLDESTDIR) xs
> + ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore
>
> include $(TOPLEVEL)/Makefile.rules
>
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xs/queueop.ml
> --- a/tools/ocaml/libs/xs/queueop.ml
> +++ b/tools/ocaml/libs/xs/queueop.ml
> @@ -13,6 +13,7 @@
> * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> * GNU Lesser General Public License for more details.
> *)
> +open Xenbus
>
> let data_concat ls = (String.concat "\000" ls) ^ "\000"
> let queue_path ty (tid: int) (path: string) con =
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xs/xs.ml
> --- a/tools/ocaml/libs/xs/xs.ml
> +++ b/tools/ocaml/libs/xs/xs.ml
> @@ -69,7 +69,7 @@
> let read_watchevent xsh = Xsraw.read_watchevent xsh.con
>
> let make fd = get_operations (Xsraw.open_fd fd)
> -let get_fd xsh = Xb.get_fd xsh.con.Xsraw.xb
> +let get_fd xsh = Xenbus.Xb.get_fd xsh.con.Xsraw.xb
>
> exception Timeout
>
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xs/xsraw.ml
> --- a/tools/ocaml/libs/xs/xsraw.ml
> +++ b/tools/ocaml/libs/xs/xsraw.ml
> @@ -14,6 +14,8 @@
> * GNU Lesser General Public License for more details.
> *)
>
> +open Xenbus
> +
> exception Partial_not_empty
> exception Unexpected_packet of string
>
> @@ -27,7 +29,7 @@
> raise (Unexpected_packet s)
>
> type con = {
> - xb: Xb.t;
> + xb: Xenbus.Xb.t;
> watchevents: (string * string) Queue.t;
> }
>
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/libs/xs/xsraw.mli
> --- a/tools/ocaml/libs/xs/xsraw.mli
> +++ b/tools/ocaml/libs/xs/xsraw.mli
> @@ -16,8 +16,8 @@
> exception Partial_not_empty
> exception Unexpected_packet of string
> exception Invalid_path of string
> -val unexpected_packet : Xb.Op.operation -> Xb.Op.operation -> 'a
> -type con = { xb : Xb.t; watchevents : (string * string) Queue.t; }
> +val unexpected_packet : Xenbus.Xb.Op.operation -> Xenbus.Xb.Op.operation ->
> 'a
> +type con = { xb : Xenbus.Xb.t; watchevents : (string * string) Queue.t; }
> val close : con -> unit
> val open_fd : Unix.file_descr -> con
> val split_string : ?limit:int -> char -> string -> string list
> @@ -26,14 +26,14 @@
> val string_of_perms : int * perm * (int * perm) list -> string
> val perms_of_string : string -> int * perm * (int * perm) list
> val pkt_send : con -> unit
> -val pkt_recv : con -> Xb.Packet.t
> -val pkt_recv_timeout : con -> float -> bool * Xb.Packet.t option
> +val pkt_recv : con -> Xenbus.Xb.Packet.t
> +val pkt_recv_timeout : con -> float -> bool * Xenbus.Xb.Packet.t option
> val queue_watchevent : con -> string -> unit
> val has_watchevents : con -> bool
> val get_watchevent : con -> string * string
> val read_watchevent : con -> string * string
> -val sync_recv : Xb.Op.operation -> con -> string
> -val sync : (Xb.t -> 'a) -> con -> string
> +val sync_recv : Xenbus.Xb.Op.operation -> con -> string
> +val sync : (Xenbus.Xb.t -> 'a) -> con -> string
> val ack : string -> unit
> val validate_path : string -> unit
> val validate_watch_path : string -> unit
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/Makefile
> --- a/tools/ocaml/xenstored/Makefile
> +++ b/tools/ocaml/xenstored/Makefile
> @@ -35,11 +35,11 @@
> XENSTOREDLIBS = \
> unix.cmxa \
> $(OCAML_TOPLEVEL)/libs/uuid/uuid.cmxa \
> - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap
> $(OCAML_TOPLEVEL)/libs/mmap/mmap.cmxa \
> + -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap
> $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \
> -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log
> $(OCAML_TOPLEVEL)/libs/log/log.cmxa \
> - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn
> $(OCAML_TOPLEVEL)/libs/eventchn/eventchn.cmxa \
> - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc
> $(OCAML_TOPLEVEL)/libs/xc/xc.cmxa \
> - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb
> $(OCAML_TOPLEVEL)/libs/xb/xb.cmxa \
> + -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn
> $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \
> + -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc
> $(OCAML_TOPLEVEL)/libs/xc/xenctrl.cmxa \
> + -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb
> $(OCAML_TOPLEVEL)/libs/xb/xenbus.cmxa \
> -ccopt -L -ccopt $(XEN_ROOT)/tools/libxc
>
> PROGRAMS = oxenstored
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/connection.ml
> --- a/tools/ocaml/xenstored/connection.ml
> +++ b/tools/ocaml/xenstored/connection.ml
> @@ -27,7 +27,7 @@
> }
>
> and t = {
> - xb: Xb.t;
> + xb: Xenbus.Xb.t;
> dom: Domain.t option;
> transactions: (int, Transaction.t) Hashtbl.t;
> mutable next_tid: int;
> @@ -93,10 +93,10 @@
> Logging.new_connection ~tid:Transaction.none ~con:(get_domstr con);
> con
>
> -let get_fd con = Xb.get_fd con.xb
> +let get_fd con = Xenbus.Xb.get_fd con.xb
> let close con =
> Logging.end_connection ~tid:Transaction.none ~con:(get_domstr con);
> - Xb.close con.xb
> + Xenbus.Xb.close con.xb
>
> let get_perm con =
> con.perm
> @@ -108,9 +108,9 @@
> con.perm <- Perms.Connection.set_target (get_perm con)
> ~perms:[Perms.READ; Perms.WRITE] target_domid
>
> let send_reply con tid rid ty data =
> - Xb.queue con.xb (Xb.Packet.create tid rid ty data)
> + Xenbus.Xb.queue con.xb (Xenbus.Xb.Packet.create tid rid ty data)
>
> -let send_error con tid rid err = send_reply con tid rid Xb.Op.Error (err ^
> "\000")
> +let send_error con tid rid err = send_reply con tid rid Xenbus.Xb.Op.Error
> (err ^ "\000")
> let send_ack con tid rid ty = send_reply con tid rid ty "OK\000"
>
> let get_watch_path con path =
> @@ -166,7 +166,7 @@
>
> let fire_single_watch watch =
> let data = Utils.join_by_null [watch.path; watch.token; ""] in
> - send_reply watch.con Transaction.none 0 Xb.Op.Watchevent data
> + send_reply watch.con Transaction.none 0 Xenbus.Xb.Op.Watchevent data
>
> let fire_watch watch path =
> let new_path =
> @@ -179,7 +179,7 @@
> path
> in
> let data = Utils.join_by_null [ new_path; watch.token; "" ] in
> - send_reply watch.con Transaction.none 0 Xb.Op.Watchevent data
> + send_reply watch.con Transaction.none 0 Xenbus.Xb.Op.Watchevent data
>
> let find_next_tid con =
> let ret = con.next_tid in con.next_tid <- con.next_tid + 1; ret
> @@ -203,15 +203,15 @@
> let get_transaction con tid =
> Hashtbl.find con.transactions tid
>
> -let do_input con = Xb.input con.xb
> -let has_input con = Xb.has_in_packet con.xb
> -let pop_in con = Xb.get_in_packet con.xb
> -let has_more_input con = Xb.has_more_input con.xb
> +let do_input con = Xenbus.Xb.input con.xb
> +let has_input con = Xenbus.Xb.has_in_packet con.xb
> +let pop_in con = Xenbus.Xb.get_in_packet con.xb
> +let has_more_input con = Xenbus.Xb.has_more_input con.xb
>
> -let has_output con = Xb.has_output con.xb
> -let has_new_output con = Xb.has_new_output con.xb
> -let peek_output con = Xb.peek_output con.xb
> -let do_output con = Xb.output con.xb
> +let has_output con = Xenbus.Xb.has_output con.xb
> +let has_new_output con = Xenbus.Xb.has_new_output con.xb
> +let peek_output con = Xenbus.Xb.peek_output con.xb
> +let do_output con = Xenbus.Xb.output con.xb
>
> let incr_ops con = con.stat_nb_ops <- con.stat_nb_ops + 1
>
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/connections.ml
> --- a/tools/ocaml/xenstored/connections.ml
> +++ b/tools/ocaml/xenstored/connections.ml
> @@ -26,12 +26,12 @@
> let create () = { anonymous = []; domains = Hashtbl.create 8; watches =
> Trie.create () }
>
> let add_anonymous cons fd can_write =
> - let xbcon = Xb.open_fd fd in
> + let xbcon = Xenbus.Xb.open_fd fd in
> let con = Connection.create xbcon None in
> cons.anonymous <- con :: cons.anonymous
>
> let add_domain cons dom =
> - let xbcon = Xb.open_mmap (Domain.get_interface dom) (fun () ->
> Domain.notify dom) in
> + let xbcon = Xenbus.Xb.open_mmap (Domain.get_interface dom) (fun () ->
> Domain.notify dom) in
> let con = Connection.create xbcon (Some dom) in
> Hashtbl.add cons.domains (Domain.get_id dom) con
>
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/domain.ml
> --- a/tools/ocaml/xenstored/domain.ml
> +++ b/tools/ocaml/xenstored/domain.ml
> @@ -20,10 +20,10 @@
>
> type t =
> {
> - id: Xc.domid;
> + id: Xenctrl.domid;
> mfn: nativeint;
> remote_port: int;
> - interface: Mmap.mmap_interface;
> + interface: Xenmmap.mmap_interface;
> eventchn: Event.t;
> mutable port: int;
> }
> @@ -47,7 +47,7 @@
> let close dom =
> debug "domain %d unbound port %d" dom.id dom.port;
> Event.unbind dom.eventchn dom.port;
> - Mmap.unmap dom.interface;
> + Xenmmap.unmap dom.interface;
> ()
>
> let make id mfn remote_port interface eventchn = {
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/domains.ml
> --- a/tools/ocaml/xenstored/domains.ml
> +++ b/tools/ocaml/xenstored/domains.ml
> @@ -16,7 +16,7 @@
>
> type domains = {
> eventchn: Event.t;
> - table: (Xc.domid, Domain.t) Hashtbl.t;
> + table: (Xenctrl.domid, Domain.t) Hashtbl.t;
> }
>
> let init eventchn =
> @@ -33,16 +33,16 @@
>
> Hashtbl.iter (fun id _ -> if id <> 0 then
> try
> - let info = Xc.domain_getinfo xc id in
> - if info.Xc.shutdown || info.Xc.dying then (
> + let info = Xenctrl.domain_getinfo xc id in
> + if info.Xenctrl.shutdown || info.Xenctrl.dying then (
> Logs.debug "general" "Domain %u died
> (dying=%b, shutdown %b -- code %d)"
> - id info.Xc.dying
> info.Xc.shutdown info.Xc.shutdown_code;
> - if info.Xc.dying then
> + id info.Xenctrl.dying
> info.Xenctrl.shutdown info.Xenctrl.shutdown_code;
> + if info.Xenctrl.dying then
> dead_dom := id :: !dead_dom
> else
> notify := true;
> )
> - with Xc.Error _ ->
> + with Xenctrl.Error _ ->
> Logs.debug "general" "Domain %u died -- no domain
> info" id;
> dead_dom := id :: !dead_dom;
> ) doms.table;
> @@ -57,7 +57,7 @@
> ()
>
> let create xc doms domid mfn port =
> - let interface = Xc.map_foreign_range xc domid (Mmap.getpagesize())
> mfn in
> + let interface = Xenctrl.map_foreign_range xc domid
> (Xenmmap.getpagesize()) mfn in
> let dom = Domain.make domid mfn port interface doms.eventchn in
> Hashtbl.add doms.table domid dom;
> Domain.bind_interdomain dom;
> @@ -66,13 +66,13 @@
> let create0 fake doms =
> let port, interface =
> if fake then (
> - 0, Xc.with_intf (fun xc -> Xc.map_foreign_range xc 0
> (Mmap.getpagesize()) 0n)
> + 0, Xenctrl.with_intf (fun xc ->
> Xenctrl.map_foreign_range xc 0 (Xenmmap.getpagesize()) 0n)
> ) else (
> let port = Utils.read_file_single_integer
> Define.xenstored_proc_port
> and fd = Unix.openfile Define.xenstored_proc_kva
> [ Unix.O_RDWR ] 0o600 in
> - let interface = Mmap.mmap fd Mmap.RDWR Mmap.SHARED
> - (Mmap.getpagesize()) 0 in
> + let interface = Xenmmap.mmap fd Xenmmap.RDWR
> Xenmmap.SHARED
> + (Xenmmap.getpagesize()) 0 in
> Unix.close fd;
> port, interface
> )
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/event.ml
> --- a/tools/ocaml/xenstored/event.ml
> +++ b/tools/ocaml/xenstored/event.ml
> @@ -16,15 +16,15 @@
>
> (**************** high level binding ****************)
> type t = {
> - handle: Eventchn.handle;
> + handle: Xeneventchn.handle;
> mutable virq_port: int;
> }
>
> -let init () = { handle = Eventchn.init (); virq_port = -1; }
> -let fd eventchn = Eventchn.fd eventchn.handle
> -let bind_dom_exc_virq eventchn = eventchn.virq_port <-
> Eventchn.bind_dom_exc_virq eventchn.handle
> -let bind_interdomain eventchn domid port = Eventchn.bind_interdomain
> eventchn.handle domid port
> -let unbind eventchn port = Eventchn.unbind eventchn.handle port
> -let notify eventchn port = Eventchn.notify eventchn.handle port
> -let pending eventchn = Eventchn.pending eventchn.handle
> -let unmask eventchn port = Eventchn.unmask eventchn.handle port
> +let init () = { handle = Xeneventchn.init (); virq_port = -1; }
> +let fd eventchn = Xeneventchn.fd eventchn.handle
> +let bind_dom_exc_virq eventchn = eventchn.virq_port <-
> Xeneventchn.bind_dom_exc_virq eventchn.handle
> +let bind_interdomain eventchn domid port = Xeneventchn.bind_interdomain
> eventchn.handle domid port
> +let unbind eventchn port = Xeneventchn.unbind eventchn.handle port
> +let notify eventchn port = Xeneventchn.notify eventchn.handle port
> +let pending eventchn = Xeneventchn.pending eventchn.handle
> +let unmask eventchn port = Xeneventchn.unmask eventchn.handle port
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/logging.ml
> --- a/tools/ocaml/xenstored/logging.ml
> +++ b/tools/ocaml/xenstored/logging.ml
> @@ -39,7 +39,7 @@
> | Commit
> | Newconn
> | Endconn
> - | XbOp of Xb.Op.operation
> + | XbOp of Xenbus.Xb.Op.operation
>
> type access =
> {
> @@ -82,35 +82,35 @@
> | Endconn -> "endconn "
>
> | XbOp op -> match op with
> - | Xb.Op.Debug -> "debug "
> + | Xenbus.Xb.Op.Debug -> "debug "
>
> - | Xb.Op.Directory -> "directory"
> - | Xb.Op.Read -> "read "
> - | Xb.Op.Getperms -> "getperms "
> + | Xenbus.Xb.Op.Directory -> "directory"
> + | Xenbus.Xb.Op.Read -> "read "
> + | Xenbus.Xb.Op.Getperms -> "getperms "
>
> - | Xb.Op.Watch -> "watch "
> - | Xb.Op.Unwatch -> "unwatch "
> + | Xenbus.Xb.Op.Watch -> "watch "
> + | Xenbus.Xb.Op.Unwatch -> "unwatch "
>
> - | Xb.Op.Transaction_start -> "t start "
> - | Xb.Op.Transaction_end -> "t end "
> + | Xenbus.Xb.Op.Transaction_start -> "t start "
> + | Xenbus.Xb.Op.Transaction_end -> "t end "
>
> - | Xb.Op.Introduce -> "introduce"
> - | Xb.Op.Release -> "release "
> - | Xb.Op.Getdomainpath -> "getdomain"
> - | Xb.Op.Isintroduced -> "is introduced"
> - | Xb.Op.Resume -> "resume "
> + | Xenbus.Xb.Op.Introduce -> "introduce"
> + | Xenbus.Xb.Op.Release -> "release "
> + | Xenbus.Xb.Op.Getdomainpath -> "getdomain"
> + | Xenbus.Xb.Op.Isintroduced -> "is introduced"
> + | Xenbus.Xb.Op.Resume -> "resume "
>
> - | Xb.Op.Write -> "write "
> - | Xb.Op.Mkdir -> "mkdir "
> - | Xb.Op.Rm -> "rm "
> - | Xb.Op.Setperms -> "setperms "
> - | Xb.Op.Restrict -> "restrict "
> - | Xb.Op.Set_target -> "settarget"
> + | Xenbus.Xb.Op.Write -> "write "
> + | Xenbus.Xb.Op.Mkdir -> "mkdir "
> + | Xenbus.Xb.Op.Rm -> "rm "
> + | Xenbus.Xb.Op.Setperms -> "setperms "
> + | Xenbus.Xb.Op.Restrict -> "restrict "
> + | Xenbus.Xb.Op.Set_target -> "settarget"
>
> - | Xb.Op.Error -> "error "
> - | Xb.Op.Watchevent -> "w event "
> + | Xenbus.Xb.Op.Error -> "error "
> + | Xenbus.Xb.Op.Watchevent -> "w event "
>
> - | x -> Xb.Op.to_string x
> + | x -> Xenbus.Xb.Op.to_string x
>
> let file_exists file =
> try
> @@ -210,10 +210,10 @@
> let xb_op ~tid ~con ~ty data =
> let print =
> match ty with
> - | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms ->
> !log_read_ops
> - | Xb.Op.Transaction_start | Xb.Op.Transaction_end ->
> + | Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory |
> Xenbus.Xb.Op.Getperms -> !log_read_ops
> + | Xenbus.Xb.Op.Transaction_start |
> Xenbus.Xb.Op.Transaction_end ->
> false (* transactions are managed below *)
> - | Xb.Op.Introduce | Xb.Op.Release | Xb.Op.Getdomainpath |
> Xb.Op.Isintroduced | Xb.Op.Resume ->
> + | Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release |
> Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume
> ->
> !log_special_ops
> | _ -> true
> in
> @@ -222,17 +222,17 @@
>
> let start_transaction ~tid ~con =
> if !log_transaction_ops && tid <> 0
> - then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_start)
> + then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start)
>
> let end_transaction ~tid ~con =
> if !log_transaction_ops && tid <> 0
> - then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_end)
> + then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end)
>
> let xb_answer ~tid ~con ~ty data =
> let print = match ty with
> - | Xb.Op.Error when data="ENOENT " -> !log_read_ops
> - | Xb.Op.Error -> !log_special_ops
> - | Xb.Op.Watchevent -> true
> + | Xenbus.Xb.Op.Error when data="ENOENT " -> !log_read_ops
> + | Xenbus.Xb.Op.Error -> !log_special_ops
> + | Xenbus.Xb.Op.Watchevent -> true
> | _ -> false
> in
> if print
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/perms.ml
> --- a/tools/ocaml/xenstored/perms.ml
> +++ b/tools/ocaml/xenstored/perms.ml
> @@ -43,9 +43,9 @@
>
> type t =
> {
> - owner: Xc.domid;
> + owner: Xenctrl.domid;
> other: permty;
> - acl: (Xc.domid * permty) list;
> + acl: (Xenctrl.domid * permty) list;
> }
>
> let create owner other acl =
> @@ -88,7 +88,7 @@
> module Connection =
> struct
>
> -type elt = Xc.domid * (permty list)
> +type elt = Xenctrl.domid * (permty list)
> type t =
> { main: elt;
> target: elt option; }
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/process.ml
> --- a/tools/ocaml/xenstored/process.ml
> +++ b/tools/ocaml/xenstored/process.ml
> @@ -54,10 +54,10 @@
> let process_watch ops cons =
> let do_op_watch op cons =
> let recurse = match (fst op) with
> - | Xb.Op.Write -> false
> - | Xb.Op.Mkdir -> false
> - | Xb.Op.Rm -> true
> - | Xb.Op.Setperms -> false
> + | Xenbus.Xb.Op.Write -> false
> + | Xenbus.Xb.Op.Mkdir -> false
> + | Xenbus.Xb.Op.Rm -> true
> + | Xenbus.Xb.Op.Setperms -> false
> | _ -> raise (Failure "huh ?") in
> Connections.fire_watches cons (snd op) recurse in
> List.iter (fun op -> do_op_watch op cons) ops
> @@ -83,7 +83,7 @@
> then None
> else try match split None '\000' data with
> | "print" :: msg :: _ ->
> - Logging.xb_op ~tid:0 ~ty:Xb.Op.Debug ~con:"=======>" msg;
> + Logging.xb_op ~tid:0 ~ty:Xenbus.Xb.Op.Debug ~con:"=======>"
> msg;
> None
> | "quota" :: domid :: _ ->
> let domid = int_of_string domid in
> @@ -120,7 +120,7 @@
> | _ -> raise Invalid_Cmd_Args
> in
> let watch = Connections.add_watch cons con node token in
> - Connection.send_ack con (Transaction.get_id t) rid Xb.Op.Watch;
> + Connection.send_ack con (Transaction.get_id t) rid Xenbus.Xb.Op.Watch;
> Connection.fire_single_watch watch
>
> let do_unwatch con t domains cons data =
> @@ -165,7 +165,7 @@
> if Domains.exist domains domid then
> Domains.find domains domid
> else try
> - let ndom = Xc.with_intf (fun xc ->
> + let ndom = Xenctrl.with_intf (fun xc ->
> Domains.create xc domains domid mfn port) in
> Connections.add_domain cons ndom;
> Connections.fire_spec_watches cons "@introduceDomain";
> @@ -299,25 +299,25 @@
>
> let function_of_type ty =
> match ty with
> - | Xb.Op.Debug -> reply_data_or_ack do_debug
> - | Xb.Op.Directory -> reply_data do_directory
> - | Xb.Op.Read -> reply_data do_read
> - | Xb.Op.Getperms -> reply_data do_getperms
> - | Xb.Op.Watch -> reply_none do_watch
> - | Xb.Op.Unwatch -> reply_ack do_unwatch
> - | Xb.Op.Transaction_start -> reply_data do_transaction_start
> - | Xb.Op.Transaction_end -> reply_ack do_transaction_end
> - | Xb.Op.Introduce -> reply_ack do_introduce
> - | Xb.Op.Release -> reply_ack do_release
> - | Xb.Op.Getdomainpath -> reply_data do_getdomainpath
> - | Xb.Op.Write -> reply_ack do_write
> - | Xb.Op.Mkdir -> reply_ack do_mkdir
> - | Xb.Op.Rm -> reply_ack do_rm
> - | Xb.Op.Setperms -> reply_ack do_setperms
> - | Xb.Op.Isintroduced -> reply_data do_isintroduced
> - | Xb.Op.Resume -> reply_ack do_resume
> - | Xb.Op.Set_target -> reply_ack do_set_target
> - | Xb.Op.Restrict -> reply_ack do_restrict
> + | Xenbus.Xb.Op.Debug -> reply_data_or_ack do_debug
> + | Xenbus.Xb.Op.Directory -> reply_data do_directory
> + | Xenbus.Xb.Op.Read -> reply_data do_read
> + | Xenbus.Xb.Op.Getperms -> reply_data do_getperms
> + | Xenbus.Xb.Op.Watch -> reply_none do_watch
> + | Xenbus.Xb.Op.Unwatch -> reply_ack do_unwatch
> + | Xenbus.Xb.Op.Transaction_start -> reply_data do_transaction_start
> + | Xenbus.Xb.Op.Transaction_end -> reply_ack do_transaction_end
> + | Xenbus.Xb.Op.Introduce -> reply_ack do_introduce
> + | Xenbus.Xb.Op.Release -> reply_ack do_release
> + | Xenbus.Xb.Op.Getdomainpath -> reply_data do_getdomainpath
> + | Xenbus.Xb.Op.Write -> reply_ack do_write
> + | Xenbus.Xb.Op.Mkdir -> reply_ack do_mkdir
> + | Xenbus.Xb.Op.Rm -> reply_ack do_rm
> + | Xenbus.Xb.Op.Setperms -> reply_ack do_setperms
> + | Xenbus.Xb.Op.Isintroduced -> reply_data do_isintroduced
> + | Xenbus.Xb.Op.Resume -> reply_ack do_resume
> + | Xenbus.Xb.Op.Set_target -> reply_ack do_set_target
> + | Xenbus.Xb.Op.Restrict -> reply_ack do_restrict
> | _ -> reply_ack do_error
>
> let input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data =
> @@ -370,11 +370,11 @@
> let do_input store cons doms con =
> if Connection.do_input con then (
> let packet = Connection.pop_in con in
> - let tid, rid, ty, data = Xb.Packet.unpack packet in
> + let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in
> (* As we don't log IO, do not call an unnecessary
> sanitize_data
> Logs.info "io" "[%s] -> [%d] %s \"%s\""
> (Connection.get_domstr con) tid
> - (Xb.Op.to_string ty) (sanitize_data data); *)
> + (Xenbus.Xb.Op.to_string ty) (sanitize_data data); *)
> process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data;
> write_access_log ~ty ~tid ~con ~data;
> Connection.incr_ops con;
> @@ -384,11 +384,11 @@
> if Connection.has_output con then (
> if Connection.has_new_output con then (
> let packet = Connection.peek_output con in
> - let tid, rid, ty, data = Xb.Packet.unpack packet in
> + let tid, rid, ty, data = Xenbus.Xb.Packet.unpack
> packet in
> (* As we don't log IO, do not call an unnecessary
> sanitize_data
> Logs.info "io" "[%s] <- %s \"%s\""
> (Connection.get_domstr con)
> - (Xb.Op.to_string ty) (sanitize_data data);*)
> + (Xenbus.Xb.Op.to_string ty) (sanitize_data
> data);*)
> write_answer_log ~ty ~tid ~con ~data;
> );
> ignore (Connection.do_output con)
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/quota.ml
> --- a/tools/ocaml/xenstored/quota.ml
> +++ b/tools/ocaml/xenstored/quota.ml
> @@ -26,7 +26,7 @@
> type t = {
> maxent: int; (* max entities per domU *)
> maxsize: int; (* max size of data store in one node *)
> - cur: (Xc.domid, int) Hashtbl.t; (* current domains quota *)
> + cur: (Xenctrl.domid, int) Hashtbl.t; (* current domains quota *)
> }
>
> let to_string quota domid =
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/transaction.ml
> --- a/tools/ocaml/xenstored/transaction.ml
> +++ b/tools/ocaml/xenstored/transaction.ml
> @@ -74,7 +74,7 @@
> type t = {
> ty: ty;
> store: Store.t;
> - mutable ops: (Xb.Op.operation * Store.Path.t) list;
> + mutable ops: (Xenbus.Xb.Op.operation * Store.Path.t) list;
> mutable read_lowpath: Store.Path.t option;
> mutable write_lowpath: Store.Path.t option;
> }
> @@ -105,23 +105,23 @@
> if path_exists
> then set_write_lowpath t path
> else set_write_lowpath t (Store.Path.get_parent path);
> - add_wop t Xb.Op.Write path
> + add_wop t Xenbus.Xb.Op.Write path
>
> let mkdir ?(with_watch=true) t perm path =
> Store.mkdir t.store perm path;
> set_write_lowpath t path;
> if with_watch then
> - add_wop t Xb.Op.Mkdir path
> + add_wop t Xenbus.Xb.Op.Mkdir path
>
> let setperms t perm path perms =
> Store.setperms t.store perm path perms;
> set_write_lowpath t path;
> - add_wop t Xb.Op.Setperms path
> + add_wop t Xenbus.Xb.Op.Setperms path
>
> let rm t perm path =
> Store.rm t.store perm path;
> set_write_lowpath t (Store.Path.get_parent path);
> - add_wop t Xb.Op.Rm path
> + add_wop t Xenbus.Xb.Op.Rm path
>
> let ls t perm path =
> let r = Store.ls t.store perm path in
> diff -r 3d1664cc9e45 -r ffbc5e9929d5 tools/ocaml/xenstored/xenstored.ml
> --- a/tools/ocaml/xenstored/xenstored.ml
> +++ b/tools/ocaml/xenstored/xenstored.ml
> @@ -35,7 +35,7 @@
> if err <> Unix.ECONNRESET then
> error "closing socket connection: read error: %s"
> (Unix.error_message err)
> - | Xb.End_of_file ->
> + | Xenbus.Xb.End_of_file ->
> Connections.del_anonymous cons c;
> debug "closing socket connection"
> in
> @@ -170,7 +170,7 @@
> let from_channel store cons doms chan =
> (* don't let the permission get on our way, full perm ! *)
> let op = Store.get_ops store Perms.Connection.full_rights in
> - let xc = Xc.interface_open () in
> + let xc = Xenctrl.interface_open () in
>
> let domain_f domid mfn port =
> let ndom =
> @@ -190,7 +190,7 @@
> op.Store.setperms path perms
> in
> finally (fun () -> from_channel_f chan domain_f watch_f store_f)
> - (fun () -> Xc.interface_close xc)
> + (fun () -> Xenctrl.interface_close xc)
>
> let from_file store cons doms file =
> let channel = open_in file in
> @@ -282,7 +282,7 @@
> Store.mkdir store (Perms.Connection.create 0)
> localpath;
>
> if cf.domain_init then (
> - let usingxiu = Xc.is_fake () in
> + let usingxiu = Xenctrl.is_fake () in
> Connections.add_domain cons (Domains.create0 usingxiu
> domains);
> Event.bind_dom_exc_virq eventchn
> );
> @@ -301,7 +301,7 @@
> (if cf.domain_init then [ Event.fd eventchn ] else [])
> in
>
> - let xc = Xc.interface_open () in
> + let xc = Xenctrl.interface_open () in
>
> let process_special_fds rset =
> let accept_connection can_write fd =
>
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@xxxxxxxxxxxxxxxxxxx
> http://lists.xensource.com/xen-devel
_______________________________________________
Xen-devel mailing list
Xen-devel@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/xen-devel
|
Home