Xen project Mailing List

Re: [Xen-devel] [PATCH 1 of 6] [OCAML] Rename the ocaml libraries

To: Jon Ludlam <jonathan.ludlam@xxxxxxxxxxxxx>

From: Ian Campbell <Ian.Campbell@xxxxxxxxxx>

Date: Fri, 7 Oct 2011 11:57:07 +0100

Cc: "xen-devel@xxxxxxxxxxxxxxxxxxx" <xen-devel@xxxxxxxxxxxxxxxxxxx>

Delivery-date: Fri, 07 Oct 2011 04:00:35 -0700

List-id: Xen developer discussion <xen-devel.lists.xensource.com>

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

©2013 Xen Project, A Linux Foundation Collaborative Project. All Rights Reserved.
Linux Foundation is a registered trademark of The Linux Foundation.
Xen Project is a trademark of The Linux Foundation.