@@ -392,6 +392,7 @@ tools/ocaml/libs/xentoollog/_xtl_levels.*
tools/ocaml/libs/xentoollog/xentoollog.ml
tools/ocaml/libs/xentoollog/xentoollog.mli
tools/ocaml/libs/xs/paths.ml
+tools/ocaml/libs/xc/xenctrl_abi_check.h
tools/ocaml/xenstored/_paths.h
tools/ocaml/xenstored/oxenstored
tools/ocaml/xenstored/oxenstored.conf
@@ -31,4 +31,9 @@ install: $(LIBS) META
uninstall:
$(OCAMLFIND) remove -destdir $(OCAMLDESTDIR) xenctrl
+xenctrl_stubs.o: xenctrl_abi_check.h
+
+xenctrl_abi_check.h: abi-check xenctrl_stubs.c xenctrl.ml
+ $(PERL) -w $^ >$@.tmp && mv -f $@.tmp $@
+
include $(TOPLEVEL)/Makefile.rules
new file mode 100755
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Data::Dumper;
+
+our %enums;
+
+@ARGV == 2 or die;
+our ($c, $o) = @ARGV;
+
+open STDIN, "<", $c or die $!;
+
+our $cline = -1;
+our $ei;
+
+while (<>) {
+ if ($cline == -1) {
+ if (m/c_bitmap_to_ocaml_list/) {
+ $cline = 0;
+ $ei = { };
+ }
+ } else {
+ $cline++;
+ m{^\s+/\* \s+ ! \s+ (.*?) \s* \*/\s*$}x or die "$cline $_ ?";
+ my @vals = split /\s+/, $1;
+ if ($cline == 1 && !@vals) {
+ $cline = -1;
+ } elsif ($cline == 1 && @vals == 3) {
+ $ei->{$_} = shift @vals foreach qw(OType OPrefix Mangle);
+ } elsif ($cline == 2 && @vals == 3) {
+ $ei->{$_} = shift @vals foreach qw(CPrefix CFinal CFinalHow);
+ die if $enums{ $ei->{OType} };
+ $enums{ $ei->{OType} } = $ei;
+ $cline = -1;
+ } else {
+ die "$_ ?";
+ }
+ }
+}
+
+sub expect ($$) {
+ printf "BUILD_BUG_ON( %-30s != %-10s );\n", @_ or die $!;
+}
+
+open STDIN, "<", $o or die $!;
+my $cval;
+$ei = undef;
+my $bitnum = 0;
+while (<>) {
+ if (!$ei) {
+ if (m{^type \s+ (\w+) \s* \= \s* $/}x && $enums{$1}) {
+ $ei = $enums{$1};
+ $cval = '';
+ $bitnum = 0;
+ }
+ } else {
+ if (m{^\s+ \| \s* $ei->{OPrefix} (\w+) \s*$}x) {
+ $cval = $1;
+ if ($ei->{Mangle} eq 'lc') {
+ $cval = lc $cval;
+ } elsif ($ei->{Mangle} eq 'none') {
+ } else {
+ die;
+ }
+ $cval = $ei->{CPrefix}.$cval;
+ expect($cval, "(1u << $bitnum)");
+ $bitnum++;
+ } elsif (m/^\w|\{/) {
+ if ($ei->{CFinalHow} eq 'max') {
+ expect($ei->{CFinal}, "(1u << ".($bitnum-1).")");
+ } elsif ($ei->{CFinalHow} eq 'all') {
+ expect($ei->{CFinal}, "(1u << $bitnum)-1u");
+ } else {
+ die Dumper($ei)." ?";
+ }
+ $ei = undef;
+ } elsif (!m{\S}) {
+ } else {
+ die "$_ ?";
+ }
+ }
+}
+
+close STDOUT or die $!;
@@ -32,6 +32,7 @@
#define XC_WANT_COMPAT_MAP_FOREIGN_API
#include <xenctrl.h>
+#include <xen-tools/libs.h>
#include "mmap_stubs.h"
@@ -119,6 +120,39 @@ static void domain_handle_of_uuid_string(xen_domain_handle_t h,
#undef X
}
+/*
+ * Various fields which are a bitmap in the C ABI are converted to lists of
+ * integers in the Ocaml ABI for more idiomatic handling.
+ */
+static value c_bitmap_to_ocaml_list
+ /* ! */
+ /*
+ * All calls to this function must be in a form suitable
+ * for xenctrl_abi_check. The parsing there is ad-hoc.
+ */
+ (unsigned int bitmap)
+{
+ CAMLparam0();
+ CAMLlocal2(list, tmp);
+
+#include "xenctrl_abi_check.h"
+
+ list = tmp = Val_emptylist;
+
+ for ( unsigned int i = 0; bitmap; i++, bitmap >>= 1 )
+ {
+ if ( !(bitmap & 1) )
+ continue;
+
+ tmp = caml_alloc_small(2, Tag_cons);
+ Field(tmp, 0) = Val_int(i);
+ Field(tmp, 1) = list;
+ list = tmp;
+ }
+
+ CAMLreturn(list);
+}
+
CAMLprim value stub_xc_domain_create(value xch, value config)
{
CAMLparam2(xch, config);
@@ -315,16 +349,13 @@ static value alloc_domaininfo(xc_domaininfo_t * info)
Store_field(result, 15, tmp);
#if defined(__i386__) || defined(__x86_64__)
- /* emulation_flags: x86_arch_emulation_flags list; */
- tmp = emul_list = Val_emptylist;
- for (i = 0; i < 10; i++) {
- if ((info->arch_config.emulation_flags >> i) & 1) {
- tmp = caml_alloc_small(2, Tag_cons);
- Field(tmp, 0) = Val_int(i);
- Field(tmp, 1) = emul_list;
- emul_list = tmp;
- }
- }
+ /*
+ * emulation_flags: x86_arch_emulation_flags list;
+ */
+ emul_list = c_bitmap_to_ocaml_list
+ /* ! x86_arch_emulation_flags X86_EMU_ none */
+ /* ! XEN_X86_EMU_ XEN_X86_EMU_ALL all */
+ (info->arch_config.emulation_flags);
/* xen_x86_arch_domainconfig */
x86_arch_config = caml_alloc_tuple(1);
@@ -635,7 +666,7 @@ CAMLprim value stub_xc_send_debug_keys(value xch, value keys)
CAMLprim value stub_xc_physinfo(value xch)
{
CAMLparam1(xch);
- CAMLlocal3(physinfo, cap_list, tmp);
+ CAMLlocal2(physinfo, cap_list);
xc_physinfo_t c_physinfo;
int r;
@@ -646,15 +677,13 @@ CAMLprim value stub_xc_physinfo(value xch)
if (r)
failwith_xc(_H(xch));
- tmp = cap_list = Val_emptylist;
- for (r = 0; r < 2; r++) {
- if ((c_physinfo.capabilities >> r) & 1) {
- tmp = caml_alloc_small(2, Tag_cons);
- Field(tmp, 0) = Val_int(r);
- Field(tmp, 1) = cap_list;
- cap_list = tmp;
- }
- }
+ /*
+ * capabilities: physinfo_cap_flag list;
+ */
+ cap_list = c_bitmap_to_ocaml_list
+ /* ! physinfo_cap_flag CAP_ lc */
+ /* ! XEN_SYSCTL_PHYSCAP_ XEN_SYSCTL_PHYSCAP_MAX max */
+ (c_physinfo.capabilities);
physinfo = caml_alloc_tuple(10);
Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core));
@@ -90,6 +90,10 @@ struct xen_sysctl_tbuf_op {
/* The platform supports direct access to I/O devices with IOMMU. */
#define _XEN_SYSCTL_PHYSCAP_directio 2
#define XEN_SYSCTL_PHYSCAP_directio (1u<<_XEN_SYSCTL_PHYSCAP_directio)
+
+/* Max XEN_SYSCTL_PHYSCAP_* constant. Used for ABI checking. */
+#define XEN_SYSCTL_PHYSCAP_MAX XEN_SYSCTL_PHYSCAP_directio
+
struct xen_sysctl_physinfo {
uint32_t threads_per_core;
uint32_t cores_per_socket;