]> git.ipfire.org Git - people/arne_f/ipfire-3.x.git/blame - xen/patches/50-upstream-23936:cdb34816a40a-rework.patch
projects / people / arne_f / ipfire-3.x.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
checkpolicy: Update to 2.1.8.
[people/arne_f/ipfire-3.x.git] / xen / patches / 50-upstream-23936:cdb34816a40a-rework.patch
CommitLineData
75d56118
MT		 1# HG changeset patch
2# User Jon Ludlam <jonathan.ludlam@eu.citrix.com>
3# Date 1317293932 -3600
4# Node ID ba4cba41f5550684719bc95a25f8f51b92fb604f
5# Parent 7998217630e236639825d4db174c852cfa18e709
6[OCAML] Rename the ocamlfind packages
7
8This patch has the same effect as xen-unstable.hg
9c/s 23936:cdb34816a40a.
10
11ocamlfind does not support namespaces, so to avoid
12name clashes the ocamlfind package names have been
13changed. Note that this does not change the names
14of the actual modules themselves.
15
16xb becomes xenbus, xc becomes xenctrl, xl becomes xenlight,
17xs becomes xenstore, eventchn becomes xeneventchn.
18
19Signed-off-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com>
20
21--- a/tools/ocaml/libs/eventchn/META.in
22+++ b/tools/ocaml/libs/eventchn/META.in
23@@ -1,5 +1,5 @@
24 version = "@VERSION@"
25 description = "Eventchn interface extension"
26 requires = "unix"
27-archive(byte) = "eventchn.cma"
28-archive(native) = "eventchn.cmxa"
29+archive(byte) = "xeneventchn.cma"
30+archive(native) = "xeneventchn.cmxa"
31--- a/tools/ocaml/libs/eventchn/Makefile
32+++ b/tools/ocaml/libs/eventchn/Makefile
33@@ -2,9 +2,11 @@
34 XEN_ROOT=$(TOPLEVEL)/../..
35 include $(TOPLEVEL)/common.make
36
37-OBJS = eventchn
38+OBJS = xeneventchn
39 INTF = $(foreach obj, $(OBJS),$(obj).cmi)
40-LIBS = eventchn.cma eventchn.cmxa
41+LIBS = xeneventchn.cma xeneventchn.cmxa
42+
43+LIBS_xeneventchn = $(LDLIBS_libxenctrl)
44
45 all: $(INTF) $(LIBS) $(PROGRAMS)
46
47@@ -12,20 +14,20 @@
48
49 libs: $(LIBS)
50
51-eventchn_OBJS = $(OBJS)
52-eventchn_C_OBJS = eventchn_stubs
53+xeneventchn_OBJS = $(OBJS)
54+xeneventchn_C_OBJS = xeneventchn_stubs
55
56-OCAML_LIBRARY = eventchn
57+OCAML_LIBRARY = xeneventchn
58
59 .PHONY: install
60 install: $(LIBS) META
61 mkdir -p $(OCAMLDESTDIR)
62- ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn
63- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore eventchn META $(INTF) $(LIBS) *.a *.so *.cmx
64+ ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn
65+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xeneventchn META $(INTF) $(LIBS) *.a *.so *.cmx
66
67 .PHONY: uninstall
68 uninstall:
69- ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn
70+ ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn
71
72 include $(TOPLEVEL)/Makefile.rules
73
74--- a/tools/ocaml/libs/eventchn/eventchn.ml
75+++ /dev/null
76@@ -1,30 +0,0 @@
77-(*
78- * Copyright (C) 2006-2007 XenSource Ltd.
79- * Copyright (C) 2008 Citrix Ltd.
80- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
81- *
82- * This program is free software; you can redistribute it and/or modify
83- * it under the terms of the GNU Lesser General Public License as published
84- * by the Free Software Foundation; version 2.1 only. with the special
85- * exception on linking described in file LICENSE.
86- *
87- * This program is distributed in the hope that it will be useful,
88- * but WITHOUT ANY WARRANTY; without even the implied warranty of
89- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
90- * GNU Lesser General Public License for more details.
91- *)
92-
93-exception Error of string
94-
95-type handle
96-
97-external init: unit -> handle = "stub_eventchn_init"
98-external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
99-external notify: handle -> int -> unit = "stub_eventchn_notify"
100-external bind_interdomain: handle -> int -> int -> int = "stub_eventchn_bind_interdomain"
101-external bind_dom_exc_virq: handle -> int = "stub_eventchn_bind_dom_exc_virq"
102-external unbind: handle -> int -> unit = "stub_eventchn_unbind"
103-external pending: handle -> int = "stub_eventchn_pending"
104-external unmask: handle -> int -> unit = "stub_eventchn_unmask"
105-
106-let _ = Callback.register_exception "eventchn.error" (Error "register_callback")
107--- a/tools/ocaml/libs/eventchn/eventchn.mli
108+++ /dev/null
109@@ -1,31 +0,0 @@
110-(*
111- * Copyright (C) 2006-2007 XenSource Ltd.
112- * Copyright (C) 2008 Citrix Ltd.
113- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
114- *
115- * This program is free software; you can redistribute it and/or modify
116- * it under the terms of the GNU Lesser General Public License as published
117- * by the Free Software Foundation; version 2.1 only. with the special
118- * exception on linking described in file LICENSE.
119- *
120- * This program is distributed in the hope that it will be useful,
121- * but WITHOUT ANY WARRANTY; without even the implied warranty of
122- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
123- * GNU Lesser General Public License for more details.
124- *)
125-
126-exception Error of string
127-
128-type handle
129-
130-external init : unit -> handle = "stub_eventchn_init"
131-external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
132-
133-external notify : handle -> int -> unit = "stub_eventchn_notify"
134-external bind_interdomain : handle -> int -> int -> int
135- = "stub_eventchn_bind_interdomain"
136-external bind_dom_exc_virq : handle -> int = "stub_eventchn_bind_dom_exc_virq"
137-external unbind : handle -> int -> unit = "stub_eventchn_unbind"
138-external pending : handle -> int = "stub_eventchn_pending"
139-external unmask : handle -> int -> unit
140- = "stub_eventchn_unmask"
141--- a/tools/ocaml/libs/eventchn/eventchn_stubs.c
142+++ /dev/null
143@@ -1,143 +0,0 @@
144-/*
145- * Copyright (C) 2006-2007 XenSource Ltd.
146- * Copyright (C) 2008 Citrix Ltd.
147- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
148- *
149- * This program is free software; you can redistribute it and/or modify
150- * it under the terms of the GNU Lesser General Public License as published
151- * by the Free Software Foundation; version 2.1 only. with the special
152- * exception on linking described in file LICENSE.
153- *
154- * This program is distributed in the hope that it will be useful,
155- * but WITHOUT ANY WARRANTY; without even the implied warranty of
156- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
157- * GNU Lesser General Public License for more details.
158- */
159-
160-#include <sys/types.h>
161-#include <sys/stat.h>
162-#include <fcntl.h>
163-#include <unistd.h>
164-#include <errno.h>
165-#include <stdint.h>
166-#include <sys/ioctl.h>
167-#include <xen/sysctl.h>
168-#include <xen/xen.h>
169-#include <xen/sys/evtchn.h>
170-#include <xenctrl.h>
171-
172-#define CAML_NAME_SPACE
173-#include <caml/mlvalues.h>
174-#include <caml/memory.h>
175-#include <caml/alloc.h>
176-#include <caml/custom.h>
177-#include <caml/callback.h>
178-#include <caml/fail.h>
179-
180-#define _H(__h) ((xc_interface *)(__h))
181-
182-CAMLprim value stub_eventchn_init(void)
183-{
184- CAMLparam0();
185- CAMLlocal1(result);
186-
187- xc_interface *xce = xc_evtchn_open(NULL, XC_OPENFLAG_NON_REENTRANT);
188- if (xce == NULL)
189- caml_failwith("open failed");
190-
191- result = (value)xce;
192- CAMLreturn(result);
193-}
194-
195-CAMLprim value stub_eventchn_fd(value xce)
196-{
197- CAMLparam1(xce);
198- CAMLlocal1(result);
199- int fd;
200-
201- fd = xc_evtchn_fd(_H(xce));
202- if (fd == -1)
203- caml_failwith("evtchn fd failed");
204-
205- result = Val_int(fd);
206-
207- CAMLreturn(result);
208-}
209-
210-CAMLprim value stub_eventchn_notify(value xce, value port)
211-{
212- CAMLparam2(xce, port);
213- int rc;
214-
215- rc = xc_evtchn_notify(_H(xce), Int_val(port));
216- if (rc == -1)
217- caml_failwith("evtchn notify failed");
218-
219- CAMLreturn(Val_unit);
220-}
221-
222-CAMLprim value stub_eventchn_bind_interdomain(value xce, value domid,
223- value remote_port)
224-{
225- CAMLparam3(xce, domid, remote_port);
226- CAMLlocal1(port);
227- evtchn_port_or_error_t rc;
228-
229- rc = xc_evtchn_bind_interdomain(_H(xce), Int_val(domid), Int_val(remote_port));
230- if (rc == -1)
231- caml_failwith("evtchn bind_interdomain failed");
232- port = Val_int(rc);
233-
234- CAMLreturn(port);
235-}
236-
237-CAMLprim value stub_eventchn_bind_dom_exc_virq(value xce)
238-{
239- CAMLparam1(xce);
240- CAMLlocal1(port);
241- evtchn_port_or_error_t rc;
242-
243- rc = xc_evtchn_bind_virq(_H(xce), VIRQ_DOM_EXC);
244- if (rc == -1)
245- caml_failwith("evtchn bind_dom_exc_virq failed");
246- port = Val_int(rc);
247-
248- CAMLreturn(port);
249-}
250-
251-CAMLprim value stub_eventchn_unbind(value xce, value port)
252-{
253- CAMLparam2(xce, port);
254- int rc;
255-
256- rc = xc_evtchn_unbind(_H(xce), Int_val(port));
257- if (rc == -1)
258- caml_failwith("evtchn unbind failed");
259-
260- CAMLreturn(Val_unit);
261-}
262-
263-CAMLprim value stub_eventchn_pending(value xce)
264-{
265- CAMLparam1(xce);
266- CAMLlocal1(result);
267- evtchn_port_or_error_t port;
268-
269- port = xc_evtchn_pending(_H(xce));
270- if (port == -1)
271- caml_failwith("evtchn pending failed");
272- result = Val_int(port);
273-
274- CAMLreturn(result);
275-}
276-
277-CAMLprim value stub_eventchn_unmask(value xce, value _port)
278-{
279- CAMLparam2(xce, _port);
280- evtchn_port_t port;
281-
282- port = Int_val(_port);
283- if (xc_evtchn_unmask(_H(xce), port))
284- caml_failwith("evtchn unmask failed");
285- CAMLreturn(Val_unit);
286-}
287--- /dev/null
288+++ b/tools/ocaml/libs/eventchn/xeneventchn.ml
289@@ -0,0 +1,30 @@
290+(*
291+ * Copyright (C) 2006-2007 XenSource Ltd.
292+ * Copyright (C) 2008 Citrix Ltd.
293+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
294+ *
295+ * This program is free software; you can redistribute it and/or modify
296+ * it under the terms of the GNU Lesser General Public License as published
297+ * by the Free Software Foundation; version 2.1 only. with the special
298+ * exception on linking described in file LICENSE.
299+ *
300+ * This program is distributed in the hope that it will be useful,
301+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
302+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
303+ * GNU Lesser General Public License for more details.
304+ *)
305+
306+exception Error of string
307+
308+type handle
309+
310+external init: unit -> handle = "stub_eventchn_init"
311+external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
312+external notify: handle -> int -> unit = "stub_eventchn_notify"
313+external bind_interdomain: handle -> int -> int -> int = "stub_eventchn_bind_interdomain"
314+external bind_dom_exc_virq: handle -> int = "stub_eventchn_bind_dom_exc_virq"
315+external unbind: handle -> int -> unit = "stub_eventchn_unbind"
316+external pending: handle -> int = "stub_eventchn_pending"
317+external unmask: handle -> int -> unit = "stub_eventchn_unmask"
318+
319+let _ = Callback.register_exception "eventchn.error" (Error "register_callback")
320--- /dev/null
321+++ b/tools/ocaml/libs/eventchn/xeneventchn.mli
322@@ -0,0 +1,31 @@
323+(*
324+ * Copyright (C) 2006-2007 XenSource Ltd.
325+ * Copyright (C) 2008 Citrix Ltd.
326+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
327+ *
328+ * This program is free software; you can redistribute it and/or modify
329+ * it under the terms of the GNU Lesser General Public License as published
330+ * by the Free Software Foundation; version 2.1 only. with the special
331+ * exception on linking described in file LICENSE.
332+ *
333+ * This program is distributed in the hope that it will be useful,
334+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
335+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
336+ * GNU Lesser General Public License for more details.
337+ *)
338+
339+exception Error of string
340+
341+type handle
342+
343+external init : unit -> handle = "stub_eventchn_init"
344+external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
345+
346+external notify : handle -> int -> unit = "stub_eventchn_notify"
347+external bind_interdomain : handle -> int -> int -> int
348+ = "stub_eventchn_bind_interdomain"
349+external bind_dom_exc_virq : handle -> int = "stub_eventchn_bind_dom_exc_virq"
350+external unbind : handle -> int -> unit = "stub_eventchn_unbind"
351+external pending : handle -> int = "stub_eventchn_pending"
352+external unmask : handle -> int -> unit
353+ = "stub_eventchn_unmask"
354--- /dev/null
355+++ b/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
356@@ -0,0 +1,143 @@
357+/*
358+ * Copyright (C) 2006-2007 XenSource Ltd.
359+ * Copyright (C) 2008 Citrix Ltd.
360+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
361+ *
362+ * This program is free software; you can redistribute it and/or modify
363+ * it under the terms of the GNU Lesser General Public License as published
364+ * by the Free Software Foundation; version 2.1 only. with the special
365+ * exception on linking described in file LICENSE.
366+ *
367+ * This program is distributed in the hope that it will be useful,
368+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
369+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
370+ * GNU Lesser General Public License for more details.
371+ */
372+
373+#include <sys/types.h>
374+#include <sys/stat.h>
375+#include <fcntl.h>
376+#include <unistd.h>
377+#include <errno.h>
378+#include <stdint.h>
379+#include <sys/ioctl.h>
380+#include <xen/sysctl.h>
381+#include <xen/xen.h>
382+#include <xen/sys/evtchn.h>
383+#include <xenctrl.h>
384+
385+#define CAML_NAME_SPACE
386+#include <caml/mlvalues.h>
387+#include <caml/memory.h>
388+#include <caml/alloc.h>
389+#include <caml/custom.h>
390+#include <caml/callback.h>
391+#include <caml/fail.h>
392+
393+#define _H(__h) ((xc_interface *)(__h))
394+
395+CAMLprim value stub_eventchn_init(void)
396+{
397+ CAMLparam0();
398+ CAMLlocal1(result);
399+
400+ xc_interface *xce = xc_evtchn_open(NULL, XC_OPENFLAG_NON_REENTRANT);
401+ if (xce == NULL)
402+ caml_failwith("open failed");
403+
404+ result = (value)xce;
405+ CAMLreturn(result);
406+}
407+
408+CAMLprim value stub_eventchn_fd(value xce)
409+{
410+ CAMLparam1(xce);
411+ CAMLlocal1(result);
412+ int fd;
413+
414+ fd = xc_evtchn_fd(_H(xce));
415+ if (fd == -1)
416+ caml_failwith("evtchn fd failed");
417+
418+ result = Val_int(fd);
419+
420+ CAMLreturn(result);
421+}
422+
423+CAMLprim value stub_eventchn_notify(value xce, value port)
424+{
425+ CAMLparam2(xce, port);
426+ int rc;
427+
428+ rc = xc_evtchn_notify(_H(xce), Int_val(port));
429+ if (rc == -1)
430+ caml_failwith("evtchn notify failed");
431+
432+ CAMLreturn(Val_unit);
433+}
434+
435+CAMLprim value stub_eventchn_bind_interdomain(value xce, value domid,
436+ value remote_port)
437+{
438+ CAMLparam3(xce, domid, remote_port);
439+ CAMLlocal1(port);
440+ evtchn_port_or_error_t rc;
441+
442+ rc = xc_evtchn_bind_interdomain(_H(xce), Int_val(domid), Int_val(remote_port));
443+ if (rc == -1)
444+ caml_failwith("evtchn bind_interdomain failed");
445+ port = Val_int(rc);
446+
447+ CAMLreturn(port);
448+}
449+
450+CAMLprim value stub_eventchn_bind_dom_exc_virq(value xce)
451+{
452+ CAMLparam1(xce);
453+ CAMLlocal1(port);
454+ evtchn_port_or_error_t rc;
455+
456+ rc = xc_evtchn_bind_virq(_H(xce), VIRQ_DOM_EXC);
457+ if (rc == -1)
458+ caml_failwith("evtchn bind_dom_exc_virq failed");
459+ port = Val_int(rc);
460+
461+ CAMLreturn(port);
462+}
463+
464+CAMLprim value stub_eventchn_unbind(value xce, value port)
465+{
466+ CAMLparam2(xce, port);
467+ int rc;
468+
469+ rc = xc_evtchn_unbind(_H(xce), Int_val(port));
470+ if (rc == -1)
471+ caml_failwith("evtchn unbind failed");
472+
473+ CAMLreturn(Val_unit);
474+}
475+
476+CAMLprim value stub_eventchn_pending(value xce)
477+{
478+ CAMLparam1(xce);
479+ CAMLlocal1(result);
480+ evtchn_port_or_error_t port;
481+
482+ port = xc_evtchn_pending(_H(xce));
483+ if (port == -1)
484+ caml_failwith("evtchn pending failed");
485+ result = Val_int(port);
486+
487+ CAMLreturn(result);
488+}
489+
490+CAMLprim value stub_eventchn_unmask(value xce, value _port)
491+{
492+ CAMLparam2(xce, _port);
493+ evtchn_port_t port;
494+
495+ port = Int_val(_port);
496+ if (xc_evtchn_unmask(_H(xce), port))
497+ caml_failwith("evtchn unmask failed");
498+ CAMLreturn(Val_unit);
499+}
500--- a/tools/ocaml/libs/mmap/META.in
501+++ b/tools/ocaml/libs/mmap/META.in
502@@ -1,4 +1,4 @@
503 version = "@VERSION@"
504 description = "Mmap interface extension"
505-archive(byte) = "mmap.cma"
506-archive(native) = "mmap.cmxa"
507+archive(byte) = "xenmmap.cma"
508+archive(native) = "xenmmap.cmxa"
509--- a/tools/ocaml/libs/mmap/Makefile
510+++ b/tools/ocaml/libs/mmap/Makefile
511@@ -2,9 +2,9 @@
512 XEN_ROOT=$(TOPLEVEL)/../..
513 include $(TOPLEVEL)/common.make
514
515-OBJS = mmap
516+OBJS = xenmmap
517 INTF = $(foreach obj, $(OBJS),$(obj).cmi)
518-LIBS = mmap.cma mmap.cmxa
519+LIBS = xenmmap.cma xenmmap.cmxa
520
521 all: $(INTF) $(LIBS) $(PROGRAMS)
522
523@@ -12,19 +12,19 @@
524
525 libs: $(LIBS)
526
527-mmap_OBJS = $(OBJS)
528-mmap_C_OBJS = mmap_stubs
529-OCAML_LIBRARY = mmap
530+xenmmap_OBJS = $(OBJS)
531+xenmmap_C_OBJS = xenmmap_stubs
532+OCAML_LIBRARY = xenmmap
533
534 .PHONY: install
535 install: $(LIBS) META
536 mkdir -p $(OCAMLDESTDIR)
537- ocamlfind remove -destdir $(OCAMLDESTDIR) mmap
538- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore mmap META $(INTF) $(LIBS) *.a *.so *.cmx
539+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenmmap
540+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenmmap META $(INTF) $(LIBS) *.a *.so *.cmx
541
542 .PHONY: uninstall
543 uninstall:
544- ocamlfind remove -destdir $(OCAMLDESTDIR) mmap
545+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenmmap
546
547 include $(TOPLEVEL)/Makefile.rules
548
549--- a/tools/ocaml/libs/mmap/mmap.ml
550+++ /dev/null
551@@ -1,31 +0,0 @@
552-(*
553- * Copyright (C) 2006-2007 XenSource Ltd.
554- * Copyright (C) 2008 Citrix Ltd.
555- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
556- *
557- * This program is free software; you can redistribute it and/or modify
558- * it under the terms of the GNU Lesser General Public License as published
559- * by the Free Software Foundation; version 2.1 only. with the special
560- * exception on linking described in file LICENSE.
561- *
562- * This program is distributed in the hope that it will be useful,
563- * but WITHOUT ANY WARRANTY; without even the implied warranty of
564- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
565- * GNU Lesser General Public License for more details.
566- *)
567-
568-type mmap_interface
569-
570-type mmap_prot_flag = RDONLY | WRONLY | RDWR
571-type mmap_map_flag = SHARED | PRIVATE
572-
573-(* mmap: fd -> prot_flag -> map_flag -> length -> offset -> interface *)
574-external mmap: Unix.file_descr -> mmap_prot_flag -> mmap_map_flag
575- -> int -> int -> mmap_interface = "stub_mmap_init"
576-external unmap: mmap_interface -> unit = "stub_mmap_final"
577-(* read: interface -> start -> length -> data *)
578-external read: mmap_interface -> int -> int -> string = "stub_mmap_read"
579-(* write: interface -> data -> start -> length -> unit *)
580-external write: mmap_interface -> string -> int -> int -> unit = "stub_mmap_write"
581-(* getpagesize: unit -> size of page *)
582-external getpagesize: unit -> int = "stub_mmap_getpagesize"
583--- a/tools/ocaml/libs/mmap/mmap.mli
584+++ /dev/null
585@@ -1,28 +0,0 @@
586-(*
587- * Copyright (C) 2006-2007 XenSource Ltd.
588- * Copyright (C) 2008 Citrix Ltd.
589- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
590- *
591- * This program is free software; you can redistribute it and/or modify
592- * it under the terms of the GNU Lesser General Public License as published
593- * by the Free Software Foundation; version 2.1 only. with the special
594- * exception on linking described in file LICENSE.
595- *
596- * This program is distributed in the hope that it will be useful,
597- * but WITHOUT ANY WARRANTY; without even the implied warranty of
598- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
599- * GNU Lesser General Public License for more details.
600- *)
601-
602-type mmap_interface
603-type mmap_prot_flag = RDONLY | WRONLY | RDWR
604-type mmap_map_flag = SHARED | PRIVATE
605-
606-external mmap : Unix.file_descr -> mmap_prot_flag -> mmap_map_flag -> int -> int
607- -> mmap_interface = "stub_mmap_init"
608-external unmap : mmap_interface -> unit = "stub_mmap_final"
609-external read : mmap_interface -> int -> int -> string = "stub_mmap_read"
610-external write : mmap_interface -> string -> int -> int -> unit
611- = "stub_mmap_write"
612-
613-external getpagesize : unit -> int = "stub_mmap_getpagesize"
614--- a/tools/ocaml/libs/mmap/mmap_stubs.c
615+++ /dev/null
616@@ -1,136 +0,0 @@
617-/*
618- * Copyright (C) 2006-2007 XenSource Ltd.
619- * Copyright (C) 2008 Citrix Ltd.
620- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
621- *
622- * This program is free software; you can redistribute it and/or modify
623- * it under the terms of the GNU Lesser General Public License as published
624- * by the Free Software Foundation; version 2.1 only. with the special
625- * exception on linking described in file LICENSE.
626- *
627- * This program is distributed in the hope that it will be useful,
628- * but WITHOUT ANY WARRANTY; without even the implied warranty of
629- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
630- * GNU Lesser General Public License for more details.
631- */
632-
633-#include <unistd.h>
634-#include <stdlib.h>
635-#include <sys/mman.h>
636-#include <string.h>
637-#include <errno.h>
638-#include "mmap_stubs.h"
639-
640-#include <caml/mlvalues.h>
641-#include <caml/memory.h>
642-#include <caml/alloc.h>
643-#include <caml/custom.h>
644-#include <caml/fail.h>
645-#include <caml/callback.h>
646-
647-#define GET_C_STRUCT(a) ((struct mmap_interface *) a)
648-
649-static int mmap_interface_init(struct mmap_interface *intf,
650- int fd, int pflag, int mflag,
651- int len, int offset)
652-{
653- intf->len = len;
654- intf->addr = mmap(NULL, len, pflag, mflag, fd, offset);
655- return (intf->addr == MAP_FAILED) ? errno : 0;
656-}
657-
658-CAMLprim value stub_mmap_init(value fd, value pflag, value mflag,
659- value len, value offset)
660-{
661- CAMLparam5(fd, pflag, mflag, len, offset);
662- CAMLlocal1(result);
663- int c_pflag, c_mflag;
664-
665- switch (Int_val(pflag)) {
666- case 0: c_pflag = PROT_READ; break;
667- case 1: c_pflag = PROT_WRITE; break;
668- case 2: c_pflag = PROT_READ|PROT_WRITE; break;
669- default: caml_invalid_argument("protectiontype");
670- }
671-
672- switch (Int_val(mflag)) {
673- case 0: c_mflag = MAP_SHARED; break;
674- case 1: c_mflag = MAP_PRIVATE; break;
675- default: caml_invalid_argument("maptype");
676- }
677-
678- result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
679-
680- if (mmap_interface_init(GET_C_STRUCT(result), Int_val(fd),
681- c_pflag, c_mflag,
682- Int_val(len), Int_val(offset)))
683- caml_failwith("mmap");
684- CAMLreturn(result);
685-}
686-
687-CAMLprim value stub_mmap_final(value interface)
688-{
689- CAMLparam1(interface);
690- struct mmap_interface *intf;
691-
692- intf = GET_C_STRUCT(interface);
693- if (intf->addr != MAP_FAILED)
694- munmap(intf->addr, intf->len);
695- intf->addr = MAP_FAILED;
696-
697- CAMLreturn(Val_unit);
698-}
699-
700-CAMLprim value stub_mmap_read(value interface, value start, value len)
701-{
702- CAMLparam3(interface, start, len);
703- CAMLlocal1(data);
704- struct mmap_interface *intf;
705- int c_start;
706- int c_len;
707-
708- c_start = Int_val(start);
709- c_len = Int_val(len);
710- intf = GET_C_STRUCT(interface);
711-
712- if (c_start > intf->len)
713- caml_invalid_argument("start invalid");
714- if (c_start + c_len > intf->len)
715- caml_invalid_argument("len invalid");
716-
717- data = caml_alloc_string(c_len);
718- memcpy((char *) data, intf->addr + c_start, c_len);
719-
720- CAMLreturn(data);
721-}
722-
723-CAMLprim value stub_mmap_write(value interface, value data,
724- value start, value len)
725-{
726- CAMLparam4(interface, data, start, len);
727- struct mmap_interface *intf;
728- int c_start;
729- int c_len;
730-
731- c_start = Int_val(start);
732- c_len = Int_val(len);
733- intf = GET_C_STRUCT(interface);
734-
735- if (c_start > intf->len)
736- caml_invalid_argument("start invalid");
737- if (c_start + c_len > intf->len)
738- caml_invalid_argument("len invalid");
739-
740- memcpy(intf->addr + c_start, (char *) data, c_len);
741-
742- CAMLreturn(Val_unit);
743-}
744-
745-CAMLprim value stub_mmap_getpagesize(value unit)
746-{
747- CAMLparam1(unit);
748- CAMLlocal1(data);
749-
750- data = Val_int(getpagesize());
751- CAMLreturn(data);
752-}
753--- /dev/null
754+++ b/tools/ocaml/libs/mmap/xenmmap.ml
755@@ -0,0 +1,31 @@
756+(*
757+ * Copyright (C) 2006-2007 XenSource Ltd.
758+ * Copyright (C) 2008 Citrix Ltd.
759+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
760+ *
761+ * This program is free software; you can redistribute it and/or modify
762+ * it under the terms of the GNU Lesser General Public License as published
763+ * by the Free Software Foundation; version 2.1 only. with the special
764+ * exception on linking described in file LICENSE.
765+ *
766+ * This program is distributed in the hope that it will be useful,
767+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
768+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
769+ * GNU Lesser General Public License for more details.
770+ *)
771+
772+type mmap_interface
773+
774+type mmap_prot_flag = RDONLY | WRONLY | RDWR
775+type mmap_map_flag = SHARED | PRIVATE
776+
777+(* mmap: fd -> prot_flag -> map_flag -> length -> offset -> interface *)
778+external mmap: Unix.file_descr -> mmap_prot_flag -> mmap_map_flag
779+ -> int -> int -> mmap_interface = "stub_mmap_init"
780+external unmap: mmap_interface -> unit = "stub_mmap_final"
781+(* read: interface -> start -> length -> data *)
782+external read: mmap_interface -> int -> int -> string = "stub_mmap_read"
783+(* write: interface -> data -> start -> length -> unit *)
784+external write: mmap_interface -> string -> int -> int -> unit = "stub_mmap_write"
785+(* getpagesize: unit -> size of page *)
786+external getpagesize: unit -> int = "stub_mmap_getpagesize"
787--- /dev/null
788+++ b/tools/ocaml/libs/mmap/xenmmap.mli
789@@ -0,0 +1,28 @@
790+(*
791+ * Copyright (C) 2006-2007 XenSource Ltd.
792+ * Copyright (C) 2008 Citrix Ltd.
793+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
794+ *
795+ * This program is free software; you can redistribute it and/or modify
796+ * it under the terms of the GNU Lesser General Public License as published
797+ * by the Free Software Foundation; version 2.1 only. with the special
798+ * exception on linking described in file LICENSE.
799+ *
800+ * This program is distributed in the hope that it will be useful,
801+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
802+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
803+ * GNU Lesser General Public License for more details.
804+ *)
805+
806+type mmap_interface
807+type mmap_prot_flag = RDONLY | WRONLY | RDWR
808+type mmap_map_flag = SHARED | PRIVATE
809+
810+external mmap : Unix.file_descr -> mmap_prot_flag -> mmap_map_flag -> int -> int
811+ -> mmap_interface = "stub_mmap_init"
812+external unmap : mmap_interface -> unit = "stub_mmap_final"
813+external read : mmap_interface -> int -> int -> string = "stub_mmap_read"
814+external write : mmap_interface -> string -> int -> int -> unit
815+ = "stub_mmap_write"
816+
817+external getpagesize : unit -> int = "stub_mmap_getpagesize"
818--- /dev/null
819+++ b/tools/ocaml/libs/mmap/xenmmap_stubs.c
820@@ -0,0 +1,136 @@
821+/*
822+ * Copyright (C) 2006-2007 XenSource Ltd.
823+ * Copyright (C) 2008 Citrix Ltd.
824+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
825+ *
826+ * This program is free software; you can redistribute it and/or modify
827+ * it under the terms of the GNU Lesser General Public License as published
828+ * by the Free Software Foundation; version 2.1 only. with the special
829+ * exception on linking described in file LICENSE.
830+ *
831+ * This program is distributed in the hope that it will be useful,
832+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
833+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
834+ * GNU Lesser General Public License for more details.
835+ */
836+
837+#include <unistd.h>
838+#include <stdlib.h>
839+#include <sys/mman.h>
840+#include <string.h>
841+#include <errno.h>
842+#include "mmap_stubs.h"
843+
844+#include <caml/mlvalues.h>
845+#include <caml/memory.h>
846+#include <caml/alloc.h>
847+#include <caml/custom.h>
848+#include <caml/fail.h>
849+#include <caml/callback.h>
850+
851+#define GET_C_STRUCT(a) ((struct mmap_interface *) a)
852+
853+static int mmap_interface_init(struct mmap_interface *intf,
854+ int fd, int pflag, int mflag,
855+ int len, int offset)
856+{
857+ intf->len = len;
858+ intf->addr = mmap(NULL, len, pflag, mflag, fd, offset);
859+ return (intf->addr == MAP_FAILED) ? errno : 0;
860+}
861+
862+CAMLprim value stub_mmap_init(value fd, value pflag, value mflag,
863+ value len, value offset)
864+{
865+ CAMLparam5(fd, pflag, mflag, len, offset);
866+ CAMLlocal1(result);
867+ int c_pflag, c_mflag;
868+
869+ switch (Int_val(pflag)) {
870+ case 0: c_pflag = PROT_READ; break;
871+ case 1: c_pflag = PROT_WRITE; break;
872+ case 2: c_pflag = PROT_READ|PROT_WRITE; break;
873+ default: caml_invalid_argument("protectiontype");
874+ }
875+
876+ switch (Int_val(mflag)) {
877+ case 0: c_mflag = MAP_SHARED; break;
878+ case 1: c_mflag = MAP_PRIVATE; break;
879+ default: caml_invalid_argument("maptype");
880+ }
881+
882+ result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
883+
884+ if (mmap_interface_init(GET_C_STRUCT(result), Int_val(fd),
885+ c_pflag, c_mflag,
886+ Int_val(len), Int_val(offset)))
887+ caml_failwith("mmap");
888+ CAMLreturn(result);
889+}
890+
891+CAMLprim value stub_mmap_final(value interface)
892+{
893+ CAMLparam1(interface);
894+ struct mmap_interface *intf;
895+
896+ intf = GET_C_STRUCT(interface);
897+ if (intf->addr != MAP_FAILED)
898+ munmap(intf->addr, intf->len);
899+ intf->addr = MAP_FAILED;
900+
901+ CAMLreturn(Val_unit);
902+}
903+
904+CAMLprim value stub_mmap_read(value interface, value start, value len)
905+{
906+ CAMLparam3(interface, start, len);
907+ CAMLlocal1(data);
908+ struct mmap_interface *intf;
909+ int c_start;
910+ int c_len;
911+
912+ c_start = Int_val(start);
913+ c_len = Int_val(len);
914+ intf = GET_C_STRUCT(interface);
915+
916+ if (c_start > intf->len)
917+ caml_invalid_argument("start invalid");
918+ if (c_start + c_len > intf->len)
919+ caml_invalid_argument("len invalid");
920+
921+ data = caml_alloc_string(c_len);
922+ memcpy((char *) data, intf->addr + c_start, c_len);
923+
924+ CAMLreturn(data);
925+}
926+
927+CAMLprim value stub_mmap_write(value interface, value data,
928+ value start, value len)
929+{
930+ CAMLparam4(interface, data, start, len);
931+ struct mmap_interface *intf;
932+ int c_start;
933+ int c_len;
934+
935+ c_start = Int_val(start);
936+ c_len = Int_val(len);
937+ intf = GET_C_STRUCT(interface);
938+
939+ if (c_start > intf->len)
940+ caml_invalid_argument("start invalid");
941+ if (c_start + c_len > intf->len)
942+ caml_invalid_argument("len invalid");
943+
944+ memcpy(intf->addr + c_start, (char *) data, c_len);
945+
946+ CAMLreturn(Val_unit);
947+}
948+
949+CAMLprim value stub_mmap_getpagesize(value unit)
950+{
951+ CAMLparam1(unit);
952+ CAMLlocal1(data);
953+
954+ data = Val_int(getpagesize());
955+ CAMLreturn(data);
956+}
957--- a/tools/ocaml/libs/xb/META.in
958+++ b/tools/ocaml/libs/xb/META.in
959@@ -1,5 +1,5 @@
960 version = "@VERSION@"
961 description = "XenBus Interface"
962-requires = "unix,mmap"
963-archive(byte) = "xb.cma"
964-archive(native) = "xb.cmxa"
965+requires = "unix,xenmmap"
966+archive(byte) = "xenbus.cma"
967+archive(native) = "xenbus.cmxa"
968--- a/tools/ocaml/libs/xb/Makefile
969+++ b/tools/ocaml/libs/xb/Makefile
970@@ -4,6 +4,7 @@
971
972 CFLAGS += -I../mmap
973 OCAMLINCLUDE += -I ../mmap
974+OCAMLOPTFLAGS += -for-pack Xenbus
975
976 .NOTPARALLEL:
977 # Ocaml is such a PITA!
978@@ -13,7 +14,7 @@
979 PRELIBS = $(foreach obj, $(PREOBJS),$(obj).cmo) $(foreach obj,$(PREOJBS),$(obj).cmx)
980 OBJS = op partial packet xs_ring xb
981 INTF = op.cmi packet.cmi xb.cmi
982-LIBS = xb.cma xb.cmxa
983+LIBS = xenbus.cma xenbus.cmxa
984
985 ALL_OCAML_OBJS = $(OBJS) $(PREOJBS)
986
987@@ -23,22 +24,30 @@
988
989 libs: $(LIBS)
990
991-xb_OBJS = $(OBJS)
992-xb_C_OBJS = xs_ring_stubs xb_stubs
993-OCAML_LIBRARY = xb
994+xenbus_OBJS = xenbus
995+xenbus_C_OBJS = xs_ring_stubs xenbus_stubs
996+OCAML_LIBRARY = xenbus
997+
998+xenbus.cmx : $(foreach obj, $(OBJS), $(obj).cmx)
999+ $(E) " CMX $@"
1000+ $(OCAMLOPT) -pack -o $@ $^
1001+
1002+xenbus.cmo : $(foreach obj, $(OBJS), $(obj).cmo)
1003+ $(E) " CMO $@"
1004+ $(OCAMLC) -pack -o $@ $^
1005
1006 %.mli: %.ml
1007 $(E) " MLI $@"
1008- $(Q)$(OCAMLC) -i $< $o
1009+ $(Q)$(OCAMLC) $(OCAMLINCLUDE) -i $< $o
1010
1011 .PHONY: install
1012 install: $(LIBS) META
1013 mkdir -p $(OCAMLDESTDIR)
1014- ocamlfind remove -destdir $(OCAMLDESTDIR) xb
1015- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xb META $(INTF) $(LIBS) *.a *.so *.cmx
1016+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus
1017+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenbus META $(LIBS) xenbus.cmi xenbus.cmx *.a *.so
1018
1019 .PHONY: uninstall
1020 uninstall:
1021- ocamlfind remove -destdir $(OCAMLDESTDIR) xb
1022+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus
1023
1024 include $(TOPLEVEL)/Makefile.rules
1025--- a/tools/ocaml/libs/xb/xb.ml
1026+++ b/tools/ocaml/libs/xb/xb.ml
1027@@ -24,7 +24,7 @@
1028
1029 type backend_mmap =
1030 {
1031- mmap: Mmap.mmap_interface; (* mmaped interface = xs_ring *)
1032+ mmap: Xenmmap.mmap_interface; (* mmaped interface = xs_ring *)
1033 eventchn_notify: unit -> unit; (* function to notify through eventchn *)
1034 mutable work_again: bool;
1035 }
1036@@ -34,7 +34,7 @@
1037 fd: Unix.file_descr;
1038 }
1039
1040-type backend = Fd of backend_fd | Mmap of backend_mmap
1041+type backend = Fd of backend_fd | Xenmmap of backend_mmap
1042
1043 type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string
1044
1045@@ -68,7 +68,7 @@
1046 let read con s len =
1047 match con.backend with
1048 | Fd backfd -> read_fd backfd con s len
1049- | Mmap backmmap -> read_mmap backmmap con s len
1050+ | Xenmmap backmmap -> read_mmap backmmap con s len
1051
1052 let write_fd back con s len =
1053 Unix.write back.fd s 0 len
1054@@ -82,7 +82,7 @@
1055 let write con s len =
1056 match con.backend with
1057 | Fd backfd -> write_fd backfd con s len
1058- | Mmap backmmap -> write_mmap backmmap con s len
1059+ | Xenmmap backmmap -> write_mmap backmmap con s len
1060
1061 let output con =
1062 (* get the output string from a string_of(packet) or partial_out *)
1063@@ -145,7 +145,7 @@
1064 let open_fd fd = newcon (Fd { fd = fd; })
1065
1066 let open_mmap mmap notifyfct =
1067- newcon (Mmap {
1068+ newcon (Xenmmap {
1069 mmap = mmap;
1070 eventchn_notify = notifyfct;
1071 work_again = false; })
1072@@ -153,12 +153,12 @@
1073 let close con =
1074 match con.backend with
1075 | Fd backend -> Unix.close backend.fd
1076- | Mmap backend -> Mmap.unmap backend.mmap
1077+ | Xenmmap backend -> Xenmmap.unmap backend.mmap
1078
1079 let is_fd con =
1080 match con.backend with
1081 | Fd _ -> true
1082- | Mmap _ -> false
1083+ | Xenmmap _ -> false
1084
1085 let is_mmap con = not (is_fd con)
1086
1087@@ -176,14 +176,14 @@
1088 let has_more_input con =
1089 match con.backend with
1090 | Fd _ -> false
1091- | Mmap backend -> backend.work_again
1092+ | Xenmmap backend -> backend.work_again
1093
1094 let is_selectable con =
1095 match con.backend with
1096 | Fd _ -> true
1097- | Mmap _ -> false
1098+ | Xenmmap _ -> false
1099
1100 let get_fd con =
1101 match con.backend with
1102 | Fd backend -> backend.fd
1103- | Mmap _ -> raise (Failure "get_fd")
1104+ | Xenmmap _ -> raise (Failure "get_fd")
1105--- a/tools/ocaml/libs/xb/xb.mli
1106+++ b/tools/ocaml/libs/xb/xb.mli
1107@@ -1,83 +1,103 @@
1108-module Op:
1109-sig
1110- type operation = Op.operation =
1111- | Debug
1112- | Directory
1113- | Read
1114- | Getperms
1115- | Watch
1116- | Unwatch
1117- | Transaction_start
1118- | Transaction_end
1119- | Introduce
1120- | Release
1121- | Getdomainpath
1122- | Write
1123- | Mkdir
1124- | Rm
1125- | Setperms
1126- | Watchevent
1127- | Error
1128- | Isintroduced
1129- | Resume
1130- | Set_target
1131- | Restrict
1132- val to_string : operation -> string
1133-end
1134-
1135-module Packet:
1136-sig
1137- type t
1138-
1139- exception Error of string
1140- exception DataError of string
1141-
1142- val create : int -> int -> Op.operation -> string -> t
1143- val unpack : t -> int * int * Op.operation * string
1144-
1145- val get_tid : t -> int
1146- val get_ty : t -> Op.operation
1147- val get_data : t -> string
1148- val get_rid: t -> int
1149-end
1150-
1151+module Op :
1152+ sig
1153+ type operation =
1154+ Op.operation =
1155+ Debug
1156+ | Directory
1157+ | Read
1158+ | Getperms
1159+ | Watch
1160+ | Unwatch
1161+ | Transaction_start
1162+ | Transaction_end
1163+ | Introduce
1164+ | Release
1165+ | Getdomainpath
1166+ | Write
1167+ | Mkdir
1168+ | Rm
1169+ | Setperms
1170+ | Watchevent
1171+ | Error
1172+ | Isintroduced
1173+ | Resume
1174+ | Set_target
1175+ | Restrict
1176+ val operation_c_mapping : operation array
1177+ val size : int
1178+ val offset_pq : int
1179+ val operation_c_mapping_pq : 'a array
1180+ val size_pq : int
1181+ val array_search : 'a -> 'a array -> int
1182+ val of_cval : int -> operation
1183+ val to_cval : operation -> int
1184+ val to_string : operation -> string
1185+ end
1186+module Packet :
1187+ sig
1188+ type t =
1189+ Packet.t = {
1190+ tid : int;
1191+ rid : int;
1192+ ty : Op.operation;
1193+ data : string;
1194+ }
1195+ exception Error of string
1196+ exception DataError of string
1197+ external string_of_header : int -> int -> int -> int -> string
1198+ = "stub_string_of_header"
1199+ val create : int -> int -> Op.operation -> string -> t
1200+ val of_partialpkt : Partial.pkt -> t
1201+ val to_string : t -> string
1202+ val unpack : t -> int * int * Op.operation * string
1203+ val get_tid : t -> int
1204+ val get_ty : t -> Op.operation
1205+ val get_data : t -> string
1206+ val get_rid : t -> int
1207+ end
1208 exception End_of_file
1209 exception Eagain
1210 exception Noent
1211 exception Invalid
1212-
1213-type t
1214-
1215-(** queue a packet into the output queue for later sending *)
1216+type backend_mmap = {
1217+ mmap : Xenmmap.mmap_interface;
1218+ eventchn_notify : unit -> unit;
1219+ mutable work_again : bool;
1220+}
1221+type backend_fd = { fd : Unix.file_descr; }
1222+type backend = Fd of backend_fd | Xenmmap of backend_mmap
1223+type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string
1224+type t = {
1225+ backend : backend;
1226+ pkt_in : Packet.t Queue.t;
1227+ pkt_out : Packet.t Queue.t;
1228+ mutable partial_in : partial_buf;
1229+ mutable partial_out : string;
1230+}
1231+val init_partial_in : unit -> partial_buf
1232 val queue : t -> Packet.t -> unit
1233-
1234-(** process the output queue, return if a packet has been totally sent *)
1235+val read_fd : backend_fd -> 'a -> string -> int -> int
1236+val read_mmap : backend_mmap -> 'a -> string -> int -> int
1237+val read : t -> string -> int -> int
1238+val write_fd : backend_fd -> 'a -> string -> int -> int
1239+val write_mmap : backend_mmap -> 'a -> string -> int -> int
1240+val write : t -> string -> int -> int
1241 val output : t -> bool
1242-
1243-(** process the input queue, return if a packet has been totally received *)
1244 val input : t -> bool
1245-
1246-(** create new connection using a fd interface *)
1247+val newcon : backend -> t
1248 val open_fd : Unix.file_descr -> t
1249-(** create new connection using a mmap intf and a function to notify eventchn *)
1250-val open_mmap : Mmap.mmap_interface -> (unit -> unit) -> t
1251-
1252-(* close a connection *)
1253+val open_mmap : Xenmmap.mmap_interface -> (unit -> unit) -> t
1254 val close : t -> unit
1255-
1256 val is_fd : t -> bool
1257 val is_mmap : t -> bool
1258-
1259 val output_len : t -> int
1260 val has_new_output : t -> bool
1261 val has_old_output : t -> bool
1262 val has_output : t -> bool
1263 val peek_output : t -> Packet.t
1264-
1265 val input_len : t -> int
1266 val has_in_packet : t -> bool
1267 val get_in_packet : t -> Packet.t
1268 val has_more_input : t -> bool
1269-
1270 val is_selectable : t -> bool
1271 val get_fd : t -> Unix.file_descr
1272--- a/tools/ocaml/libs/xb/xb_stubs.c
1273+++ /dev/null
1274@@ -1,71 +0,0 @@
1275-/*
1276- * Copyright (C) 2006-2007 XenSource Ltd.
1277- * Copyright (C) 2008 Citrix Ltd.
1278- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
1279- *
1280- * This program is free software; you can redistribute it and/or modify
1281- * it under the terms of the GNU Lesser General Public License as published
1282- * by the Free Software Foundation; version 2.1 only. with the special
1283- * exception on linking described in file LICENSE.
1284- *
1285- * This program is distributed in the hope that it will be useful,
1286- * but WITHOUT ANY WARRANTY; without even the implied warranty of
1287- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1288- * GNU Lesser General Public License for more details.
1289- */
1290-
1291-#include <unistd.h>
1292-#include <stdlib.h>
1293-#include <sys/mman.h>
1294-#include <string.h>
1295-#include <errno.h>
1296-
1297-#include <caml/mlvalues.h>
1298-#include <caml/memory.h>
1299-#include <caml/alloc.h>
1300-#include <caml/custom.h>
1301-#include <caml/fail.h>
1302-#include <caml/callback.h>
1303-
1304-#include <xenctrl.h>
1305-#include <xen/io/xs_wire.h>
1306-
1307-CAMLprim value stub_header_size(void)
1308-{
1309- CAMLparam0();
1310- CAMLreturn(Val_int(sizeof(struct xsd_sockmsg)));
1311-}
1312-
1313-CAMLprim value stub_header_of_string(value s)
1314-{
1315- CAMLparam1(s);
1316- CAMLlocal1(ret);
1317- struct xsd_sockmsg *hdr;
1318-
1319- if (caml_string_length(s) != sizeof(struct xsd_sockmsg))
1320- caml_failwith("xb header incomplete");
1321- ret = caml_alloc_tuple(4);
1322- hdr = (struct xsd_sockmsg *) String_val(s);
1323- Store_field(ret, 0, Val_int(hdr->tx_id));
1324- Store_field(ret, 1, Val_int(hdr->req_id));
1325- Store_field(ret, 2, Val_int(hdr->type));
1326- Store_field(ret, 3, Val_int(hdr->len));
1327- CAMLreturn(ret);
1328-}
1329-
1330-CAMLprim value stub_string_of_header(value tid, value rid, value ty, value len)
1331-{
1332- CAMLparam4(tid, rid, ty, len);
1333- CAMLlocal1(ret);
1334- struct xsd_sockmsg xsd = {
1335- .type = Int_val(ty),
1336- .tx_id = Int_val(tid),
1337- .req_id = Int_val(rid),
1338- .len = Int_val(len),
1339- };
1340-
1341- ret = caml_alloc_string(sizeof(struct xsd_sockmsg));
1342- memcpy(String_val(ret), &xsd, sizeof(struct xsd_sockmsg));
1343-
1344- CAMLreturn(ret);
1345-}
1346--- /dev/null
1347+++ b/tools/ocaml/libs/xb/xenbus_stubs.c
1348@@ -0,0 +1,71 @@
1349+/*
1350+ * Copyright (C) 2006-2007 XenSource Ltd.
1351+ * Copyright (C) 2008 Citrix Ltd.
1352+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
1353+ *
1354+ * This program is free software; you can redistribute it and/or modify
1355+ * it under the terms of the GNU Lesser General Public License as published
1356+ * by the Free Software Foundation; version 2.1 only. with the special
1357+ * exception on linking described in file LICENSE.
1358+ *
1359+ * This program is distributed in the hope that it will be useful,
1360+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
1361+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1362+ * GNU Lesser General Public License for more details.
1363+ */
1364+
1365+#include <unistd.h>
1366+#include <stdlib.h>
1367+#include <sys/mman.h>
1368+#include <string.h>
1369+#include <errno.h>
1370+
1371+#include <caml/mlvalues.h>
1372+#include <caml/memory.h>
1373+#include <caml/alloc.h>
1374+#include <caml/custom.h>
1375+#include <caml/fail.h>
1376+#include <caml/callback.h>
1377+
1378+#include <xenctrl.h>
1379+#include <xen/io/xs_wire.h>
1380+
1381+CAMLprim value stub_header_size(void)
1382+{
1383+ CAMLparam0();
1384+ CAMLreturn(Val_int(sizeof(struct xsd_sockmsg)));
1385+}
1386+
1387+CAMLprim value stub_header_of_string(value s)
1388+{
1389+ CAMLparam1(s);
1390+ CAMLlocal1(ret);
1391+ struct xsd_sockmsg *hdr;
1392+
1393+ if (caml_string_length(s) != sizeof(struct xsd_sockmsg))
1394+ caml_failwith("xb header incomplete");
1395+ ret = caml_alloc_tuple(4);
1396+ hdr = (struct xsd_sockmsg *) String_val(s);
1397+ Store_field(ret, 0, Val_int(hdr->tx_id));
1398+ Store_field(ret, 1, Val_int(hdr->req_id));
1399+ Store_field(ret, 2, Val_int(hdr->type));
1400+ Store_field(ret, 3, Val_int(hdr->len));
1401+ CAMLreturn(ret);
1402+}
1403+
1404+CAMLprim value stub_string_of_header(value tid, value rid, value ty, value len)
1405+{
1406+ CAMLparam4(tid, rid, ty, len);
1407+ CAMLlocal1(ret);
1408+ struct xsd_sockmsg xsd = {
1409+ .type = Int_val(ty),
1410+ .tx_id = Int_val(tid),
1411+ .req_id = Int_val(rid),
1412+ .len = Int_val(len),
1413+ };
1414+
1415+ ret = caml_alloc_string(sizeof(struct xsd_sockmsg));
1416+ memcpy(String_val(ret), &xsd, sizeof(struct xsd_sockmsg));
1417+
1418+ CAMLreturn(ret);
1419+}
1420--- a/tools/ocaml/libs/xb/xs_ring.ml
1421+++ b/tools/ocaml/libs/xb/xs_ring.ml
1422@@ -14,5 +14,5 @@
1423 * GNU Lesser General Public License for more details.
1424 *)
1425
1426-external read: Mmap.mmap_interface -> string -> int -> int = "ml_interface_read"
1427-external write: Mmap.mmap_interface -> string -> int -> int = "ml_interface_write"
1428+external read: Xenmmap.mmap_interface -> string -> int -> int = "ml_interface_read"
1429+external write: Xenmmap.mmap_interface -> string -> int -> int = "ml_interface_write"
1430--- a/tools/ocaml/libs/xc/META.in
1431+++ b/tools/ocaml/libs/xc/META.in
1432@@ -1,5 +1,5 @@
1433 version = "@VERSION@"
1434 description = "Xen Control Interface"
1435-requires = "mmap,uuid"
1436-archive(byte) = "xc.cma"
1437-archive(native) = "xc.cmxa"
1438+requires = "xenmmap,uuid"
1439+archive(byte) = "xenctrl.cma"
1440+archive(native) = "xenctrl.cmxa"
1441--- a/tools/ocaml/libs/xc/Makefile
1442+++ b/tools/ocaml/libs/xc/Makefile
1443@@ -5,16 +5,16 @@
1444 CFLAGS += -I../mmap -I./ -I$(XEN_ROOT)/tools/libxc
1445 OCAMLINCLUDE += -I ../mmap -I ../uuid -I $(XEN_ROOT)/tools/libxc
1446
1447-OBJS = xc
1448-INTF = xc.cmi
1449-LIBS = xc.cma xc.cmxa
1450+OBJS = xenctrl
1451+INTF = xenctrl.cmi
1452+LIBS = xenctrl.cma xenctrl.cmxa
1453
1454-LIBS_xc = -L$(XEN_ROOT)/tools/libxc -lxenctrl -lxenguest
1455+LIBS_xenctrl = -L$(XEN_ROOT)/tools/libxc -lxenctrl -lxenguest
1456
1457-xc_OBJS = $(OBJS)
1458-xc_C_OBJS = xc_stubs
1459+xenctrl_OBJS = $(OBJS)
1460+xenctrl_C_OBJS = xenctrl_stubs
1461
1462-OCAML_LIBRARY = xc
1463+OCAML_LIBRARY = xenctrl
1464
1465 all: $(INTF) $(LIBS)
1466
1467@@ -23,11 +23,11 @@
1468 .PHONY: install
1469 install: $(LIBS) META
1470 mkdir -p $(OCAMLDESTDIR)
1471- ocamlfind remove -destdir $(OCAMLDESTDIR) xc
1472- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xc META $(INTF) $(LIBS) *.a *.so *.cmx
1473+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl
1474+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenctrl META $(INTF) $(LIBS) *.a *.so *.cmx
1475
1476 .PHONY: uninstall
1477 uninstall:
1478- ocamlfind remove -destdir $(OCAMLDESTDIR) xc
1479+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl
1480
1481 include $(TOPLEVEL)/Makefile.rules
1482--- a/tools/ocaml/libs/xc/xc.ml
1483+++ /dev/null
1484@@ -1,326 +0,0 @@
1485-(*
1486- * Copyright (C) 2006-2007 XenSource Ltd.
1487- * Copyright (C) 2008 Citrix Ltd.
1488- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
1489- *
1490- * This program is free software; you can redistribute it and/or modify
1491- * it under the terms of the GNU Lesser General Public License as published
1492- * by the Free Software Foundation; version 2.1 only. with the special
1493- * exception on linking described in file LICENSE.
1494- *
1495- * This program is distributed in the hope that it will be useful,
1496- * but WITHOUT ANY WARRANTY; without even the implied warranty of
1497- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1498- * GNU Lesser General Public License for more details.
1499- *)
1500-
1501-(** *)
1502-type domid = int
1503-
1504-(* ** xenctrl.h ** *)
1505-
1506-type vcpuinfo =
1507-{
1508- online: bool;
1509- blocked: bool;
1510- running: bool;
1511- cputime: int64;
1512- cpumap: int32;
1513-}
1514-
1515-type domaininfo =
1516-{
1517- domid : domid;
1518- dying : bool;
1519- shutdown : bool;
1520- paused : bool;
1521- blocked : bool;
1522- running : bool;
1523- hvm_guest : bool;
1524- shutdown_code : int;
1525- total_memory_pages: nativeint;
1526- max_memory_pages : nativeint;
1527- shared_info_frame : int64;
1528- cpu_time : int64;
1529- nr_online_vcpus : int;
1530- max_vcpu_id : int;
1531- ssidref : int32;
1532- handle : int array;
1533-}
1534-
1535-type sched_control =
1536-{
1537- weight : int;
1538- cap : int;
1539-}
1540-
1541-type physinfo_cap_flag =
1542- | CAP_HVM
1543- | CAP_DirectIO
1544-
1545-type physinfo =
1546-{
1547- threads_per_core : int;
1548- cores_per_socket : int;
1549- nr_cpus : int;
1550- max_node_id : int;
1551- cpu_khz : int;
1552- total_pages : nativeint;
1553- free_pages : nativeint;
1554- scrub_pages : nativeint;
1555- (* XXX hw_cap *)
1556- capabilities : physinfo_cap_flag list;
1557-}
1558-
1559-type version =
1560-{
1561- major : int;
1562- minor : int;
1563- extra : string;
1564-}
1565-
1566-
1567-type compile_info =
1568-{
1569- compiler : string;
1570- compile_by : string;
1571- compile_domain : string;
1572- compile_date : string;
1573-}
1574-
1575-type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt
1576-
1577-type domain_create_flag = CDF_HVM | CDF_HAP
1578-
1579-exception Error of string
1580-
1581-type handle
1582-
1583-(* this is only use by coredumping *)
1584-external sizeof_core_header: unit -> int
1585- = "stub_sizeof_core_header"
1586-external sizeof_vcpu_guest_context: unit -> int
1587- = "stub_sizeof_vcpu_guest_context"
1588-external sizeof_xen_pfn: unit -> int = "stub_sizeof_xen_pfn"
1589-(* end of use *)
1590-
1591-external interface_open: unit -> handle = "stub_xc_interface_open"
1592-external interface_close: handle -> unit = "stub_xc_interface_close"
1593-
1594-external is_fake: unit -> bool = "stub_xc_interface_is_fake"
1595-
1596-let with_intf f =
1597- let xc = interface_open () in
1598- let r = try f xc with exn -> interface_close xc; raise exn in
1599- interface_close xc;
1600- r
1601-
1602-external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid
1603- = "stub_xc_domain_create"
1604-
1605-let domain_create handle n flags uuid =
1606- _domain_create handle n flags (Uuid.int_array_of_uuid uuid)
1607-
1608-external _domain_sethandle: handle -> domid -> int array -> unit
1609- = "stub_xc_domain_sethandle"
1610-
1611-let domain_sethandle handle n uuid =
1612- _domain_sethandle handle n (Uuid.int_array_of_uuid uuid)
1613-
1614-external domain_max_vcpus: handle -> domid -> int -> unit
1615- = "stub_xc_domain_max_vcpus"
1616-
1617-external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause"
1618-external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause"
1619-external domain_resume_fast: handle -> domid -> unit = "stub_xc_domain_resume_fast"
1620-external domain_destroy: handle -> domid -> unit = "stub_xc_domain_destroy"
1621-
1622-external domain_shutdown: handle -> domid -> shutdown_reason -> unit
1623- = "stub_xc_domain_shutdown"
1624-
1625-external _domain_getinfolist: handle -> domid -> int -> domaininfo list
1626- = "stub_xc_domain_getinfolist"
1627-
1628-let domain_getinfolist handle first_domain =
1629- let nb = 2 in
1630- let last_domid l = (List.hd l).domid + 1 in
1631- let rec __getlist from =
1632- let l = _domain_getinfolist handle from nb in
1633- (if List.length l = nb then __getlist (last_domid l) else []) @ l
1634- in
1635- List.rev (__getlist first_domain)
1636-
1637-external domain_getinfo: handle -> domid -> domaininfo= "stub_xc_domain_getinfo"
1638-
1639-external domain_get_vcpuinfo: handle -> int -> int -> vcpuinfo
1640- = "stub_xc_vcpu_getinfo"
1641-
1642-external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit
1643- = "stub_xc_domain_ioport_permission"
1644-external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit
1645- = "stub_xc_domain_iomem_permission"
1646-external domain_irq_permission: handle -> domid -> int -> bool -> unit
1647- = "stub_xc_domain_irq_permission"
1648-
1649-external vcpu_affinity_set: handle -> domid -> int -> bool array -> unit
1650- = "stub_xc_vcpu_setaffinity"
1651-external vcpu_affinity_get: handle -> domid -> int -> bool array
1652- = "stub_xc_vcpu_getaffinity"
1653-
1654-external vcpu_context_get: handle -> domid -> int -> string
1655- = "stub_xc_vcpu_context_get"
1656-
1657-external sched_id: handle -> int = "stub_xc_sched_id"
1658-
1659-external sched_credit_domain_set: handle -> domid -> sched_control -> unit
1660- = "stub_sched_credit_domain_set"
1661-external sched_credit_domain_get: handle -> domid -> sched_control
1662- = "stub_sched_credit_domain_get"
1663-
1664-external shadow_allocation_set: handle -> domid -> int -> unit
1665- = "stub_shadow_allocation_set"
1666-external shadow_allocation_get: handle -> domid -> int
1667- = "stub_shadow_allocation_get"
1668-
1669-external evtchn_alloc_unbound: handle -> domid -> domid -> int
1670- = "stub_xc_evtchn_alloc_unbound"
1671-external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset"
1672-
1673-external readconsolering: handle -> string = "stub_xc_readconsolering"
1674-
1675-external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys"
1676-external physinfo: handle -> physinfo = "stub_xc_physinfo"
1677-external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
1678-
1679-external domain_setmaxmem: handle -> domid -> int64 -> unit
1680- = "stub_xc_domain_setmaxmem"
1681-external domain_set_memmap_limit: handle -> domid -> int64 -> unit
1682- = "stub_xc_domain_set_memmap_limit"
1683-external domain_memory_increase_reservation: handle -> domid -> int64 -> unit
1684- = "stub_xc_domain_memory_increase_reservation"
1685-
1686-external domain_set_machine_address_size: handle -> domid -> int -> unit
1687- = "stub_xc_domain_set_machine_address_size"
1688-external domain_get_machine_address_size: handle -> domid -> int
1689- = "stub_xc_domain_get_machine_address_size"
1690-
1691-external domain_cpuid_set: handle -> domid -> (int64 * (int64 option))
1692- -> string option array
1693- -> string option array
1694- = "stub_xc_domain_cpuid_set"
1695-external domain_cpuid_apply_policy: handle -> domid -> unit
1696- = "stub_xc_domain_cpuid_apply_policy"
1697-external cpuid_check: handle -> (int64 * (int64 option)) -> string option array -> (bool * string option array)
1698- = "stub_xc_cpuid_check"
1699-
1700-external map_foreign_range: handle -> domid -> int
1701- -> nativeint -> Mmap.mmap_interface
1702- = "stub_map_foreign_range"
1703-
1704-external domain_get_pfn_list: handle -> domid -> nativeint -> nativeint array
1705- = "stub_xc_domain_get_pfn_list"
1706-
1707-external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
1708- = "stub_xc_domain_assign_device"
1709-external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
1710- = "stub_xc_domain_deassign_device"
1711-external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool
1712- = "stub_xc_domain_test_assign_device"
1713-
1714-external version: handle -> version = "stub_xc_version_version"
1715-external version_compile_info: handle -> compile_info
1716- = "stub_xc_version_compile_info"
1717-external version_changeset: handle -> string = "stub_xc_version_changeset"
1718-external version_capabilities: handle -> string =
1719- "stub_xc_version_capabilities"
1720-
1721-external watchdog : handle -> int -> int32 -> int
1722- = "stub_xc_watchdog"
1723-
1724-(* core dump structure *)
1725-type core_magic = Magic_hvm | Magic_pv
1726-
1727-type core_header = {
1728- xch_magic: core_magic;
1729- xch_nr_vcpus: int;
1730- xch_nr_pages: nativeint;
1731- xch_index_offset: int64;
1732- xch_ctxt_offset: int64;
1733- xch_pages_offset: int64;
1734-}
1735-
1736-external marshall_core_header: core_header -> string = "stub_marshall_core_header"
1737-
1738-(* coredump *)
1739-let coredump xch domid fd =
1740- let dump s =
1741- let wd = Unix.write fd s 0 (String.length s) in
1742- if wd <> String.length s then
1743- failwith "error while writing";
1744- in
1745-
1746- let info = domain_getinfo xch domid in
1747-
1748- let nrpages = info.total_memory_pages in
1749- let ctxt = Array.make info.max_vcpu_id None in
1750- let nr_vcpus = ref 0 in
1751- for i = 0 to info.max_vcpu_id - 1
1752- do
1753- ctxt.(i) <- try
1754- let v = vcpu_context_get xch domid i in
1755- incr nr_vcpus;
1756- Some v
1757- with _ -> None
1758- done;
1759-
1760- (* FIXME page offset if not rounded to sup *)
1761- let page_offset =
1762- Int64.add
1763- (Int64.of_int (sizeof_core_header () +
1764- (sizeof_vcpu_guest_context () * !nr_vcpus)))
1765- (Int64.of_nativeint (
1766- Nativeint.mul
1767- (Nativeint.of_int (sizeof_xen_pfn ()))
1768- nrpages)
1769- )
1770- in
1771-
1772- let header = {
1773- xch_magic = if info.hvm_guest then Magic_hvm else Magic_pv;
1774- xch_nr_vcpus = !nr_vcpus;
1775- xch_nr_pages = nrpages;
1776- xch_ctxt_offset = Int64.of_int (sizeof_core_header ());
1777- xch_index_offset = Int64.of_int (sizeof_core_header ()
1778- + sizeof_vcpu_guest_context ());
1779- xch_pages_offset = page_offset;
1780- } in
1781-
1782- dump (marshall_core_header header);
1783- for i = 0 to info.max_vcpu_id - 1
1784- do
1785- match ctxt.(i) with
1786- | None -> ()
1787- | Some ctxt_i -> dump ctxt_i
1788- done;
1789- let pfns = domain_get_pfn_list xch domid nrpages in
1790- if Array.length pfns <> Nativeint.to_int nrpages then
1791- failwith "could not get the page frame list";
1792-
1793- let page_size = Mmap.getpagesize () in
1794- for i = 0 to Nativeint.to_int nrpages - 1
1795- do
1796- let page = map_foreign_range xch domid page_size pfns.(i) in
1797- let data = Mmap.read page 0 page_size in
1798- Mmap.unmap page;
1799- dump data
1800- done
1801-
1802-(* ** Misc ** *)
1803-
1804-(**
1805- Convert the given number of pages to an amount in KiB, rounded up.
1806- *)
1807-external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
1808-let pages_to_mib pages = Int64.div (pages_to_kib pages) 1024L
1809-
1810-let _ = Callback.register_exception "xc.error" (Error "register_callback")
1811--- a/tools/ocaml/libs/xc/xc.mli
1812+++ /dev/null
1813@@ -1,184 +0,0 @@
1814-(*
1815- * Copyright (C) 2006-2007 XenSource Ltd.
1816- * Copyright (C) 2008 Citrix Ltd.
1817- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
1818- *
1819- * This program is free software; you can redistribute it and/or modify
1820- * it under the terms of the GNU Lesser General Public License as published
1821- * by the Free Software Foundation; version 2.1 only. with the special
1822- * exception on linking described in file LICENSE.
1823- *
1824- * This program is distributed in the hope that it will be useful,
1825- * but WITHOUT ANY WARRANTY; without even the implied warranty of
1826- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1827- * GNU Lesser General Public License for more details.
1828- *)
1829-
1830-type domid = int
1831-type vcpuinfo = {
1832- online : bool;
1833- blocked : bool;
1834- running : bool;
1835- cputime : int64;
1836- cpumap : int32;
1837-}
1838-type domaininfo = {
1839- domid : domid;
1840- dying : bool;
1841- shutdown : bool;
1842- paused : bool;
1843- blocked : bool;
1844- running : bool;
1845- hvm_guest : bool;
1846- shutdown_code : int;
1847- total_memory_pages : nativeint;
1848- max_memory_pages : nativeint;
1849- shared_info_frame : int64;
1850- cpu_time : int64;
1851- nr_online_vcpus : int;
1852- max_vcpu_id : int;
1853- ssidref : int32;
1854- handle : int array;
1855-}
1856-type sched_control = { weight : int; cap : int; }
1857-type physinfo_cap_flag = CAP_HVM | CAP_DirectIO
1858-type physinfo = {
1859- threads_per_core : int;
1860- cores_per_socket : int;
1861- nr_cpus : int;
1862- max_node_id : int;
1863- cpu_khz : int;
1864- total_pages : nativeint;
1865- free_pages : nativeint;
1866- scrub_pages : nativeint;
1867- capabilities : physinfo_cap_flag list;
1868-}
1869-type version = { major : int; minor : int; extra : string; }
1870-type compile_info = {
1871- compiler : string;
1872- compile_by : string;
1873- compile_domain : string;
1874- compile_date : string;
1875-}
1876-type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt
1877-
1878-type domain_create_flag = CDF_HVM | CDF_HAP
1879-
1880-exception Error of string
1881-type handle
1882-external sizeof_core_header : unit -> int = "stub_sizeof_core_header"
1883-external sizeof_vcpu_guest_context : unit -> int
1884- = "stub_sizeof_vcpu_guest_context"
1885-external sizeof_xen_pfn : unit -> int = "stub_sizeof_xen_pfn"
1886-external interface_open : unit -> handle = "stub_xc_interface_open"
1887-external is_fake : unit -> bool = "stub_xc_interface_is_fake"
1888-external interface_close : handle -> unit = "stub_xc_interface_close"
1889-val with_intf : (handle -> 'a) -> 'a
1890-external _domain_create : handle -> int32 -> domain_create_flag list -> int array -> domid
1891- = "stub_xc_domain_create"
1892-val domain_create : handle -> int32 -> domain_create_flag list -> 'a Uuid.t -> domid
1893-external _domain_sethandle : handle -> domid -> int array -> unit
1894- = "stub_xc_domain_sethandle"
1895-val domain_sethandle : handle -> domid -> 'a Uuid.t -> unit
1896-external domain_max_vcpus : handle -> domid -> int -> unit
1897- = "stub_xc_domain_max_vcpus"
1898-external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause"
1899-external domain_unpause : handle -> domid -> unit = "stub_xc_domain_unpause"
1900-external domain_resume_fast : handle -> domid -> unit
1901- = "stub_xc_domain_resume_fast"
1902-external domain_destroy : handle -> domid -> unit = "stub_xc_domain_destroy"
1903-external domain_shutdown : handle -> domid -> shutdown_reason -> unit
1904- = "stub_xc_domain_shutdown"
1905-external _domain_getinfolist : handle -> domid -> int -> domaininfo list
1906- = "stub_xc_domain_getinfolist"
1907-val domain_getinfolist : handle -> domid -> domaininfo list
1908-external domain_getinfo : handle -> domid -> domaininfo
1909- = "stub_xc_domain_getinfo"
1910-external domain_get_vcpuinfo : handle -> int -> int -> vcpuinfo
1911- = "stub_xc_vcpu_getinfo"
1912-external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit
1913- = "stub_xc_domain_ioport_permission"
1914-external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit
1915- = "stub_xc_domain_iomem_permission"
1916-external domain_irq_permission: handle -> domid -> int -> bool -> unit
1917- = "stub_xc_domain_irq_permission"
1918-external vcpu_affinity_set : handle -> domid -> int -> bool array -> unit
1919- = "stub_xc_vcpu_setaffinity"
1920-external vcpu_affinity_get : handle -> domid -> int -> bool array
1921- = "stub_xc_vcpu_getaffinity"
1922-external vcpu_context_get : handle -> domid -> int -> string
1923- = "stub_xc_vcpu_context_get"
1924-external sched_id : handle -> int = "stub_xc_sched_id"
1925-external sched_credit_domain_set : handle -> domid -> sched_control -> unit
1926- = "stub_sched_credit_domain_set"
1927-external sched_credit_domain_get : handle -> domid -> sched_control
1928- = "stub_sched_credit_domain_get"
1929-external shadow_allocation_set : handle -> domid -> int -> unit
1930- = "stub_shadow_allocation_set"
1931-external shadow_allocation_get : handle -> domid -> int
1932- = "stub_shadow_allocation_get"
1933-external evtchn_alloc_unbound : handle -> domid -> domid -> int
1934- = "stub_xc_evtchn_alloc_unbound"
1935-external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset"
1936-external readconsolering : handle -> string = "stub_xc_readconsolering"
1937-external send_debug_keys : handle -> string -> unit = "stub_xc_send_debug_keys"
1938-external physinfo : handle -> physinfo = "stub_xc_physinfo"
1939-external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
1940-external domain_setmaxmem : handle -> domid -> int64 -> unit
1941- = "stub_xc_domain_setmaxmem"
1942-external domain_set_memmap_limit : handle -> domid -> int64 -> unit
1943- = "stub_xc_domain_set_memmap_limit"
1944-external domain_memory_increase_reservation :
1945- handle -> domid -> int64 -> unit
1946- = "stub_xc_domain_memory_increase_reservation"
1947-external map_foreign_range :
1948- handle -> domid -> int -> nativeint -> Mmap.mmap_interface
1949- = "stub_map_foreign_range"
1950-external domain_get_pfn_list :
1951- handle -> domid -> nativeint -> nativeint array
1952- = "stub_xc_domain_get_pfn_list"
1953-
1954-external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
1955- = "stub_xc_domain_assign_device"
1956-external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
1957- = "stub_xc_domain_deassign_device"
1958-external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool
1959- = "stub_xc_domain_test_assign_device"
1960-
1961-external version : handle -> version = "stub_xc_version_version"
1962-external version_compile_info : handle -> compile_info
1963- = "stub_xc_version_compile_info"
1964-external version_changeset : handle -> string = "stub_xc_version_changeset"
1965-external version_capabilities : handle -> string
1966- = "stub_xc_version_capabilities"
1967-type core_magic = Magic_hvm | Magic_pv
1968-type core_header = {
1969- xch_magic : core_magic;
1970- xch_nr_vcpus : int;
1971- xch_nr_pages : nativeint;
1972- xch_index_offset : int64;
1973- xch_ctxt_offset : int64;
1974- xch_pages_offset : int64;
1975-}
1976-external marshall_core_header : core_header -> string
1977- = "stub_marshall_core_header"
1978-val coredump : handle -> domid -> Unix.file_descr -> unit
1979-external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
1980-val pages_to_mib : int64 -> int64
1981-external watchdog : handle -> int -> int32 -> int
1982- = "stub_xc_watchdog"
1983-
1984-external domain_set_machine_address_size: handle -> domid -> int -> unit
1985- = "stub_xc_domain_set_machine_address_size"
1986-external domain_get_machine_address_size: handle -> domid -> int
1987- = "stub_xc_domain_get_machine_address_size"
1988-
1989-external domain_cpuid_set: handle -> domid -> (int64 * (int64 option))
1990- -> string option array
1991- -> string option array
1992- = "stub_xc_domain_cpuid_set"
1993-external domain_cpuid_apply_policy: handle -> domid -> unit
1994- = "stub_xc_domain_cpuid_apply_policy"
1995-external cpuid_check: handle -> (int64 * (int64 option)) -> string option array -> (bool * string option array)
1996- = "stub_xc_cpuid_check"
1997-
1998--- a/tools/ocaml/libs/xc/xc_stubs.c
1999+++ /dev/null
2000@@ -1,1161 +0,0 @@
2001-/*
2002- * Copyright (C) 2006-2007 XenSource Ltd.
2003- * Copyright (C) 2008 Citrix Ltd.
2004- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
2005- *
2006- * This program is free software; you can redistribute it and/or modify
2007- * it under the terms of the GNU Lesser General Public License as published
2008- * by the Free Software Foundation; version 2.1 only. with the special
2009- * exception on linking described in file LICENSE.
2010- *
2011- * This program is distributed in the hope that it will be useful,
2012- * but WITHOUT ANY WARRANTY; without even the implied warranty of
2013- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2014- * GNU Lesser General Public License for more details.
2015- */
2016-
2017-#define _XOPEN_SOURCE 600
2018-#include <stdlib.h>
2019-#include <errno.h>
2020-
2021-#define CAML_NAME_SPACE
2022-#include <caml/alloc.h>
2023-#include <caml/memory.h>
2024-#include <caml/signals.h>
2025-#include <caml/fail.h>
2026-#include <caml/callback.h>
2027-
2028-#include <sys/mman.h>
2029-#include <stdint.h>
2030-#include <string.h>
2031-
2032-#include <xenctrl.h>
2033-
2034-#include "mmap_stubs.h"
2035-
2036-#define PAGE_SHIFT 12
2037-#define PAGE_SIZE (1UL << PAGE_SHIFT)
2038-#define PAGE_MASK (~(PAGE_SIZE-1))
2039-
2040-#define _H(__h) ((xc_interface *)(__h))
2041-#define _D(__d) ((uint32_t)Int_val(__d))
2042-
2043-#define Val_none (Val_int(0))
2044-
2045-#define string_of_option_array(array, index) \
2046- ((Field(array, index) == Val_none) ? NULL : String_val(Field(Field(array, index), 0)))
2047-
2048-/* maybe here we should check the range of the input instead of blindly
2049- * casting it to uint32 */
2050-#define cpuid_input_of_val(i1, i2, input) \
2051- i1 = (uint32_t) Int64_val(Field(input, 0)); \
2052- i2 = ((Field(input, 1) == Val_none) ? 0xffffffff : (uint32_t) Int64_val(Field(Field(input, 1), 0)));
2053-
2054-#define ERROR_STRLEN 1024
2055-void failwith_xc(xc_interface *xch)
2056-{
2057- static char error_str[ERROR_STRLEN];
2058- if (xch) {
2059- const xc_error *error = xc_get_last_error(xch);
2060- if (error->code == XC_ERROR_NONE)
2061- snprintf(error_str, ERROR_STRLEN, "%d: %s", errno, strerror(errno));
2062- else
2063- snprintf(error_str, ERROR_STRLEN, "%d: %s: %s",
2064- error->code,
2065- xc_error_code_to_desc(error->code),
2066- error->message);
2067- } else {
2068- snprintf(error_str, ERROR_STRLEN, "Unable to open XC interface");
2069- }
2070- caml_raise_with_string(*caml_named_value("xc.error"), error_str);
2071-}
2072-
2073-CAMLprim value stub_sizeof_core_header(value unit)
2074-{
2075- CAMLparam1(unit);
2076- CAMLreturn(Val_int(sizeof(struct xc_core_header)));
2077-}
2078-
2079-CAMLprim value stub_sizeof_vcpu_guest_context(value unit)
2080-{
2081- CAMLparam1(unit);
2082- CAMLreturn(Val_int(sizeof(struct vcpu_guest_context)));
2083-}
2084-
2085-CAMLprim value stub_sizeof_xen_pfn(value unit)
2086-{
2087- CAMLparam1(unit);
2088- CAMLreturn(Val_int(sizeof(xen_pfn_t)));
2089-}
2090-
2091-#define XC_CORE_MAGIC 0xF00FEBED
2092-#define XC_CORE_MAGIC_HVM 0xF00FEBEE
2093-
2094-CAMLprim value stub_marshall_core_header(value header)
2095-{
2096- CAMLparam1(header);
2097- CAMLlocal1(s);
2098- struct xc_core_header c_header;
2099-
2100- c_header.xch_magic = (Field(header, 0))
2101- ? XC_CORE_MAGIC
2102- : XC_CORE_MAGIC_HVM;
2103- c_header.xch_nr_vcpus = Int_val(Field(header, 1));
2104- c_header.xch_nr_pages = Nativeint_val(Field(header, 2));
2105- c_header.xch_ctxt_offset = Int64_val(Field(header, 3));
2106- c_header.xch_index_offset = Int64_val(Field(header, 4));
2107- c_header.xch_pages_offset = Int64_val(Field(header, 5));
2108-
2109- s = caml_alloc_string(sizeof(c_header));
2110- memcpy(String_val(s), (char *) &c_header, sizeof(c_header));
2111- CAMLreturn(s);
2112-}
2113-
2114-CAMLprim value stub_xc_interface_open(void)
2115-{
2116- CAMLparam0();
2117- xc_interface *xch;
2118- xch = xc_interface_open(NULL, NULL, XC_OPENFLAG_NON_REENTRANT);
2119- if (xch == NULL)
2120- failwith_xc(NULL);
2121- CAMLreturn((value)xch);
2122-}
2123-
2124-
2125-CAMLprim value stub_xc_interface_is_fake(void)
2126-{
2127- CAMLparam0();
2128- int is_fake = xc_interface_is_fake();
2129- CAMLreturn(Val_int(is_fake));
2130-}
2131-
2132-CAMLprim value stub_xc_interface_close(value xch)
2133-{
2134- CAMLparam1(xch);
2135-
2136- // caml_enter_blocking_section();
2137- xc_interface_close(_H(xch));
2138- // caml_leave_blocking_section();
2139-
2140- CAMLreturn(Val_unit);
2141-}
2142-
2143-static int domain_create_flag_table[] = {
2144- XEN_DOMCTL_CDF_hvm_guest,
2145- XEN_DOMCTL_CDF_hap,
2146-};
2147-
2148-CAMLprim value stub_xc_domain_create(value xch, value ssidref,
2149- value flags, value handle)
2150-{
2151- CAMLparam4(xch, ssidref, flags, handle);
2152-
2153- uint32_t domid = 0;
2154- xen_domain_handle_t h = { 0 };
2155- int result;
2156- int i;
2157- uint32_t c_ssidref = Int32_val(ssidref);
2158- unsigned int c_flags = 0;
2159- value l;
2160-
2161- if (Wosize_val(handle) != 16)
2162- caml_invalid_argument("Handle not a 16-integer array");
2163-
2164- for (i = 0; i < sizeof(h); i++) {
2165- h[i] = Int_val(Field(handle, i)) & 0xff;
2166- }
2167-
2168- for (l = flags; l != Val_none; l = Field(l, 1)) {
2169- int v = Int_val(Field(l, 0));
2170- c_flags |= domain_create_flag_table[v];
2171- }
2172-
2173- // caml_enter_blocking_section();
2174- result = xc_domain_create(_H(xch), c_ssidref, h, c_flags, &domid);
2175- // caml_leave_blocking_section();
2176-
2177- if (result < 0)
2178- failwith_xc(_H(xch));
2179-
2180- CAMLreturn(Val_int(domid));
2181-}
2182-
2183-CAMLprim value stub_xc_domain_max_vcpus(value xch, value domid,
2184- value max_vcpus)
2185-{
2186- CAMLparam3(xch, domid, max_vcpus);
2187- int r;
2188-
2189- r = xc_domain_max_vcpus(_H(xch), _D(domid), Int_val(max_vcpus));
2190- if (r)
2191- failwith_xc(_H(xch));
2192-
2193- CAMLreturn(Val_unit);
2194-}
2195-
2196-
2197-value stub_xc_domain_sethandle(value xch, value domid, value handle)
2198-{
2199- CAMLparam3(xch, domid, handle);
2200- xen_domain_handle_t h = { 0 };
2201- int i;
2202-
2203- if (Wosize_val(handle) != 16)
2204- caml_invalid_argument("Handle not a 16-integer array");
2205-
2206- for (i = 0; i < sizeof(h); i++) {
2207- h[i] = Int_val(Field(handle, i)) & 0xff;
2208- }
2209-
2210- i = xc_domain_sethandle(_H(xch), _D(domid), h);
2211- if (i)
2212- failwith_xc(_H(xch));
2213-
2214- CAMLreturn(Val_unit);
2215-}
2216-
2217-static value dom_op(value xch, value domid, int (*fn)(xc_interface *, uint32_t))
2218-{
2219- CAMLparam2(xch, domid);
2220-
2221- uint32_t c_domid = _D(domid);
2222-
2223- // caml_enter_blocking_section();
2224- int result = fn(_H(xch), c_domid);
2225- // caml_leave_blocking_section();
2226- if (result)
2227- failwith_xc(_H(xch));
2228- CAMLreturn(Val_unit);
2229-}
2230-
2231-CAMLprim value stub_xc_domain_pause(value xch, value domid)
2232-{
2233- return dom_op(xch, domid, xc_domain_pause);
2234-}
2235-
2236-
2237-CAMLprim value stub_xc_domain_unpause(value xch, value domid)
2238-{
2239- return dom_op(xch, domid, xc_domain_unpause);
2240-}
2241-
2242-CAMLprim value stub_xc_domain_destroy(value xch, value domid)
2243-{
2244- return dom_op(xch, domid, xc_domain_destroy);
2245-}
2246-
2247-CAMLprim value stub_xc_domain_resume_fast(value xch, value domid)
2248-{
2249- CAMLparam2(xch, domid);
2250-
2251- uint32_t c_domid = _D(domid);
2252-
2253- // caml_enter_blocking_section();
2254- int result = xc_domain_resume(_H(xch), c_domid, 1);
2255- // caml_leave_blocking_section();
2256- if (result)
2257- failwith_xc(_H(xch));
2258- CAMLreturn(Val_unit);
2259-}
2260-
2261-CAMLprim value stub_xc_domain_shutdown(value xch, value domid, value reason)
2262-{
2263- CAMLparam3(xch, domid, reason);
2264- int ret;
2265-
2266- ret = xc_domain_shutdown(_H(xch), _D(domid), Int_val(reason));
2267- if (ret < 0)
2268- failwith_xc(_H(xch));
2269-
2270- CAMLreturn(Val_unit);
2271-}
2272-
2273-static value alloc_domaininfo(xc_domaininfo_t * info)
2274-{
2275- CAMLparam0();
2276- CAMLlocal2(result, tmp);
2277- int i;
2278-
2279- result = caml_alloc_tuple(16);
2280-
2281- Store_field(result, 0, Val_int(info->domain));
2282- Store_field(result, 1, Val_bool(info->flags & XEN_DOMINF_dying));
2283- Store_field(result, 2, Val_bool(info->flags & XEN_DOMINF_shutdown));
2284- Store_field(result, 3, Val_bool(info->flags & XEN_DOMINF_paused));
2285- Store_field(result, 4, Val_bool(info->flags & XEN_DOMINF_blocked));
2286- Store_field(result, 5, Val_bool(info->flags & XEN_DOMINF_running));
2287- Store_field(result, 6, Val_bool(info->flags & XEN_DOMINF_hvm_guest));
2288- Store_field(result, 7, Val_int((info->flags >> XEN_DOMINF_shutdownshift)
2289- & XEN_DOMINF_shutdownmask));
2290- Store_field(result, 8, caml_copy_nativeint(info->tot_pages));
2291- Store_field(result, 9, caml_copy_nativeint(info->max_pages));
2292- Store_field(result, 10, caml_copy_int64(info->shared_info_frame));
2293- Store_field(result, 11, caml_copy_int64(info->cpu_time));
2294- Store_field(result, 12, Val_int(info->nr_online_vcpus));
2295- Store_field(result, 13, Val_int(info->max_vcpu_id));
2296- Store_field(result, 14, caml_copy_int32(info->ssidref));
2297-
2298- tmp = caml_alloc_small(16, 0);
2299- for (i = 0; i < 16; i++) {
2300- Field(tmp, i) = Val_int(info->handle[i]);
2301- }
2302-
2303- Store_field(result, 15, tmp);
2304-
2305- CAMLreturn(result);
2306-}
2307-
2308-CAMLprim value stub_xc_domain_getinfolist(value xch, value first_domain, value nb)
2309-{
2310- CAMLparam3(xch, first_domain, nb);
2311- CAMLlocal2(result, temp);
2312- xc_domaininfo_t * info;
2313- int i, ret, toalloc, retval;
2314- unsigned int c_max_domains;
2315- uint32_t c_first_domain;
2316-
2317- /* get the minimum number of allocate byte we need and bump it up to page boundary */
2318- toalloc = (sizeof(xc_domaininfo_t) * Int_val(nb)) | 0xfff;
2319- ret = posix_memalign((void **) ((void *) &info), 4096, toalloc);
2320- if (ret)
2321- caml_raise_out_of_memory();
2322-
2323- result = temp = Val_emptylist;
2324-
2325- c_first_domain = _D(first_domain);
2326- c_max_domains = Int_val(nb);
2327- // caml_enter_blocking_section();
2328- retval = xc_domain_getinfolist(_H(xch), c_first_domain,
2329- c_max_domains, info);
2330- // caml_leave_blocking_section();
2331-
2332- if (retval < 0) {
2333- free(info);
2334- failwith_xc(_H(xch));
2335- }
2336- for (i = 0; i < retval; i++) {
2337- result = caml_alloc_small(2, Tag_cons);
2338- Field(result, 0) = Val_int(0);
2339- Field(result, 1) = temp;
2340- temp = result;
2341-
2342- Store_field(result, 0, alloc_domaininfo(info + i));
2343- }
2344-
2345- free(info);
2346- CAMLreturn(result);
2347-}
2348-
2349-CAMLprim value stub_xc_domain_getinfo(value xch, value domid)
2350-{
2351- CAMLparam2(xch, domid);
2352- CAMLlocal1(result);
2353- xc_domaininfo_t info;
2354- int ret;
2355-
2356- ret = xc_domain_getinfolist(_H(xch), _D(domid), 1, &info);
2357- if (ret != 1)
2358- failwith_xc(_H(xch));
2359- if (info.domain != _D(domid))
2360- failwith_xc(_H(xch));
2361-
2362- result = alloc_domaininfo(&info);
2363- CAMLreturn(result);
2364-}
2365-
2366-CAMLprim value stub_xc_vcpu_getinfo(value xch, value domid, value vcpu)
2367-{
2368- CAMLparam3(xch, domid, vcpu);
2369- CAMLlocal1(result);
2370- xc_vcpuinfo_t info;
2371- int retval;
2372-
2373- uint32_t c_domid = _D(domid);
2374- uint32_t c_vcpu = Int_val(vcpu);
2375- // caml_enter_blocking_section();
2376- retval = xc_vcpu_getinfo(_H(xch), c_domid,
2377- c_vcpu, &info);
2378- // caml_leave_blocking_section();
2379- if (retval < 0)
2380- failwith_xc(_H(xch));
2381-
2382- result = caml_alloc_tuple(5);
2383- Store_field(result, 0, Val_bool(info.online));
2384- Store_field(result, 1, Val_bool(info.blocked));
2385- Store_field(result, 2, Val_bool(info.running));
2386- Store_field(result, 3, caml_copy_int64(info.cpu_time));
2387- Store_field(result, 4, caml_copy_int32(info.cpu));
2388-
2389- CAMLreturn(result);
2390-}
2391-
2392-CAMLprim value stub_xc_vcpu_context_get(value xch, value domid,
2393- value cpu)
2394-{
2395- CAMLparam3(xch, domid, cpu);
2396- CAMLlocal1(context);
2397- int ret;
2398- vcpu_guest_context_any_t ctxt;
2399-
2400- ret = xc_vcpu_getcontext(_H(xch), _D(domid), Int_val(cpu), &ctxt);
2401-
2402- context = caml_alloc_string(sizeof(ctxt));
2403- memcpy(String_val(context), (char *) &ctxt.c, sizeof(ctxt.c));
2404-
2405- CAMLreturn(context);
2406-}
2407-
2408-static int get_cpumap_len(value xch, value cpumap)
2409-{
2410- int ml_len = Wosize_val(cpumap);
2411- int xc_len = xc_get_max_cpus(_H(xch));
2412-
2413- if (ml_len < xc_len)
2414- return ml_len;
2415- else
2416- return xc_len;
2417-}
2418-
2419-CAMLprim value stub_xc_vcpu_setaffinity(value xch, value domid,
2420- value vcpu, value cpumap)
2421-{
2422- CAMLparam4(xch, domid, vcpu, cpumap);
2423- int i, len = get_cpumap_len(xch, cpumap);
2424- xc_cpumap_t c_cpumap;
2425- int retval;
2426-
2427- c_cpumap = xc_cpumap_alloc(_H(xch));
2428- if (c_cpumap == NULL)
2429- failwith_xc(_H(xch));
2430-
2431- for (i=0; i<len; i++) {
2432- if (Bool_val(Field(cpumap, i)))
2433- c_cpumap[i/8] |= i << (i&7);
2434- }
2435- retval = xc_vcpu_setaffinity(_H(xch), _D(domid),
2436- Int_val(vcpu), c_cpumap);
2437- free(c_cpumap);
2438-
2439- if (retval < 0)
2440- failwith_xc(_H(xch));
2441- CAMLreturn(Val_unit);
2442-}
2443-
2444-CAMLprim value stub_xc_vcpu_getaffinity(value xch, value domid,
2445- value vcpu)
2446-{
2447- CAMLparam3(xch, domid, vcpu);
2448- CAMLlocal1(ret);
2449- xc_cpumap_t c_cpumap;
2450- int i, len = xc_get_max_cpus(_H(xch));
2451- int retval;
2452-
2453- c_cpumap = xc_cpumap_alloc(_H(xch));
2454- if (c_cpumap == NULL)
2455- failwith_xc(_H(xch));
2456-
2457- retval = xc_vcpu_getaffinity(_H(xch), _D(domid),
2458- Int_val(vcpu), c_cpumap);
2459- free(c_cpumap);
2460-
2461- if (retval < 0) {
2462- free(c_cpumap);
2463- failwith_xc(_H(xch));
2464- }
2465-
2466- ret = caml_alloc(len, 0);
2467-
2468- for (i=0; i<len; i++) {
2469- if (c_cpumap[i%8] & 1 << (i&7))
2470- Store_field(ret, i, Val_true);
2471- else
2472- Store_field(ret, i, Val_false);
2473- }
2474-
2475- free(c_cpumap);
2476-
2477- CAMLreturn(ret);
2478-}
2479-
2480-CAMLprim value stub_xc_sched_id(value xch)
2481-{
2482- CAMLparam1(xch);
2483- int sched_id;
2484-
2485- if (xc_sched_id(_H(xch), &sched_id))
2486- failwith_xc(_H(xch));
2487- CAMLreturn(Val_int(sched_id));
2488-}
2489-
2490-CAMLprim value stub_xc_evtchn_alloc_unbound(value xch,
2491- value local_domid,
2492- value remote_domid)
2493-{
2494- CAMLparam3(xch, local_domid, remote_domid);
2495-
2496- uint32_t c_local_domid = _D(local_domid);
2497- uint32_t c_remote_domid = _D(remote_domid);
2498-
2499- // caml_enter_blocking_section();
2500- int result = xc_evtchn_alloc_unbound(_H(xch), c_local_domid,
2501- c_remote_domid);
2502- // caml_leave_blocking_section();
2503-
2504- if (result < 0)
2505- failwith_xc(_H(xch));
2506- CAMLreturn(Val_int(result));
2507-}
2508-
2509-CAMLprim value stub_xc_evtchn_reset(value xch, value domid)
2510-{
2511- CAMLparam2(xch, domid);
2512- int r;
2513-
2514- r = xc_evtchn_reset(_H(xch), _D(domid));
2515- if (r < 0)
2516- failwith_xc(_H(xch));
2517- CAMLreturn(Val_unit);
2518-}
2519-
2520-
2521-#define RING_SIZE 32768
2522-static char ring[RING_SIZE];
2523-
2524-CAMLprim value stub_xc_readconsolering(value xch)
2525-{
2526- unsigned int size = RING_SIZE;
2527- char *ring_ptr = ring;
2528-
2529- CAMLparam1(xch);
2530-
2531- // caml_enter_blocking_section();
2532- int retval = xc_readconsolering(_H(xch), ring_ptr, &size, 0, 0, NULL);
2533- // caml_leave_blocking_section();
2534-
2535- if (retval)
2536- failwith_xc(_H(xch));
2537- ring[size] = '\0';
2538- CAMLreturn(caml_copy_string(ring));
2539-}
2540-
2541-CAMLprim value stub_xc_send_debug_keys(value xch, value keys)
2542-{
2543- CAMLparam2(xch, keys);
2544- int r;
2545-
2546- r = xc_send_debug_keys(_H(xch), String_val(keys));
2547- if (r)
2548- failwith_xc(_H(xch));
2549- CAMLreturn(Val_unit);
2550-}
2551-
2552-CAMLprim value stub_xc_physinfo(value xch)
2553-{
2554- CAMLparam1(xch);
2555- CAMLlocal3(physinfo, cap_list, tmp);
2556- xc_physinfo_t c_physinfo;
2557- int r;
2558-
2559- // caml_enter_blocking_section();
2560- r = xc_physinfo(_H(xch), &c_physinfo);
2561- // caml_leave_blocking_section();
2562-
2563- if (r)
2564- failwith_xc(_H(xch));
2565-
2566- tmp = cap_list = Val_emptylist;
2567- for (r = 0; r < 2; r++) {
2568- if ((c_physinfo.capabilities >> r) & 1) {
2569- tmp = caml_alloc_small(2, Tag_cons);
2570- Field(tmp, 0) = Val_int(r);
2571- Field(tmp, 1) = cap_list;
2572- cap_list = tmp;
2573- }
2574- }
2575-
2576- physinfo = caml_alloc_tuple(9);
2577- Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core));
2578- Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket));
2579- Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus));
2580- Store_field(physinfo, 3, Val_int(c_physinfo.max_node_id));
2581- Store_field(physinfo, 4, Val_int(c_physinfo.cpu_khz));
2582- Store_field(physinfo, 5, caml_copy_nativeint(c_physinfo.total_pages));
2583- Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages));
2584- Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages));
2585- Store_field(physinfo, 8, cap_list);
2586-
2587- CAMLreturn(physinfo);
2588-}
2589-
2590-CAMLprim value stub_xc_pcpu_info(value xch, value nr_cpus)
2591-{
2592- CAMLparam2(xch, nr_cpus);
2593- CAMLlocal2(pcpus, v);
2594- xc_cpuinfo_t *info;
2595- int r, size;
2596-
2597- if (Int_val(nr_cpus) < 1)
2598- caml_invalid_argument("nr_cpus");
2599-
2600- info = calloc(Int_val(nr_cpus) + 1, sizeof(*info));
2601- if (!info)
2602- caml_raise_out_of_memory();
2603-
2604- // caml_enter_blocking_section();
2605- r = xc_getcpuinfo(_H(xch), Int_val(nr_cpus), info, &size);
2606- // caml_leave_blocking_section();
2607-
2608- if (r) {
2609- free(info);
2610- failwith_xc(_H(xch));
2611- }
2612-
2613- if (size > 0) {
2614- int i;
2615- pcpus = caml_alloc(size, 0);
2616- for (i = 0; i < size; i++) {
2617- v = caml_copy_int64(info[i].idletime);
2618- caml_modify(&Field(pcpus, i), v);
2619- }
2620- } else
2621- pcpus = Atom(0);
2622- free(info);
2623- CAMLreturn(pcpus);
2624-}
2625-
2626-CAMLprim value stub_xc_domain_setmaxmem(value xch, value domid,
2627- value max_memkb)
2628-{
2629- CAMLparam3(xch, domid, max_memkb);
2630-
2631- uint32_t c_domid = _D(domid);
2632- unsigned int c_max_memkb = Int64_val(max_memkb);
2633- // caml_enter_blocking_section();
2634- int retval = xc_domain_setmaxmem(_H(xch), c_domid,
2635- c_max_memkb);
2636- // caml_leave_blocking_section();
2637- if (retval)
2638- failwith_xc(_H(xch));
2639- CAMLreturn(Val_unit);
2640-}
2641-
2642-CAMLprim value stub_xc_domain_set_memmap_limit(value xch, value domid,
2643- value map_limitkb)
2644-{
2645- CAMLparam3(xch, domid, map_limitkb);
2646- unsigned long v;
2647- int retval;
2648-
2649- v = Int64_val(map_limitkb);
2650- retval = xc_domain_set_memmap_limit(_H(xch), _D(domid), v);
2651- if (retval)
2652- failwith_xc(_H(xch));
2653-
2654- CAMLreturn(Val_unit);
2655-}
2656-
2657-CAMLprim value stub_xc_domain_memory_increase_reservation(value xch,
2658- value domid,
2659- value mem_kb)
2660-{
2661- CAMLparam3(xch, domid, mem_kb);
2662-
2663- unsigned long nr_extents = ((unsigned long)(Int64_val(mem_kb))) >> (PAGE_SHIFT - 10);
2664-
2665- uint32_t c_domid = _D(domid);
2666- // caml_enter_blocking_section();
2667- int retval = xc_domain_increase_reservation_exact(_H(xch), c_domid,
2668- nr_extents, 0, 0, NULL);
2669- // caml_leave_blocking_section();
2670-
2671- if (retval)
2672- failwith_xc(_H(xch));
2673- CAMLreturn(Val_unit);
2674-}
2675-
2676-CAMLprim value stub_xc_domain_set_machine_address_size(value xch,
2677- value domid,
2678- value width)
2679-{
2680- CAMLparam3(xch, domid, width);
2681- uint32_t c_domid = _D(domid);
2682- int c_width = Int_val(width);
2683-
2684- int retval = xc_domain_set_machine_address_size(_H(xch), c_domid, c_width);
2685- if (retval)
2686- failwith_xc(_H(xch));
2687- CAMLreturn(Val_unit);
2688-}
2689-
2690-CAMLprim value stub_xc_domain_get_machine_address_size(value xch,
2691- value domid)
2692-{
2693- CAMLparam2(xch, domid);
2694- int retval;
2695-
2696- retval = xc_domain_get_machine_address_size(_H(xch), _D(domid));
2697- if (retval < 0)
2698- failwith_xc(_H(xch));
2699- CAMLreturn(Val_int(retval));
2700-}
2701-
2702-CAMLprim value stub_xc_domain_cpuid_set(value xch, value domid,
2703- value input,
2704- value config)
2705-{
2706- CAMLparam4(xch, domid, input, config);
2707- CAMLlocal2(array, tmp);
2708- int r;
2709- unsigned int c_input[2];
2710- char *c_config[4], *out_config[4];
2711-
2712- c_config[0] = string_of_option_array(config, 0);
2713- c_config[1] = string_of_option_array(config, 1);
2714- c_config[2] = string_of_option_array(config, 2);
2715- c_config[3] = string_of_option_array(config, 3);
2716-
2717- cpuid_input_of_val(c_input[0], c_input[1], input);
2718-
2719- array = caml_alloc(4, 0);
2720- for (r = 0; r < 4; r++) {
2721- tmp = Val_none;
2722- if (c_config[r]) {
2723- tmp = caml_alloc_small(1, 0);
2724- Field(tmp, 0) = caml_alloc_string(32);
2725- }
2726- Store_field(array, r, tmp);
2727- }
2728-
2729- for (r = 0; r < 4; r++)
2730- out_config[r] = (c_config[r]) ? String_val(Field(Field(array, r), 0)) : NULL;
2731-
2732- r = xc_cpuid_set(_H(xch), _D(domid),
2733- c_input, (const char **)c_config, out_config);
2734- if (r < 0)
2735- failwith_xc(_H(xch));
2736- CAMLreturn(array);
2737-}
2738-
2739-CAMLprim value stub_xc_domain_cpuid_apply_policy(value xch, value domid)
2740-{
2741- CAMLparam2(xch, domid);
2742- int r;
2743-
2744- r = xc_cpuid_apply_policy(_H(xch), _D(domid));
2745- if (r < 0)
2746- failwith_xc(_H(xch));
2747- CAMLreturn(Val_unit);
2748-}
2749-
2750-CAMLprim value stub_xc_cpuid_check(value xch, value input, value config)
2751-{
2752- CAMLparam3(xch, input, config);
2753- CAMLlocal3(ret, array, tmp);
2754- int r;
2755- unsigned int c_input[2];
2756- char *c_config[4], *out_config[4];
2757-
2758- c_config[0] = string_of_option_array(config, 0);
2759- c_config[1] = string_of_option_array(config, 1);
2760- c_config[2] = string_of_option_array(config, 2);
2761- c_config[3] = string_of_option_array(config, 3);
2762-
2763- cpuid_input_of_val(c_input[0], c_input[1], input);
2764-
2765- array = caml_alloc(4, 0);
2766- for (r = 0; r < 4; r++) {
2767- tmp = Val_none;
2768- if (c_config[r]) {
2769- tmp = caml_alloc_small(1, 0);
2770- Field(tmp, 0) = caml_alloc_string(32);
2771- }
2772- Store_field(array, r, tmp);
2773- }
2774-
2775- for (r = 0; r < 4; r++)
2776- out_config[r] = (c_config[r]) ? String_val(Field(Field(array, r), 0)) : NULL;
2777-
2778- r = xc_cpuid_check(_H(xch), c_input, (const char **)c_config, out_config);
2779- if (r < 0)
2780- failwith_xc(_H(xch));
2781-
2782- ret = caml_alloc_tuple(2);
2783- Store_field(ret, 0, Val_bool(r));
2784- Store_field(ret, 1, array);
2785-
2786- CAMLreturn(ret);
2787-}
2788-
2789-CAMLprim value stub_xc_version_version(value xch)
2790-{
2791- CAMLparam1(xch);
2792- CAMLlocal1(result);
2793- xen_extraversion_t extra;
2794- long packed;
2795- int retval;
2796-
2797- // caml_enter_blocking_section();
2798- packed = xc_version(_H(xch), XENVER_version, NULL);
2799- retval = xc_version(_H(xch), XENVER_extraversion, &extra);
2800- // caml_leave_blocking_section();
2801-
2802- if (retval)
2803- failwith_xc(_H(xch));
2804-
2805- result = caml_alloc_tuple(3);
2806-
2807- Store_field(result, 0, Val_int(packed >> 16));
2808- Store_field(result, 1, Val_int(packed & 0xffff));
2809- Store_field(result, 2, caml_copy_string(extra));
2810-
2811- CAMLreturn(result);
2812-}
2813-
2814-
2815-CAMLprim value stub_xc_version_compile_info(value xch)
2816-{
2817- CAMLparam1(xch);
2818- CAMLlocal1(result);
2819- xen_compile_info_t ci;
2820- int retval;
2821-
2822- // caml_enter_blocking_section();
2823- retval = xc_version(_H(xch), XENVER_compile_info, &ci);
2824- // caml_leave_blocking_section();
2825-
2826- if (retval)
2827- failwith_xc(_H(xch));
2828-
2829- result = caml_alloc_tuple(4);
2830-
2831- Store_field(result, 0, caml_copy_string(ci.compiler));
2832- Store_field(result, 1, caml_copy_string(ci.compile_by));
2833- Store_field(result, 2, caml_copy_string(ci.compile_domain));
2834- Store_field(result, 3, caml_copy_string(ci.compile_date));
2835-
2836- CAMLreturn(result);
2837-}
2838-
2839-
2840-static value xc_version_single_string(value xch, int code, void *info)
2841-{
2842- CAMLparam1(xch);
2843- int retval;
2844-
2845- // caml_enter_blocking_section();
2846- retval = xc_version(_H(xch), code, info);
2847- // caml_leave_blocking_section();
2848-
2849- if (retval)
2850- failwith_xc(_H(xch));
2851-
2852- CAMLreturn(caml_copy_string((char *)info));
2853-}
2854-
2855-
2856-CAMLprim value stub_xc_version_changeset(value xch)
2857-{
2858- xen_changeset_info_t ci;
2859-
2860- return xc_version_single_string(xch, XENVER_changeset, &ci);
2861-}
2862-
2863-
2864-CAMLprim value stub_xc_version_capabilities(value xch)
2865-{
2866- xen_capabilities_info_t ci;
2867-
2868- return xc_version_single_string(xch, XENVER_capabilities, &ci);
2869-}
2870-
2871-
2872-CAMLprim value stub_pages_to_kib(value pages)
2873-{
2874- CAMLparam1(pages);
2875-
2876- CAMLreturn(caml_copy_int64(Int64_val(pages) << (PAGE_SHIFT - 10)));
2877-}
2878-
2879-
2880-CAMLprim value stub_map_foreign_range(value xch, value dom,
2881- value size, value mfn)
2882-{
2883- CAMLparam4(xch, dom, size, mfn);
2884- CAMLlocal1(result);
2885- struct mmap_interface *intf;
2886- uint32_t c_dom;
2887- unsigned long c_mfn;
2888-
2889- result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
2890- intf = (struct mmap_interface *) result;
2891-
2892- intf->len = Int_val(size);
2893-
2894- c_dom = _D(dom);
2895- c_mfn = Nativeint_val(mfn);
2896- // caml_enter_blocking_section();
2897- intf->addr = xc_map_foreign_range(_H(xch), c_dom,
2898- intf->len, PROT_READ|PROT_WRITE,
2899- c_mfn);
2900- // caml_leave_blocking_section();
2901- if (!intf->addr)
2902- caml_failwith("xc_map_foreign_range error");
2903- CAMLreturn(result);
2904-}
2905-
2906-CAMLprim value stub_sched_credit_domain_get(value xch, value domid)
2907-{
2908- CAMLparam2(xch, domid);
2909- CAMLlocal1(sdom);
2910- struct xen_domctl_sched_credit c_sdom;
2911- int ret;
2912-
2913- // caml_enter_blocking_section();
2914- ret = xc_sched_credit_domain_get(_H(xch), _D(domid), &c_sdom);
2915- // caml_leave_blocking_section();
2916- if (ret != 0)
2917- failwith_xc(_H(xch));
2918-
2919- sdom = caml_alloc_tuple(2);
2920- Store_field(sdom, 0, Val_int(c_sdom.weight));
2921- Store_field(sdom, 1, Val_int(c_sdom.cap));
2922-
2923- CAMLreturn(sdom);
2924-}
2925-
2926-CAMLprim value stub_sched_credit_domain_set(value xch, value domid,
2927- value sdom)
2928-{
2929- CAMLparam3(xch, domid, sdom);
2930- struct xen_domctl_sched_credit c_sdom;
2931- int ret;
2932-
2933- c_sdom.weight = Int_val(Field(sdom, 0));
2934- c_sdom.cap = Int_val(Field(sdom, 1));
2935- // caml_enter_blocking_section();
2936- ret = xc_sched_credit_domain_set(_H(xch), _D(domid), &c_sdom);
2937- // caml_leave_blocking_section();
2938- if (ret != 0)
2939- failwith_xc(_H(xch));
2940-
2941- CAMLreturn(Val_unit);
2942-}
2943-
2944-CAMLprim value stub_shadow_allocation_get(value xch, value domid)
2945-{
2946- CAMLparam2(xch, domid);
2947- CAMLlocal1(mb);
2948- unsigned long c_mb;
2949- int ret;
2950-
2951- // caml_enter_blocking_section();
2952- ret = xc_shadow_control(_H(xch), _D(domid),
2953- XEN_DOMCTL_SHADOW_OP_GET_ALLOCATION,
2954- NULL, 0, &c_mb, 0, NULL);
2955- // caml_leave_blocking_section();
2956- if (ret != 0)
2957- failwith_xc(_H(xch));
2958-
2959- mb = Val_int(c_mb);
2960- CAMLreturn(mb);
2961-}
2962-
2963-CAMLprim value stub_shadow_allocation_set(value xch, value domid,
2964- value mb)
2965-{
2966- CAMLparam3(xch, domid, mb);
2967- unsigned long c_mb;
2968- int ret;
2969-
2970- c_mb = Int_val(mb);
2971- // caml_enter_blocking_section();
2972- ret = xc_shadow_control(_H(xch), _D(domid),
2973- XEN_DOMCTL_SHADOW_OP_SET_ALLOCATION,
2974- NULL, 0, &c_mb, 0, NULL);
2975- // caml_leave_blocking_section();
2976- if (ret != 0)
2977- failwith_xc(_H(xch));
2978-
2979- CAMLreturn(Val_unit);
2980-}
2981-
2982-CAMLprim value stub_xc_domain_get_pfn_list(value xch, value domid,
2983- value nr_pfns)
2984-{
2985- CAMLparam3(xch, domid, nr_pfns);
2986- CAMLlocal2(array, v);
2987- unsigned long c_nr_pfns;
2988- long ret, i;
2989- uint64_t *c_array;
2990-
2991- c_nr_pfns = Nativeint_val(nr_pfns);
2992-
2993- c_array = malloc(sizeof(uint64_t) * c_nr_pfns);
2994- if (!c_array)
2995- caml_raise_out_of_memory();
2996-
2997- ret = xc_get_pfn_list(_H(xch), _D(domid),
2998- c_array, c_nr_pfns);
2999- if (ret < 0) {
3000- free(c_array);
3001- failwith_xc(_H(xch));
3002- }
3003-
3004- array = caml_alloc(ret, 0);
3005- for (i = 0; i < ret; i++) {
3006- v = caml_copy_nativeint(c_array[i]);
3007- Store_field(array, i, v);
3008- }
3009- free(c_array);
3010-
3011- CAMLreturn(array);
3012-}
3013-
3014-CAMLprim value stub_xc_domain_ioport_permission(value xch, value domid,
3015- value start_port, value nr_ports,
3016- value allow)
3017-{
3018- CAMLparam5(xch, domid, start_port, nr_ports, allow);
3019- uint32_t c_start_port, c_nr_ports;
3020- uint8_t c_allow;
3021- int ret;
3022-
3023- c_start_port = Int_val(start_port);
3024- c_nr_ports = Int_val(nr_ports);
3025- c_allow = Bool_val(allow);
3026-
3027- ret = xc_domain_ioport_permission(_H(xch), _D(domid),
3028- c_start_port, c_nr_ports, c_allow);
3029- if (ret < 0)
3030- failwith_xc(_H(xch));
3031-
3032- CAMLreturn(Val_unit);
3033-}
3034-
3035-CAMLprim value stub_xc_domain_iomem_permission(value xch, value domid,
3036- value start_pfn, value nr_pfns,
3037- value allow)
3038-{
3039- CAMLparam5(xch, domid, start_pfn, nr_pfns, allow);
3040- unsigned long c_start_pfn, c_nr_pfns;
3041- uint8_t c_allow;
3042- int ret;
3043-
3044- c_start_pfn = Nativeint_val(start_pfn);
3045- c_nr_pfns = Nativeint_val(nr_pfns);
3046- c_allow = Bool_val(allow);
3047-
3048- ret = xc_domain_iomem_permission(_H(xch), _D(domid),
3049- c_start_pfn, c_nr_pfns, c_allow);
3050- if (ret < 0)
3051- failwith_xc(_H(xch));
3052-
3053- CAMLreturn(Val_unit);
3054-}
3055-
3056-CAMLprim value stub_xc_domain_irq_permission(value xch, value domid,
3057- value pirq, value allow)
3058-{
3059- CAMLparam4(xch, domid, pirq, allow);
3060- uint8_t c_pirq;
3061- uint8_t c_allow;
3062- int ret;
3063-
3064- c_pirq = Int_val(pirq);
3065- c_allow = Bool_val(allow);
3066-
3067- ret = xc_domain_irq_permission(_H(xch), _D(domid),
3068- c_pirq, c_allow);
3069- if (ret < 0)
3070- failwith_xc(_H(xch));
3071-
3072- CAMLreturn(Val_unit);
3073-}
3074-
3075-static uint32_t pci_dev_to_bdf(int domain, int bus, int slot, int func)
3076-{
3077- uint32_t bdf = 0;
3078- bdf |= (bus & 0xff) << 16;
3079- bdf |= (slot & 0x1f) << 11;
3080- bdf |= (func & 0x7) << 8;
3081- return bdf;
3082-}
3083-
3084-CAMLprim value stub_xc_domain_test_assign_device(value xch, value domid, value desc)
3085-{
3086- CAMLparam3(xch, domid, desc);
3087- int ret;
3088- int domain, bus, slot, func;
3089- uint32_t bdf;
3090-
3091- domain = Int_val(Field(desc, 0));
3092- bus = Int_val(Field(desc, 1));
3093- slot = Int_val(Field(desc, 2));
3094- func = Int_val(Field(desc, 3));
3095- bdf = pci_dev_to_bdf(domain, bus, slot, func);
3096-
3097- ret = xc_test_assign_device(_H(xch), _D(domid), bdf);
3098-
3099- CAMLreturn(Val_bool(ret == 0));
3100-}
3101-
3102-CAMLprim value stub_xc_domain_assign_device(value xch, value domid, value desc)
3103-{
3104- CAMLparam3(xch, domid, desc);
3105- int ret;
3106- int domain, bus, slot, func;
3107- uint32_t bdf;
3108-
3109- domain = Int_val(Field(desc, 0));
3110- bus = Int_val(Field(desc, 1));
3111- slot = Int_val(Field(desc, 2));
3112- func = Int_val(Field(desc, 3));
3113- bdf = pci_dev_to_bdf(domain, bus, slot, func);
3114-
3115- ret = xc_assign_device(_H(xch), _D(domid), bdf);
3116-
3117- if (ret < 0)
3118- failwith_xc(_H(xch));
3119- CAMLreturn(Val_unit);
3120-}
3121-
3122-CAMLprim value stub_xc_domain_deassign_device(value xch, value domid, value desc)
3123-{
3124- CAMLparam3(xch, domid, desc);
3125- int ret;
3126- int domain, bus, slot, func;
3127- uint32_t bdf;
3128-
3129- domain = Int_val(Field(desc, 0));
3130- bus = Int_val(Field(desc, 1));
3131- slot = Int_val(Field(desc, 2));
3132- func = Int_val(Field(desc, 3));
3133- bdf = pci_dev_to_bdf(domain, bus, slot, func);
3134-
3135- ret = xc_deassign_device(_H(xch), _D(domid), bdf);
3136-
3137- if (ret < 0)
3138- failwith_xc(_H(xch));
3139- CAMLreturn(Val_unit);
3140-}
3141-
3142-CAMLprim value stub_xc_watchdog(value xch, value domid, value timeout)
3143-{
3144- CAMLparam3(xch, domid, timeout);
3145- int ret;
3146- unsigned int c_timeout = Int32_val(timeout);
3147-
3148- ret = xc_watchdog(_H(xch), _D(domid), c_timeout);
3149- if (ret < 0)
3150- failwith_xc(_H(xch));
3151-
3152- CAMLreturn(Val_int(ret));
3153-}
3154-
3155-/*
3156- * Local variables:
3157- * indent-tabs-mode: t
3158- * c-basic-offset: 8
3159- * tab-width: 8
3160- * End:
3161- */
3162--- /dev/null
3163+++ b/tools/ocaml/libs/xc/xenctrl.ml
3164@@ -0,0 +1,326 @@
3165+(*
3166+ * Copyright (C) 2006-2007 XenSource Ltd.
3167+ * Copyright (C) 2008 Citrix Ltd.
3168+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
3169+ *
3170+ * This program is free software; you can redistribute it and/or modify
3171+ * it under the terms of the GNU Lesser General Public License as published
3172+ * by the Free Software Foundation; version 2.1 only. with the special
3173+ * exception on linking described in file LICENSE.
3174+ *
3175+ * This program is distributed in the hope that it will be useful,
3176+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
3177+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3178+ * GNU Lesser General Public License for more details.
3179+ *)
3180+
3181+(** *)
3182+type domid = int
3183+
3184+(* ** xenctrl.h ** *)
3185+
3186+type vcpuinfo =
3187+{
3188+ online: bool;
3189+ blocked: bool;
3190+ running: bool;
3191+ cputime: int64;
3192+ cpumap: int32;
3193+}
3194+
3195+type domaininfo =
3196+{
3197+ domid : domid;
3198+ dying : bool;
3199+ shutdown : bool;
3200+ paused : bool;
3201+ blocked : bool;
3202+ running : bool;
3203+ hvm_guest : bool;
3204+ shutdown_code : int;
3205+ total_memory_pages: nativeint;
3206+ max_memory_pages : nativeint;
3207+ shared_info_frame : int64;
3208+ cpu_time : int64;
3209+ nr_online_vcpus : int;
3210+ max_vcpu_id : int;
3211+ ssidref : int32;
3212+ handle : int array;
3213+}
3214+
3215+type sched_control =
3216+{
3217+ weight : int;
3218+ cap : int;
3219+}
3220+
3221+type physinfo_cap_flag =
3222+ | CAP_HVM
3223+ | CAP_DirectIO
3224+
3225+type physinfo =
3226+{
3227+ threads_per_core : int;
3228+ cores_per_socket : int;
3229+ nr_cpus : int;
3230+ max_node_id : int;
3231+ cpu_khz : int;
3232+ total_pages : nativeint;
3233+ free_pages : nativeint;
3234+ scrub_pages : nativeint;
3235+ (* XXX hw_cap *)
3236+ capabilities : physinfo_cap_flag list;
3237+}
3238+
3239+type version =
3240+{
3241+ major : int;
3242+ minor : int;
3243+ extra : string;
3244+}
3245+
3246+
3247+type compile_info =
3248+{
3249+ compiler : string;
3250+ compile_by : string;
3251+ compile_domain : string;
3252+ compile_date : string;
3253+}
3254+
3255+type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt
3256+
3257+type domain_create_flag = CDF_HVM | CDF_HAP
3258+
3259+exception Error of string
3260+
3261+type handle
3262+
3263+(* this is only use by coredumping *)
3264+external sizeof_core_header: unit -> int
3265+ = "stub_sizeof_core_header"
3266+external sizeof_vcpu_guest_context: unit -> int
3267+ = "stub_sizeof_vcpu_guest_context"
3268+external sizeof_xen_pfn: unit -> int = "stub_sizeof_xen_pfn"
3269+(* end of use *)
3270+
3271+external interface_open: unit -> handle = "stub_xc_interface_open"
3272+external interface_close: handle -> unit = "stub_xc_interface_close"
3273+
3274+external is_fake: unit -> bool = "stub_xc_interface_is_fake"
3275+
3276+let with_intf f =
3277+ let xc = interface_open () in
3278+ let r = try f xc with exn -> interface_close xc; raise exn in
3279+ interface_close xc;
3280+ r
3281+
3282+external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid
3283+ = "stub_xc_domain_create"
3284+
3285+let domain_create handle n flags uuid =
3286+ _domain_create handle n flags (Uuid.int_array_of_uuid uuid)
3287+
3288+external _domain_sethandle: handle -> domid -> int array -> unit
3289+ = "stub_xc_domain_sethandle"
3290+
3291+let domain_sethandle handle n uuid =
3292+ _domain_sethandle handle n (Uuid.int_array_of_uuid uuid)
3293+
3294+external domain_max_vcpus: handle -> domid -> int -> unit
3295+ = "stub_xc_domain_max_vcpus"
3296+
3297+external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause"
3298+external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause"
3299+external domain_resume_fast: handle -> domid -> unit = "stub_xc_domain_resume_fast"
3300+external domain_destroy: handle -> domid -> unit = "stub_xc_domain_destroy"
3301+
3302+external domain_shutdown: handle -> domid -> shutdown_reason -> unit
3303+ = "stub_xc_domain_shutdown"
3304+
3305+external _domain_getinfolist: handle -> domid -> int -> domaininfo list
3306+ = "stub_xc_domain_getinfolist"
3307+
3308+let domain_getinfolist handle first_domain =
3309+ let nb = 2 in
3310+ let last_domid l = (List.hd l).domid + 1 in
3311+ let rec __getlist from =
3312+ let l = _domain_getinfolist handle from nb in
3313+ (if List.length l = nb then __getlist (last_domid l) else []) @ l
3314+ in
3315+ List.rev (__getlist first_domain)
3316+
3317+external domain_getinfo: handle -> domid -> domaininfo= "stub_xc_domain_getinfo"
3318+
3319+external domain_get_vcpuinfo: handle -> int -> int -> vcpuinfo
3320+ = "stub_xc_vcpu_getinfo"
3321+
3322+external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit
3323+ = "stub_xc_domain_ioport_permission"
3324+external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit
3325+ = "stub_xc_domain_iomem_permission"
3326+external domain_irq_permission: handle -> domid -> int -> bool -> unit
3327+ = "stub_xc_domain_irq_permission"
3328+
3329+external vcpu_affinity_set: handle -> domid -> int -> bool array -> unit
3330+ = "stub_xc_vcpu_setaffinity"
3331+external vcpu_affinity_get: handle -> domid -> int -> bool array
3332+ = "stub_xc_vcpu_getaffinity"
3333+
3334+external vcpu_context_get: handle -> domid -> int -> string
3335+ = "stub_xc_vcpu_context_get"
3336+
3337+external sched_id: handle -> int = "stub_xc_sched_id"
3338+
3339+external sched_credit_domain_set: handle -> domid -> sched_control -> unit
3340+ = "stub_sched_credit_domain_set"
3341+external sched_credit_domain_get: handle -> domid -> sched_control
3342+ = "stub_sched_credit_domain_get"
3343+
3344+external shadow_allocation_set: handle -> domid -> int -> unit
3345+ = "stub_shadow_allocation_set"
3346+external shadow_allocation_get: handle -> domid -> int
3347+ = "stub_shadow_allocation_get"
3348+
3349+external evtchn_alloc_unbound: handle -> domid -> domid -> int
3350+ = "stub_xc_evtchn_alloc_unbound"
3351+external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset"
3352+
3353+external readconsolering: handle -> string = "stub_xc_readconsolering"
3354+
3355+external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys"
3356+external physinfo: handle -> physinfo = "stub_xc_physinfo"
3357+external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
3358+
3359+external domain_setmaxmem: handle -> domid -> int64 -> unit
3360+ = "stub_xc_domain_setmaxmem"
3361+external domain_set_memmap_limit: handle -> domid -> int64 -> unit
3362+ = "stub_xc_domain_set_memmap_limit"
3363+external domain_memory_increase_reservation: handle -> domid -> int64 -> unit
3364+ = "stub_xc_domain_memory_increase_reservation"
3365+
3366+external domain_set_machine_address_size: handle -> domid -> int -> unit
3367+ = "stub_xc_domain_set_machine_address_size"
3368+external domain_get_machine_address_size: handle -> domid -> int
3369+ = "stub_xc_domain_get_machine_address_size"
3370+
3371+external domain_cpuid_set: handle -> domid -> (int64 * (int64 option))
3372+ -> string option array
3373+ -> string option array
3374+ = "stub_xc_domain_cpuid_set"
3375+external domain_cpuid_apply_policy: handle -> domid -> unit
3376+ = "stub_xc_domain_cpuid_apply_policy"
3377+external cpuid_check: handle -> (int64 * (int64 option)) -> string option array -> (bool * string option array)
3378+ = "stub_xc_cpuid_check"
3379+
3380+external map_foreign_range: handle -> domid -> int
3381+ -> nativeint -> Xenmmap.mmap_interface
3382+ = "stub_map_foreign_range"
3383+
3384+external domain_get_pfn_list: handle -> domid -> nativeint -> nativeint array
3385+ = "stub_xc_domain_get_pfn_list"
3386+
3387+external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
3388+ = "stub_xc_domain_assign_device"
3389+external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
3390+ = "stub_xc_domain_deassign_device"
3391+external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool
3392+ = "stub_xc_domain_test_assign_device"
3393+
3394+external version: handle -> version = "stub_xc_version_version"
3395+external version_compile_info: handle -> compile_info
3396+ = "stub_xc_version_compile_info"
3397+external version_changeset: handle -> string = "stub_xc_version_changeset"
3398+external version_capabilities: handle -> string =
3399+ "stub_xc_version_capabilities"
3400+
3401+external watchdog : handle -> int -> int32 -> int
3402+ = "stub_xc_watchdog"
3403+
3404+(* core dump structure *)
3405+type core_magic = Magic_hvm | Magic_pv
3406+
3407+type core_header = {
3408+ xch_magic: core_magic;
3409+ xch_nr_vcpus: int;
3410+ xch_nr_pages: nativeint;
3411+ xch_index_offset: int64;
3412+ xch_ctxt_offset: int64;
3413+ xch_pages_offset: int64;
3414+}
3415+
3416+external marshall_core_header: core_header -> string = "stub_marshall_core_header"
3417+
3418+(* coredump *)
3419+let coredump xch domid fd =
3420+ let dump s =
3421+ let wd = Unix.write fd s 0 (String.length s) in
3422+ if wd <> String.length s then
3423+ failwith "error while writing";
3424+ in
3425+
3426+ let info = domain_getinfo xch domid in
3427+
3428+ let nrpages = info.total_memory_pages in
3429+ let ctxt = Array.make info.max_vcpu_id None in
3430+ let nr_vcpus = ref 0 in
3431+ for i = 0 to info.max_vcpu_id - 1
3432+ do
3433+ ctxt.(i) <- try
3434+ let v = vcpu_context_get xch domid i in
3435+ incr nr_vcpus;
3436+ Some v
3437+ with _ -> None
3438+ done;
3439+
3440+ (* FIXME page offset if not rounded to sup *)
3441+ let page_offset =
3442+ Int64.add
3443+ (Int64.of_int (sizeof_core_header () +
3444+ (sizeof_vcpu_guest_context () * !nr_vcpus)))
3445+ (Int64.of_nativeint (
3446+ Nativeint.mul
3447+ (Nativeint.of_int (sizeof_xen_pfn ()))
3448+ nrpages)
3449+ )
3450+ in
3451+
3452+ let header = {
3453+ xch_magic = if info.hvm_guest then Magic_hvm else Magic_pv;
3454+ xch_nr_vcpus = !nr_vcpus;
3455+ xch_nr_pages = nrpages;
3456+ xch_ctxt_offset = Int64.of_int (sizeof_core_header ());
3457+ xch_index_offset = Int64.of_int (sizeof_core_header ()
3458+ + sizeof_vcpu_guest_context ());
3459+ xch_pages_offset = page_offset;
3460+ } in
3461+
3462+ dump (marshall_core_header header);
3463+ for i = 0 to info.max_vcpu_id - 1
3464+ do
3465+ match ctxt.(i) with
3466+ | None -> ()
3467+ | Some ctxt_i -> dump ctxt_i
3468+ done;
3469+ let pfns = domain_get_pfn_list xch domid nrpages in
3470+ if Array.length pfns <> Nativeint.to_int nrpages then
3471+ failwith "could not get the page frame list";
3472+
3473+ let page_size = Xenmmap.getpagesize () in
3474+ for i = 0 to Nativeint.to_int nrpages - 1
3475+ do
3476+ let page = map_foreign_range xch domid page_size pfns.(i) in
3477+ let data = Xenmmap.read page 0 page_size in
3478+ Xenmmap.unmap page;
3479+ dump data
3480+ done
3481+
3482+(* ** Misc ** *)
3483+
3484+(**
3485+ Convert the given number of pages to an amount in KiB, rounded up.
3486+ *)
3487+external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
3488+let pages_to_mib pages = Int64.div (pages_to_kib pages) 1024L
3489+
3490+let _ = Callback.register_exception "xc.error" (Error "register_callback")
3491--- /dev/null
3492+++ b/tools/ocaml/libs/xc/xenctrl.mli
3493@@ -0,0 +1,184 @@
3494+(*
3495+ * Copyright (C) 2006-2007 XenSource Ltd.
3496+ * Copyright (C) 2008 Citrix Ltd.
3497+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
3498+ *
3499+ * This program is free software; you can redistribute it and/or modify
3500+ * it under the terms of the GNU Lesser General Public License as published
3501+ * by the Free Software Foundation; version 2.1 only. with the special
3502+ * exception on linking described in file LICENSE.
3503+ *
3504+ * This program is distributed in the hope that it will be useful,
3505+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
3506+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3507+ * GNU Lesser General Public License for more details.
3508+ *)
3509+
3510+type domid = int
3511+type vcpuinfo = {
3512+ online : bool;
3513+ blocked : bool;
3514+ running : bool;
3515+ cputime : int64;
3516+ cpumap : int32;
3517+}
3518+type domaininfo = {
3519+ domid : domid;
3520+ dying : bool;
3521+ shutdown : bool;
3522+ paused : bool;
3523+ blocked : bool;
3524+ running : bool;
3525+ hvm_guest : bool;
3526+ shutdown_code : int;
3527+ total_memory_pages : nativeint;
3528+ max_memory_pages : nativeint;
3529+ shared_info_frame : int64;
3530+ cpu_time : int64;
3531+ nr_online_vcpus : int;
3532+ max_vcpu_id : int;
3533+ ssidref : int32;
3534+ handle : int array;
3535+}
3536+type sched_control = { weight : int; cap : int; }
3537+type physinfo_cap_flag = CAP_HVM | CAP_DirectIO
3538+type physinfo = {
3539+ threads_per_core : int;
3540+ cores_per_socket : int;
3541+ nr_cpus : int;
3542+ max_node_id : int;
3543+ cpu_khz : int;
3544+ total_pages : nativeint;
3545+ free_pages : nativeint;
3546+ scrub_pages : nativeint;
3547+ capabilities : physinfo_cap_flag list;
3548+}
3549+type version = { major : int; minor : int; extra : string; }
3550+type compile_info = {
3551+ compiler : string;
3552+ compile_by : string;
3553+ compile_domain : string;
3554+ compile_date : string;
3555+}
3556+type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt
3557+
3558+type domain_create_flag = CDF_HVM | CDF_HAP
3559+
3560+exception Error of string
3561+type handle
3562+external sizeof_core_header : unit -> int = "stub_sizeof_core_header"
3563+external sizeof_vcpu_guest_context : unit -> int
3564+ = "stub_sizeof_vcpu_guest_context"
3565+external sizeof_xen_pfn : unit -> int = "stub_sizeof_xen_pfn"
3566+external interface_open : unit -> handle = "stub_xc_interface_open"
3567+external is_fake : unit -> bool = "stub_xc_interface_is_fake"
3568+external interface_close : handle -> unit = "stub_xc_interface_close"
3569+val with_intf : (handle -> 'a) -> 'a
3570+external _domain_create : handle -> int32 -> domain_create_flag list -> int array -> domid
3571+ = "stub_xc_domain_create"
3572+val domain_create : handle -> int32 -> domain_create_flag list -> 'a Uuid.t -> domid
3573+external _domain_sethandle : handle -> domid -> int array -> unit
3574+ = "stub_xc_domain_sethandle"
3575+val domain_sethandle : handle -> domid -> 'a Uuid.t -> unit
3576+external domain_max_vcpus : handle -> domid -> int -> unit
3577+ = "stub_xc_domain_max_vcpus"
3578+external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause"
3579+external domain_unpause : handle -> domid -> unit = "stub_xc_domain_unpause"
3580+external domain_resume_fast : handle -> domid -> unit
3581+ = "stub_xc_domain_resume_fast"
3582+external domain_destroy : handle -> domid -> unit = "stub_xc_domain_destroy"
3583+external domain_shutdown : handle -> domid -> shutdown_reason -> unit
3584+ = "stub_xc_domain_shutdown"
3585+external _domain_getinfolist : handle -> domid -> int -> domaininfo list
3586+ = "stub_xc_domain_getinfolist"
3587+val domain_getinfolist : handle -> domid -> domaininfo list
3588+external domain_getinfo : handle -> domid -> domaininfo
3589+ = "stub_xc_domain_getinfo"
3590+external domain_get_vcpuinfo : handle -> int -> int -> vcpuinfo
3591+ = "stub_xc_vcpu_getinfo"
3592+external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit
3593+ = "stub_xc_domain_ioport_permission"
3594+external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit
3595+ = "stub_xc_domain_iomem_permission"
3596+external domain_irq_permission: handle -> domid -> int -> bool -> unit
3597+ = "stub_xc_domain_irq_permission"
3598+external vcpu_affinity_set : handle -> domid -> int -> bool array -> unit
3599+ = "stub_xc_vcpu_setaffinity"
3600+external vcpu_affinity_get : handle -> domid -> int -> bool array
3601+ = "stub_xc_vcpu_getaffinity"
3602+external vcpu_context_get : handle -> domid -> int -> string
3603+ = "stub_xc_vcpu_context_get"
3604+external sched_id : handle -> int = "stub_xc_sched_id"
3605+external sched_credit_domain_set : handle -> domid -> sched_control -> unit
3606+ = "stub_sched_credit_domain_set"
3607+external sched_credit_domain_get : handle -> domid -> sched_control
3608+ = "stub_sched_credit_domain_get"
3609+external shadow_allocation_set : handle -> domid -> int -> unit
3610+ = "stub_shadow_allocation_set"
3611+external shadow_allocation_get : handle -> domid -> int
3612+ = "stub_shadow_allocation_get"
3613+external evtchn_alloc_unbound : handle -> domid -> domid -> int
3614+ = "stub_xc_evtchn_alloc_unbound"
3615+external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset"
3616+external readconsolering : handle -> string = "stub_xc_readconsolering"
3617+external send_debug_keys : handle -> string -> unit = "stub_xc_send_debug_keys"
3618+external physinfo : handle -> physinfo = "stub_xc_physinfo"
3619+external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
3620+external domain_setmaxmem : handle -> domid -> int64 -> unit
3621+ = "stub_xc_domain_setmaxmem"
3622+external domain_set_memmap_limit : handle -> domid -> int64 -> unit
3623+ = "stub_xc_domain_set_memmap_limit"
3624+external domain_memory_increase_reservation :
3625+ handle -> domid -> int64 -> unit
3626+ = "stub_xc_domain_memory_increase_reservation"
3627+external map_foreign_range :
3628+ handle -> domid -> int -> nativeint -> Xenmmap.mmap_interface
3629+ = "stub_map_foreign_range"
3630+external domain_get_pfn_list :
3631+ handle -> domid -> nativeint -> nativeint array
3632+ = "stub_xc_domain_get_pfn_list"
3633+
3634+external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
3635+ = "stub_xc_domain_assign_device"
3636+external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
3637+ = "stub_xc_domain_deassign_device"
3638+external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool
3639+ = "stub_xc_domain_test_assign_device"
3640+
3641+external version : handle -> version = "stub_xc_version_version"
3642+external version_compile_info : handle -> compile_info
3643+ = "stub_xc_version_compile_info"
3644+external version_changeset : handle -> string = "stub_xc_version_changeset"
3645+external version_capabilities : handle -> string
3646+ = "stub_xc_version_capabilities"
3647+type core_magic = Magic_hvm | Magic_pv
3648+type core_header = {
3649+ xch_magic : core_magic;
3650+ xch_nr_vcpus : int;
3651+ xch_nr_pages : nativeint;
3652+ xch_index_offset : int64;
3653+ xch_ctxt_offset : int64;
3654+ xch_pages_offset : int64;
3655+}
3656+external marshall_core_header : core_header -> string
3657+ = "stub_marshall_core_header"
3658+val coredump : handle -> domid -> Unix.file_descr -> unit
3659+external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
3660+val pages_to_mib : int64 -> int64
3661+external watchdog : handle -> int -> int32 -> int
3662+ = "stub_xc_watchdog"
3663+
3664+external domain_set_machine_address_size: handle -> domid -> int -> unit
3665+ = "stub_xc_domain_set_machine_address_size"
3666+external domain_get_machine_address_size: handle -> domid -> int
3667+ = "stub_xc_domain_get_machine_address_size"
3668+
3669+external domain_cpuid_set: handle -> domid -> (int64 * (int64 option))
3670+ -> string option array
3671+ -> string option array
3672+ = "stub_xc_domain_cpuid_set"
3673+external domain_cpuid_apply_policy: handle -> domid -> unit
3674+ = "stub_xc_domain_cpuid_apply_policy"
3675+external cpuid_check: handle -> (int64 * (int64 option)) -> string option array -> (bool * string option array)
3676+ = "stub_xc_cpuid_check"
3677+
3678--- /dev/null
3679+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
3680@@ -0,0 +1,1161 @@
3681+/*
3682+ * Copyright (C) 2006-2007 XenSource Ltd.
3683+ * Copyright (C) 2008 Citrix Ltd.
3684+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
3685+ *
3686+ * This program is free software; you can redistribute it and/or modify
3687+ * it under the terms of the GNU Lesser General Public License as published
3688+ * by the Free Software Foundation; version 2.1 only. with the special
3689+ * exception on linking described in file LICENSE.
3690+ *
3691+ * This program is distributed in the hope that it will be useful,
3692+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
3693+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3694+ * GNU Lesser General Public License for more details.
3695+ */
3696+
3697+#define _XOPEN_SOURCE 600
3698+#include <stdlib.h>
3699+#include <errno.h>
3700+
3701+#define CAML_NAME_SPACE
3702+#include <caml/alloc.h>
3703+#include <caml/memory.h>
3704+#include <caml/signals.h>
3705+#include <caml/fail.h>
3706+#include <caml/callback.h>
3707+
3708+#include <sys/mman.h>
3709+#include <stdint.h>
3710+#include <string.h>
3711+
3712+#include <xenctrl.h>
3713+
3714+#include "mmap_stubs.h"
3715+
3716+#define PAGE_SHIFT 12
3717+#define PAGE_SIZE (1UL << PAGE_SHIFT)
3718+#define PAGE_MASK (~(PAGE_SIZE-1))
3719+
3720+#define _H(__h) ((xc_interface *)(__h))
3721+#define _D(__d) ((uint32_t)Int_val(__d))
3722+
3723+#define Val_none (Val_int(0))
3724+
3725+#define string_of_option_array(array, index) \
3726+ ((Field(array, index) == Val_none) ? NULL : String_val(Field(Field(array, index), 0)))
3727+
3728+/* maybe here we should check the range of the input instead of blindly
3729+ * casting it to uint32 */
3730+#define cpuid_input_of_val(i1, i2, input) \
3731+ i1 = (uint32_t) Int64_val(Field(input, 0)); \
3732+ i2 = ((Field(input, 1) == Val_none) ? 0xffffffff : (uint32_t) Int64_val(Field(Field(input, 1), 0)));
3733+
3734+#define ERROR_STRLEN 1024
3735+void failwith_xc(xc_interface *xch)
3736+{
3737+ static char error_str[ERROR_STRLEN];
3738+ if (xch) {
3739+ const xc_error *error = xc_get_last_error(xch);
3740+ if (error->code == XC_ERROR_NONE)
3741+ snprintf(error_str, ERROR_STRLEN, "%d: %s", errno, strerror(errno));
3742+ else
3743+ snprintf(error_str, ERROR_STRLEN, "%d: %s: %s",
3744+ error->code,
3745+ xc_error_code_to_desc(error->code),
3746+ error->message);
3747+ } else {
3748+ snprintf(error_str, ERROR_STRLEN, "Unable to open XC interface");
3749+ }
3750+ caml_raise_with_string(*caml_named_value("xc.error"), error_str);
3751+}
3752+
3753+CAMLprim value stub_sizeof_core_header(value unit)
3754+{
3755+ CAMLparam1(unit);
3756+ CAMLreturn(Val_int(sizeof(struct xc_core_header)));
3757+}
3758+
3759+CAMLprim value stub_sizeof_vcpu_guest_context(value unit)
3760+{
3761+ CAMLparam1(unit);
3762+ CAMLreturn(Val_int(sizeof(struct vcpu_guest_context)));
3763+}
3764+
3765+CAMLprim value stub_sizeof_xen_pfn(value unit)
3766+{
3767+ CAMLparam1(unit);
3768+ CAMLreturn(Val_int(sizeof(xen_pfn_t)));
3769+}
3770+
3771+#define XC_CORE_MAGIC 0xF00FEBED
3772+#define XC_CORE_MAGIC_HVM 0xF00FEBEE
3773+
3774+CAMLprim value stub_marshall_core_header(value header)
3775+{
3776+ CAMLparam1(header);
3777+ CAMLlocal1(s);
3778+ struct xc_core_header c_header;
3779+
3780+ c_header.xch_magic = (Field(header, 0))
3781+ ? XC_CORE_MAGIC
3782+ : XC_CORE_MAGIC_HVM;
3783+ c_header.xch_nr_vcpus = Int_val(Field(header, 1));
3784+ c_header.xch_nr_pages = Nativeint_val(Field(header, 2));
3785+ c_header.xch_ctxt_offset = Int64_val(Field(header, 3));
3786+ c_header.xch_index_offset = Int64_val(Field(header, 4));
3787+ c_header.xch_pages_offset = Int64_val(Field(header, 5));
3788+
3789+ s = caml_alloc_string(sizeof(c_header));
3790+ memcpy(String_val(s), (char *) &c_header, sizeof(c_header));
3791+ CAMLreturn(s);
3792+}
3793+
3794+CAMLprim value stub_xc_interface_open(void)
3795+{
3796+ CAMLparam0();
3797+ xc_interface *xch;
3798+ xch = xc_interface_open(NULL, NULL, XC_OPENFLAG_NON_REENTRANT);
3799+ if (xch == NULL)
3800+ failwith_xc(NULL);
3801+ CAMLreturn((value)xch);
3802+}
3803+
3804+
3805+CAMLprim value stub_xc_interface_is_fake(void)
3806+{
3807+ CAMLparam0();
3808+ int is_fake = xc_interface_is_fake();
3809+ CAMLreturn(Val_int(is_fake));
3810+}
3811+
3812+CAMLprim value stub_xc_interface_close(value xch)
3813+{
3814+ CAMLparam1(xch);
3815+
3816+ // caml_enter_blocking_section();
3817+ xc_interface_close(_H(xch));
3818+ // caml_leave_blocking_section();
3819+
3820+ CAMLreturn(Val_unit);
3821+}
3822+
3823+static int domain_create_flag_table[] = {
3824+ XEN_DOMCTL_CDF_hvm_guest,
3825+ XEN_DOMCTL_CDF_hap,
3826+};
3827+
3828+CAMLprim value stub_xc_domain_create(value xch, value ssidref,
3829+ value flags, value handle)
3830+{
3831+ CAMLparam4(xch, ssidref, flags, handle);
3832+
3833+ uint32_t domid = 0;
3834+ xen_domain_handle_t h = { 0 };
3835+ int result;
3836+ int i;
3837+ uint32_t c_ssidref = Int32_val(ssidref);
3838+ unsigned int c_flags = 0;
3839+ value l;
3840+
3841+ if (Wosize_val(handle) != 16)
3842+ caml_invalid_argument("Handle not a 16-integer array");
3843+
3844+ for (i = 0; i < sizeof(h); i++) {
3845+ h[i] = Int_val(Field(handle, i)) & 0xff;
3846+ }
3847+
3848+ for (l = flags; l != Val_none; l = Field(l, 1)) {
3849+ int v = Int_val(Field(l, 0));
3850+ c_flags |= domain_create_flag_table[v];
3851+ }
3852+
3853+ // caml_enter_blocking_section();
3854+ result = xc_domain_create(_H(xch), c_ssidref, h, c_flags, &domid);
3855+ // caml_leave_blocking_section();
3856+
3857+ if (result < 0)
3858+ failwith_xc(_H(xch));
3859+
3860+ CAMLreturn(Val_int(domid));
3861+}
3862+
3863+CAMLprim value stub_xc_domain_max_vcpus(value xch, value domid,
3864+ value max_vcpus)
3865+{
3866+ CAMLparam3(xch, domid, max_vcpus);
3867+ int r;
3868+
3869+ r = xc_domain_max_vcpus(_H(xch), _D(domid), Int_val(max_vcpus));
3870+ if (r)
3871+ failwith_xc(_H(xch));
3872+
3873+ CAMLreturn(Val_unit);
3874+}
3875+
3876+
3877+value stub_xc_domain_sethandle(value xch, value domid, value handle)
3878+{
3879+ CAMLparam3(xch, domid, handle);
3880+ xen_domain_handle_t h = { 0 };
3881+ int i;
3882+
3883+ if (Wosize_val(handle) != 16)
3884+ caml_invalid_argument("Handle not a 16-integer array");
3885+
3886+ for (i = 0; i < sizeof(h); i++) {
3887+ h[i] = Int_val(Field(handle, i)) & 0xff;
3888+ }
3889+
3890+ i = xc_domain_sethandle(_H(xch), _D(domid), h);
3891+ if (i)
3892+ failwith_xc(_H(xch));
3893+
3894+ CAMLreturn(Val_unit);
3895+}
3896+
3897+static value dom_op(value xch, value domid, int (*fn)(xc_interface *, uint32_t))
3898+{
3899+ CAMLparam2(xch, domid);
3900+
3901+ uint32_t c_domid = _D(domid);
3902+
3903+ // caml_enter_blocking_section();
3904+ int result = fn(_H(xch), c_domid);
3905+ // caml_leave_blocking_section();
3906+ if (result)
3907+ failwith_xc(_H(xch));
3908+ CAMLreturn(Val_unit);
3909+}
3910+
3911+CAMLprim value stub_xc_domain_pause(value xch, value domid)
3912+{
3913+ return dom_op(xch, domid, xc_domain_pause);
3914+}
3915+
3916+
3917+CAMLprim value stub_xc_domain_unpause(value xch, value domid)
3918+{
3919+ return dom_op(xch, domid, xc_domain_unpause);
3920+}
3921+
3922+CAMLprim value stub_xc_domain_destroy(value xch, value domid)
3923+{
3924+ return dom_op(xch, domid, xc_domain_destroy);
3925+}
3926+
3927+CAMLprim value stub_xc_domain_resume_fast(value xch, value domid)
3928+{
3929+ CAMLparam2(xch, domid);
3930+
3931+ uint32_t c_domid = _D(domid);
3932+
3933+ // caml_enter_blocking_section();
3934+ int result = xc_domain_resume(_H(xch), c_domid, 1);
3935+ // caml_leave_blocking_section();
3936+ if (result)
3937+ failwith_xc(_H(xch));
3938+ CAMLreturn(Val_unit);
3939+}
3940+
3941+CAMLprim value stub_xc_domain_shutdown(value xch, value domid, value reason)
3942+{
3943+ CAMLparam3(xch, domid, reason);
3944+ int ret;
3945+
3946+ ret = xc_domain_shutdown(_H(xch), _D(domid), Int_val(reason));
3947+ if (ret < 0)
3948+ failwith_xc(_H(xch));
3949+
3950+ CAMLreturn(Val_unit);
3951+}
3952+
3953+static value alloc_domaininfo(xc_domaininfo_t * info)
3954+{
3955+ CAMLparam0();
3956+ CAMLlocal2(result, tmp);
3957+ int i;
3958+
3959+ result = caml_alloc_tuple(16);
3960+
3961+ Store_field(result, 0, Val_int(info->domain));
3962+ Store_field(result, 1, Val_bool(info->flags & XEN_DOMINF_dying));
3963+ Store_field(result, 2, Val_bool(info->flags & XEN_DOMINF_shutdown));
3964+ Store_field(result, 3, Val_bool(info->flags & XEN_DOMINF_paused));
3965+ Store_field(result, 4, Val_bool(info->flags & XEN_DOMINF_blocked));
3966+ Store_field(result, 5, Val_bool(info->flags & XEN_DOMINF_running));
3967+ Store_field(result, 6, Val_bool(info->flags & XEN_DOMINF_hvm_guest));
3968+ Store_field(result, 7, Val_int((info->flags >> XEN_DOMINF_shutdownshift)
3969+ & XEN_DOMINF_shutdownmask));
3970+ Store_field(result, 8, caml_copy_nativeint(info->tot_pages));
3971+ Store_field(result, 9, caml_copy_nativeint(info->max_pages));
3972+ Store_field(result, 10, caml_copy_int64(info->shared_info_frame));
3973+ Store_field(result, 11, caml_copy_int64(info->cpu_time));
3974+ Store_field(result, 12, Val_int(info->nr_online_vcpus));
3975+ Store_field(result, 13, Val_int(info->max_vcpu_id));
3976+ Store_field(result, 14, caml_copy_int32(info->ssidref));
3977+
3978+ tmp = caml_alloc_small(16, 0);
3979+ for (i = 0; i < 16; i++) {
3980+ Field(tmp, i) = Val_int(info->handle[i]);
3981+ }
3982+
3983+ Store_field(result, 15, tmp);
3984+
3985+ CAMLreturn(result);
3986+}
3987+
3988+CAMLprim value stub_xc_domain_getinfolist(value xch, value first_domain, value nb)
3989+{
3990+ CAMLparam3(xch, first_domain, nb);
3991+ CAMLlocal2(result, temp);
3992+ xc_domaininfo_t * info;
3993+ int i, ret, toalloc, retval;
3994+ unsigned int c_max_domains;
3995+ uint32_t c_first_domain;
3996+
3997+ /* get the minimum number of allocate byte we need and bump it up to page boundary */
3998+ toalloc = (sizeof(xc_domaininfo_t) * Int_val(nb)) | 0xfff;
3999+ ret = posix_memalign((void **) ((void *) &info), 4096, toalloc);
4000+ if (ret)
4001+ caml_raise_out_of_memory();
4002+
4003+ result = temp = Val_emptylist;
4004+
4005+ c_first_domain = _D(first_domain);
4006+ c_max_domains = Int_val(nb);
4007+ // caml_enter_blocking_section();
4008+ retval = xc_domain_getinfolist(_H(xch), c_first_domain,
4009+ c_max_domains, info);
4010+ // caml_leave_blocking_section();
4011+
4012+ if (retval < 0) {
4013+ free(info);
4014+ failwith_xc(_H(xch));
4015+ }
4016+ for (i = 0; i < retval; i++) {
4017+ result = caml_alloc_small(2, Tag_cons);
4018+ Field(result, 0) = Val_int(0);
4019+ Field(result, 1) = temp;
4020+ temp = result;
4021+
4022+ Store_field(result, 0, alloc_domaininfo(info + i));
4023+ }
4024+
4025+ free(info);
4026+ CAMLreturn(result);
4027+}
4028+
4029+CAMLprim value stub_xc_domain_getinfo(value xch, value domid)
4030+{
4031+ CAMLparam2(xch, domid);
4032+ CAMLlocal1(result);
4033+ xc_domaininfo_t info;
4034+ int ret;
4035+
4036+ ret = xc_domain_getinfolist(_H(xch), _D(domid), 1, &info);
4037+ if (ret != 1)
4038+ failwith_xc(_H(xch));
4039+ if (info.domain != _D(domid))
4040+ failwith_xc(_H(xch));
4041+
4042+ result = alloc_domaininfo(&info);
4043+ CAMLreturn(result);
4044+}
4045+
4046+CAMLprim value stub_xc_vcpu_getinfo(value xch, value domid, value vcpu)
4047+{
4048+ CAMLparam3(xch, domid, vcpu);
4049+ CAMLlocal1(result);
4050+ xc_vcpuinfo_t info;
4051+ int retval;
4052+
4053+ uint32_t c_domid = _D(domid);
4054+ uint32_t c_vcpu = Int_val(vcpu);
4055+ // caml_enter_blocking_section();
4056+ retval = xc_vcpu_getinfo(_H(xch), c_domid,
4057+ c_vcpu, &info);
4058+ // caml_leave_blocking_section();
4059+ if (retval < 0)
4060+ failwith_xc(_H(xch));
4061+
4062+ result = caml_alloc_tuple(5);
4063+ Store_field(result, 0, Val_bool(info.online));
4064+ Store_field(result, 1, Val_bool(info.blocked));
4065+ Store_field(result, 2, Val_bool(info.running));
4066+ Store_field(result, 3, caml_copy_int64(info.cpu_time));
4067+ Store_field(result, 4, caml_copy_int32(info.cpu));
4068+
4069+ CAMLreturn(result);
4070+}
4071+
4072+CAMLprim value stub_xc_vcpu_context_get(value xch, value domid,
4073+ value cpu)
4074+{
4075+ CAMLparam3(xch, domid, cpu);
4076+ CAMLlocal1(context);
4077+ int ret;
4078+ vcpu_guest_context_any_t ctxt;
4079+
4080+ ret = xc_vcpu_getcontext(_H(xch), _D(domid), Int_val(cpu), &ctxt);
4081+
4082+ context = caml_alloc_string(sizeof(ctxt));
4083+ memcpy(String_val(context), (char *) &ctxt.c, sizeof(ctxt.c));
4084+
4085+ CAMLreturn(context);
4086+}
4087+
4088+static int get_cpumap_len(value xch, value cpumap)
4089+{
4090+ int ml_len = Wosize_val(cpumap);
4091+ int xc_len = xc_get_max_cpus(_H(xch));
4092+
4093+ if (ml_len < xc_len)
4094+ return ml_len;
4095+ else
4096+ return xc_len;
4097+}
4098+
4099+CAMLprim value stub_xc_vcpu_setaffinity(value xch, value domid,
4100+ value vcpu, value cpumap)
4101+{
4102+ CAMLparam4(xch, domid, vcpu, cpumap);
4103+ int i, len = get_cpumap_len(xch, cpumap);
4104+ xc_cpumap_t c_cpumap;
4105+ int retval;
4106+
4107+ c_cpumap = xc_cpumap_alloc(_H(xch));
4108+ if (c_cpumap == NULL)
4109+ failwith_xc(_H(xch));
4110+
4111+ for (i=0; i<len; i++) {
4112+ if (Bool_val(Field(cpumap, i)))
4113+ c_cpumap[i/8] |= i << (i&7);
4114+ }
4115+ retval = xc_vcpu_setaffinity(_H(xch), _D(domid),
4116+ Int_val(vcpu), c_cpumap);
4117+ free(c_cpumap);
4118+
4119+ if (retval < 0)
4120+ failwith_xc(_H(xch));
4121+ CAMLreturn(Val_unit);
4122+}
4123+
4124+CAMLprim value stub_xc_vcpu_getaffinity(value xch, value domid,
4125+ value vcpu)
4126+{
4127+ CAMLparam3(xch, domid, vcpu);
4128+ CAMLlocal1(ret);
4129+ xc_cpumap_t c_cpumap;
4130+ int i, len = xc_get_max_cpus(_H(xch));
4131+ int retval;
4132+
4133+ c_cpumap = xc_cpumap_alloc(_H(xch));
4134+ if (c_cpumap == NULL)
4135+ failwith_xc(_H(xch));
4136+
4137+ retval = xc_vcpu_getaffinity(_H(xch), _D(domid),
4138+ Int_val(vcpu), c_cpumap);
4139+ free(c_cpumap);
4140+
4141+ if (retval < 0) {
4142+ free(c_cpumap);
4143+ failwith_xc(_H(xch));
4144+ }
4145+
4146+ ret = caml_alloc(len, 0);
4147+
4148+ for (i=0; i<len; i++) {
4149+ if (c_cpumap[i%8] & 1 << (i&7))
4150+ Store_field(ret, i, Val_true);
4151+ else
4152+ Store_field(ret, i, Val_false);
4153+ }
4154+
4155+ free(c_cpumap);
4156+
4157+ CAMLreturn(ret);
4158+}
4159+
4160+CAMLprim value stub_xc_sched_id(value xch)
4161+{
4162+ CAMLparam1(xch);
4163+ int sched_id;
4164+
4165+ if (xc_sched_id(_H(xch), &sched_id))
4166+ failwith_xc(_H(xch));
4167+ CAMLreturn(Val_int(sched_id));
4168+}
4169+
4170+CAMLprim value stub_xc_evtchn_alloc_unbound(value xch,
4171+ value local_domid,
4172+ value remote_domid)
4173+{
4174+ CAMLparam3(xch, local_domid, remote_domid);
4175+
4176+ uint32_t c_local_domid = _D(local_domid);
4177+ uint32_t c_remote_domid = _D(remote_domid);
4178+
4179+ // caml_enter_blocking_section();
4180+ int result = xc_evtchn_alloc_unbound(_H(xch), c_local_domid,
4181+ c_remote_domid);
4182+ // caml_leave_blocking_section();
4183+
4184+ if (result < 0)
4185+ failwith_xc(_H(xch));
4186+ CAMLreturn(Val_int(result));
4187+}
4188+
4189+CAMLprim value stub_xc_evtchn_reset(value xch, value domid)
4190+{
4191+ CAMLparam2(xch, domid);
4192+ int r;
4193+
4194+ r = xc_evtchn_reset(_H(xch), _D(domid));
4195+ if (r < 0)
4196+ failwith_xc(_H(xch));
4197+ CAMLreturn(Val_unit);
4198+}
4199+
4200+
4201+#define RING_SIZE 32768
4202+static char ring[RING_SIZE];
4203+
4204+CAMLprim value stub_xc_readconsolering(value xch)
4205+{
4206+ unsigned int size = RING_SIZE;
4207+ char *ring_ptr = ring;
4208+
4209+ CAMLparam1(xch);
4210+
4211+ // caml_enter_blocking_section();
4212+ int retval = xc_readconsolering(_H(xch), ring_ptr, &size, 0, 0, NULL);
4213+ // caml_leave_blocking_section();
4214+
4215+ if (retval)
4216+ failwith_xc(_H(xch));
4217+ ring[size] = '\0';
4218+ CAMLreturn(caml_copy_string(ring));
4219+}
4220+
4221+CAMLprim value stub_xc_send_debug_keys(value xch, value keys)
4222+{
4223+ CAMLparam2(xch, keys);
4224+ int r;
4225+
4226+ r = xc_send_debug_keys(_H(xch), String_val(keys));
4227+ if (r)
4228+ failwith_xc(_H(xch));
4229+ CAMLreturn(Val_unit);
4230+}
4231+
4232+CAMLprim value stub_xc_physinfo(value xch)
4233+{
4234+ CAMLparam1(xch);
4235+ CAMLlocal3(physinfo, cap_list, tmp);
4236+ xc_physinfo_t c_physinfo;
4237+ int r;
4238+
4239+ // caml_enter_blocking_section();
4240+ r = xc_physinfo(_H(xch), &c_physinfo);
4241+ // caml_leave_blocking_section();
4242+
4243+ if (r)
4244+ failwith_xc(_H(xch));
4245+
4246+ tmp = cap_list = Val_emptylist;
4247+ for (r = 0; r < 2; r++) {
4248+ if ((c_physinfo.capabilities >> r) & 1) {
4249+ tmp = caml_alloc_small(2, Tag_cons);
4250+ Field(tmp, 0) = Val_int(r);
4251+ Field(tmp, 1) = cap_list;
4252+ cap_list = tmp;
4253+ }
4254+ }
4255+
4256+ physinfo = caml_alloc_tuple(9);
4257+ Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core));
4258+ Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket));
4259+ Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus));
4260+ Store_field(physinfo, 3, Val_int(c_physinfo.max_node_id));
4261+ Store_field(physinfo, 4, Val_int(c_physinfo.cpu_khz));
4262+ Store_field(physinfo, 5, caml_copy_nativeint(c_physinfo.total_pages));
4263+ Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages));
4264+ Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages));
4265+ Store_field(physinfo, 8, cap_list);
4266+
4267+ CAMLreturn(physinfo);
4268+}
4269+
4270+CAMLprim value stub_xc_pcpu_info(value xch, value nr_cpus)
4271+{
4272+ CAMLparam2(xch, nr_cpus);
4273+ CAMLlocal2(pcpus, v);
4274+ xc_cpuinfo_t *info;
4275+ int r, size;
4276+
4277+ if (Int_val(nr_cpus) < 1)
4278+ caml_invalid_argument("nr_cpus");
4279+
4280+ info = calloc(Int_val(nr_cpus) + 1, sizeof(*info));
4281+ if (!info)
4282+ caml_raise_out_of_memory();
4283+
4284+ // caml_enter_blocking_section();
4285+ r = xc_getcpuinfo(_H(xch), Int_val(nr_cpus), info, &size);
4286+ // caml_leave_blocking_section();
4287+
4288+ if (r) {
4289+ free(info);
4290+ failwith_xc(_H(xch));
4291+ }
4292+
4293+ if (size > 0) {
4294+ int i;
4295+ pcpus = caml_alloc(size, 0);
4296+ for (i = 0; i < size; i++) {
4297+ v = caml_copy_int64(info[i].idletime);
4298+ caml_modify(&Field(pcpus, i), v);
4299+ }
4300+ } else
4301+ pcpus = Atom(0);
4302+ free(info);
4303+ CAMLreturn(pcpus);
4304+}
4305+
4306+CAMLprim value stub_xc_domain_setmaxmem(value xch, value domid,
4307+ value max_memkb)
4308+{
4309+ CAMLparam3(xch, domid, max_memkb);
4310+
4311+ uint32_t c_domid = _D(domid);
4312+ unsigned int c_max_memkb = Int64_val(max_memkb);
4313+ // caml_enter_blocking_section();
4314+ int retval = xc_domain_setmaxmem(_H(xch), c_domid,
4315+ c_max_memkb);
4316+ // caml_leave_blocking_section();
4317+ if (retval)
4318+ failwith_xc(_H(xch));
4319+ CAMLreturn(Val_unit);
4320+}
4321+
4322+CAMLprim value stub_xc_domain_set_memmap_limit(value xch, value domid,
4323+ value map_limitkb)
4324+{
4325+ CAMLparam3(xch, domid, map_limitkb);
4326+ unsigned long v;
4327+ int retval;
4328+
4329+ v = Int64_val(map_limitkb);
4330+ retval = xc_domain_set_memmap_limit(_H(xch), _D(domid), v);
4331+ if (retval)
4332+ failwith_xc(_H(xch));
4333+
4334+ CAMLreturn(Val_unit);
4335+}
4336+
4337+CAMLprim value stub_xc_domain_memory_increase_reservation(value xch,
4338+ value domid,
4339+ value mem_kb)
4340+{
4341+ CAMLparam3(xch, domid, mem_kb);
4342+
4343+ unsigned long nr_extents = ((unsigned long)(Int64_val(mem_kb))) >> (PAGE_SHIFT - 10);
4344+
4345+ uint32_t c_domid = _D(domid);
4346+ // caml_enter_blocking_section();
4347+ int retval = xc_domain_increase_reservation_exact(_H(xch), c_domid,
4348+ nr_extents, 0, 0, NULL);
4349+ // caml_leave_blocking_section();
4350+
4351+ if (retval)
4352+ failwith_xc(_H(xch));
4353+ CAMLreturn(Val_unit);
4354+}
4355+
4356+CAMLprim value stub_xc_domain_set_machine_address_size(value xch,
4357+ value domid,
4358+ value width)
4359+{
4360+ CAMLparam3(xch, domid, width);
4361+ uint32_t c_domid = _D(domid);
4362+ int c_width = Int_val(width);
4363+
4364+ int retval = xc_domain_set_machine_address_size(_H(xch), c_domid, c_width);
4365+ if (retval)
4366+ failwith_xc(_H(xch));
4367+ CAMLreturn(Val_unit);
4368+}
4369+
4370+CAMLprim value stub_xc_domain_get_machine_address_size(value xch,
4371+ value domid)
4372+{
4373+ CAMLparam2(xch, domid);
4374+ int retval;
4375+
4376+ retval = xc_domain_get_machine_address_size(_H(xch), _D(domid));
4377+ if (retval < 0)
4378+ failwith_xc(_H(xch));
4379+ CAMLreturn(Val_int(retval));
4380+}
4381+
4382+CAMLprim value stub_xc_domain_cpuid_set(value xch, value domid,
4383+ value input,
4384+ value config)
4385+{
4386+ CAMLparam4(xch, domid, input, config);
4387+ CAMLlocal2(array, tmp);
4388+ int r;
4389+ unsigned int c_input[2];
4390+ char *c_config[4], *out_config[4];
4391+
4392+ c_config[0] = string_of_option_array(config, 0);
4393+ c_config[1] = string_of_option_array(config, 1);
4394+ c_config[2] = string_of_option_array(config, 2);
4395+ c_config[3] = string_of_option_array(config, 3);
4396+
4397+ cpuid_input_of_val(c_input[0], c_input[1], input);
4398+
4399+ array = caml_alloc(4, 0);
4400+ for (r = 0; r < 4; r++) {
4401+ tmp = Val_none;
4402+ if (c_config[r]) {
4403+ tmp = caml_alloc_small(1, 0);
4404+ Field(tmp, 0) = caml_alloc_string(32);
4405+ }
4406+ Store_field(array, r, tmp);
4407+ }
4408+
4409+ for (r = 0; r < 4; r++)
4410+ out_config[r] = (c_config[r]) ? String_val(Field(Field(array, r), 0)) : NULL;
4411+
4412+ r = xc_cpuid_set(_H(xch), _D(domid),
4413+ c_input, (const char **)c_config, out_config);
4414+ if (r < 0)
4415+ failwith_xc(_H(xch));
4416+ CAMLreturn(array);
4417+}
4418+
4419+CAMLprim value stub_xc_domain_cpuid_apply_policy(value xch, value domid)
4420+{
4421+ CAMLparam2(xch, domid);
4422+ int r;
4423+
4424+ r = xc_cpuid_apply_policy(_H(xch), _D(domid));
4425+ if (r < 0)
4426+ failwith_xc(_H(xch));
4427+ CAMLreturn(Val_unit);
4428+}
4429+
4430+CAMLprim value stub_xc_cpuid_check(value xch, value input, value config)
4431+{
4432+ CAMLparam3(xch, input, config);
4433+ CAMLlocal3(ret, array, tmp);
4434+ int r;
4435+ unsigned int c_input[2];
4436+ char *c_config[4], *out_config[4];
4437+
4438+ c_config[0] = string_of_option_array(config, 0);
4439+ c_config[1] = string_of_option_array(config, 1);
4440+ c_config[2] = string_of_option_array(config, 2);
4441+ c_config[3] = string_of_option_array(config, 3);
4442+
4443+ cpuid_input_of_val(c_input[0], c_input[1], input);
4444+
4445+ array = caml_alloc(4, 0);
4446+ for (r = 0; r < 4; r++) {
4447+ tmp = Val_none;
4448+ if (c_config[r]) {
4449+ tmp = caml_alloc_small(1, 0);
4450+ Field(tmp, 0) = caml_alloc_string(32);
4451+ }
4452+ Store_field(array, r, tmp);
4453+ }
4454+
4455+ for (r = 0; r < 4; r++)
4456+ out_config[r] = (c_config[r]) ? String_val(Field(Field(array, r), 0)) : NULL;
4457+
4458+ r = xc_cpuid_check(_H(xch), c_input, (const char **)c_config, out_config);
4459+ if (r < 0)
4460+ failwith_xc(_H(xch));
4461+
4462+ ret = caml_alloc_tuple(2);
4463+ Store_field(ret, 0, Val_bool(r));
4464+ Store_field(ret, 1, array);
4465+
4466+ CAMLreturn(ret);
4467+}
4468+
4469+CAMLprim value stub_xc_version_version(value xch)
4470+{
4471+ CAMLparam1(xch);
4472+ CAMLlocal1(result);
4473+ xen_extraversion_t extra;
4474+ long packed;
4475+ int retval;
4476+
4477+ // caml_enter_blocking_section();
4478+ packed = xc_version(_H(xch), XENVER_version, NULL);
4479+ retval = xc_version(_H(xch), XENVER_extraversion, &extra);
4480+ // caml_leave_blocking_section();
4481+
4482+ if (retval)
4483+ failwith_xc(_H(xch));
4484+
4485+ result = caml_alloc_tuple(3);
4486+
4487+ Store_field(result, 0, Val_int(packed >> 16));
4488+ Store_field(result, 1, Val_int(packed & 0xffff));
4489+ Store_field(result, 2, caml_copy_string(extra));
4490+
4491+ CAMLreturn(result);
4492+}
4493+
4494+
4495+CAMLprim value stub_xc_version_compile_info(value xch)
4496+{
4497+ CAMLparam1(xch);
4498+ CAMLlocal1(result);
4499+ xen_compile_info_t ci;
4500+ int retval;
4501+
4502+ // caml_enter_blocking_section();
4503+ retval = xc_version(_H(xch), XENVER_compile_info, &ci);
4504+ // caml_leave_blocking_section();
4505+
4506+ if (retval)
4507+ failwith_xc(_H(xch));
4508+
4509+ result = caml_alloc_tuple(4);
4510+
4511+ Store_field(result, 0, caml_copy_string(ci.compiler));
4512+ Store_field(result, 1, caml_copy_string(ci.compile_by));
4513+ Store_field(result, 2, caml_copy_string(ci.compile_domain));
4514+ Store_field(result, 3, caml_copy_string(ci.compile_date));
4515+
4516+ CAMLreturn(result);
4517+}
4518+
4519+
4520+static value xc_version_single_string(value xch, int code, void *info)
4521+{
4522+ CAMLparam1(xch);
4523+ int retval;
4524+
4525+ // caml_enter_blocking_section();
4526+ retval = xc_version(_H(xch), code, info);
4527+ // caml_leave_blocking_section();
4528+
4529+ if (retval)
4530+ failwith_xc(_H(xch));
4531+
4532+ CAMLreturn(caml_copy_string((char *)info));
4533+}
4534+
4535+
4536+CAMLprim value stub_xc_version_changeset(value xch)
4537+{
4538+ xen_changeset_info_t ci;
4539+
4540+ return xc_version_single_string(xch, XENVER_changeset, &ci);
4541+}
4542+
4543+
4544+CAMLprim value stub_xc_version_capabilities(value xch)
4545+{
4546+ xen_capabilities_info_t ci;
4547+
4548+ return xc_version_single_string(xch, XENVER_capabilities, &ci);
4549+}
4550+
4551+
4552+CAMLprim value stub_pages_to_kib(value pages)
4553+{
4554+ CAMLparam1(pages);
4555+
4556+ CAMLreturn(caml_copy_int64(Int64_val(pages) << (PAGE_SHIFT - 10)));
4557+}
4558+
4559+
4560+CAMLprim value stub_map_foreign_range(value xch, value dom,
4561+ value size, value mfn)
4562+{
4563+ CAMLparam4(xch, dom, size, mfn);
4564+ CAMLlocal1(result);
4565+ struct mmap_interface *intf;
4566+ uint32_t c_dom;
4567+ unsigned long c_mfn;
4568+
4569+ result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
4570+ intf = (struct mmap_interface *) result;
4571+
4572+ intf->len = Int_val(size);
4573+
4574+ c_dom = _D(dom);
4575+ c_mfn = Nativeint_val(mfn);
4576+ // caml_enter_blocking_section();
4577+ intf->addr = xc_map_foreign_range(_H(xch), c_dom,
4578+ intf->len, PROT_READ|PROT_WRITE,
4579+ c_mfn);
4580+ // caml_leave_blocking_section();
4581+ if (!intf->addr)
4582+ caml_failwith("xc_map_foreign_range error");
4583+ CAMLreturn(result);
4584+}
4585+
4586+CAMLprim value stub_sched_credit_domain_get(value xch, value domid)
4587+{
4588+ CAMLparam2(xch, domid);
4589+ CAMLlocal1(sdom);
4590+ struct xen_domctl_sched_credit c_sdom;
4591+ int ret;
4592+
4593+ // caml_enter_blocking_section();
4594+ ret = xc_sched_credit_domain_get(_H(xch), _D(domid), &c_sdom);
4595+ // caml_leave_blocking_section();
4596+ if (ret != 0)
4597+ failwith_xc(_H(xch));
4598+
4599+ sdom = caml_alloc_tuple(2);
4600+ Store_field(sdom, 0, Val_int(c_sdom.weight));
4601+ Store_field(sdom, 1, Val_int(c_sdom.cap));
4602+
4603+ CAMLreturn(sdom);
4604+}
4605+
4606+CAMLprim value stub_sched_credit_domain_set(value xch, value domid,
4607+ value sdom)
4608+{
4609+ CAMLparam3(xch, domid, sdom);
4610+ struct xen_domctl_sched_credit c_sdom;
4611+ int ret;
4612+
4613+ c_sdom.weight = Int_val(Field(sdom, 0));
4614+ c_sdom.cap = Int_val(Field(sdom, 1));
4615+ // caml_enter_blocking_section();
4616+ ret = xc_sched_credit_domain_set(_H(xch), _D(domid), &c_sdom);
4617+ // caml_leave_blocking_section();
4618+ if (ret != 0)
4619+ failwith_xc(_H(xch));
4620+
4621+ CAMLreturn(Val_unit);
4622+}
4623+
4624+CAMLprim value stub_shadow_allocation_get(value xch, value domid)
4625+{
4626+ CAMLparam2(xch, domid);
4627+ CAMLlocal1(mb);
4628+ unsigned long c_mb;
4629+ int ret;
4630+
4631+ // caml_enter_blocking_section();
4632+ ret = xc_shadow_control(_H(xch), _D(domid),
4633+ XEN_DOMCTL_SHADOW_OP_GET_ALLOCATION,
4634+ NULL, 0, &c_mb, 0, NULL);
4635+ // caml_leave_blocking_section();
4636+ if (ret != 0)
4637+ failwith_xc(_H(xch));
4638+
4639+ mb = Val_int(c_mb);
4640+ CAMLreturn(mb);
4641+}
4642+
4643+CAMLprim value stub_shadow_allocation_set(value xch, value domid,
4644+ value mb)
4645+{
4646+ CAMLparam3(xch, domid, mb);
4647+ unsigned long c_mb;
4648+ int ret;
4649+
4650+ c_mb = Int_val(mb);
4651+ // caml_enter_blocking_section();
4652+ ret = xc_shadow_control(_H(xch), _D(domid),
4653+ XEN_DOMCTL_SHADOW_OP_SET_ALLOCATION,
4654+ NULL, 0, &c_mb, 0, NULL);
4655+ // caml_leave_blocking_section();
4656+ if (ret != 0)
4657+ failwith_xc(_H(xch));
4658+
4659+ CAMLreturn(Val_unit);
4660+}
4661+
4662+CAMLprim value stub_xc_domain_get_pfn_list(value xch, value domid,
4663+ value nr_pfns)
4664+{
4665+ CAMLparam3(xch, domid, nr_pfns);
4666+ CAMLlocal2(array, v);
4667+ unsigned long c_nr_pfns;
4668+ long ret, i;
4669+ uint64_t *c_array;
4670+
4671+ c_nr_pfns = Nativeint_val(nr_pfns);
4672+
4673+ c_array = malloc(sizeof(uint64_t) * c_nr_pfns);
4674+ if (!c_array)
4675+ caml_raise_out_of_memory();
4676+
4677+ ret = xc_get_pfn_list(_H(xch), _D(domid),
4678+ c_array, c_nr_pfns);
4679+ if (ret < 0) {
4680+ free(c_array);
4681+ failwith_xc(_H(xch));
4682+ }
4683+
4684+ array = caml_alloc(ret, 0);
4685+ for (i = 0; i < ret; i++) {
4686+ v = caml_copy_nativeint(c_array[i]);
4687+ Store_field(array, i, v);
4688+ }
4689+ free(c_array);
4690+
4691+ CAMLreturn(array);
4692+}
4693+
4694+CAMLprim value stub_xc_domain_ioport_permission(value xch, value domid,
4695+ value start_port, value nr_ports,
4696+ value allow)
4697+{
4698+ CAMLparam5(xch, domid, start_port, nr_ports, allow);
4699+ uint32_t c_start_port, c_nr_ports;
4700+ uint8_t c_allow;
4701+ int ret;
4702+
4703+ c_start_port = Int_val(start_port);
4704+ c_nr_ports = Int_val(nr_ports);
4705+ c_allow = Bool_val(allow);
4706+
4707+ ret = xc_domain_ioport_permission(_H(xch), _D(domid),
4708+ c_start_port, c_nr_ports, c_allow);
4709+ if (ret < 0)
4710+ failwith_xc(_H(xch));
4711+
4712+ CAMLreturn(Val_unit);
4713+}
4714+
4715+CAMLprim value stub_xc_domain_iomem_permission(value xch, value domid,
4716+ value start_pfn, value nr_pfns,
4717+ value allow)
4718+{
4719+ CAMLparam5(xch, domid, start_pfn, nr_pfns, allow);
4720+ unsigned long c_start_pfn, c_nr_pfns;
4721+ uint8_t c_allow;
4722+ int ret;
4723+
4724+ c_start_pfn = Nativeint_val(start_pfn);
4725+ c_nr_pfns = Nativeint_val(nr_pfns);
4726+ c_allow = Bool_val(allow);
4727+
4728+ ret = xc_domain_iomem_permission(_H(xch), _D(domid),
4729+ c_start_pfn, c_nr_pfns, c_allow);
4730+ if (ret < 0)
4731+ failwith_xc(_H(xch));
4732+
4733+ CAMLreturn(Val_unit);
4734+}
4735+
4736+CAMLprim value stub_xc_domain_irq_permission(value xch, value domid,
4737+ value pirq, value allow)
4738+{
4739+ CAMLparam4(xch, domid, pirq, allow);
4740+ uint8_t c_pirq;
4741+ uint8_t c_allow;
4742+ int ret;
4743+
4744+ c_pirq = Int_val(pirq);
4745+ c_allow = Bool_val(allow);
4746+
4747+ ret = xc_domain_irq_permission(_H(xch), _D(domid),
4748+ c_pirq, c_allow);
4749+ if (ret < 0)
4750+ failwith_xc(_H(xch));
4751+
4752+ CAMLreturn(Val_unit);
4753+}
4754+
4755+static uint32_t pci_dev_to_bdf(int domain, int bus, int slot, int func)
4756+{
4757+ uint32_t bdf = 0;
4758+ bdf |= (bus & 0xff) << 16;
4759+ bdf |= (slot & 0x1f) << 11;
4760+ bdf |= (func & 0x7) << 8;
4761+ return bdf;
4762+}
4763+
4764+CAMLprim value stub_xc_domain_test_assign_device(value xch, value domid, value desc)
4765+{
4766+ CAMLparam3(xch, domid, desc);
4767+ int ret;
4768+ int domain, bus, slot, func;
4769+ uint32_t bdf;
4770+
4771+ domain = Int_val(Field(desc, 0));
4772+ bus = Int_val(Field(desc, 1));
4773+ slot = Int_val(Field(desc, 2));
4774+ func = Int_val(Field(desc, 3));
4775+ bdf = pci_dev_to_bdf(domain, bus, slot, func);
4776+
4777+ ret = xc_test_assign_device(_H(xch), _D(domid), bdf);
4778+
4779+ CAMLreturn(Val_bool(ret == 0));
4780+}
4781+
4782+CAMLprim value stub_xc_domain_assign_device(value xch, value domid, value desc)
4783+{
4784+ CAMLparam3(xch, domid, desc);
4785+ int ret;
4786+ int domain, bus, slot, func;
4787+ uint32_t bdf;
4788+
4789+ domain = Int_val(Field(desc, 0));
4790+ bus = Int_val(Field(desc, 1));
4791+ slot = Int_val(Field(desc, 2));
4792+ func = Int_val(Field(desc, 3));
4793+ bdf = pci_dev_to_bdf(domain, bus, slot, func);
4794+
4795+ ret = xc_assign_device(_H(xch), _D(domid), bdf);
4796+
4797+ if (ret < 0)
4798+ failwith_xc(_H(xch));
4799+ CAMLreturn(Val_unit);
4800+}
4801+
4802+CAMLprim value stub_xc_domain_deassign_device(value xch, value domid, value desc)
4803+{
4804+ CAMLparam3(xch, domid, desc);
4805+ int ret;
4806+ int domain, bus, slot, func;
4807+ uint32_t bdf;
4808+
4809+ domain = Int_val(Field(desc, 0));
4810+ bus = Int_val(Field(desc, 1));
4811+ slot = Int_val(Field(desc, 2));
4812+ func = Int_val(Field(desc, 3));
4813+ bdf = pci_dev_to_bdf(domain, bus, slot, func);
4814+
4815+ ret = xc_deassign_device(_H(xch), _D(domid), bdf);
4816+
4817+ if (ret < 0)
4818+ failwith_xc(_H(xch));
4819+ CAMLreturn(Val_unit);
4820+}
4821+
4822+CAMLprim value stub_xc_watchdog(value xch, value domid, value timeout)
4823+{
4824+ CAMLparam3(xch, domid, timeout);
4825+ int ret;
4826+ unsigned int c_timeout = Int32_val(timeout);
4827+
4828+ ret = xc_watchdog(_H(xch), _D(domid), c_timeout);
4829+ if (ret < 0)
4830+ failwith_xc(_H(xch));
4831+
4832+ CAMLreturn(Val_int(ret));
4833+}
4834+
4835+/*
4836+ * Local variables:
4837+ * indent-tabs-mode: t
4838+ * c-basic-offset: 8
4839+ * tab-width: 8
4840+ * End:
4841+ */
4842--- a/tools/ocaml/libs/xl/Makefile
4843+++ b/tools/ocaml/libs/xl/Makefile
4844@@ -2,14 +2,14 @@
4845 XEN_ROOT=$(TOPLEVEL)/../..
4846 include $(TOPLEVEL)/common.make
4847
4848-OBJS = xl
4849-INTF = xl.cmi
4850-LIBS = xl.cma xl.cmxa
4851+OBJS = xenlight
4852+INTF = xenlight.cmi
4853+LIBS = xenlight.cma xenlight.cmxa
4854
4855-xl_OBJS = $(OBJS)
4856-xl_C_OBJS = xl_stubs
4857+xenlight_OBJS = $(OBJS)
4858+xenlight_C_OBJS = xenlight_stubs
4859
4860-OCAML_LIBRARY = xl
4861+OCAML_LIBRARY = xenlight
4862
4863 all: $(INTF) $(LIBS)
4864
4865@@ -18,11 +18,11 @@
4866 .PHONY: install
4867 install: $(LIBS) META
4868 mkdir -p $(OCAMLDESTDIR)
4869- ocamlfind remove -destdir $(OCAMLDESTDIR) xl
4870- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xl META $(INTF) $(LIBS) *.a *.so *.cmx
4871+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight
4872+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenlight META $(INTF) $(LIBS) *.a *.so *.cmx
4873
4874 .PHONY: uninstall
4875 uninstall:
4876- ocamlfind remove -destdir $(OCAMLDESTDIR) xl
4877+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight
4878
4879 include $(TOPLEVEL)/Makefile.rules
4880--- /dev/null
4881+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
4882@@ -0,0 +1,729 @@
4883+/*
4884+ * Copyright (C) 2009-2010 Citrix Ltd.
4885+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
4886+ *
4887+ * This program is free software; you can redistribute it and/or modify
4888+ * it under the terms of the GNU Lesser General Public License as published
4889+ * by the Free Software Foundation; version 2.1 only. with the special
4890+ * exception on linking described in file LICENSE.
4891+ *
4892+ * This program is distributed in the hope that it will be useful,
4893+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
4894+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4895+ * GNU Lesser General Public License for more details.
4896+ */
4897+
4898+#include <stdlib.h>
4899+
4900+#define CAML_NAME_SPACE
4901+#include <caml/alloc.h>
4902+#include <caml/memory.h>
4903+#include <caml/signals.h>
4904+#include <caml/fail.h>
4905+#include <caml/callback.h>
4906+
4907+#include <sys/mman.h>
4908+#include <stdint.h>
4909+#include <string.h>
4910+
4911+#include "libxl.h"
4912+
4913+struct caml_logger {
4914+ struct xentoollog_logger logger;
4915+ int log_offset;
4916+ char log_buf[2048];
4917+};
4918+
4919+typedef struct caml_gc {
4920+ int offset;
4921+ void *ptrs[64];
4922+} caml_gc;
4923+
4924+void log_vmessage(struct xentoollog_logger *logger, xentoollog_level level,
4925+ int errnoval, const char *context, const char *format, va_list al)
4926+{
4927+ struct caml_logger *ologger = (struct caml_logger *) logger;
4928+
4929+ ologger->log_offset += vsnprintf(ologger->log_buf + ologger->log_offset,
4930+ 2048 - ologger->log_offset, format, al);
4931+}
4932+
4933+void log_destroy(struct xentoollog_logger *logger)
4934+{
4935+}
4936+
4937+#define INIT_STRUCT() libxl_ctx ctx; struct caml_logger lg; struct caml_gc gc; gc.offset = 0;
4938+
4939+#define INIT_CTX() \
4940+ lg.logger.vmessage = log_vmessage; \
4941+ lg.logger.destroy = log_destroy; \
4942+ lg.logger.progress = NULL; \
4943+ caml_enter_blocking_section(); \
4944+ ret = libxl_ctx_init(&ctx, LIBXL_VERSION, (struct xentoollog_logger *) &lg); \
4945+ if (ret != 0) \
4946+ failwith_xl("cannot init context", &lg);
4947+
4948+#define FREE_CTX() \
4949+ gc_free(&gc); \
4950+ caml_leave_blocking_section(); \
4951+ libxl_ctx_free(&ctx)
4952+
4953+static char * dup_String_val(caml_gc *gc, value s)
4954+{
4955+ int len;
4956+ char *c;
4957+ len = caml_string_length(s);
4958+ c = calloc(len + 1, sizeof(char));
4959+ if (!c)
4960+ caml_raise_out_of_memory();
4961+ gc->ptrs[gc->offset++] = c;
4962+ memcpy(c, String_val(s), len);
4963+ return c;
4964+}
4965+
4966+static void gc_free(caml_gc *gc)
4967+{
4968+ int i;
4969+ for (i = 0; i < gc->offset; i++) {
4970+ free(gc->ptrs[i]);
4971+ }
4972+}
4973+
4974+void failwith_xl(char *fname, struct caml_logger *lg)
4975+{
4976+ char *s;
4977+ s = (lg) ? lg->log_buf : fname;
4978+ caml_raise_with_string(*caml_named_value("xl.error"), s);
4979+}
4980+
4981+#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed then */
4982+static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
4983+{
4984+ void *ptr;
4985+ ptr = calloc(nmemb, size);
4986+ if (!ptr)
4987+ caml_raise_out_of_memory();
4988+ gc->ptrs[gc->offset++] = ptr;
4989+ return ptr;
4990+}
4991+
4992+static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value v)
4993+{
4994+ CAMLparam1(v);
4995+ CAMLlocal1(a);
4996+ int i;
4997+ char **array;
4998+
4999+ for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) { i++; }
5000+
5001+ array = gc_calloc(gc, (i + 1) * 2, sizeof(char *));
5002+ if (!array)
5003+ return 1;
5004+ for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1), i++) {
5005+ value b = Field(a, 0);
5006+ array[i * 2] = dup_String_val(gc, Field(b, 0));
5007+ array[i * 2 + 1] = dup_String_val(gc, Field(b, 1));
5008+ }
5009+ *c_val = array;
5010+ CAMLreturn(0);
5011+}
5012+
5013+static int domain_create_info_val (caml_gc *gc, libxl_domain_create_info *c_val, value v)
5014+{
5015+ CAMLparam1(v);
5016+ CAMLlocal1(a);
5017+ uint8_t *uuid = libxl_uuid_bytearray(&c_val->uuid);
5018+ int i;
5019+
5020+ c_val->hvm = Bool_val(Field(v, 0));
5021+ c_val->hap = Bool_val(Field(v, 1));
5022+ c_val->oos = Bool_val(Field(v, 2));
5023+ c_val->ssidref = Int32_val(Field(v, 3));
5024+ c_val->name = dup_String_val(gc, Field(v, 4));
5025+ a = Field(v, 5);
5026+ for (i = 0; i < 16; i++)
5027+ uuid[i] = Int_val(Field(a, i));
5028+ string_string_tuple_array_val(gc, &(c_val->xsdata), Field(v, 6));
5029+ string_string_tuple_array_val(gc, &(c_val->platformdata), Field(v, 7));
5030+
5031+ c_val->poolid = Int32_val(Field(v, 8));
5032+ c_val->poolname = dup_String_val(gc, Field(v, 9));
5033+
5034+ CAMLreturn(0);
5035+}
5036+
5037+static int domain_build_info_val (caml_gc *gc, libxl_domain_build_info *c_val, value v)
5038+{
5039+ CAMLparam1(v);
5040+ CAMLlocal1(infopriv);
5041+
5042+ c_val->max_vcpus = Int_val(Field(v, 0));
5043+ c_val->cur_vcpus = Int_val(Field(v, 1));
5044+ c_val->max_memkb = Int64_val(Field(v, 2));
5045+ c_val->target_memkb = Int64_val(Field(v, 3));
5046+ c_val->video_memkb = Int64_val(Field(v, 4));
5047+ c_val->shadow_memkb = Int64_val(Field(v, 5));
5048+ c_val->kernel.path = dup_String_val(gc, Field(v, 6));
5049+ c_val->is_hvm = Tag_val(Field(v, 7)) == 0;
5050+ infopriv = Field(Field(v, 7), 0);
5051+ if (c_val->hvm) {
5052+ c_val->u.hvm.pae = Bool_val(Field(infopriv, 0));
5053+ c_val->u.hvm.apic = Bool_val(Field(infopriv, 1));
5054+ c_val->u.hvm.acpi = Bool_val(Field(infopriv, 2));
5055+ c_val->u.hvm.nx = Bool_val(Field(infopriv, 3));
5056+ c_val->u.hvm.viridian = Bool_val(Field(infopriv, 4));
5057+ c_val->u.hvm.timeoffset = dup_String_val(gc, Field(infopriv, 5));
5058+ c_val->u.hvm.timer_mode = Int_val(Field(infopriv, 6));
5059+ c_val->u.hvm.hpet = Int_val(Field(infopriv, 7));
5060+ c_val->u.hvm.vpt_align = Int_val(Field(infopriv, 8));
5061+ } else {
5062+ c_val->u.pv.slack_memkb = Int64_val(Field(infopriv, 0));
5063+ c_val->u.pv.cmdline = dup_String_val(gc, Field(infopriv, 1));
5064+ c_val->u.pv.ramdisk.path = dup_String_val(gc, Field(infopriv, 2));
5065+ c_val->u.pv.features = dup_String_val(gc, Field(infopriv, 3));
5066+ }
5067+
5068+ CAMLreturn(0);
5069+}
5070+#endif
5071+
5072+static int device_disk_val(caml_gc *gc, libxl_device_disk *c_val, value v)
5073+{
5074+ CAMLparam1(v);
5075+
5076+ c_val->backend_domid = Int_val(Field(v, 0));
5077+ c_val->pdev_path = dup_String_val(gc, Field(v, 1));
5078+ c_val->vdev = dup_String_val(gc, Field(v, 2));
5079+ c_val->backend = (Int_val(Field(v, 3)));
5080+ c_val->format = (Int_val(Field(v, 4)));
5081+ c_val->unpluggable = Bool_val(Field(v, 5));
5082+ c_val->readwrite = Bool_val(Field(v, 6));
5083+ c_val->is_cdrom = Bool_val(Field(v, 7));
5084+
5085+ CAMLreturn(0);
5086+}
5087+
5088+static int device_nic_val(caml_gc *gc, libxl_device_nic *c_val, value v)
5089+{
5090+ CAMLparam1(v);
5091+ int i;
5092+ int ret = 0;
5093+ c_val->backend_domid = Int_val(Field(v, 0));
5094+ c_val->devid = Int_val(Field(v, 1));
5095+ c_val->mtu = Int_val(Field(v, 2));
5096+ c_val->model = dup_String_val(gc, Field(v, 3));
5097+
5098+ if (Wosize_val(Field(v, 4)) != 6) {
5099+ ret = 1;
5100+ goto out;
5101+ }
5102+ for (i = 0; i < 6; i++)
5103+ c_val->mac[i] = Int_val(Field(Field(v, 4), i));
5104+
5105+ /* not handling c_val->ip */
5106+ c_val->bridge = dup_String_val(gc, Field(v, 5));
5107+ c_val->ifname = dup_String_val(gc, Field(v, 6));
5108+ c_val->script = dup_String_val(gc, Field(v, 7));
5109+ c_val->nictype = (Int_val(Field(v, 8))) + NICTYPE_IOEMU;
5110+
5111+out:
5112+ CAMLreturn(ret);
5113+}
5114+
5115+static int device_console_val(caml_gc *gc, libxl_device_console *c_val, value v)
5116+{
5117+ CAMLparam1(v);
5118+
5119+ c_val->backend_domid = Int_val(Field(v, 0));
5120+ c_val->devid = Int_val(Field(v, 1));
5121+ c_val->consback = (Int_val(Field(v, 2))) + LIBXL_CONSBACK_XENCONSOLED;
5122+
5123+ CAMLreturn(0);
5124+}
5125+
5126+static int device_vkb_val(caml_gc *gc, libxl_device_vkb *c_val, value v)
5127+{
5128+ CAMLparam1(v);
5129+
5130+ c_val->backend_domid = Int_val(Field(v, 0));
5131+ c_val->devid = Int_val(Field(v, 1));
5132+
5133+ CAMLreturn(0);
5134+}
5135+
5136+static int device_vfb_val(caml_gc *gc, libxl_device_vfb *c_val, value v)
5137+{
5138+ CAMLparam1(v);
5139+
5140+ c_val->backend_domid = Int_val(Field(v, 0));
5141+ c_val->devid = Int_val(Field(v, 1));
5142+ c_val->vnc = Bool_val(Field(v, 2));
5143+ c_val->vnclisten = dup_String_val(gc, Field(v, 3));
5144+ c_val->vncpasswd = dup_String_val(gc, Field(v, 4));
5145+ c_val->vncdisplay = Int_val(Field(v, 5));
5146+ c_val->keymap = dup_String_val(gc, Field(v, 6));
5147+ c_val->sdl = Bool_val(Field(v, 7));
5148+ c_val->opengl = Bool_val(Field(v, 8));
5149+ c_val->display = dup_String_val(gc, Field(v, 9));
5150+ c_val->xauthority = dup_String_val(gc, Field(v, 10));
5151+
5152+ CAMLreturn(0);
5153+}
5154+
5155+static int device_pci_val(caml_gc *gc, libxl_device_pci *c_val, value v)
5156+{
5157+ union {
5158+ unsigned int value;
5159+ struct {
5160+ unsigned int reserved1:2;
5161+ unsigned int reg:6;
5162+ unsigned int func:3;
5163+ unsigned int dev:5;
5164+ unsigned int bus:8;
5165+ unsigned int reserved2:7;
5166+ unsigned int enable:1;
5167+ }fields;
5168+ }u;
5169+ CAMLparam1(v);
5170+
5171+ /* FIXME: propagate API change to ocaml */
5172+ u.value = Int_val(Field(v, 0));
5173+ c_val->reg = u.fields.reg;
5174+ c_val->func = u.fields.func;
5175+ c_val->dev = u.fields.dev;
5176+ c_val->bus = u.fields.bus;
5177+ c_val->enable = u.fields.enable;
5178+
5179+ c_val->domain = Int_val(Field(v, 1));
5180+ c_val->vdevfn = Int_val(Field(v, 2));
5181+ c_val->msitranslate = Bool_val(Field(v, 3));
5182+ c_val->power_mgmt = Bool_val(Field(v, 4));
5183+
5184+ CAMLreturn(0);
5185+}
5186+
5187+static int sched_credit_val(caml_gc *gc, libxl_sched_credit *c_val, value v)
5188+{
5189+ CAMLparam1(v);
5190+ c_val->weight = Int_val(Field(v, 0));
5191+ c_val->cap = Int_val(Field(v, 1));
5192+ CAMLreturn(0);
5193+}
5194+
5195+static int domain_build_state_val(caml_gc *gc, libxl_domain_build_state *c_val, value v)
5196+{
5197+ CAMLparam1(v);
5198+
5199+ c_val->store_port = Int_val(Field(v, 0));
5200+ c_val->store_mfn = Int64_val(Field(v, 1));
5201+ c_val->console_port = Int_val(Field(v, 2));
5202+ c_val->console_mfn = Int64_val(Field(v, 3));
5203+
5204+ CAMLreturn(0);
5205+}
5206+
5207+static value Val_sched_credit(libxl_sched_credit *c_val)
5208+{
5209+ CAMLparam0();
5210+ CAMLlocal1(v);
5211+
5212+ v = caml_alloc_tuple(2);
5213+
5214+ Store_field(v, 0, Val_int(c_val->weight));
5215+ Store_field(v, 1, Val_int(c_val->cap));
5216+
5217+ CAMLreturn(v);
5218+}
5219+
5220+static value Val_physinfo(libxl_physinfo *c_val)
5221+{
5222+ CAMLparam0();
5223+ CAMLlocal2(v, hwcap);
5224+ int i;
5225+
5226+ hwcap = caml_alloc_tuple(8);
5227+ for (i = 0; i < 8; i++)
5228+ Store_field(hwcap, i, caml_copy_int32(c_val->hw_cap[i]));
5229+
5230+ v = caml_alloc_tuple(11);
5231+ Store_field(v, 0, Val_int(c_val->threads_per_core));
5232+ Store_field(v, 1, Val_int(c_val->cores_per_socket));
5233+ Store_field(v, 2, Val_int(c_val->max_cpu_id));
5234+ Store_field(v, 3, Val_int(c_val->nr_cpus));
5235+ Store_field(v, 4, Val_int(c_val->cpu_khz));
5236+ Store_field(v, 5, caml_copy_int64(c_val->total_pages));
5237+ Store_field(v, 6, caml_copy_int64(c_val->free_pages));
5238+ Store_field(v, 7, caml_copy_int64(c_val->scrub_pages));
5239+ Store_field(v, 8, Val_int(c_val->nr_nodes));
5240+ Store_field(v, 9, hwcap);
5241+ Store_field(v, 10, caml_copy_int32(c_val->phys_cap));
5242+
5243+ CAMLreturn(v);
5244+}
5245+
5246+value stub_xl_disk_add(value info, value domid)
5247+{
5248+ CAMLparam2(info, domid);
5249+ libxl_device_disk c_info;
5250+ int ret;
5251+ INIT_STRUCT();
5252+
5253+ device_disk_val(&gc, &c_info, info);
5254+ c_info.domid = Int_val(domid);
5255+
5256+ INIT_CTX();
5257+ ret = libxl_device_disk_add(&ctx, Int_val(domid), &c_info);
5258+ if (ret != 0)
5259+ failwith_xl("disk_add", &lg);
5260+ FREE_CTX();
5261+ CAMLreturn(Val_unit);
5262+}
5263+
5264+value stub_xl_disk_remove(value info, value domid)
5265+{
5266+ CAMLparam2(info, domid);
5267+ libxl_device_disk c_info;
5268+ int ret;
5269+ INIT_STRUCT();
5270+
5271+ device_disk_val(&gc, &c_info, info);
5272+ c_info.domid = Int_val(domid);
5273+
5274+ INIT_CTX();
5275+ ret = libxl_device_disk_del(&ctx, &c_info, 0);
5276+ if (ret != 0)
5277+ failwith_xl("disk_remove", &lg);
5278+ FREE_CTX();
5279+ CAMLreturn(Val_unit);
5280+}
5281+
5282+value stub_xl_nic_add(value info, value domid)
5283+{
5284+ CAMLparam2(info, domid);
5285+ libxl_device_nic c_info;
5286+ int ret;
5287+ INIT_STRUCT();
5288+
5289+ device_nic_val(&gc, &c_info, info);
5290+ c_info.domid = Int_val(domid);
5291+
5292+ INIT_CTX();
5293+ ret = libxl_device_nic_add(&ctx, Int_val(domid), &c_info);
5294+ if (ret != 0)
5295+ failwith_xl("nic_add", &lg);
5296+ FREE_CTX();
5297+ CAMLreturn(Val_unit);
5298+}
5299+
5300+value stub_xl_nic_remove(value info, value domid)
5301+{
5302+ CAMLparam2(info, domid);
5303+ libxl_device_nic c_info;
5304+ int ret;
5305+ INIT_STRUCT();
5306+
5307+ device_nic_val(&gc, &c_info, info);
5308+ c_info.domid = Int_val(domid);
5309+
5310+ INIT_CTX();
5311+ ret = libxl_device_nic_del(&ctx, &c_info, 0);
5312+ if (ret != 0)
5313+ failwith_xl("nic_remove", &lg);
5314+ FREE_CTX();
5315+ CAMLreturn(Val_unit);
5316+}
5317+
5318+value stub_xl_console_add(value info, value state, value domid)
5319+{
5320+ CAMLparam3(info, state, domid);
5321+ libxl_device_console c_info;
5322+ libxl_domain_build_state c_state;
5323+ int ret;
5324+ INIT_STRUCT();
5325+
5326+ device_console_val(&gc, &c_info, info);
5327+ domain_build_state_val(&gc, &c_state, state);
5328+ c_info.domid = Int_val(domid);
5329+ c_info.build_state = &c_state;
5330+
5331+ INIT_CTX();
5332+ ret = libxl_device_console_add(&ctx, Int_val(domid), &c_info);
5333+ if (ret != 0)
5334+ failwith_xl("console_add", &lg);
5335+ FREE_CTX();
5336+ CAMLreturn(Val_unit);
5337+}
5338+
5339+value stub_xl_vkb_add(value info, value domid)
5340+{
5341+ CAMLparam2(info, domid);
5342+ libxl_device_vkb c_info;
5343+ int ret;
5344+ INIT_STRUCT();
5345+
5346+ device_vkb_val(&gc, &c_info, info);
5347+ c_info.domid = Int_val(domid);
5348+
5349+ INIT_CTX();
5350+ ret = libxl_device_vkb_add(&ctx, Int_val(domid), &c_info);
5351+ if (ret != 0)
5352+ failwith_xl("vkb_add", &lg);
5353+ FREE_CTX();
5354+
5355+ CAMLreturn(Val_unit);
5356+}
5357+
5358+value stub_xl_vkb_clean_shutdown(value domid)
5359+{
5360+ CAMLparam1(domid);
5361+ int ret;
5362+ INIT_STRUCT();
5363+
5364+ INIT_CTX();
5365+ ret = libxl_device_vkb_clean_shutdown(&ctx, Int_val(domid));
5366+ if (ret != 0)
5367+ failwith_xl("vkb_clean_shutdown", &lg);
5368+ FREE_CTX();
5369+
5370+ CAMLreturn(Val_unit);
5371+}
5372+
5373+value stub_xl_vkb_hard_shutdown(value domid)
5374+{
5375+ CAMLparam1(domid);
5376+ int ret;
5377+ INIT_STRUCT();
5378+
5379+ INIT_CTX();
5380+ ret = libxl_device_vkb_hard_shutdown(&ctx, Int_val(domid));
5381+ if (ret != 0)
5382+ failwith_xl("vkb_hard_shutdown", &lg);
5383+ FREE_CTX();
5384+
5385+ CAMLreturn(Val_unit);
5386+}
5387+
5388+value stub_xl_vfb_add(value info, value domid)
5389+{
5390+ CAMLparam2(info, domid);
5391+ libxl_device_vfb c_info;
5392+ int ret;
5393+ INIT_STRUCT();
5394+
5395+ device_vfb_val(&gc, &c_info, info);
5396+ c_info.domid = Int_val(domid);
5397+
5398+ INIT_CTX();
5399+ ret = libxl_device_vfb_add(&ctx, Int_val(domid), &c_info);
5400+ if (ret != 0)
5401+ failwith_xl("vfb_add", &lg);
5402+ FREE_CTX();
5403+
5404+ CAMLreturn(Val_unit);
5405+}
5406+
5407+value stub_xl_vfb_clean_shutdown(value domid)
5408+{
5409+ CAMLparam1(domid);
5410+ int ret;
5411+ INIT_STRUCT();
5412+
5413+ INIT_CTX();
5414+ ret = libxl_device_vfb_clean_shutdown(&ctx, Int_val(domid));
5415+ if (ret != 0)
5416+ failwith_xl("vfb_clean_shutdown", &lg);
5417+ FREE_CTX();
5418+
5419+ CAMLreturn(Val_unit);
5420+}
5421+
5422+value stub_xl_vfb_hard_shutdown(value domid)
5423+{
5424+ CAMLparam1(domid);
5425+ int ret;
5426+ INIT_STRUCT();
5427+
5428+ INIT_CTX();
5429+ ret = libxl_device_vfb_hard_shutdown(&ctx, Int_val(domid));
5430+ if (ret != 0)
5431+ failwith_xl("vfb_hard_shutdown", &lg);
5432+ FREE_CTX();
5433+
5434+ CAMLreturn(Val_unit);
5435+}
5436+
5437+value stub_xl_pci_add(value info, value domid)
5438+{
5439+ CAMLparam2(info, domid);
5440+ libxl_device_pci c_info;
5441+ int ret;
5442+ INIT_STRUCT();
5443+
5444+ device_pci_val(&gc, &c_info, info);
5445+
5446+ INIT_CTX();
5447+ ret = libxl_device_pci_add(&ctx, Int_val(domid), &c_info);
5448+ if (ret != 0)
5449+ failwith_xl("pci_add", &lg);
5450+ FREE_CTX();
5451+
5452+ CAMLreturn(Val_unit);
5453+}
5454+
5455+value stub_xl_pci_remove(value info, value domid)
5456+{
5457+ CAMLparam2(info, domid);
5458+ libxl_device_pci c_info;
5459+ int ret;
5460+ INIT_STRUCT();
5461+
5462+ device_pci_val(&gc, &c_info, info);
5463+
5464+ INIT_CTX();
5465+ ret = libxl_device_pci_remove(&ctx, Int_val(domid), &c_info, 0);
5466+ if (ret != 0)
5467+ failwith_xl("pci_remove", &lg);
5468+ FREE_CTX();
5469+
5470+ CAMLreturn(Val_unit);
5471+}
5472+
5473+value stub_xl_pci_shutdown(value domid)
5474+{
5475+ CAMLparam1(domid);
5476+ int ret;
5477+ INIT_STRUCT();
5478+
5479+ INIT_CTX();
5480+ ret = libxl_device_pci_shutdown(&ctx, Int_val(domid));
5481+ if (ret != 0)
5482+ failwith_xl("pci_shutdown", &lg);
5483+ FREE_CTX();
5484+
5485+ CAMLreturn(Val_unit);
5486+}
5487+
5488+value stub_xl_button_press(value domid, value button)
5489+{
5490+ CAMLparam2(domid, button);
5491+ int ret;
5492+ INIT_STRUCT();
5493+
5494+ INIT_CTX();
5495+ ret = libxl_button_press(&ctx, Int_val(domid), Int_val(button) + POWER_BUTTON);
5496+ if (ret != 0)
5497+ failwith_xl("button_press", &lg);
5498+ FREE_CTX();
5499+
5500+ CAMLreturn(Val_unit);
5501+}
5502+
5503+value stub_xl_physinfo(value unit)
5504+{
5505+ CAMLparam1(unit);
5506+ CAMLlocal1(physinfo);
5507+ libxl_physinfo c_physinfo;
5508+ int ret;
5509+ INIT_STRUCT();
5510+
5511+ INIT_CTX();
5512+ ret = libxl_get_physinfo(&ctx, &c_physinfo);
5513+ if (ret != 0)
5514+ failwith_xl("physinfo", &lg);
5515+ FREE_CTX();
5516+
5517+ physinfo = Val_physinfo(&c_physinfo);
5518+ CAMLreturn(physinfo);
5519+}
5520+
5521+value stub_xl_sched_credit_domain_get(value domid)
5522+{
5523+ CAMLparam1(domid);
5524+ CAMLlocal1(scinfo);
5525+ libxl_sched_credit c_scinfo;
5526+ int ret;
5527+ INIT_STRUCT();
5528+
5529+ INIT_CTX();
5530+ ret = libxl_sched_credit_domain_get(&ctx, Int_val(domid), &c_scinfo);
5531+ if (ret != 0)
5532+ failwith_xl("sched_credit_domain_get", &lg);
5533+ FREE_CTX();
5534+
5535+ scinfo = Val_sched_credit(&c_scinfo);
5536+ CAMLreturn(scinfo);
5537+}
5538+
5539+value stub_xl_sched_credit_domain_set(value domid, value scinfo)
5540+{
5541+ CAMLparam2(domid, scinfo);
5542+ libxl_sched_credit c_scinfo;
5543+ int ret;
5544+ INIT_STRUCT();
5545+
5546+ sched_credit_val(&gc, &c_scinfo, scinfo);
5547+
5548+ INIT_CTX();
5549+ ret = libxl_sched_credit_domain_set(&ctx, Int_val(domid), &c_scinfo);
5550+ if (ret != 0)
5551+ failwith_xl("sched_credit_domain_set", &lg);
5552+ FREE_CTX();
5553+
5554+ CAMLreturn(Val_unit);
5555+}
5556+
5557+value stub_xl_send_trigger(value domid, value trigger, value vcpuid)
5558+{
5559+ CAMLparam3(domid, trigger, vcpuid);
5560+ int ret;
5561+ char *c_trigger;
5562+ INIT_STRUCT();
5563+
5564+ c_trigger = dup_String_val(&gc, trigger);
5565+
5566+ INIT_CTX();
5567+ ret = libxl_send_trigger(&ctx, Int_val(domid), c_trigger, Int_val(vcpuid));
5568+ if (ret != 0)
5569+ failwith_xl("send_trigger", &lg);
5570+ FREE_CTX();
5571+ CAMLreturn(Val_unit);
5572+}
5573+
5574+value stub_xl_send_sysrq(value domid, value sysrq)
5575+{
5576+ CAMLparam2(domid, sysrq);
5577+ int ret;
5578+ INIT_STRUCT();
5579+
5580+ INIT_CTX();
5581+ ret = libxl_send_sysrq(&ctx, Int_val(domid), Int_val(sysrq));
5582+ if (ret != 0)
5583+ failwith_xl("send_sysrq", &lg);
5584+ FREE_CTX();
5585+ CAMLreturn(Val_unit);
5586+}
5587+
5588+value stub_xl_send_debug_keys(value keys)
5589+{
5590+ CAMLparam1(keys);
5591+ int ret;
5592+ char *c_keys;
5593+ INIT_STRUCT();
5594+
5595+ c_keys = dup_String_val(&gc, keys);
5596+
5597+ INIT_CTX();
5598+ ret = libxl_send_debug_keys(&ctx, c_keys);
5599+ if (ret != 0)
5600+ failwith_xl("send_debug_keys", &lg);
5601+ FREE_CTX();
5602+ CAMLreturn(Val_unit);
5603+}
5604+
5605+/*
5606+ * Local variables:
5607+ * indent-tabs-mode: t
5608+ * c-basic-offset: 8
5609+ * tab-width: 8
5610+ * End:
5611+ */
5612--- a/tools/ocaml/libs/xl/xl_stubs.c
5613+++ /dev/null
5614@@ -1,729 +0,0 @@
5615-/*
5616- * Copyright (C) 2009-2010 Citrix Ltd.
5617- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
5618- *
5619- * This program is free software; you can redistribute it and/or modify
5620- * it under the terms of the GNU Lesser General Public License as published
5621- * by the Free Software Foundation; version 2.1 only. with the special
5622- * exception on linking described in file LICENSE.
5623- *
5624- * This program is distributed in the hope that it will be useful,
5625- * but WITHOUT ANY WARRANTY; without even the implied warranty of
5626- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
5627- * GNU Lesser General Public License for more details.
5628- */
5629-
5630-#include <stdlib.h>
5631-
5632-#define CAML_NAME_SPACE
5633-#include <caml/alloc.h>
5634-#include <caml/memory.h>
5635-#include <caml/signals.h>
5636-#include <caml/fail.h>
5637-#include <caml/callback.h>
5638-
5639-#include <sys/mman.h>
5640-#include <stdint.h>
5641-#include <string.h>
5642-
5643-#include "libxl.h"
5644-
5645-struct caml_logger {
5646- struct xentoollog_logger logger;
5647- int log_offset;
5648- char log_buf[2048];
5649-};
5650-
5651-typedef struct caml_gc {
5652- int offset;
5653- void *ptrs[64];
5654-} caml_gc;
5655-
5656-void log_vmessage(struct xentoollog_logger *logger, xentoollog_level level,
5657- int errnoval, const char *context, const char *format, va_list al)
5658-{
5659- struct caml_logger *ologger = (struct caml_logger *) logger;
5660-
5661- ologger->log_offset += vsnprintf(ologger->log_buf + ologger->log_offset,
5662- 2048 - ologger->log_offset, format, al);
5663-}
5664-
5665-void log_destroy(struct xentoollog_logger *logger)
5666-{
5667-}
5668-
5669-#define INIT_STRUCT() libxl_ctx ctx; struct caml_logger lg; struct caml_gc gc; gc.offset = 0;
5670-
5671-#define INIT_CTX() \
5672- lg.logger.vmessage = log_vmessage; \
5673- lg.logger.destroy = log_destroy; \
5674- lg.logger.progress = NULL; \
5675- caml_enter_blocking_section(); \
5676- ret = libxl_ctx_init(&ctx, LIBXL_VERSION, (struct xentoollog_logger *) &lg); \
5677- if (ret != 0) \
5678- failwith_xl("cannot init context", &lg);
5679-
5680-#define FREE_CTX() \
5681- gc_free(&gc); \
5682- caml_leave_blocking_section(); \
5683- libxl_ctx_free(&ctx)
5684-
5685-static char * dup_String_val(caml_gc *gc, value s)
5686-{
5687- int len;
5688- char *c;
5689- len = caml_string_length(s);
5690- c = calloc(len + 1, sizeof(char));
5691- if (!c)
5692- caml_raise_out_of_memory();
5693- gc->ptrs[gc->offset++] = c;
5694- memcpy(c, String_val(s), len);
5695- return c;
5696-}
5697-
5698-static void gc_free(caml_gc *gc)
5699-{
5700- int i;
5701- for (i = 0; i < gc->offset; i++) {
5702- free(gc->ptrs[i]);
5703- }
5704-}
5705-
5706-void failwith_xl(char *fname, struct caml_logger *lg)
5707-{
5708- char *s;
5709- s = (lg) ? lg->log_buf : fname;
5710- caml_raise_with_string(*caml_named_value("xl.error"), s);
5711-}
5712-
5713-#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed then */
5714-static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
5715-{
5716- void *ptr;
5717- ptr = calloc(nmemb, size);
5718- if (!ptr)
5719- caml_raise_out_of_memory();
5720- gc->ptrs[gc->offset++] = ptr;
5721- return ptr;
5722-}
5723-
5724-static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value v)
5725-{
5726- CAMLparam1(v);
5727- CAMLlocal1(a);
5728- int i;
5729- char **array;
5730-
5731- for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) { i++; }
5732-
5733- array = gc_calloc(gc, (i + 1) * 2, sizeof(char *));
5734- if (!array)
5735- return 1;
5736- for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1), i++) {
5737- value b = Field(a, 0);
5738- array[i * 2] = dup_String_val(gc, Field(b, 0));
5739- array[i * 2 + 1] = dup_String_val(gc, Field(b, 1));
5740- }
5741- *c_val = array;
5742- CAMLreturn(0);
5743-}
5744-
5745-static int domain_create_info_val (caml_gc *gc, libxl_domain_create_info *c_val, value v)
5746-{
5747- CAMLparam1(v);
5748- CAMLlocal1(a);
5749- uint8_t *uuid = libxl_uuid_bytearray(&c_val->uuid);
5750- int i;
5751-
5752- c_val->hvm = Bool_val(Field(v, 0));
5753- c_val->hap = Bool_val(Field(v, 1));
5754- c_val->oos = Bool_val(Field(v, 2));
5755- c_val->ssidref = Int32_val(Field(v, 3));
5756- c_val->name = dup_String_val(gc, Field(v, 4));
5757- a = Field(v, 5);
5758- for (i = 0; i < 16; i++)
5759- uuid[i] = Int_val(Field(a, i));
5760- string_string_tuple_array_val(gc, &(c_val->xsdata), Field(v, 6));
5761- string_string_tuple_array_val(gc, &(c_val->platformdata), Field(v, 7));
5762-
5763- c_val->poolid = Int32_val(Field(v, 8));
5764- c_val->poolname = dup_String_val(gc, Field(v, 9));
5765-
5766- CAMLreturn(0);
5767-}
5768-
5769-static int domain_build_info_val (caml_gc *gc, libxl_domain_build_info *c_val, value v)
5770-{
5771- CAMLparam1(v);
5772- CAMLlocal1(infopriv);
5773-
5774- c_val->max_vcpus = Int_val(Field(v, 0));
5775- c_val->cur_vcpus = Int_val(Field(v, 1));
5776- c_val->max_memkb = Int64_val(Field(v, 2));
5777- c_val->target_memkb = Int64_val(Field(v, 3));
5778- c_val->video_memkb = Int64_val(Field(v, 4));
5779- c_val->shadow_memkb = Int64_val(Field(v, 5));
5780- c_val->kernel.path = dup_String_val(gc, Field(v, 6));
5781- c_val->is_hvm = Tag_val(Field(v, 7)) == 0;
5782- infopriv = Field(Field(v, 7), 0);
5783- if (c_val->hvm) {
5784- c_val->u.hvm.pae = Bool_val(Field(infopriv, 0));
5785- c_val->u.hvm.apic = Bool_val(Field(infopriv, 1));
5786- c_val->u.hvm.acpi = Bool_val(Field(infopriv, 2));
5787- c_val->u.hvm.nx = Bool_val(Field(infopriv, 3));
5788- c_val->u.hvm.viridian = Bool_val(Field(infopriv, 4));
5789- c_val->u.hvm.timeoffset = dup_String_val(gc, Field(infopriv, 5));
5790- c_val->u.hvm.timer_mode = Int_val(Field(infopriv, 6));
5791- c_val->u.hvm.hpet = Int_val(Field(infopriv, 7));
5792- c_val->u.hvm.vpt_align = Int_val(Field(infopriv, 8));
5793- } else {
5794- c_val->u.pv.slack_memkb = Int64_val(Field(infopriv, 0));
5795- c_val->u.pv.cmdline = dup_String_val(gc, Field(infopriv, 1));
5796- c_val->u.pv.ramdisk.path = dup_String_val(gc, Field(infopriv, 2));
5797- c_val->u.pv.features = dup_String_val(gc, Field(infopriv, 3));
5798- }
5799-
5800- CAMLreturn(0);
5801-}
5802-#endif
5803-
5804-static int device_disk_val(caml_gc *gc, libxl_device_disk *c_val, value v)
5805-{
5806- CAMLparam1(v);
5807-
5808- c_val->backend_domid = Int_val(Field(v, 0));
5809- c_val->pdev_path = dup_String_val(gc, Field(v, 1));
5810- c_val->vdev = dup_String_val(gc, Field(v, 2));
5811- c_val->backend = (Int_val(Field(v, 3)));
5812- c_val->format = (Int_val(Field(v, 4)));
5813- c_val->unpluggable = Bool_val(Field(v, 5));
5814- c_val->readwrite = Bool_val(Field(v, 6));
5815- c_val->is_cdrom = Bool_val(Field(v, 7));
5816-
5817- CAMLreturn(0);
5818-}
5819-
5820-static int device_nic_val(caml_gc *gc, libxl_device_nic *c_val, value v)
5821-{
5822- CAMLparam1(v);
5823- int i;
5824- int ret = 0;
5825- c_val->backend_domid = Int_val(Field(v, 0));
5826- c_val->devid = Int_val(Field(v, 1));
5827- c_val->mtu = Int_val(Field(v, 2));
5828- c_val->model = dup_String_val(gc, Field(v, 3));
5829-
5830- if (Wosize_val(Field(v, 4)) != 6) {
5831- ret = 1;
5832- goto out;
5833- }
5834- for (i = 0; i < 6; i++)
5835- c_val->mac[i] = Int_val(Field(Field(v, 4), i));
5836-
5837- /* not handling c_val->ip */
5838- c_val->bridge = dup_String_val(gc, Field(v, 5));
5839- c_val->ifname = dup_String_val(gc, Field(v, 6));
5840- c_val->script = dup_String_val(gc, Field(v, 7));
5841- c_val->nictype = (Int_val(Field(v, 8))) + NICTYPE_IOEMU;
5842-
5843-out:
5844- CAMLreturn(ret);
5845-}
5846-
5847-static int device_console_val(caml_gc *gc, libxl_device_console *c_val, value v)
5848-{
5849- CAMLparam1(v);
5850-
5851- c_val->backend_domid = Int_val(Field(v, 0));
5852- c_val->devid = Int_val(Field(v, 1));
5853- c_val->consback = (Int_val(Field(v, 2))) + LIBXL_CONSBACK_XENCONSOLED;
5854-
5855- CAMLreturn(0);
5856-}
5857-
5858-static int device_vkb_val(caml_gc *gc, libxl_device_vkb *c_val, value v)
5859-{
5860- CAMLparam1(v);
5861-
5862- c_val->backend_domid = Int_val(Field(v, 0));
5863- c_val->devid = Int_val(Field(v, 1));
5864-
5865- CAMLreturn(0);
5866-}
5867-
5868-static int device_vfb_val(caml_gc *gc, libxl_device_vfb *c_val, value v)
5869-{
5870- CAMLparam1(v);
5871-
5872- c_val->backend_domid = Int_val(Field(v, 0));
5873- c_val->devid = Int_val(Field(v, 1));
5874- c_val->vnc = Bool_val(Field(v, 2));
5875- c_val->vnclisten = dup_String_val(gc, Field(v, 3));
5876- c_val->vncpasswd = dup_String_val(gc, Field(v, 4));
5877- c_val->vncdisplay = Int_val(Field(v, 5));
5878- c_val->keymap = dup_String_val(gc, Field(v, 6));
5879- c_val->sdl = Bool_val(Field(v, 7));
5880- c_val->opengl = Bool_val(Field(v, 8));
5881- c_val->display = dup_String_val(gc, Field(v, 9));
5882- c_val->xauthority = dup_String_val(gc, Field(v, 10));
5883-
5884- CAMLreturn(0);
5885-}
5886-
5887-static int device_pci_val(caml_gc *gc, libxl_device_pci *c_val, value v)
5888-{
5889- union {
5890- unsigned int value;
5891- struct {
5892- unsigned int reserved1:2;
5893- unsigned int reg:6;
5894- unsigned int func:3;
5895- unsigned int dev:5;
5896- unsigned int bus:8;
5897- unsigned int reserved2:7;
5898- unsigned int enable:1;
5899- }fields;
5900- }u;
5901- CAMLparam1(v);
5902-
5903- /* FIXME: propagate API change to ocaml */
5904- u.value = Int_val(Field(v, 0));
5905- c_val->reg = u.fields.reg;
5906- c_val->func = u.fields.func;
5907- c_val->dev = u.fields.dev;
5908- c_val->bus = u.fields.bus;
5909- c_val->enable = u.fields.enable;
5910-
5911- c_val->domain = Int_val(Field(v, 1));
5912- c_val->vdevfn = Int_val(Field(v, 2));
5913- c_val->msitranslate = Bool_val(Field(v, 3));
5914- c_val->power_mgmt = Bool_val(Field(v, 4));
5915-
5916- CAMLreturn(0);
5917-}
5918-
5919-static int sched_credit_val(caml_gc *gc, libxl_sched_credit *c_val, value v)
5920-{
5921- CAMLparam1(v);
5922- c_val->weight = Int_val(Field(v, 0));
5923- c_val->cap = Int_val(Field(v, 1));
5924- CAMLreturn(0);
5925-}
5926-
5927-static int domain_build_state_val(caml_gc *gc, libxl_domain_build_state *c_val, value v)
5928-{
5929- CAMLparam1(v);
5930-
5931- c_val->store_port = Int_val(Field(v, 0));
5932- c_val->store_mfn = Int64_val(Field(v, 1));
5933- c_val->console_port = Int_val(Field(v, 2));
5934- c_val->console_mfn = Int64_val(Field(v, 3));
5935-
5936- CAMLreturn(0);
5937-}
5938-
5939-static value Val_sched_credit(libxl_sched_credit *c_val)
5940-{
5941- CAMLparam0();
5942- CAMLlocal1(v);
5943-
5944- v = caml_alloc_tuple(2);
5945-
5946- Store_field(v, 0, Val_int(c_val->weight));
5947- Store_field(v, 1, Val_int(c_val->cap));
5948-
5949- CAMLreturn(v);
5950-}
5951-
5952-static value Val_physinfo(libxl_physinfo *c_val)
5953-{
5954- CAMLparam0();
5955- CAMLlocal2(v, hwcap);
5956- int i;
5957-
5958- hwcap = caml_alloc_tuple(8);
5959- for (i = 0; i < 8; i++)
5960- Store_field(hwcap, i, caml_copy_int32(c_val->hw_cap[i]));
5961-
5962- v = caml_alloc_tuple(11);
5963- Store_field(v, 0, Val_int(c_val->threads_per_core));
5964- Store_field(v, 1, Val_int(c_val->cores_per_socket));
5965- Store_field(v, 2, Val_int(c_val->max_cpu_id));
5966- Store_field(v, 3, Val_int(c_val->nr_cpus));
5967- Store_field(v, 4, Val_int(c_val->cpu_khz));
5968- Store_field(v, 5, caml_copy_int64(c_val->total_pages));
5969- Store_field(v, 6, caml_copy_int64(c_val->free_pages));
5970- Store_field(v, 7, caml_copy_int64(c_val->scrub_pages));
5971- Store_field(v, 8, Val_int(c_val->nr_nodes));
5972- Store_field(v, 9, hwcap);
5973- Store_field(v, 10, caml_copy_int32(c_val->phys_cap));
5974-
5975- CAMLreturn(v);
5976-}
5977-
5978-value stub_xl_disk_add(value info, value domid)
5979-{
5980- CAMLparam2(info, domid);
5981- libxl_device_disk c_info;
5982- int ret;
5983- INIT_STRUCT();
5984-
5985- device_disk_val(&gc, &c_info, info);
5986- c_info.domid = Int_val(domid);
5987-
5988- INIT_CTX();
5989- ret = libxl_device_disk_add(&ctx, Int_val(domid), &c_info);
5990- if (ret != 0)
5991- failwith_xl("disk_add", &lg);
5992- FREE_CTX();
5993- CAMLreturn(Val_unit);
5994-}
5995-
5996-value stub_xl_disk_remove(value info, value domid)
5997-{
5998- CAMLparam2(info, domid);
5999- libxl_device_disk c_info;
6000- int ret;
6001- INIT_STRUCT();
6002-
6003- device_disk_val(&gc, &c_info, info);
6004- c_info.domid = Int_val(domid);
6005-
6006- INIT_CTX();
6007- ret = libxl_device_disk_del(&ctx, &c_info, 0);
6008- if (ret != 0)
6009- failwith_xl("disk_remove", &lg);
6010- FREE_CTX();
6011- CAMLreturn(Val_unit);
6012-}
6013-
6014-value stub_xl_nic_add(value info, value domid)
6015-{
6016- CAMLparam2(info, domid);
6017- libxl_device_nic c_info;
6018- int ret;
6019- INIT_STRUCT();
6020-
6021- device_nic_val(&gc, &c_info, info);
6022- c_info.domid = Int_val(domid);
6023-
6024- INIT_CTX();
6025- ret = libxl_device_nic_add(&ctx, Int_val(domid), &c_info);
6026- if (ret != 0)
6027- failwith_xl("nic_add", &lg);
6028- FREE_CTX();
6029- CAMLreturn(Val_unit);
6030-}
6031-
6032-value stub_xl_nic_remove(value info, value domid)
6033-{
6034- CAMLparam2(info, domid);
6035- libxl_device_nic c_info;
6036- int ret;
6037- INIT_STRUCT();
6038-
6039- device_nic_val(&gc, &c_info, info);
6040- c_info.domid = Int_val(domid);
6041-
6042- INIT_CTX();
6043- ret = libxl_device_nic_del(&ctx, &c_info, 0);
6044- if (ret != 0)
6045- failwith_xl("nic_remove", &lg);
6046- FREE_CTX();
6047- CAMLreturn(Val_unit);
6048-}
6049-
6050-value stub_xl_console_add(value info, value state, value domid)
6051-{
6052- CAMLparam3(info, state, domid);
6053- libxl_device_console c_info;
6054- libxl_domain_build_state c_state;
6055- int ret;
6056- INIT_STRUCT();
6057-
6058- device_console_val(&gc, &c_info, info);
6059- domain_build_state_val(&gc, &c_state, state);
6060- c_info.domid = Int_val(domid);
6061- c_info.build_state = &c_state;
6062-
6063- INIT_CTX();
6064- ret = libxl_device_console_add(&ctx, Int_val(domid), &c_info);
6065- if (ret != 0)
6066- failwith_xl("console_add", &lg);
6067- FREE_CTX();
6068- CAMLreturn(Val_unit);
6069-}
6070-
6071-value stub_xl_vkb_add(value info, value domid)
6072-{
6073- CAMLparam2(info, domid);
6074- libxl_device_vkb c_info;
6075- int ret;
6076- INIT_STRUCT();
6077-
6078- device_vkb_val(&gc, &c_info, info);
6079- c_info.domid = Int_val(domid);
6080-
6081- INIT_CTX();
6082- ret = libxl_device_vkb_add(&ctx, Int_val(domid), &c_info);
6083- if (ret != 0)
6084- failwith_xl("vkb_add", &lg);
6085- FREE_CTX();
6086-
6087- CAMLreturn(Val_unit);
6088-}
6089-
6090-value stub_xl_vkb_clean_shutdown(value domid)
6091-{
6092- CAMLparam1(domid);
6093- int ret;
6094- INIT_STRUCT();
6095-
6096- INIT_CTX();
6097- ret = libxl_device_vkb_clean_shutdown(&ctx, Int_val(domid));
6098- if (ret != 0)
6099- failwith_xl("vkb_clean_shutdown", &lg);
6100- FREE_CTX();
6101-
6102- CAMLreturn(Val_unit);
6103-}
6104-
6105-value stub_xl_vkb_hard_shutdown(value domid)
6106-{
6107- CAMLparam1(domid);
6108- int ret;
6109- INIT_STRUCT();
6110-
6111- INIT_CTX();
6112- ret = libxl_device_vkb_hard_shutdown(&ctx, Int_val(domid));
6113- if (ret != 0)
6114- failwith_xl("vkb_hard_shutdown", &lg);
6115- FREE_CTX();
6116-
6117- CAMLreturn(Val_unit);
6118-}
6119-
6120-value stub_xl_vfb_add(value info, value domid)
6121-{
6122- CAMLparam2(info, domid);
6123- libxl_device_vfb c_info;
6124- int ret;
6125- INIT_STRUCT();
6126-
6127- device_vfb_val(&gc, &c_info, info);
6128- c_info.domid = Int_val(domid);
6129-
6130- INIT_CTX();
6131- ret = libxl_device_vfb_add(&ctx, Int_val(domid), &c_info);
6132- if (ret != 0)
6133- failwith_xl("vfb_add", &lg);
6134- FREE_CTX();
6135-
6136- CAMLreturn(Val_unit);
6137-}
6138-
6139-value stub_xl_vfb_clean_shutdown(value domid)
6140-{
6141- CAMLparam1(domid);
6142- int ret;
6143- INIT_STRUCT();
6144-
6145- INIT_CTX();
6146- ret = libxl_device_vfb_clean_shutdown(&ctx, Int_val(domid));
6147- if (ret != 0)
6148- failwith_xl("vfb_clean_shutdown", &lg);
6149- FREE_CTX();
6150-
6151- CAMLreturn(Val_unit);
6152-}
6153-
6154-value stub_xl_vfb_hard_shutdown(value domid)
6155-{
6156- CAMLparam1(domid);
6157- int ret;
6158- INIT_STRUCT();
6159-
6160- INIT_CTX();
6161- ret = libxl_device_vfb_hard_shutdown(&ctx, Int_val(domid));
6162- if (ret != 0)
6163- failwith_xl("vfb_hard_shutdown", &lg);
6164- FREE_CTX();
6165-
6166- CAMLreturn(Val_unit);
6167-}
6168-
6169-value stub_xl_pci_add(value info, value domid)
6170-{
6171- CAMLparam2(info, domid);
6172- libxl_device_pci c_info;
6173- int ret;
6174- INIT_STRUCT();
6175-
6176- device_pci_val(&gc, &c_info, info);
6177-
6178- INIT_CTX();
6179- ret = libxl_device_pci_add(&ctx, Int_val(domid), &c_info);
6180- if (ret != 0)
6181- failwith_xl("pci_add", &lg);
6182- FREE_CTX();
6183-
6184- CAMLreturn(Val_unit);
6185-}
6186-
6187-value stub_xl_pci_remove(value info, value domid)
6188-{
6189- CAMLparam2(info, domid);
6190- libxl_device_pci c_info;
6191- int ret;
6192- INIT_STRUCT();
6193-
6194- device_pci_val(&gc, &c_info, info);
6195-
6196- INIT_CTX();
6197- ret = libxl_device_pci_remove(&ctx, Int_val(domid), &c_info, 0);
6198- if (ret != 0)
6199- failwith_xl("pci_remove", &lg);
6200- FREE_CTX();
6201-
6202- CAMLreturn(Val_unit);
6203-}
6204-
6205-value stub_xl_pci_shutdown(value domid)
6206-{
6207- CAMLparam1(domid);
6208- int ret;
6209- INIT_STRUCT();
6210-
6211- INIT_CTX();
6212- ret = libxl_device_pci_shutdown(&ctx, Int_val(domid));
6213- if (ret != 0)
6214- failwith_xl("pci_shutdown", &lg);
6215- FREE_CTX();
6216-
6217- CAMLreturn(Val_unit);
6218-}
6219-
6220-value stub_xl_button_press(value domid, value button)
6221-{
6222- CAMLparam2(domid, button);
6223- int ret;
6224- INIT_STRUCT();
6225-
6226- INIT_CTX();
6227- ret = libxl_button_press(&ctx, Int_val(domid), Int_val(button) + POWER_BUTTON);
6228- if (ret != 0)
6229- failwith_xl("button_press", &lg);
6230- FREE_CTX();
6231-
6232- CAMLreturn(Val_unit);
6233-}
6234-
6235-value stub_xl_physinfo(value unit)
6236-{
6237- CAMLparam1(unit);
6238- CAMLlocal1(physinfo);
6239- libxl_physinfo c_physinfo;
6240- int ret;
6241- INIT_STRUCT();
6242-
6243- INIT_CTX();
6244- ret = libxl_get_physinfo(&ctx, &c_physinfo);
6245- if (ret != 0)
6246- failwith_xl("physinfo", &lg);
6247- FREE_CTX();
6248-
6249- physinfo = Val_physinfo(&c_physinfo);
6250- CAMLreturn(physinfo);
6251-}
6252-
6253-value stub_xl_sched_credit_domain_get(value domid)
6254-{
6255- CAMLparam1(domid);
6256- CAMLlocal1(scinfo);
6257- libxl_sched_credit c_scinfo;
6258- int ret;
6259- INIT_STRUCT();
6260-
6261- INIT_CTX();
6262- ret = libxl_sched_credit_domain_get(&ctx, Int_val(domid), &c_scinfo);
6263- if (ret != 0)
6264- failwith_xl("sched_credit_domain_get", &lg);
6265- FREE_CTX();
6266-
6267- scinfo = Val_sched_credit(&c_scinfo);
6268- CAMLreturn(scinfo);
6269-}
6270-
6271-value stub_xl_sched_credit_domain_set(value domid, value scinfo)
6272-{
6273- CAMLparam2(domid, scinfo);
6274- libxl_sched_credit c_scinfo;
6275- int ret;
6276- INIT_STRUCT();
6277-
6278- sched_credit_val(&gc, &c_scinfo, scinfo);
6279-
6280- INIT_CTX();
6281- ret = libxl_sched_credit_domain_set(&ctx, Int_val(domid), &c_scinfo);
6282- if (ret != 0)
6283- failwith_xl("sched_credit_domain_set", &lg);
6284- FREE_CTX();
6285-
6286- CAMLreturn(Val_unit);
6287-}
6288-
6289-value stub_xl_send_trigger(value domid, value trigger, value vcpuid)
6290-{
6291- CAMLparam3(domid, trigger, vcpuid);
6292- int ret;
6293- char *c_trigger;
6294- INIT_STRUCT();
6295-
6296- c_trigger = dup_String_val(&gc, trigger);
6297-
6298- INIT_CTX();
6299- ret = libxl_send_trigger(&ctx, Int_val(domid), c_trigger, Int_val(vcpuid));
6300- if (ret != 0)
6301- failwith_xl("send_trigger", &lg);
6302- FREE_CTX();
6303- CAMLreturn(Val_unit);
6304-}
6305-
6306-value stub_xl_send_sysrq(value domid, value sysrq)
6307-{
6308- CAMLparam2(domid, sysrq);
6309- int ret;
6310- INIT_STRUCT();
6311-
6312- INIT_CTX();
6313- ret = libxl_send_sysrq(&ctx, Int_val(domid), Int_val(sysrq));
6314- if (ret != 0)
6315- failwith_xl("send_sysrq", &lg);
6316- FREE_CTX();
6317- CAMLreturn(Val_unit);
6318-}
6319-
6320-value stub_xl_send_debug_keys(value keys)
6321-{
6322- CAMLparam1(keys);
6323- int ret;
6324- char *c_keys;
6325- INIT_STRUCT();
6326-
6327- c_keys = dup_String_val(&gc, keys);
6328-
6329- INIT_CTX();
6330- ret = libxl_send_debug_keys(&ctx, c_keys);
6331- if (ret != 0)
6332- failwith_xl("send_debug_keys", &lg);
6333- FREE_CTX();
6334- CAMLreturn(Val_unit);
6335-}
6336-
6337-/*
6338- * Local variables:
6339- * indent-tabs-mode: t
6340- * c-basic-offset: 8
6341- * tab-width: 8
6342- * End:
6343- */
6344--- a/tools/ocaml/libs/xs/META.in
6345+++ b/tools/ocaml/libs/xs/META.in
6346@@ -1,5 +1,5 @@
6347 version = "@VERSION@"
6348 description = "XenStore Interface"
6349-requires = "unix,xb"
6350-archive(byte) = "xs.cma"
6351-archive(native) = "xs.cmxa"
6352+requires = "unix,xenbus"
6353+archive(byte) = "xenstore.cma"
6354+archive(native) = "xenstore.cmxa"
6355--- a/tools/ocaml/libs/xs/Makefile
6356+++ b/tools/ocaml/libs/xs/Makefile
6357@@ -3,6 +3,7 @@
6358 include $(TOPLEVEL)/common.make
6359
6360 OCAMLINCLUDE += -I ../xb/
6361+OCAMLOPTFLAGS += -for-pack Xenstore
6362
6363 .NOTPARALLEL:
6364 # Ocaml is such a PITA!
6365@@ -12,7 +13,7 @@
6366 PRELIBS = $(foreach obj, $(PREOBJS),$(obj).cmo) $(foreach obj,$(PREOJBS),$(obj).cmx)
6367 OBJS = queueop xsraw xst xs
6368 INTF = xsraw.cmi xst.cmi xs.cmi
6369-LIBS = xs.cma xs.cmxa
6370+LIBS = xenstore.cma xenstore.cmxa
6371
6372 all: $(PREINTF) $(PRELIBS) $(INTF) $(LIBS) $(PROGRAMS)
6373
6374@@ -20,26 +21,26 @@
6375
6376 libs: $(LIBS)
6377
6378-xs_OBJS = $(OBJS)
6379-OCAML_NOC_LIBRARY = xs
6380+xenstore_OBJS = xenstore
6381+OCAML_NOC_LIBRARY = xenstore
6382
6383-#xs.cmxa: $(foreach obj,$(OBJS),$(obj).cmx)
6384-# $(E) " MLLIB $@"
6385-# $(Q)$(OCAMLOPT) $(OCAMLOPTFLAGS) -a -o $@ $(foreach obj,$(OBJS),$(obj).cmx)
6386-#
6387-#xs.cma: $(foreach obj,$(OBJS),$(obj).cmo)
6388-# $(E) " MLLIB $@"
6389-# $(Q)$(OCAMLC) -a -o $@ $(foreach obj,$(OBJS),$(obj).cmo)
6390+xenstore.cmx : $(foreach obj, $(OBJS), $(obj).cmx)
6391+ $(E) " CMX $@"
6392+ $(Q)$(OCAMLOPT) -pack -o $@ $^
6393+
6394+xenstore.cmo : $(foreach obj, $(OBJS), $(obj).cmo)
6395+ $(E) " CMO $@"
6396+ $(Q)$(OCAMLC) -pack -o $@ $^
6397
6398 .PHONY: install
6399 install: $(LIBS) META
6400 mkdir -p $(OCAMLDESTDIR)
6401- ocamlfind remove -destdir $(OCAMLDESTDIR) xs
6402- ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xs META $(INTF) xs.mli xst.mli xsraw.mli $(LIBS) *.a *.cmx
6403+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore
6404+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenstore META $(LIBS) xenstore.cmx xenstore.cmi *.a
6405
6406 .PHONY: uninstall
6407 uninstall:
6408- ocamlfind remove -destdir $(OCAMLDESTDIR) xs
6409+ ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore
6410
6411 include $(TOPLEVEL)/Makefile.rules
6412
6413--- a/tools/ocaml/libs/xs/queueop.ml
6414+++ b/tools/ocaml/libs/xs/queueop.ml
6415@@ -13,6 +13,7 @@
6416 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6417 * GNU Lesser General Public License for more details.
6418 *)
6419+open Xenbus
6420
6421 let data_concat ls = (String.concat "\000" ls) ^ "\000"
6422 let queue_path ty (tid: int) (path: string) con =
6423--- a/tools/ocaml/libs/xs/xs.ml
6424+++ b/tools/ocaml/libs/xs/xs.ml
6425@@ -69,7 +69,7 @@
6426 let read_watchevent xsh = Xsraw.read_watchevent xsh.con
6427
6428 let make fd = get_operations (Xsraw.open_fd fd)
6429-let get_fd xsh = Xb.get_fd xsh.con.Xsraw.xb
6430+let get_fd xsh = Xenbus.Xb.get_fd xsh.con.Xsraw.xb
6431
6432 exception Timeout
6433
6434--- a/tools/ocaml/libs/xs/xsraw.ml
6435+++ b/tools/ocaml/libs/xs/xsraw.ml
6436@@ -14,6 +14,8 @@
6437 * GNU Lesser General Public License for more details.
6438 *)
6439
6440+open Xenbus
6441+
6442 exception Partial_not_empty
6443 exception Unexpected_packet of string
6444
6445@@ -27,7 +29,7 @@
6446 raise (Unexpected_packet s)
6447
6448 type con = {
6449- xb: Xb.t;
6450+ xb: Xenbus.Xb.t;
6451 watchevents: (string * string) Queue.t;
6452 }
6453
6454--- a/tools/ocaml/libs/xs/xsraw.mli
6455+++ b/tools/ocaml/libs/xs/xsraw.mli
6456@@ -16,8 +16,8 @@
6457 exception Partial_not_empty
6458 exception Unexpected_packet of string
6459 exception Invalid_path of string
6460-val unexpected_packet : Xb.Op.operation -> Xb.Op.operation -> 'a
6461-type con = { xb : Xb.t; watchevents : (string * string) Queue.t; }
6462+val unexpected_packet : Xenbus.Xb.Op.operation -> Xenbus.Xb.Op.operation -> 'a
6463+type con = { xb : Xenbus.Xb.t; watchevents : (string * string) Queue.t; }
6464 val close : con -> unit
6465 val open_fd : Unix.file_descr -> con
6466 val split_string : ?limit:int -> char -> string -> string list
6467@@ -26,14 +26,14 @@
6468 val string_of_perms : int * perm * (int * perm) list -> string
6469 val perms_of_string : string -> int * perm * (int * perm) list
6470 val pkt_send : con -> unit
6471-val pkt_recv : con -> Xb.Packet.t
6472-val pkt_recv_timeout : con -> float -> bool * Xb.Packet.t option
6473+val pkt_recv : con -> Xenbus.Xb.Packet.t
6474+val pkt_recv_timeout : con -> float -> bool * Xenbus.Xb.Packet.t option
6475 val queue_watchevent : con -> string -> unit
6476 val has_watchevents : con -> bool
6477 val get_watchevent : con -> string * string
6478 val read_watchevent : con -> string * string
6479-val sync_recv : Xb.Op.operation -> con -> string
6480-val sync : (Xb.t -> 'a) -> con -> string
6481+val sync_recv : Xenbus.Xb.Op.operation -> con -> string
6482+val sync : (Xenbus.Xb.t -> 'a) -> con -> string
6483 val ack : string -> unit
6484 val validate_path : string -> unit
6485 val validate_watch_path : string -> unit
6486--- a/tools/ocaml/xenstored/Makefile
6487+++ b/tools/ocaml/xenstored/Makefile
6488@@ -35,11 +35,11 @@
6489 XENSTOREDLIBS = \
6490 unix.cmxa \
6491 $(OCAML_TOPLEVEL)/libs/uuid/uuid.cmxa \
6492- -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/mmap.cmxa \
6493+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \
6494 -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \
6495- -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/eventchn.cmxa \
6496- -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xc.cmxa \
6497- -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xb.cmxa \
6498+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \
6499+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xenctrl.cmxa \
6500+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xenbus.cmxa \
6501 -ccopt -L -ccopt $(XEN_ROOT)/tools/libxc
6502
6503 PROGRAMS = oxenstored
6504--- a/tools/ocaml/xenstored/connection.ml
6505+++ b/tools/ocaml/xenstored/connection.ml
6506@@ -27,7 +27,7 @@
6507 }
6508
6509 and t = {
6510- xb: Xb.t;
6511+ xb: Xenbus.Xb.t;
6512 dom: Domain.t option;
6513 transactions: (int, Transaction.t) Hashtbl.t;
6514 mutable next_tid: int;
6515@@ -93,10 +93,10 @@
6516 Logging.new_connection ~tid:Transaction.none ~con:(get_domstr con);
6517 con
6518
6519-let get_fd con = Xb.get_fd con.xb
6520+let get_fd con = Xenbus.Xb.get_fd con.xb
6521 let close con =
6522 Logging.end_connection ~tid:Transaction.none ~con:(get_domstr con);
6523- Xb.close con.xb
6524+ Xenbus.Xb.close con.xb
6525
6526 let get_perm con =
6527 con.perm
6528@@ -108,9 +108,9 @@
6529 con.perm <- Perms.Connection.set_target (get_perm con) ~perms:[Perms.READ; Perms.WRITE] target_domid
6530
6531 let send_reply con tid rid ty data =
6532- Xb.queue con.xb (Xb.Packet.create tid rid ty data)
6533+ Xenbus.Xb.queue con.xb (Xenbus.Xb.Packet.create tid rid ty data)
6534
6535-let send_error con tid rid err = send_reply con tid rid Xb.Op.Error (err ^ "\000")
6536+let send_error con tid rid err = send_reply con tid rid Xenbus.Xb.Op.Error (err ^ "\000")
6537 let send_ack con tid rid ty = send_reply con tid rid ty "OK\000"
6538
6539 let get_watch_path con path =
6540@@ -166,7 +166,7 @@
6541
6542 let fire_single_watch watch =
6543 let data = Utils.join_by_null [watch.path; watch.token; ""] in
6544- send_reply watch.con Transaction.none 0 Xb.Op.Watchevent data
6545+ send_reply watch.con Transaction.none 0 Xenbus.Xb.Op.Watchevent data
6546
6547 let fire_watch watch path =
6548 let new_path =
6549@@ -179,7 +179,7 @@
6550 path
6551 in
6552 let data = Utils.join_by_null [ new_path; watch.token; "" ] in
6553- send_reply watch.con Transaction.none 0 Xb.Op.Watchevent data
6554+ send_reply watch.con Transaction.none 0 Xenbus.Xb.Op.Watchevent data
6555
6556 let find_next_tid con =
6557 let ret = con.next_tid in con.next_tid <- con.next_tid + 1; ret
6558@@ -203,15 +203,15 @@
6559 let get_transaction con tid =
6560 Hashtbl.find con.transactions tid
6561
6562-let do_input con = Xb.input con.xb
6563-let has_input con = Xb.has_in_packet con.xb
6564-let pop_in con = Xb.get_in_packet con.xb
6565-let has_more_input con = Xb.has_more_input con.xb
6566-
6567-let has_output con = Xb.has_output con.xb
6568-let has_new_output con = Xb.has_new_output con.xb
6569-let peek_output con = Xb.peek_output con.xb
6570-let do_output con = Xb.output con.xb
6571+let do_input con = Xenbus.Xb.input con.xb
6572+let has_input con = Xenbus.Xb.has_in_packet con.xb
6573+let pop_in con = Xenbus.Xb.get_in_packet con.xb
6574+let has_more_input con = Xenbus.Xb.has_more_input con.xb
6575+
6576+let has_output con = Xenbus.Xb.has_output con.xb
6577+let has_new_output con = Xenbus.Xb.has_new_output con.xb
6578+let peek_output con = Xenbus.Xb.peek_output con.xb
6579+let do_output con = Xenbus.Xb.output con.xb
6580
6581 let incr_ops con = con.stat_nb_ops <- con.stat_nb_ops + 1
6582
6583--- a/tools/ocaml/xenstored/connections.ml
6584+++ b/tools/ocaml/xenstored/connections.ml
6585@@ -26,12 +26,12 @@
6586 let create () = { anonymous = []; domains = Hashtbl.create 8; watches = Trie.create () }
6587
6588 let add_anonymous cons fd can_write =
6589- let xbcon = Xb.open_fd fd in
6590+ let xbcon = Xenbus.Xb.open_fd fd in
6591 let con = Connection.create xbcon None in
6592 cons.anonymous <- con :: cons.anonymous
6593
6594 let add_domain cons dom =
6595- let xbcon = Xb.open_mmap (Domain.get_interface dom) (fun () -> Domain.notify dom) in
6596+ let xbcon = Xenbus.Xb.open_mmap (Domain.get_interface dom) (fun () -> Domain.notify dom) in
6597 let con = Connection.create xbcon (Some dom) in
6598 Hashtbl.add cons.domains (Domain.get_id dom) con
6599
6600--- a/tools/ocaml/xenstored/domain.ml
6601+++ b/tools/ocaml/xenstored/domain.ml
6602@@ -20,10 +20,10 @@
6603
6604 type t =
6605 {
6606- id: Xc.domid;
6607+ id: Xenctrl.domid;
6608 mfn: nativeint;
6609 remote_port: int;
6610- interface: Mmap.mmap_interface;
6611+ interface: Xenmmap.mmap_interface;
6612 eventchn: Event.t;
6613 mutable port: int;
6614 }
6615@@ -47,7 +47,7 @@
6616 let close dom =
6617 debug "domain %d unbound port %d" dom.id dom.port;
6618 Event.unbind dom.eventchn dom.port;
6619- Mmap.unmap dom.interface;
6620+ Xenmmap.unmap dom.interface;
6621 ()
6622
6623 let make id mfn remote_port interface eventchn = {
6624--- a/tools/ocaml/xenstored/domains.ml
6625+++ b/tools/ocaml/xenstored/domains.ml
6626@@ -16,7 +16,7 @@
6627
6628 type domains = {
6629 eventchn: Event.t;
6630- table: (Xc.domid, Domain.t) Hashtbl.t;
6631+ table: (Xenctrl.domid, Domain.t) Hashtbl.t;
6632 }
6633
6634 let init eventchn =
6635@@ -33,16 +33,16 @@
6636
6637 Hashtbl.iter (fun id _ -> if id <> 0 then
6638 try
6639- let info = Xc.domain_getinfo xc id in
6640- if info.Xc.shutdown || info.Xc.dying then (
6641+ let info = Xenctrl.domain_getinfo xc id in
6642+ if info.Xenctrl.shutdown || info.Xenctrl.dying then (
6643 Logs.debug "general" "Domain %u died (dying=%b, shutdown %b -- code %d)"
6644- id info.Xc.dying info.Xc.shutdown info.Xc.shutdown_code;
6645- if info.Xc.dying then
6646+ id info.Xenctrl.dying info.Xenctrl.shutdown info.Xenctrl.shutdown_code;
6647+ if info.Xenctrl.dying then
6648 dead_dom := id :: !dead_dom
6649 else
6650 notify := true;
6651 )
6652- with Xc.Error _ ->
6653+ with Xenctrl.Error _ ->
6654 Logs.debug "general" "Domain %u died -- no domain info" id;
6655 dead_dom := id :: !dead_dom;
6656 ) doms.table;
6657@@ -57,7 +57,7 @@
6658 ()
6659
6660 let create xc doms domid mfn port =
6661- let interface = Xc.map_foreign_range xc domid (Mmap.getpagesize()) mfn in
6662+ let interface = Xenctrl.map_foreign_range xc domid (Xenmmap.getpagesize()) mfn in
6663 let dom = Domain.make domid mfn port interface doms.eventchn in
6664 Hashtbl.add doms.table domid dom;
6665 Domain.bind_interdomain dom;
6666@@ -66,13 +66,13 @@
6667 let create0 fake doms =
6668 let port, interface =
6669 if fake then (
6670- 0, Xc.with_intf (fun xc -> Xc.map_foreign_range xc 0 (Mmap.getpagesize()) 0n)
6671+ 0, Xenctrl.with_intf (fun xc -> Xenctrl.map_foreign_range xc 0 (Xenmmap.getpagesize()) 0n)
6672 ) else (
6673 let port = Utils.read_file_single_integer Define.xenstored_proc_port
6674 and fd = Unix.openfile Define.xenstored_proc_kva
6675 [ Unix.O_RDWR ] 0o600 in
6676- let interface = Mmap.mmap fd Mmap.RDWR Mmap.SHARED
6677- (Mmap.getpagesize()) 0 in
6678+ let interface = Xenmmap.mmap fd Xenmmap.RDWR Xenmmap.SHARED
6679+ (Xenmmap.getpagesize()) 0 in
6680 Unix.close fd;
6681 port, interface
6682 )
6683--- a/tools/ocaml/xenstored/event.ml
6684+++ b/tools/ocaml/xenstored/event.ml
6685@@ -16,15 +16,15 @@
6686
6687 (**************** high level binding ****************)
6688 type t = {
6689- handle: Eventchn.handle;
6690+ handle: Xeneventchn.handle;
6691 mutable virq_port: int;
6692 }
6693
6694-let init () = { handle = Eventchn.init (); virq_port = -1; }
6695-let fd eventchn = Eventchn.fd eventchn.handle
6696-let bind_dom_exc_virq eventchn = eventchn.virq_port <- Eventchn.bind_dom_exc_virq eventchn.handle
6697-let bind_interdomain eventchn domid port = Eventchn.bind_interdomain eventchn.handle domid port
6698-let unbind eventchn port = Eventchn.unbind eventchn.handle port
6699-let notify eventchn port = Eventchn.notify eventchn.handle port
6700-let pending eventchn = Eventchn.pending eventchn.handle
6701-let unmask eventchn port = Eventchn.unmask eventchn.handle port
6702+let init () = { handle = Xeneventchn.init (); virq_port = -1; }
6703+let fd eventchn = Xeneventchn.fd eventchn.handle
6704+let bind_dom_exc_virq eventchn = eventchn.virq_port <- Xeneventchn.bind_dom_exc_virq eventchn.handle
6705+let bind_interdomain eventchn domid port = Xeneventchn.bind_interdomain eventchn.handle domid port
6706+let unbind eventchn port = Xeneventchn.unbind eventchn.handle port
6707+let notify eventchn port = Xeneventchn.notify eventchn.handle port
6708+let pending eventchn = Xeneventchn.pending eventchn.handle
6709+let unmask eventchn port = Xeneventchn.unmask eventchn.handle port
6710--- a/tools/ocaml/xenstored/logging.ml
6711+++ b/tools/ocaml/xenstored/logging.ml
6712@@ -39,7 +39,7 @@
6713 | Commit
6714 | Newconn
6715 | Endconn
6716- | XbOp of Xb.Op.operation
6717+ | XbOp of Xenbus.Xb.Op.operation
6718
6719 type access =
6720 {
6721@@ -82,35 +82,35 @@
6722 | Endconn -> "endconn "
6723
6724 | XbOp op -> match op with
6725- | Xb.Op.Debug -> "debug "
6726+ | Xenbus.Xb.Op.Debug -> "debug "
6727
6728- | Xb.Op.Directory -> "directory"
6729- | Xb.Op.Read -> "read "
6730- | Xb.Op.Getperms -> "getperms "
6731-
6732- | Xb.Op.Watch -> "watch "
6733- | Xb.Op.Unwatch -> "unwatch "
6734-
6735- | Xb.Op.Transaction_start -> "t start "
6736- | Xb.Op.Transaction_end -> "t end "
6737-
6738- | Xb.Op.Introduce -> "introduce"
6739- | Xb.Op.Release -> "release "
6740- | Xb.Op.Getdomainpath -> "getdomain"
6741- | Xb.Op.Isintroduced -> "is introduced"
6742- | Xb.Op.Resume -> "resume "
6743+ | Xenbus.Xb.Op.Directory -> "directory"
6744+ | Xenbus.Xb.Op.Read -> "read "
6745+ | Xenbus.Xb.Op.Getperms -> "getperms "
6746+
6747+ | Xenbus.Xb.Op.Watch -> "watch "
6748+ | Xenbus.Xb.Op.Unwatch -> "unwatch "
6749+
6750+ | Xenbus.Xb.Op.Transaction_start -> "t start "
6751+ | Xenbus.Xb.Op.Transaction_end -> "t end "
6752+
6753+ | Xenbus.Xb.Op.Introduce -> "introduce"
6754+ | Xenbus.Xb.Op.Release -> "release "
6755+ | Xenbus.Xb.Op.Getdomainpath -> "getdomain"
6756+ | Xenbus.Xb.Op.Isintroduced -> "is introduced"
6757+ | Xenbus.Xb.Op.Resume -> "resume "
6758
6759- | Xb.Op.Write -> "write "
6760- | Xb.Op.Mkdir -> "mkdir "
6761- | Xb.Op.Rm -> "rm "
6762- | Xb.Op.Setperms -> "setperms "
6763- | Xb.Op.Restrict -> "restrict "
6764- | Xb.Op.Set_target -> "settarget"
6765+ | Xenbus.Xb.Op.Write -> "write "
6766+ | Xenbus.Xb.Op.Mkdir -> "mkdir "
6767+ | Xenbus.Xb.Op.Rm -> "rm "
6768+ | Xenbus.Xb.Op.Setperms -> "setperms "
6769+ | Xenbus.Xb.Op.Restrict -> "restrict "
6770+ | Xenbus.Xb.Op.Set_target -> "settarget"
6771
6772- | Xb.Op.Error -> "error "
6773- | Xb.Op.Watchevent -> "w event "
6774+ | Xenbus.Xb.Op.Error -> "error "
6775+ | Xenbus.Xb.Op.Watchevent -> "w event "
6776
6777- | x -> Xb.Op.to_string x
6778+ | x -> Xenbus.Xb.Op.to_string x
6779
6780 let file_exists file =
6781 try
6782@@ -210,10 +210,10 @@
6783 let xb_op ~tid ~con ~ty data =
6784 let print =
6785 match ty with
6786- | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !log_read_ops
6787- | Xb.Op.Transaction_start | Xb.Op.Transaction_end ->
6788+ | Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !log_read_ops
6789+ | Xenbus.Xb.Op.Transaction_start | Xenbus.Xb.Op.Transaction_end ->
6790 false (* transactions are managed below *)
6791- | Xb.Op.Introduce | Xb.Op.Release | Xb.Op.Getdomainpath | Xb.Op.Isintroduced | Xb.Op.Resume ->
6792+ | Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume ->
6793 !log_special_ops
6794 | _ -> true
6795 in
6796@@ -222,17 +222,17 @@
6797
6798 let start_transaction ~tid ~con =
6799 if !log_transaction_ops && tid <> 0
6800- then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_start)
6801+ then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start)
6802
6803 let end_transaction ~tid ~con =
6804 if !log_transaction_ops && tid <> 0
6805- then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_end)
6806+ then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end)
6807
6808 let xb_answer ~tid ~con ~ty data =
6809 let print = match ty with
6810- | Xb.Op.Error when data="ENOENT " -> !log_read_ops
6811- | Xb.Op.Error -> !log_special_ops
6812- | Xb.Op.Watchevent -> true
6813+ | Xenbus.Xb.Op.Error when data="ENOENT " -> !log_read_ops
6814+ | Xenbus.Xb.Op.Error -> !log_special_ops
6815+ | Xenbus.Xb.Op.Watchevent -> true
6816 | _ -> false
6817 in
6818 if print
6819--- a/tools/ocaml/xenstored/perms.ml
6820+++ b/tools/ocaml/xenstored/perms.ml
6821@@ -43,9 +43,9 @@
6822
6823 type t =
6824 {
6825- owner: Xc.domid;
6826+ owner: Xenctrl.domid;
6827 other: permty;
6828- acl: (Xc.domid * permty) list;
6829+ acl: (Xenctrl.domid * permty) list;
6830 }
6831
6832 let create owner other acl =
6833@@ -88,7 +88,7 @@
6834 module Connection =
6835 struct
6836
6837-type elt = Xc.domid * (permty list)
6838+type elt = Xenctrl.domid * (permty list)
6839 type t =
6840 { main: elt;
6841 target: elt option; }
6842--- a/tools/ocaml/xenstored/process.ml
6843+++ b/tools/ocaml/xenstored/process.ml
6844@@ -54,10 +54,10 @@
6845 let process_watch ops cons =
6846 let do_op_watch op cons =
6847 let recurse = match (fst op) with
6848- | Xb.Op.Write -> false
6849- | Xb.Op.Mkdir -> false
6850- | Xb.Op.Rm -> true
6851- | Xb.Op.Setperms -> false
6852+ | Xenbus.Xb.Op.Write -> false
6853+ | Xenbus.Xb.Op.Mkdir -> false
6854+ | Xenbus.Xb.Op.Rm -> true
6855+ | Xenbus.Xb.Op.Setperms -> false
6856 | _ -> raise (Failure "huh ?") in
6857 Connections.fire_watches cons (snd op) recurse in
6858 List.iter (fun op -> do_op_watch op cons) ops
6859@@ -83,7 +83,7 @@
6860 then None
6861 else try match split None '\000' data with
6862 | "print" :: msg :: _ ->
6863- Logging.xb_op ~tid:0 ~ty:Xb.Op.Debug ~con:"=======>" msg;
6864+ Logging.xb_op ~tid:0 ~ty:Xenbus.Xb.Op.Debug ~con:"=======>" msg;
6865 None
6866 | "quota" :: domid :: _ ->
6867 let domid = int_of_string domid in
6868@@ -120,7 +120,7 @@
6869 | _ -> raise Invalid_Cmd_Args
6870 in
6871 let watch = Connections.add_watch cons con node token in
6872- Connection.send_ack con (Transaction.get_id t) rid Xb.Op.Watch;
6873+ Connection.send_ack con (Transaction.get_id t) rid Xenbus.Xb.Op.Watch;
6874 Connection.fire_single_watch watch
6875
6876 let do_unwatch con t domains cons data =
6877@@ -165,7 +165,7 @@
6878 if Domains.exist domains domid then
6879 Domains.find domains domid
6880 else try
6881- let ndom = Xc.with_intf (fun xc ->
6882+ let ndom = Xenctrl.with_intf (fun xc ->
6883 Domains.create xc domains domid mfn port) in
6884 Connections.add_domain cons ndom;
6885 Connections.fire_spec_watches cons "@introduceDomain";
6886@@ -299,25 +299,25 @@
6887
6888 let function_of_type ty =
6889 match ty with
6890- | Xb.Op.Debug -> reply_data_or_ack do_debug
6891- | Xb.Op.Directory -> reply_data do_directory
6892- | Xb.Op.Read -> reply_data do_read
6893- | Xb.Op.Getperms -> reply_data do_getperms
6894- | Xb.Op.Watch -> reply_none do_watch
6895- | Xb.Op.Unwatch -> reply_ack do_unwatch
6896- | Xb.Op.Transaction_start -> reply_data do_transaction_start
6897- | Xb.Op.Transaction_end -> reply_ack do_transaction_end
6898- | Xb.Op.Introduce -> reply_ack do_introduce
6899- | Xb.Op.Release -> reply_ack do_release
6900- | Xb.Op.Getdomainpath -> reply_data do_getdomainpath
6901- | Xb.Op.Write -> reply_ack do_write
6902- | Xb.Op.Mkdir -> reply_ack do_mkdir
6903- | Xb.Op.Rm -> reply_ack do_rm
6904- | Xb.Op.Setperms -> reply_ack do_setperms
6905- | Xb.Op.Isintroduced -> reply_data do_isintroduced
6906- | Xb.Op.Resume -> reply_ack do_resume
6907- | Xb.Op.Set_target -> reply_ack do_set_target
6908- | Xb.Op.Restrict -> reply_ack do_restrict
6909+ | Xenbus.Xb.Op.Debug -> reply_data_or_ack do_debug
6910+ | Xenbus.Xb.Op.Directory -> reply_data do_directory
6911+ | Xenbus.Xb.Op.Read -> reply_data do_read
6912+ | Xenbus.Xb.Op.Getperms -> reply_data do_getperms
6913+ | Xenbus.Xb.Op.Watch -> reply_none do_watch
6914+ | Xenbus.Xb.Op.Unwatch -> reply_ack do_unwatch
6915+ | Xenbus.Xb.Op.Transaction_start -> reply_data do_transaction_start
6916+ | Xenbus.Xb.Op.Transaction_end -> reply_ack do_transaction_end
6917+ | Xenbus.Xb.Op.Introduce -> reply_ack do_introduce
6918+ | Xenbus.Xb.Op.Release -> reply_ack do_release
6919+ | Xenbus.Xb.Op.Getdomainpath -> reply_data do_getdomainpath
6920+ | Xenbus.Xb.Op.Write -> reply_ack do_write
6921+ | Xenbus.Xb.Op.Mkdir -> reply_ack do_mkdir
6922+ | Xenbus.Xb.Op.Rm -> reply_ack do_rm
6923+ | Xenbus.Xb.Op.Setperms -> reply_ack do_setperms
6924+ | Xenbus.Xb.Op.Isintroduced -> reply_data do_isintroduced
6925+ | Xenbus.Xb.Op.Resume -> reply_ack do_resume
6926+ | Xenbus.Xb.Op.Set_target -> reply_ack do_set_target
6927+ | Xenbus.Xb.Op.Restrict -> reply_ack do_restrict
6928 | _ -> reply_ack do_error
6929
6930 let input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data =
6931@@ -370,11 +370,11 @@
6932 let do_input store cons doms con =
6933 if Connection.do_input con then (
6934 let packet = Connection.pop_in con in
6935- let tid, rid, ty, data = Xb.Packet.unpack packet in
6936+ let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in
6937 (* As we don't log IO, do not call an unnecessary sanitize_data
6938 Logs.info "io" "[%s] -> [%d] %s \"%s\""
6939 (Connection.get_domstr con) tid
6940- (Xb.Op.to_string ty) (sanitize_data data); *)
6941+ (Xenbus.Xb.Op.to_string ty) (sanitize_data data); *)
6942 process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data;
6943 write_access_log ~ty ~tid ~con ~data;
6944 Connection.incr_ops con;
6945@@ -384,11 +384,11 @@
6946 if Connection.has_output con then (
6947 if Connection.has_new_output con then (
6948 let packet = Connection.peek_output con in
6949- let tid, rid, ty, data = Xb.Packet.unpack packet in
6950+ let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in
6951 (* As we don't log IO, do not call an unnecessary sanitize_data
6952 Logs.info "io" "[%s] <- %s \"%s\""
6953 (Connection.get_domstr con)
6954- (Xb.Op.to_string ty) (sanitize_data data);*)
6955+ (Xenbus.Xb.Op.to_string ty) (sanitize_data data);*)
6956 write_answer_log ~ty ~tid ~con ~data;
6957 );
6958 ignore (Connection.do_output con)
6959--- a/tools/ocaml/xenstored/quota.ml
6960+++ b/tools/ocaml/xenstored/quota.ml
6961@@ -26,7 +26,7 @@
6962 type t = {
6963 maxent: int; (* max entities per domU *)
6964 maxsize: int; (* max size of data store in one node *)
6965- cur: (Xc.domid, int) Hashtbl.t; (* current domains quota *)
6966+ cur: (Xenctrl.domid, int) Hashtbl.t; (* current domains quota *)
6967 }
6968
6969 let to_string quota domid =
6970--- a/tools/ocaml/xenstored/transaction.ml
6971+++ b/tools/ocaml/xenstored/transaction.ml
6972@@ -74,7 +74,7 @@
6973 type t = {
6974 ty: ty;
6975 store: Store.t;
6976- mutable ops: (Xb.Op.operation * Store.Path.t) list;
6977+ mutable ops: (Xenbus.Xb.Op.operation * Store.Path.t) list;
6978 mutable read_lowpath: Store.Path.t option;
6979 mutable write_lowpath: Store.Path.t option;
6980 }
6981@@ -105,23 +105,23 @@
6982 if path_exists
6983 then set_write_lowpath t path
6984 else set_write_lowpath t (Store.Path.get_parent path);
6985- add_wop t Xb.Op.Write path
6986+ add_wop t Xenbus.Xb.Op.Write path
6987
6988 let mkdir ?(with_watch=true) t perm path =
6989 Store.mkdir t.store perm path;
6990 set_write_lowpath t path;
6991 if with_watch then
6992- add_wop t Xb.Op.Mkdir path
6993+ add_wop t Xenbus.Xb.Op.Mkdir path
6994
6995 let setperms t perm path perms =
6996 Store.setperms t.store perm path perms;
6997 set_write_lowpath t path;
6998- add_wop t Xb.Op.Setperms path
6999+ add_wop t Xenbus.Xb.Op.Setperms path
7000
7001 let rm t perm path =
7002 Store.rm t.store perm path;
7003 set_write_lowpath t (Store.Path.get_parent path);
7004- add_wop t Xb.Op.Rm path
7005+ add_wop t Xenbus.Xb.Op.Rm path
7006
7007 let ls t perm path =
7008 let r = Store.ls t.store perm path in
7009--- a/tools/ocaml/xenstored/xenstored.ml
7010+++ b/tools/ocaml/xenstored/xenstored.ml
7011@@ -35,7 +35,7 @@
7012 if err <> Unix.ECONNRESET then
7013 error "closing socket connection: read error: %s"
7014 (Unix.error_message err)
7015- | Xb.End_of_file ->
7016+ | Xenbus.Xb.End_of_file ->
7017 Connections.del_anonymous cons c;
7018 debug "closing socket connection"
7019 in
7020@@ -170,7 +170,7 @@
7021 let from_channel store cons doms chan =
7022 (* don't let the permission get on our way, full perm ! *)
7023 let op = Store.get_ops store Perms.Connection.full_rights in
7024- let xc = Xc.interface_open () in
7025+ let xc = Xenctrl.interface_open () in
7026
7027 let domain_f domid mfn port =
7028 let ndom =
7029@@ -190,7 +190,7 @@
7030 op.Store.setperms path perms
7031 in
7032 finally (fun () -> from_channel_f chan domain_f watch_f store_f)
7033- (fun () -> Xc.interface_close xc)
7034+ (fun () -> Xenctrl.interface_close xc)
7035
7036 let from_file store cons doms file =
7037 let channel = open_in file in
7038@@ -282,7 +282,7 @@
7039 Store.mkdir store (Perms.Connection.create 0) localpath;
7040
7041 if cf.domain_init then (
7042- let usingxiu = Xc.is_fake () in
7043+ let usingxiu = Xenctrl.is_fake () in
7044 Connections.add_domain cons (Domains.create0 usingxiu domains);
7045 Event.bind_dom_exc_virq eventchn
7046 );
7047@@ -301,7 +301,7 @@
7048 (if cf.domain_init then [ Event.fd eventchn ] else [])
7049 in
7050
7051- let xc = Xc.interface_open () in
7052+ let xc = Xenctrl.interface_open () in
7053
7054 let process_special_fds rset =
7055 let accept_connection can_write fd =
7056--- a/tools/ocaml/libs/xl/xl.ml
7057+++ /dev/null
7058@@ -1,213 +0,0 @@
7059-(*
7060- * Copyright (C) 2009-2010 Citrix Ltd.
7061- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
7062- *
7063- * This program is free software; you can redistribute it and/or modify
7064- * it under the terms of the GNU Lesser General Public License as published
7065- * by the Free Software Foundation; version 2.1 only. with the special
7066- * exception on linking described in file LICENSE.
7067- *
7068- * This program is distributed in the hope that it will be useful,
7069- * but WITHOUT ANY WARRANTY; without even the implied warranty of
7070- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
7071- * GNU Lesser General Public License for more details.
7072- *)
7073-
7074-exception Error of string
7075-
7076-type create_info =
7077-{
7078- hvm : bool;
7079- hap : bool;
7080- oos : bool;
7081- ssidref : int32;
7082- name : string;
7083- uuid : int array;
7084- xsdata : (string * string) list;
7085- platformdata : (string * string) list;
7086- poolid : int32;
7087- poolname : string;
7088-}
7089-
7090-type build_pv_info =
7091-{
7092- slack_memkb : int64;
7093- cmdline : string;
7094- ramdisk : string;
7095- features : string;
7096-}
7097-
7098-type build_hvm_info =
7099-{
7100- pae : bool;
7101- apic : bool;
7102- acpi : bool;
7103- nx : bool;
7104- viridian : bool;
7105- timeoffset : string;
7106- timer_mode : int;
7107- hpet : int;
7108- vpt_align : int;
7109-}
7110-
7111-type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info
7112-
7113-type build_info =
7114-{
7115- max_vcpus : int;
7116- cur_vcpus : int;
7117- max_memkb : int64;
7118- target_memkb : int64;
7119- video_memkb : int64;
7120- shadow_memkb : int64;
7121- kernel : string;
7122- priv: build_spec;
7123-}
7124-
7125-type build_state =
7126-{
7127- store_port : int;
7128- store_mfn : int64;
7129- console_port : int;
7130- console_mfn : int64;
7131-}
7132-
7133-type domid = int
7134-
7135-type disk_phystype =
7136- | PHYSTYPE_QCOW
7137- | PHYSTYPE_QCOW2
7138- | PHYSTYPE_VHD
7139- | PHYSTYPE_AIO
7140- | PHYSTYPE_FILE
7141- | PHYSTYPE_PHY
7142-
7143-type disk_info =
7144-{
7145- backend_domid : domid;
7146- physpath : string;
7147- phystype : disk_phystype;
7148- virtpath : string;
7149- unpluggable : bool;
7150- readwrite : bool;
7151- is_cdrom : bool;
7152-}
7153-
7154-type nic_type =
7155- | NICTYPE_IOEMU
7156- | NICTYPE_VIF
7157-
7158-type nic_info =
7159-{
7160- backend_domid : domid;
7161- devid : int;
7162- mtu : int;
7163- model : string;
7164- mac : int array;
7165- bridge : string;
7166- ifname : string;
7167- script : string;
7168- nictype : nic_type;
7169-}
7170-
7171-type console_type =
7172- | CONSOLETYPE_XENCONSOLED
7173- | CONSOLETYPE_IOEMU
7174-
7175-type console_info =
7176-{
7177- backend_domid : domid;
7178- devid : int;
7179- consoletype : console_type;
7180-}
7181-
7182-type vkb_info =
7183-{
7184- backend_domid : domid;
7185- devid : int;
7186-}
7187-
7188-type vfb_info =
7189-{
7190- backend_domid : domid;
7191- devid : int;
7192- vnc : bool;
7193- vnclisten : string;
7194- vncpasswd : string;
7195- vncdisplay : int;
7196- vncunused : bool;
7197- keymap : string;
7198- sdl : bool;
7199- opengl : bool;
7200- display : string;
7201- xauthority : string;
7202-}
7203-
7204-type pci_info =
7205-{
7206- v : int; (* domain * bus * dev * func multiplexed *)
7207- domain : int;
7208- vdevfn : int;
7209- msitranslate : bool;
7210- power_mgmt : bool;
7211-}
7212-
7213-type physinfo =
7214-{
7215- threads_per_core: int;
7216- cores_per_socket: int;
7217- max_cpu_id: int;
7218- nr_cpus: int;
7219- cpu_khz: int;
7220- total_pages: int64;
7221- free_pages: int64;
7222- scrub_pages: int64;
7223- nr_nodes: int;
7224- hwcap: int32 array;
7225- physcap: int32;
7226-}
7227-
7228-type sched_credit =
7229-{
7230- weight: int;
7231- cap: int;
7232-}
7233-
7234-external domain_make : create_info -> domid = "stub_xl_domain_make"
7235-external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build"
7236-
7237-external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add"
7238-external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove"
7239-
7240-external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add"
7241-external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove"
7242-
7243-external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add"
7244-
7245-external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add"
7246-external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown"
7247-external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown"
7248-
7249-external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add"
7250-external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown"
7251-external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown"
7252-
7253-external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add"
7254-external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove"
7255-external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown"
7256-
7257-type button =
7258- | Button_Power
7259- | Button_Sleep
7260-
7261-external button_press : domid -> button -> unit = "stub_xl_button_press"
7262-external physinfo : unit -> physinfo = "stub_xl_physinfo"
7263-
7264-external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get"
7265-external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set"
7266-
7267-external send_trigger : domid -> string -> int -> unit = "stub_xl_send_trigger"
7268-external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
7269-external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys"
7270-
7271-let _ = Callback.register_exception "xl.error" (Error "register_callback")
7272--- a/tools/ocaml/libs/xl/xl.mli
7273+++ /dev/null
7274@@ -1,211 +0,0 @@
7275-(*
7276- * Copyright (C) 2009-2010 Citrix Ltd.
7277- * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
7278- *
7279- * This program is free software; you can redistribute it and/or modify
7280- * it under the terms of the GNU Lesser General Public License as published
7281- * by the Free Software Foundation; version 2.1 only. with the special
7282- * exception on linking described in file LICENSE.
7283- *
7284- * This program is distributed in the hope that it will be useful,
7285- * but WITHOUT ANY WARRANTY; without even the implied warranty of
7286- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
7287- * GNU Lesser General Public License for more details.
7288- *)
7289-
7290-exception Error of string
7291-
7292-type create_info =
7293-{
7294- hvm : bool;
7295- hap : bool;
7296- oos : bool;
7297- ssidref : int32;
7298- name : string;
7299- uuid : int array;
7300- xsdata : (string * string) list;
7301- platformdata : (string * string) list;
7302- poolid : int32;
7303- poolname : string;
7304-}
7305-
7306-type build_pv_info =
7307-{
7308- slack_memkb : int64;
7309- cmdline : string;
7310- ramdisk : string;
7311- features : string;
7312-}
7313-
7314-type build_hvm_info =
7315-{
7316- pae : bool;
7317- apic : bool;
7318- acpi : bool;
7319- nx : bool;
7320- viridian : bool;
7321- timeoffset : string;
7322- timer_mode : int;
7323- hpet : int;
7324- vpt_align : int;
7325-}
7326-
7327-type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info
7328-
7329-type build_info =
7330-{
7331- max_vcpus : int;
7332- cur_vcpus : int;
7333- max_memkb : int64;
7334- target_memkb : int64;
7335- video_memkb : int64;
7336- shadow_memkb : int64;
7337- kernel : string;
7338- priv: build_spec;
7339-}
7340-
7341-type build_state =
7342-{
7343- store_port : int;
7344- store_mfn : int64;
7345- console_port : int;
7346- console_mfn : int64;
7347-}
7348-
7349-type domid = int
7350-
7351-type disk_phystype =
7352- | PHYSTYPE_QCOW
7353- | PHYSTYPE_QCOW2
7354- | PHYSTYPE_VHD
7355- | PHYSTYPE_AIO
7356- | PHYSTYPE_FILE
7357- | PHYSTYPE_PHY
7358-
7359-type disk_info =
7360-{
7361- backend_domid : domid;
7362- physpath : string;
7363- phystype : disk_phystype;
7364- virtpath : string;
7365- unpluggable : bool;
7366- readwrite : bool;
7367- is_cdrom : bool;
7368-}
7369-
7370-type nic_type =
7371- | NICTYPE_IOEMU
7372- | NICTYPE_VIF
7373-
7374-type nic_info =
7375-{
7376- backend_domid : domid;
7377- devid : int;
7378- mtu : int;
7379- model : string;
7380- mac : int array;
7381- bridge : string;
7382- ifname : string;
7383- script : string;
7384- nictype : nic_type;
7385-}
7386-
7387-type console_type =
7388- | CONSOLETYPE_XENCONSOLED
7389- | CONSOLETYPE_IOEMU
7390-
7391-type console_info =
7392-{
7393- backend_domid : domid;
7394- devid : int;
7395- consoletype : console_type;
7396-}
7397-
7398-type vkb_info =
7399-{
7400- backend_domid : domid;
7401- devid : int;
7402-}
7403-
7404-type vfb_info =
7405-{
7406- backend_domid : domid;
7407- devid : int;
7408- vnc : bool;
7409- vnclisten : string;
7410- vncpasswd : string;
7411- vncdisplay : int;
7412- vncunused : bool;
7413- keymap : string;
7414- sdl : bool;
7415- opengl : bool;
7416- display : string;
7417- xauthority : string;
7418-}
7419-
7420-type pci_info =
7421-{
7422- v : int; (* domain * bus * dev * func multiplexed *)
7423- domain : int;
7424- vdevfn : int;
7425- msitranslate : bool;
7426- power_mgmt : bool;
7427-}
7428-
7429-type physinfo =
7430-{
7431- threads_per_core: int;
7432- cores_per_socket: int;
7433- max_cpu_id: int;
7434- nr_cpus: int;
7435- cpu_khz: int;
7436- total_pages: int64;
7437- free_pages: int64;
7438- scrub_pages: int64;
7439- nr_nodes: int;
7440- hwcap: int32 array;
7441- physcap: int32;
7442-}
7443-
7444-type sched_credit =
7445-{
7446- weight: int;
7447- cap: int;
7448-}
7449-
7450-external domain_make : create_info -> domid = "stub_xl_domain_make"
7451-external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build"
7452-
7453-external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add"
7454-external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove"
7455-
7456-external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add"
7457-external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove"
7458-
7459-external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add"
7460-
7461-external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add"
7462-external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown"
7463-external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown"
7464-
7465-external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add"
7466-external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown"
7467-external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown"
7468-
7469-external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add"
7470-external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove"
7471-external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown"
7472-
7473-type button =
7474- | Button_Power
7475- | Button_Sleep
7476-
7477-external button_press : domid -> button -> unit = "stub_xl_button_press"
7478-external physinfo : unit -> physinfo = "stub_xl_physinfo"
7479-
7480-external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get"
7481-external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set"
7482-
7483-external send_trigger : domid -> string -> int -> unit = "stub_xl_send_trigger"
7484-external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
7485-external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys"
7486--- /dev/null
7487+++ b/tools/ocaml/libs/xl/xenlight.ml
7488@@ -0,0 +1,213 @@
7489+(*
7490+ * Copyright (C) 2009-2010 Citrix Ltd.
7491+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
7492+ *
7493+ * This program is free software; you can redistribute it and/or modify
7494+ * it under the terms of the GNU Lesser General Public License as published
7495+ * by the Free Software Foundation; version 2.1 only. with the special
7496+ * exception on linking described in file LICENSE.
7497+ *
7498+ * This program is distributed in the hope that it will be useful,
7499+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
7500+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
7501+ * GNU Lesser General Public License for more details.
7502+ *)
7503+
7504+exception Error of string
7505+
7506+type create_info =
7507+{
7508+ hvm : bool;
7509+ hap : bool;
7510+ oos : bool;
7511+ ssidref : int32;
7512+ name : string;
7513+ uuid : int array;
7514+ xsdata : (string * string) list;
7515+ platformdata : (string * string) list;
7516+ poolid : int32;
7517+ poolname : string;
7518+}
7519+
7520+type build_pv_info =
7521+{
7522+ slack_memkb : int64;
7523+ cmdline : string;
7524+ ramdisk : string;
7525+ features : string;
7526+}
7527+
7528+type build_hvm_info =
7529+{
7530+ pae : bool;
7531+ apic : bool;
7532+ acpi : bool;
7533+ nx : bool;
7534+ viridian : bool;
7535+ timeoffset : string;
7536+ timer_mode : int;
7537+ hpet : int;
7538+ vpt_align : int;
7539+}
7540+
7541+type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info
7542+
7543+type build_info =
7544+{
7545+ max_vcpus : int;
7546+ cur_vcpus : int;
7547+ max_memkb : int64;
7548+ target_memkb : int64;
7549+ video_memkb : int64;
7550+ shadow_memkb : int64;
7551+ kernel : string;
7552+ priv: build_spec;
7553+}
7554+
7555+type build_state =
7556+{
7557+ store_port : int;
7558+ store_mfn : int64;
7559+ console_port : int;
7560+ console_mfn : int64;
7561+}
7562+
7563+type domid = int
7564+
7565+type disk_phystype =
7566+ | PHYSTYPE_QCOW
7567+ | PHYSTYPE_QCOW2
7568+ | PHYSTYPE_VHD
7569+ | PHYSTYPE_AIO
7570+ | PHYSTYPE_FILE
7571+ | PHYSTYPE_PHY
7572+
7573+type disk_info =
7574+{
7575+ backend_domid : domid;
7576+ physpath : string;
7577+ phystype : disk_phystype;
7578+ virtpath : string;
7579+ unpluggable : bool;
7580+ readwrite : bool;
7581+ is_cdrom : bool;
7582+}
7583+
7584+type nic_type =
7585+ | NICTYPE_IOEMU
7586+ | NICTYPE_VIF
7587+
7588+type nic_info =
7589+{
7590+ backend_domid : domid;
7591+ devid : int;
7592+ mtu : int;
7593+ model : string;
7594+ mac : int array;
7595+ bridge : string;
7596+ ifname : string;
7597+ script : string;
7598+ nictype : nic_type;
7599+}
7600+
7601+type console_type =
7602+ | CONSOLETYPE_XENCONSOLED
7603+ | CONSOLETYPE_IOEMU
7604+
7605+type console_info =
7606+{
7607+ backend_domid : domid;
7608+ devid : int;
7609+ consoletype : console_type;
7610+}
7611+
7612+type vkb_info =
7613+{
7614+ backend_domid : domid;
7615+ devid : int;
7616+}
7617+
7618+type vfb_info =
7619+{
7620+ backend_domid : domid;
7621+ devid : int;
7622+ vnc : bool;
7623+ vnclisten : string;
7624+ vncpasswd : string;
7625+ vncdisplay : int;
7626+ vncunused : bool;
7627+ keymap : string;
7628+ sdl : bool;
7629+ opengl : bool;
7630+ display : string;
7631+ xauthority : string;
7632+}
7633+
7634+type pci_info =
7635+{
7636+ v : int; (* domain * bus * dev * func multiplexed *)
7637+ domain : int;
7638+ vdevfn : int;
7639+ msitranslate : bool;
7640+ power_mgmt : bool;
7641+}
7642+
7643+type physinfo =
7644+{
7645+ threads_per_core: int;
7646+ cores_per_socket: int;
7647+ max_cpu_id: int;
7648+ nr_cpus: int;
7649+ cpu_khz: int;
7650+ total_pages: int64;
7651+ free_pages: int64;
7652+ scrub_pages: int64;
7653+ nr_nodes: int;
7654+ hwcap: int32 array;
7655+ physcap: int32;
7656+}
7657+
7658+type sched_credit =
7659+{
7660+ weight: int;
7661+ cap: int;
7662+}
7663+
7664+external domain_make : create_info -> domid = "stub_xl_domain_make"
7665+external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build"
7666+
7667+external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add"
7668+external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove"
7669+
7670+external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add"
7671+external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove"
7672+
7673+external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add"
7674+
7675+external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add"
7676+external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown"
7677+external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown"
7678+
7679+external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add"
7680+external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown"
7681+external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown"
7682+
7683+external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add"
7684+external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove"
7685+external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown"
7686+
7687+type button =
7688+ | Button_Power
7689+ | Button_Sleep
7690+
7691+external button_press : domid -> button -> unit = "stub_xl_button_press"
7692+external physinfo : unit -> physinfo = "stub_xl_physinfo"
7693+
7694+external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get"
7695+external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set"
7696+
7697+external send_trigger : domid -> string -> int -> unit = "stub_xl_send_trigger"
7698+external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
7699+external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys"
7700+
7701+let _ = Callback.register_exception "xl.error" (Error "register_callback")
7702--- /dev/null
7703+++ b/tools/ocaml/libs/xl/xenlight.mli
7704@@ -0,0 +1,211 @@
7705+(*
7706+ * Copyright (C) 2009-2010 Citrix Ltd.
7707+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
7708+ *
7709+ * This program is free software; you can redistribute it and/or modify
7710+ * it under the terms of the GNU Lesser General Public License as published
7711+ * by the Free Software Foundation; version 2.1 only. with the special
7712+ * exception on linking described in file LICENSE.
7713+ *
7714+ * This program is distributed in the hope that it will be useful,
7715+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
7716+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
7717+ * GNU Lesser General Public License for more details.
7718+ *)
7719+
7720+exception Error of string
7721+
7722+type create_info =
7723+{
7724+ hvm : bool;
7725+ hap : bool;
7726+ oos : bool;
7727+ ssidref : int32;
7728+ name : string;
7729+ uuid : int array;
7730+ xsdata : (string * string) list;
7731+ platformdata : (string * string) list;
7732+ poolid : int32;
7733+ poolname : string;
7734+}
7735+
7736+type build_pv_info =
7737+{
7738+ slack_memkb : int64;
7739+ cmdline : string;
7740+ ramdisk : string;
7741+ features : string;
7742+}
7743+
7744+type build_hvm_info =
7745+{
7746+ pae : bool;
7747+ apic : bool;
7748+ acpi : bool;
7749+ nx : bool;
7750+ viridian : bool;
7751+ timeoffset : string;
7752+ timer_mode : int;
7753+ hpet : int;
7754+ vpt_align : int;
7755+}
7756+
7757+type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info
7758+
7759+type build_info =
7760+{
7761+ max_vcpus : int;
7762+ cur_vcpus : int;
7763+ max_memkb : int64;
7764+ target_memkb : int64;
7765+ video_memkb : int64;
7766+ shadow_memkb : int64;
7767+ kernel : string;
7768+ priv: build_spec;
7769+}
7770+
7771+type build_state =
7772+{
7773+ store_port : int;
7774+ store_mfn : int64;
7775+ console_port : int;
7776+ console_mfn : int64;
7777+}
7778+
7779+type domid = int
7780+
7781+type disk_phystype =
7782+ | PHYSTYPE_QCOW
7783+ | PHYSTYPE_QCOW2
7784+ | PHYSTYPE_VHD
7785+ | PHYSTYPE_AIO
7786+ | PHYSTYPE_FILE
7787+ | PHYSTYPE_PHY
7788+
7789+type disk_info =
7790+{
7791+ backend_domid : domid;
7792+ physpath : string;
7793+ phystype : disk_phystype;
7794+ virtpath : string;
7795+ unpluggable : bool;
7796+ readwrite : bool;
7797+ is_cdrom : bool;
7798+}
7799+
7800+type nic_type =
7801+ | NICTYPE_IOEMU
7802+ | NICTYPE_VIF
7803+
7804+type nic_info =
7805+{
7806+ backend_domid : domid;
7807+ devid : int;
7808+ mtu : int;
7809+ model : string;
7810+ mac : int array;
7811+ bridge : string;
7812+ ifname : string;
7813+ script : string;
7814+ nictype : nic_type;
7815+}
7816+
7817+type console_type =
7818+ | CONSOLETYPE_XENCONSOLED
7819+ | CONSOLETYPE_IOEMU
7820+
7821+type console_info =
7822+{
7823+ backend_domid : domid;
7824+ devid : int;
7825+ consoletype : console_type;
7826+}
7827+
7828+type vkb_info =
7829+{
7830+ backend_domid : domid;
7831+ devid : int;
7832+}
7833+
7834+type vfb_info =
7835+{
7836+ backend_domid : domid;
7837+ devid : int;
7838+ vnc : bool;
7839+ vnclisten : string;
7840+ vncpasswd : string;
7841+ vncdisplay : int;
7842+ vncunused : bool;
7843+ keymap : string;
7844+ sdl : bool;
7845+ opengl : bool;
7846+ display : string;
7847+ xauthority : string;
7848+}
7849+
7850+type pci_info =
7851+{
7852+ v : int; (* domain * bus * dev * func multiplexed *)
7853+ domain : int;
7854+ vdevfn : int;
7855+ msitranslate : bool;
7856+ power_mgmt : bool;
7857+}
7858+
7859+type physinfo =
7860+{
7861+ threads_per_core: int;
7862+ cores_per_socket: int;
7863+ max_cpu_id: int;
7864+ nr_cpus: int;
7865+ cpu_khz: int;
7866+ total_pages: int64;
7867+ free_pages: int64;
7868+ scrub_pages: int64;
7869+ nr_nodes: int;
7870+ hwcap: int32 array;
7871+ physcap: int32;
7872+}
7873+
7874+type sched_credit =
7875+{
7876+ weight: int;
7877+ cap: int;
7878+}
7879+
7880+external domain_make : create_info -> domid = "stub_xl_domain_make"
7881+external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build"
7882+
7883+external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add"
7884+external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove"
7885+
7886+external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add"
7887+external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove"
7888+
7889+external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add"
7890+
7891+external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add"
7892+external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown"
7893+external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown"
7894+
7895+external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add"
7896+external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown"
7897+external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown"
7898+
7899+external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add"
7900+external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove"
7901+external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown"
7902+
7903+type button =
7904+ | Button_Power
7905+ | Button_Sleep
7906+
7907+external button_press : domid -> button -> unit = "stub_xl_button_press"
7908+external physinfo : unit -> physinfo = "stub_xl_physinfo"
7909+
7910+external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get"
7911+external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set"
7912+
7913+external send_trigger : domid -> string -> int -> unit = "stub_xl_send_trigger"
7914+external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
7915+external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys"
7916--- a/tools/ocaml/libs/xl/META.in
7917+++ b/tools/ocaml/libs/xl/META.in
7918@@ -1,4 +1,4 @@
7919 version = "@VERSION@"
7920 description = "Xen Toolstack Library"
7921-archive(byte) = "xl.cma"
7922-archive(native) = "xl.cmxa"
7923+archive(byte) = "xenlight.cma"
7924+archive(native) = "xenlight.cmxa"
Arne's tree of IPFire 3.x.