From nobody Thu Nov 28 06:29:22 2024 Delivered-To: importer@patchew.org Received-SPF: pass (zohomail.com: domain of lists.xenproject.org designates 192.237.175.120 as permitted sender) client-ip=192.237.175.120; envelope-from=xen-devel-bounces@lists.xenproject.org; helo=lists.xenproject.org; Authentication-Results: mx.zohomail.com; dkim=pass; spf=pass (zohomail.com: domain of lists.xenproject.org designates 192.237.175.120 as permitted sender) smtp.mailfrom=xen-devel-bounces@lists.xenproject.org; dmarc=pass(p=reject dis=none) header.from=citrix.com ARC-Seal: i=1; a=rsa-sha256; t=1675957442; cv=none; d=zohomail.com; s=zohoarc; b=XX0KzWbm8R0nqSVSXOMvlyl2/el80foZtaKaz+zOAgNqcjtcJU4fiURU7UDjDtX5rTkkewa73/6Ph3csHSJXG3SeacVu+NN55Ulkr0HUdtguNV73yINOFN3MvjcuqynJwtdqAkcbyfyaQMlhPR4mRDMdopJoGeuOvhKT3wPZ1Yc= ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=zohomail.com; s=zohoarc; t=1675957442; h=Content-Type:Content-Transfer-Encoding:Cc:Date:From:List-Subscribe:List-Post:List-Id:List-Help:List-Unsubscribe:MIME-Version:Message-ID:Sender:Subject:To; bh=+L7zDnprLjheJ/2IeoNbTwm6oLeU1y8+mTuS2/jbeks=; b=jAfnBNmiQvGk0ae+/Dxg46zyt+JvWxWqTEbpdvif9hX9d3zGdZc62sXpptzQ57YpTaiK2jPDBGtnCIwKvhudy37BIc767iy1n+TnMj7i87Nu6f129pvPyjkagi0xS8sJJwUFX9cX5cJ5KbQ/PzX8IMaG9FO8eKio5ngng3ysxLY= ARC-Authentication-Results: i=1; mx.zohomail.com; dkim=pass; spf=pass (zohomail.com: domain of lists.xenproject.org designates 192.237.175.120 as permitted sender) smtp.mailfrom=xen-devel-bounces@lists.xenproject.org; dmarc=pass header.from= (p=reject dis=none) Return-Path: Received: from lists.xenproject.org (lists.xenproject.org [192.237.175.120]) by mx.zohomail.com with SMTPS id 1675957442171533.7739761571058; Thu, 9 Feb 2023 07:44:02 -0800 (PST) Received: from list by lists.xenproject.org with outflank-mailman.492629.762259 (Exim 4.92) (envelope-from ) id 1pQ94y-0002Ng-Ez; Thu, 09 Feb 2023 15:43:20 +0000 Received: by outflank-mailman (output) from mailman id 492629.762259; Thu, 09 Feb 2023 15:43:20 +0000 Received: from localhost ([127.0.0.1] helo=lists.xenproject.org) by lists.xenproject.org with esmtp (Exim 4.92) (envelope-from ) id 1pQ94y-0002NZ-Ap; Thu, 09 Feb 2023 15:43:20 +0000 Received: by outflank-mailman (input) for mailman id 492629; Thu, 09 Feb 2023 15:43:19 +0000 Received: from se1-gles-sth1-in.inumbo.com ([159.253.27.254] helo=se1-gles-sth1.inumbo.com) by lists.xenproject.org with esmtp (Exim 4.92) (envelope-from ) id 1pQ94w-0002MA-S8 for xen-devel@lists.xenproject.org; Thu, 09 Feb 2023 15:43:19 +0000 Received: from esa4.hc3370-68.iphmx.com (esa4.hc3370-68.iphmx.com [216.71.155.144]) by se1-gles-sth1.inumbo.com (Halon) with ESMTPS id 76c8d14c-a890-11ed-933c-83870f6b2ba8; Thu, 09 Feb 2023 16:43:15 +0100 (CET) X-Outflank-Mailman: Message body and most headers restored to incoming version X-BeenThere: xen-devel@lists.xenproject.org List-Id: Xen developer discussion List-Unsubscribe: , List-Post: List-Help: List-Subscribe: , Errors-To: xen-devel-bounces@lists.xenproject.org Precedence: list Sender: "Xen-devel" X-Inumbo-ID: 76c8d14c-a890-11ed-933c-83870f6b2ba8 DKIM-Signature: v=1; a=rsa-sha256; c=simple/simple; d=citrix.com; s=securemail; t=1675957395; h=from:to:cc:subject:date:message-id:mime-version: content-transfer-encoding; bh=55kE0HTPmlwaufUDDLRel8X/8YuHKHFsZZWYGoztJTY=; b=SvicFw39kQbHjTyrFj0AalkA2cK6zwc0RBrjJ5TomjfK/lO4lNgNxeE1 BNXejZu3Sauz/fHUuvGXU68PAd07fHAHd6l3zZu9zkcEERkGCKpqjqI8k kyT9UuM8waoREw/Uu/11cK03eRuDIYVbh0TMCdCg6hlIasii1EekgzciD Y=; Authentication-Results: esa4.hc3370-68.iphmx.com; dkim=none (message not signed) header.i=none X-SBRS: 4.0 X-MesageID: 98804802 X-Ironport-Server: esa4.hc3370-68.iphmx.com X-Remote-IP: 162.221.156.123 X-Policy: $RELAYED IronPort-Data: A9a23:kYXRYKnFUULN4q/0wb6CtYDo5gyOJkRdPkR7XQ2eYbSJt1+Wr1Gzt xIfWWGEMvaIYjGge9h2aNzl9B9X7ZCAmtdkSVNpqnozFCMWpZLJC+rCIxarNUt+DCFhoGFPt JxCN4aafKjYaleG+39B55C49SEUOZmgH+a6U6icfHgqH2eIcQ954Tp7gek1n4V0ttawBgKJq LvartbWfVSowFaYCEpNg064gE4p7auaVA8w5ARkPqgR5A6GzBH5MbpETU2PByqgKmVrNrbSq 9brlNmR4m7f9hExPdKp+p6TnpoiG+O60aCm0xK6aoD66vRwjnVaPpUTbZLwXXx/mTSR9+2d/ f0W3XCGpaXFCYWX8AgVe0Ew/yiTpsSq8pefSZS0mZT7I0Er7xIAahihZa07FdRwxwp5PY1B3 dM8ESIxYAqovMeJx7GhELYxoeUhFda+aevzulk4pd3YJfMvQJSFSKTW/95Imjw3g6iiH96HO ZBfM2A2Kk2dPVsWYAx/5JEWxY9EglHWdTFCpU3Tjq0w+2XJlyR60aT3McqTcduPLSlQthfI9 jqarzyjav0cHPDO8QLY20yrvLXKnAH8Zo4VCeGy+cc/1TV/wURMUUZLBDNXu8KRmkO4Ht5SN UEQ0i4vtrQpslymSMHnWB+1q2LCuQQTM/JcGvM3wBuAwa3V50CeHGdsc9JaQIV47olsH2Vsj wLX2YqzXlSDrYF5V1qy0o6GkT2oEhMwEmgBf3VbECwk4eD89dRbYg30cv5vF6u8j9vQED72w iyXoCVWu4j/nfLnxI3gowmZ3mvESozhC1dsu16JBj7NAhZRPtbNWmC+1bTMAR+sxq69R0LJg nULktP2AAsmXcDUz3zlrAng8diUCxe53N/02wYH83oJrW7FF5ufkWd4vllDyL9BaJpsRNMQS Ba7VfltzJFSJmC2SqR8fpi8Dc8npYC5S4u4BqCNNoQfM8IgHONiwM2ITRXAt4wKuBFz+ZzTx L/BKZr8ZZrkIfsPIMWKqxc1juZwm3FWKZL7TpHn1RW3uYdyl1bMIYrpxGCmN7hjhIvd+VW9z jqqH5fSo/mpeLGkM3a/HE96BQxiEEXX8ris8ZYHJ7fceFY9cIzjYteIqY4cl0Vet/w9vo/1E ruVBie0FHKXaaX7FDi3 IronPort-HdrOrdr: A9a23:wNoys6tch7RlZjkYpkPnEJud7skC6oMji2hC6mlwRA09TyXGra qTdaUgviMc1gx4ZJh5o6H5BEGBKUm9yXcH2/hrAV7CZniuhILMFuxfBOTZslnd8kHFmNK1kJ 0QCpSWa+eARWSS7/yKhzVQeuxIrLa6GeKT9IHjJhxWPGJXgtRbnmJE43GgYy9LrWd9ZKYRJd 653I5qtjCgcXMYYoCQHX8eRdXOoNXNidbPfQMGLwRP0njFsRqYrJrBVzSI1BYXVD1ChZ0493 LergD/7qK/99mm1x7n0XPJ5Zg+oqqt9jIDPr3BtiEmEESjtu+aXvUhZ1S2hkF7nAjg0idrrD CGmWZbAy060QKtQojym2qn5+Co6kdT11byjVCfmnftusr/WXYzDNdAn5tQdl/D51Mnp8wU6t M+44u1jeskMfr7plWJ2/HYExVx0kakq3srluAey3RZTIsFcbdU6YgS5llcHpsMFD/zrNlPKp gZMOjMoPJNNV+KZXHQuWdihNSqQ3QoBx+DBkwPoNac3TRalG1wi0EY2MsclHEd849Vcegy28 3UdqBz0L1eRM4faqxwQO8HXMusE2TIBQnBNWqDSG6XZ53v+0i926IfzI9Fld1CIqZ4s6fasK 6xLm9liQ== X-IronPort-AV: E=Sophos;i="5.97,284,1669093200"; d="scan'208";a="98804802" From: Andrew Cooper To: Xen-devel CC: Andrew Cooper , Christian Lindig , David Scott , =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= , Rob Hoes Subject: [PATCH] tools/ocaml: Drop libxl bindings Date: Thu, 9 Feb 2023 15:43:00 +0000 Message-ID: <20230209154300.22130-1-andrew.cooper3@citrix.com> X-Mailer: git-send-email 2.11.0 MIME-Version: 1.0 Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: quoted-printable X-ZohoMail-DKIM: pass (identity @citrix.com) X-ZM-MESSAGEID: 1675957442979100001 There are significant issues with these bindings, and their companion half = in Xapi was deleted in 2018 https://github.com/xapi-project/xen-api/commit/203292ebe0c487d7ae4adb961a= 6d080f4fbe933d owing to there having been no development of these bindings since 2014. In the unlikely event that we'd want to reinstate them, they'd need reworki= ng basically from scratch anyway. Signed-off-by: Andrew Cooper Acked-by: Christian Lindig --- CC: Christian Lindig CC: David Scott CC: Edwin T=C3=B6r=C3=B6k CC: Rob Hoes I'm unsure whether to drop xentoollog. They're technically orphaned by this change, but could be used in principle by the other bindings. --- tools/ocaml/Makefile | 4 - tools/ocaml/libs/Makefile | 2 +- tools/ocaml/libs/xl/META.in | 5 - tools/ocaml/libs/xl/Makefile | 71 -- tools/ocaml/libs/xl/genwrap.py | 582 ------------ tools/ocaml/libs/xl/xenlight.ml.in | 94 -- tools/ocaml/libs/xl/xenlight.mli.in | 93 -- tools/ocaml/libs/xl/xenlight_stubs.c | 1663 ------------------------------= ---- tools/ocaml/test/Makefile | 55 -- tools/ocaml/test/dmesg.ml | 17 - tools/ocaml/test/list_domains.ml | 26 - tools/ocaml/test/raise_exception.ml | 9 - tools/ocaml/test/send_debug_keys.ml | 13 - tools/ocaml/test/xtl.ml | 39 - 14 files changed, 1 insertion(+), 2672 deletions(-) delete mode 100644 tools/ocaml/libs/xl/META.in delete mode 100644 tools/ocaml/libs/xl/Makefile delete mode 100644 tools/ocaml/libs/xl/genwrap.py delete mode 100644 tools/ocaml/libs/xl/xenlight.ml.in delete mode 100644 tools/ocaml/libs/xl/xenlight.mli.in delete mode 100644 tools/ocaml/libs/xl/xenlight_stubs.c delete mode 100644 tools/ocaml/test/Makefile delete mode 100644 tools/ocaml/test/dmesg.ml delete mode 100644 tools/ocaml/test/list_domains.ml delete mode 100644 tools/ocaml/test/raise_exception.ml delete mode 100644 tools/ocaml/test/send_debug_keys.ml delete mode 100644 tools/ocaml/test/xtl.ml diff --git a/tools/ocaml/Makefile b/tools/ocaml/Makefile index 85bfd087c9c6..1557fd6c3c1a 100644 --- a/tools/ocaml/Makefile +++ b/tools/ocaml/Makefile @@ -4,10 +4,6 @@ include $(XEN_ROOT)/tools/Rules.mk SUBDIRS :=3D libs SUBDIRS +=3D xenstored =20 -ifeq ($(CONFIG_TESTS),y) -SUBDIRS +=3D test -endif - .NOTPARALLEL: # targets here must be run in order, otherwise we can try # to build programs before the libraries are done diff --git a/tools/ocaml/libs/Makefile b/tools/ocaml/libs/Makefile index 5146c5248460..49ea7dd1cb8a 100644 --- a/tools/ocaml/libs/Makefile +++ b/tools/ocaml/libs/Makefile @@ -5,7 +5,7 @@ SUBDIRS=3D \ mmap \ xentoollog \ eventchn xc \ - xb xs xl + xb xs =20 .PHONY: all all: subdirs-all diff --git a/tools/ocaml/libs/xl/META.in b/tools/ocaml/libs/xl/META.in deleted file mode 100644 index 3f0c5526cb2e..000000000000 --- a/tools/ocaml/libs/xl/META.in +++ /dev/null @@ -1,5 +0,0 @@ -version =3D "@VERSION@" -description =3D "Xen Toolstack Library" -requires =3D "xentoollog" -archive(byte) =3D "xenlight.cma" -archive(native) =3D "xenlight.cmxa" diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile deleted file mode 100644 index 22d6c93aae7a..000000000000 --- a/tools/ocaml/libs/xl/Makefile +++ /dev/null @@ -1,71 +0,0 @@ -OCAML_TOPLEVEL=3D$(CURDIR)/../.. -XEN_ROOT=3D$(OCAML_TOPLEVEL)/../.. -include $(OCAML_TOPLEVEL)/common.make - -# ignore unused generated functions and allow mixed declarations and code -CFLAGS +=3D -Wno-unused -Wno-declaration-after-statement - -CFLAGS +=3D $(CFLAGS_libxenlight) -CFLAGS +=3D -I ../xentoollog -CFLAGS +=3D $(APPEND_CFLAGS) - -OBJS =3D xenlight -INTF =3D xenlight.cmi -LIBS =3D xenlight.cma xenlight.cmxa - -OCAMLINCLUDE +=3D -I ../xentoollog - -LIBS_xenlight =3D $(call xenlibs-ldflags-ldlibs,light) - -xenlight_OBJS =3D $(OBJS) -xenlight_C_OBJS =3D xenlight_stubs - -OCAML_LIBRARY =3D xenlight - -GENERATED_FILES +=3D xenlight.ml xenlight.ml.tmp xenlight.mli xenlight.mli= .tmp -GENERATED_FILES +=3D _libxl_types.ml.in _libxl_types.mli.in -GENERATED_FILES +=3D _libxl_types.inc META - -all: $(INTF) $(LIBS) - -xenlight.ml: xenlight.ml.in _libxl_types.ml.in - $(Q)sed -e '1i\ -(*\ - * AUTO-GENERATED FILE DO NOT EDIT\ - * Generated from xenlight.ml.in and _libxl_types.ml.in\ - *)\ -' \ - -e '/^(\* @@LIBXL_TYPES@@ \*)$$/r_libxl_types.ml.in' \ - < xenlight.ml.in > xenlight.ml.tmp - $(Q)mv xenlight.ml.tmp xenlight.ml - -xenlight.mli: xenlight.mli.in _libxl_types.mli.in - $(Q)sed -e '1i\ -(*\ - * AUTO-GENERATED FILE DO NOT EDIT\ - * Generated from xenlight.mli.in and _libxl_types.mli.in\ - *)\ -' \ - -e '/^(\* @@LIBXL_TYPES@@ \*)$$/r_libxl_types.mli.in' \ - < xenlight.mli.in > xenlight.mli.tmp - $(Q)mv xenlight.mli.tmp xenlight.mli - -_libxl_types.ml.in _libxl_types.mli.in _libxl_types.inc: genwrap.py $(XEN_= ROOT)/tools/libs/light/libxl_types.idl \ - $(XEN_ROOT)/tools/libs/light/idl.py - PYTHONPATH=3D$(XEN_ROOT)/tools/libs/light $(PYTHON) genwrap.py \ - $(XEN_ROOT)/tools/libs/light/libxl_types.idl \ - _libxl_types.mli.in _libxl_types.ml.in _libxl_types.inc - -libs: $(LIBS) - -.PHONY: install -install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) - $(OCAMLFIND) remove -destdir $(OCAMLDESTDIR) xenlight - $(OCAMLFIND) install -destdir $(OCAMLDESTDIR) -ldconf ignore xenlight MET= A $(INTF) $(LIBS) *.a *.so *.cmx - -.PHONY: uninstall -uninstall: - $(OCAMLFIND) remove -destdir $(OCAMLDESTDIR) xenlight - -include $(OCAML_TOPLEVEL)/Makefile.rules diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py deleted file mode 100644 index 7bf26bdcd831..000000000000 --- a/tools/ocaml/libs/xl/genwrap.py +++ /dev/null @@ -1,582 +0,0 @@ -#!/usr/bin/python - -from __future__ import print_function - -import sys,os -from functools import reduce - -import idl - -# typename -> ( ocaml_type, c_from_ocaml, ocaml_from_c ) -builtins =3D { - "bool": ("bool", "%(c)s =3D Bool_val= (%(o)s)", "Val_bool(%(c)s)" ), - "int": ("int", "%(c)s =3D Int_val(= %(o)s)", "Val_int(%(c)s)" ), - "char *": ("string option", "%(c)s =3D String_o= ption_val(%(o)s)", "Val_string_option(%(c)s)"), - "libxl_domid": ("domid", "%(c)s =3D Int_val(= %(o)s)", "Val_int(%(c)s)" ), - "libxl_devid": ("devid", "%(c)s =3D Int_val(= %(o)s)", "Val_int(%(c)s)" ), - "libxl_defbool": ("bool option", "%(c)s =3D Defbool_= val(%(o)s)", "Val_defbool(%(c)s)" ), - "libxl_uuid": ("int array", "Uuid_val(&%(c)s, %= (o)s)", "Val_uuid(&%(c)s)"), - "libxl_bitmap": ("bool array", "Bitmap_val(ctx, &%= (c)s, %(o)s)", "Val_bitmap(&%(c)s)"), - "libxl_key_value_list": ("(string * string) list", "libxl_key_value_li= st_val(&%(c)s, %(o)s)", "Val_key_value_list(&%(c)s)"), - "libxl_string_list": ("string list", "libxl_string_list_= val(&%(c)s, %(o)s)", "Val_string_list(&%(c)s)"), - "libxl_mac": ("int array", "Mac_val(&%(c)s, %(= o)s)", "Val_mac(&%(c)s)"), - "libxl_hwcap": ("int32 array", None, = "Val_hwcap(&%(c)s)"), - "libxl_ms_vm_genid": ("int array", "Ms_vm_genid_val(&%= (c)s, %(o)s)", "Val_ms_vm_genid(&%(c)s)"), - # The following needs to be sorted out later - "libxl_cpuid_policy_list": ("unit", "%(c)s =3D 0", = "Val_unit"), - } - -DEVICE_FUNCTIONS =3D [ ("add", ["ctx", "t", "domid", "?async:'a= ", "unit", "unit"]), - ("remove", ["ctx", "t", "domid", "?async:'a",= "unit", "unit"]), - ("destroy", ["ctx", "t", "domid", "?async:'a",= "unit", "unit"]), - ] -DEVICE_LIST =3D [ ("list", ["ctx", "domid", "t list"]), - ] - -functions =3D { # ( name , [type1,type2,....] ) - "device_vfb": DEVICE_FUNCTIONS, - "device_vkb": DEVICE_FUNCTIONS, - "device_disk": DEVICE_FUNCTIONS + DEVICE_LIST + - [ ("insert", ["ctx", "t", "domid", "?async:'= a", "unit", "unit"]), - ("of_vdev", ["ctx", "domid", "string", "t"]= ), - ], - "device_nic": DEVICE_FUNCTIONS + DEVICE_LIST + - [ ("of_devid", ["ctx", "domid", "int", "t"]), - ], - "device_pci": DEVICE_FUNCTIONS + DEVICE_LIST + - [ ("assignable_add", ["ctx", "t", "bool", "unit"]= ), - ("assignable_remove", ["ctx", "t", "bool", "unit"]= ), - ("assignable_list", ["ctx", "t list"]), - ], - "dominfo": [ ("list", ["ctx", "t list"]), - ("get", ["ctx", "domid", "t"]), - ], - "physinfo": [ ("get", ["ctx", "t"]), - ], - "cputopology": [ ("get", ["ctx", "t array"]), - ], - "domain_sched_params": - [ ("get", ["ctx", "domid", "t"]), - ("set", ["ctx", "domid", "t", "unit"]), - ], -} -def stub_fn_name(ty, name): - return "stub_xl_%s_%s" % (ty.rawname,name) - -def ocaml_type_of(ty): - if ty.rawname in ["domid","devid"]: - return ty.rawname - elif isinstance(ty,idl.UInt): - if ty.width in [8, 16]: - # handle as ints - width =3D None - elif ty.width in [32, 64]: - width =3D ty.width - else: - raise NotImplementedError("Cannot handle %d-bit int" % ty.widt= h) - if width: - return "int%d" % ty.width - else: - return "int" - elif isinstance(ty,idl.Array): - return "%s array" % ocaml_type_of(ty.elem_type) - elif isinstance(ty,idl.Builtin): - if ty.typename not in builtins: - raise NotImplementedError("Unknown Builtin %s (%s)" % (ty.type= name, type(ty))) - typename,_,_ =3D builtins[ty.typename] - if not typename: - raise NotImplementedError("No typename for Builtin %s (%s)" % = (ty.typename, type(ty))) - return typename - elif isinstance(ty,idl.KeyedUnion): - return ty.union_name - elif isinstance(ty,idl.Aggregate): - if ty.rawname is None: - return ty.anon_struct - else: - return ty.rawname.capitalize() + ".t" - else: - return ty.rawname - -ocaml_keywords =3D ['and', 'as', 'assert', 'begin', 'end', 'class', 'const= raint', - 'do', 'done', 'downto', 'else', 'if', 'end', 'exception', 'external', = 'false', - 'for', 'fun', 'function', 'functor', 'if', 'in', 'include', 'inherit', - 'initializer', 'lazy', 'let', 'match', 'method', 'module', 'mutable', = 'new', - 'object', 'of', 'open', 'or', 'private', 'rec', 'sig', 'struct', 'then= ', 'to', - 'true', 'try', 'type', 'val', 'virtual', 'when', 'while', 'with'] - -def munge_name(name): - if name in ocaml_keywords: - return "xl_" + name - else: - return name - -def ocaml_instance_of_field(f): - if isinstance(f.type, idl.KeyedUnion): - name =3D f.type.keyvar.name - else: - name =3D f.name - return "%s : %s" % (munge_name(name), ocaml_type_of(f.type)) - -def gen_struct(ty, indent): - s =3D "" - for f in ty.fields: - if f.type.private: - continue - x =3D ocaml_instance_of_field(f) - x =3D x.replace("\n", "\n"+indent) - s +=3D indent + x + ";\n" - return s - -def gen_ocaml_keyedunions(ty, interface, indent, parent =3D None): - s =3D "" - union_type =3D "" - - if ty.rawname is not None: - # Non-anonymous types need no special handling - pass - elif isinstance(ty, idl.KeyedUnion): - if parent is None: - nparent =3D ty.keyvar.name - else: - nparent =3D parent + "_" + ty.keyvar.name - - for f in ty.fields: - if f.type is None: continue - if f.type.rawname is not None: continue - if isinstance(f.type, idl.Struct) and not f.type.has_fields():= continue - s +=3D "\ntype %s_%s =3D\n" % (nparent,f.name) - s +=3D "{\n" - s +=3D gen_struct(f.type, indent + "\t") - s +=3D "}\n" - - name =3D "%s__union" % ty.keyvar.name - s +=3D "\n" - s +=3D "type %s =3D " % name - u =3D [] - for f in ty.fields: - if f.type is None: - u.append("%s" % (f.name.capitalize())) - elif isinstance(f.type, idl.Struct): - if f.type.rawname is not None: - u.append("%s of %s.t" % (f.name.capitalize(), f.type.r= awname.capitalize())) - elif f.type.has_fields(): - u.append("%s of %s_%s" % (f.name.capitalize(), nparent= , f.name)) - else: - u.append("%s" % (f.name.capitalize())) - else: - raise NotImplementedError("Cannot handle KeyedUnion fields= which are not Structs") - - s +=3D " | ".join(u) + "\n" - ty.union_name =3D name - - union_type =3D "?%s:%s" % (munge_name(nparent), ty.keyvar.type.raw= name) - - if s =3D=3D "": - return None, None - return s.replace("\n", "\n%s" % indent), union_type - -def gen_ocaml_anonstruct(ty, interface, indent, parent =3D None): - s=3D "" - - if ty.rawname is not None: - # Non-anonymous types need no special handling - pass - elif isinstance(ty, idl.Struct): - name =3D "%s__anon" % parent - s +=3D "type %s =3D {\n" % name - s +=3D gen_struct(ty, indent) - s +=3D "}\n" - ty.anon_struct =3D name - if s =3D=3D "": - return None - s =3D indent + s - return s.replace("\n", "\n%s" % indent) - -def gen_ocaml_ml(ty, interface, indent=3D""): - - if interface: - s =3D ("""(* %s interface *)\n""" % ty.typename) - else: - s =3D ("""(* %s implementation *)\n""" % ty.typename) - - if isinstance(ty, idl.Enumeration): - s +=3D "type %s =3D \n" % ty.rawname - for v in ty.values: - s +=3D "\t | %s\n" % v.rawname - - if interface: - s +=3D "\nval string_of_%s : %s -> string\n" % (ty.rawname, ty= .rawname) - else: - s +=3D "\nlet string_of_%s =3D function\n" % ty.rawname - for v in ty.values: - s +=3D '\t| %s -> "%s"\n' % (v.rawname, v.valuename) - - elif isinstance(ty, idl.Aggregate): - s +=3D "" - - if ty.typename is None: - raise NotImplementedError("%s has no typename" % type(ty)) - else: - - module_name =3D ty.rawname[0].upper() + ty.rawname[1:] - - if interface: - s +=3D "module %s : sig\n" % module_name - else: - s +=3D "module %s =3D struct\n" % module_name - - # Handle KeyedUnions... - union_types =3D [] - for f in ty.fields: - ku, union_type =3D gen_ocaml_keyedunions(f.type, interface, "\= t") - if ku is not None: - s +=3D ku - s +=3D "\n" - if union_type is not None: - union_types.append(union_type) - - # Handle anonymous structs... - for f in ty.fields: - anon =3D gen_ocaml_anonstruct(f.type, interface, "\t", f.name) - if anon is not None: - s +=3D anon - s +=3D "\n" - - s +=3D "\ttype t =3D\n" - s +=3D "\t{\n" - s +=3D gen_struct(ty, "\t\t") - s +=3D "\t}\n" - - if ty.init_fn is not None: - union_args =3D "".join([u + " -> " for u in union_types]) - if interface: - s +=3D "\tval default : ctx -> %sunit -> t\n" % union_args - else: - s +=3D "\texternal default : ctx -> %sunit -> t =3D \"stub= _libxl_%s_init\"\n" % (union_args, ty.rawname) - - if ty.rawname in functions: - for name,args in functions[ty.rawname]: - s +=3D "\texternal %s : " % name - s +=3D " -> ".join(args) - s +=3D " =3D \"%s\"\n" % stub_fn_name(ty,name) - - s +=3D "end\n" - - else: - raise NotImplementedError("%s" % type(ty)) - return s.replace("\n", "\n%s" % indent) - -def c_val(ty, c, o, indent=3D"", parent =3D None): - s =3D indent - if isinstance(ty,idl.UInt): - if ty.width in [8, 16]: - # handle as ints - width =3D None - elif ty.width in [32, 64]: - width =3D ty.width - else: - raise NotImplementedError("Cannot handle %d-bit int" % ty.widt= h) - if width: - s +=3D "%s =3D Int%d_val(%s);" % (c, width, o) - else: - s +=3D "%s =3D Int_val(%s);" % (c, o) - elif isinstance(ty,idl.Builtin): - if ty.typename not in builtins: - raise NotImplementedError("Unknown Builtin %s (%s)" % (ty.type= name, type(ty))) - _,fn,_ =3D builtins[ty.typename] - if not fn: - raise NotImplementedError("No c_val fn for Builtin %s (%s)" % = (ty.typename, type(ty))) - s +=3D "%s;" % (fn % { "o": o, "c": c }) - elif isinstance (ty,idl.Array): - s +=3D "{\n" - s +=3D "\tint i;\n" - s +=3D "\t%s =3D Wosize_val(%s);\n" % (parent + ty.lenvar.name, o) - s +=3D "\t%s =3D (%s) calloc(%s, sizeof(*%s));\n" % (c, ty.typenam= e, parent + ty.lenvar.name, c) - s +=3D "\tfor(i=3D0; i<%s; i++) {\n" % (parent + ty.lenvar.name) - s +=3D c_val(ty.elem_type, c+"[i]", "Field(%s, i)" % o, indent=3D"= \t\t", parent=3Dparent) + "\n" - s +=3D "\t}\n" - s +=3D "}\n" - elif isinstance(ty,idl.Enumeration) and (parent is None): - n =3D 0 - s +=3D "switch(Int_val(%s)) {\n" % o - for e in ty.values: - s +=3D " case %d: *%s =3D %s; break;\n" % (n, c, e.name) - n +=3D 1 - s +=3D " default: failwith_xl(ERROR_FAIL, \"cannot convert valu= e to %s\"); break;\n" % ty.typename - s +=3D "}" - elif isinstance(ty, idl.KeyedUnion): - s +=3D "{\n" - s +=3D "\tif(Is_long(%s)) {\n" % o - n =3D 0 - s +=3D "\t\tswitch(Int_val(%s)) {\n" % o - for f in ty.fields: - if f.type is None or not f.type.has_fields(): - s +=3D "\t\t case %d: %s =3D %s; break;\n" % (n, - parent + ty.keyvar.nam= e, - f.enumname) - n +=3D 1 - s +=3D "\t\t default: failwith_xl(ERROR_FAIL, \"variant handlin= g bug %s%s (long)\"); break;\n" % (parent, ty.keyvar.name) - s +=3D "\t\t}\n" - s +=3D "\t} else {\n" - s +=3D "\t\t/* Is block... */\n" - s +=3D "\t\tswitch(Tag_val(%s)) {\n" % o - n =3D 0 - for f in ty.fields: - if f.type is not None and f.type.has_fields(): - if f.type.private: - continue - s +=3D "\t\t case %d:\n" % (n) - s +=3D "\t\t %s =3D %s;\n" % (parent + ty.keyvar.na= me, f.enumname) - (nparent,fexpr) =3D ty.member(c, f, False) - s +=3D "%s" % c_val(f.type, fexpr, "Field(%s, 0)" % o, par= ent=3Dnparent, indent=3Dindent+"\t\t ") - s +=3D "break;\n" - n +=3D 1 - s +=3D "\t\t default: failwith_xl(ERROR_FAIL, \"variant handlin= g bug %s%s (block)\"); break;\n" % (parent, ty.keyvar.name) - s +=3D "\t\t}\n" - s +=3D "\t}\n" - s +=3D "}" - elif isinstance(ty, idl.Aggregate) and (parent is None or ty.rawname i= s None): - n =3D 0 - for f in ty.fields: - if f.type.private: - continue - (nparent,fexpr) =3D ty.member(c, f, ty.rawname is not None) - s +=3D "%s\n" % c_val(f.type, fexpr, "Field(%s, %d)" % (o,n), = parent=3Dnparent) - n =3D n + 1 - else: - s +=3D "%s_val(ctx, %s, %s);" % (ty.rawname, ty.pass_arg(c, parent= is None, passby=3Didl.PASS_BY_REFERENCE), o) - - return s.replace("\n", "\n%s" % indent) - -def gen_c_val(ty, indent=3D""): - s =3D "/* Convert caml value to %s */\n" % ty.rawname - - s +=3D "static int %s_val (libxl_ctx *ctx, %s, value v)\n" % (ty.rawna= me, ty.make_arg("c_val", passby=3Didl.PASS_BY_REFERENCE)) - s +=3D "{\n" - s +=3D "\tCAMLparam1(v);\n" - s +=3D "\n" - - s +=3D c_val(ty, "c_val", "v", indent=3D"\t") + "\n" - - s +=3D "\tCAMLreturn(0);\n" - s +=3D "}\n" - - return s.replace("\n", "\n%s" % indent) - -def ocaml_Val(ty, o, c, indent=3D"", parent =3D None): - s =3D indent - if isinstance(ty,idl.UInt): - if ty.width in [8, 16]: - # handle as ints - width =3D None - elif ty.width in [32, 64]: - width =3D ty.width - else: - raise NotImplementedError("Cannot handle %d-bit int" % ty.widt= h) - if width: - s +=3D "%s =3D caml_copy_int%d(%s);" % (o, width, c) - else: - s +=3D "%s =3D Val_int(%s);" % (o, c) - elif isinstance(ty,idl.Builtin): - if ty.typename not in builtins: - raise NotImplementedError("Unknown Builtin %s (%s)" % (ty.type= name, type(ty))) - _,_,fn =3D builtins[ty.typename] - if not fn: - raise NotImplementedError("No ocaml Val fn for Builtin %s (%s)= " % (ty.typename, type(ty))) - s +=3D "%s =3D %s;" % (o, fn % { "c": c }) - elif isinstance(ty, idl.Array): - s +=3D "{\n" - s +=3D "\t int i;\n" - s +=3D "\t CAMLlocal1(array_elem);\n" - s +=3D "\t %s =3D caml_alloc(%s,0);\n" % (o, parent + ty.lenvar= .name) - s +=3D "\t for(i=3D0; i<%s; i++) {\n" % (parent + ty.lenvar.nam= e) - s +=3D "\t %s\n" % ocaml_Val(ty.elem_type, "array_elem", c = + "[i]", "", parent=3Dparent) - s +=3D "\t Store_field(%s, i, array_elem);\n" % o - s +=3D "\t }\n" - s +=3D "\t}" - elif isinstance(ty,idl.Enumeration) and (parent is None): - n =3D 0 - s +=3D "switch(%s) {\n" % c - for e in ty.values: - s +=3D " case %s: %s =3D Val_int(%d); break;\n" % (e.name, = o, n) - n +=3D 1 - s +=3D " default: failwith_xl(ERROR_FAIL, \"cannot convert valu= e from %s\"); break;\n" % ty.typename - s +=3D "}" - elif isinstance(ty, idl.KeyedUnion): - n =3D 0 - m =3D 0 - s +=3D "switch(%s) {\n" % (parent + ty.keyvar.name) - for f in ty.fields: - s +=3D "\t case %s:\n" % f.enumname - if f.type is None: - s +=3D "\t /* %d: None */\n" % n - s +=3D "\t %s =3D Val_long(%d);\n" % (o,n) - n +=3D 1 - elif not f.type.has_fields(): - s +=3D "\t /* %d: Long */\n" % n - s +=3D "\t %s =3D Val_long(%d);\n" % (o,n) - n +=3D 1 - else: - s +=3D "\t /* %d: Block */\n" % m - (nparent,fexpr) =3D ty.member(c, f, parent is None) - s +=3D "\t {\n" - s +=3D "\t\t CAMLlocal1(tmp);\n" - s +=3D "\t\t %s =3D caml_alloc(%d,%d);\n" % (o, 1, = m) - s +=3D ocaml_Val(f.type, 'tmp', fexpr, indent=3D"\t\t = ", parent=3Dnparent) - s +=3D "\n" - s +=3D "\t\t Store_field(%s, 0, tmp);\n" % o - s +=3D "\t }\n" - m +=3D 1 - #s +=3D "\t %s =3D caml_alloc(%d,%d);\n" % (o,len(f= .type.fields),n) - s +=3D "\t break;\n" - s +=3D "\t default: failwith_xl(ERROR_FAIL, \"cannot convert va= lue from %s\"); break;\n" % ty.typename - s +=3D "\t}" - elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is= None): - s +=3D "{\n" - if ty.rawname is None: - fn =3D "anon_field" - else: - fn =3D "%s_field" % ty.rawname - s +=3D "\tCAMLlocal1(%s);\n" % fn - s +=3D "\n" - s +=3D "\t%s =3D caml_alloc_tuple(%d);\n" % (o, len(ty.fields)) - - n =3D 0 - for f in ty.fields: - if f.type.private: - continue - - (nparent,fexpr) =3D ty.member(c, f, parent is None) - - s +=3D "\n" - s +=3D "\t%s\n" % ocaml_Val(f.type, fn, ty.pass_arg(fexpr, c),= parent=3Dnparent) - s +=3D "\tStore_field(%s, %d, %s);\n" % (o, n, fn) - n =3D n + 1 - s +=3D "}" - else: - s +=3D "%s =3D Val_%s(%s);" % (o, ty.rawname, ty.pass_arg(c, paren= t is None)) - - return s.replace("\n", "\n%s" % indent).rstrip(indent) - -def gen_Val_ocaml(ty, indent=3D""): - s =3D "/* Convert %s to a caml value */\n" % ty.rawname - - s +=3D "static value Val_%s (%s)\n" % (ty.rawname, ty.make_arg(ty.rawn= ame+"_c")) - s +=3D "{\n" - s +=3D "\tCAMLparam0();\n" - s +=3D "\tCAMLlocal1(%s_ocaml);\n" % ty.rawname - - s +=3D ocaml_Val(ty, "%s_ocaml" % ty.rawname, "%s_c" % ty.rawname, ind= ent=3D"\t") + "\n" - - s +=3D "\tCAMLreturn(%s_ocaml);\n" % ty.rawname - s +=3D "}\n" - return s.replace("\n", "\n%s" % indent) - -def gen_c_stub_prototype(ty, fns): - s =3D "/* Stubs for %s */\n" % ty.rawname - for name,args in fns: - # For N args we return one value and take N-1 values as parameters - s +=3D "value %s(" % stub_fn_name(ty, name) - s +=3D ", ".join(["value v%d" % v for v in range(1,len(args))]) - s +=3D ");\n" - return s - -def gen_c_default(ty): - s =3D "/* Get the defaults for %s */\n" % ty.rawname - # Handle KeyedUnions... - union_types =3D [] - for f in ty.fields: - if isinstance(f.type, idl.KeyedUnion): - union_types.append(f.type.keyvar) - - s +=3D "value stub_libxl_%s_init(value ctx, %svalue unit)\n" % (ty.raw= name, - "".join(["value " + u.name + ", " for u in union_types])) - s +=3D "{\n" - s +=3D "\tCAMLparam%d(ctx, %sunit);\n" % (len(union_types) + 2, "".joi= n([u.name + ", " for u in union_types])) - s +=3D "\tCAMLlocal1(val);\n" - s +=3D "\tlibxl_%s c_val;\n" % ty.rawname - s +=3D "\tlibxl_%s_init(&c_val);\n" % ty.rawname - for u in union_types: - s +=3D "\tif (%s !=3D Val_none) {\n" % u.name - s +=3D "\t\t%s c =3D 0;\n" % u.type.typename - s +=3D "\t\t%s_val(CTX, &c, Some_val(%s));\n" % (u.type.rawname, u= .name) - s +=3D "\t\tlibxl_%s_init_%s(&c_val, c);\n" % (ty.rawname, u.name) - s +=3D "\t}\n" - s +=3D "\tval =3D Val_%s(&c_val);\n" % ty.rawname - if ty.dispose_fn: - s +=3D "\tlibxl_%s_dispose(&c_val);\n" % ty.rawname - s +=3D "\tCAMLreturn(val);\n" - s +=3D "}\n" - return s - -def gen_c_defaults(ty): - s =3D gen_c_default(ty) - return s - -def autogen_header(open_comment, close_comment): - s =3D open_comment + " AUTO-GENERATED FILE DO NOT EDIT " + close_comme= nt + "\n" - s +=3D open_comment + " autogenerated by \n" - s +=3D reduce(lambda x,y: x + " ", range(len(open_comment + " ")), "") - s +=3D "%s" % " ".join(sys.argv) - s +=3D "\n " + close_comment + "\n\n" - return s - -if __name__ =3D=3D '__main__': - if len(sys.argv) < 4: - print("Usage: genwrap.py ", file=3Dsys.std= err) - sys.exit(1) - - (_,types) =3D idl.parse(sys.argv[1]) - - # Do not generate these yet. - blacklist =3D [ - "cpupoolinfo", - "vcpuinfo", - ] - - for t in blacklist: - if t not in [ty.rawname for ty in types]: - print("unknown type %s in blacklist" % t) - - types =3D [ty for ty in types if not ty.rawname in blacklist] - - _ml =3D sys.argv[3] - ml =3D open(_ml, 'w') - ml.write(autogen_header("(*", "*)")) - - _mli =3D sys.argv[2] - mli =3D open(_mli, 'w') - mli.write(autogen_header("(*", "*)")) - - _cinc =3D sys.argv[4] - cinc =3D open(_cinc, 'w') - cinc.write(autogen_header("/*", "*/")) - - for ty in types: - if ty.private: - continue - #sys.stdout.write(" TYPE %-20s " % ty.rawname) - ml.write(gen_ocaml_ml(ty, False)) - ml.write("\n") - - mli.write(gen_ocaml_ml(ty, True)) - mli.write("\n") - - if ty.marshal_in(): - cinc.write(gen_c_val(ty)) - cinc.write("\n") - cinc.write(gen_Val_ocaml(ty)) - cinc.write("\n") - if ty.rawname in functions: - cinc.write(gen_c_stub_prototype(ty, functions[ty.rawname])) - cinc.write("\n") - if ty.init_fn is not None: - cinc.write(gen_c_defaults(ty)) - cinc.write("\n") - #sys.stdout.write("\n") - - ml.write("(* END OF AUTO-GENERATED CODE *)\n") - ml.close() - mli.write("(* END OF AUTO-GENERATED CODE *)\n") - mli.close() - cinc.close() diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenli= ght.ml.in deleted file mode 100644 index 6989bb6638cd..000000000000 --- a/tools/ocaml/libs/xl/xenlight.ml.in +++ /dev/null @@ -1,94 +0,0 @@ -(* - * Copyright (C) 2009-2011 Citrix Ltd. - * Author Vincent Hanquez - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type ctx -type domid =3D int -type devid =3D int - -(* @@LIBXL_TYPES@@ *) - -exception Error of (error * string) - -external ctx_alloc: Xentoollog.handle -> ctx =3D "stub_libxl_ctx_alloc" - -external test_raise_exception: unit -> unit =3D "stub_raise_exception" - -type event =3D - | POLLIN (* There is data to read *) - | POLLPRI (* There is urgent data to read *) - | POLLOUT (* Writing now will not block *) - | POLLERR (* Error condition (revents only) *) - | POLLHUP (* Device has been disconnected (revents only) *) - | POLLNVAL (* Invalid request: fd not open (revents only). *) - -module Domain =3D struct - external create_new : ctx -> Domain_config.t -> ?async:'a -> unit -> domi= d =3D "stub_libxl_domain_create_new" - external create_restore : ctx -> Domain_config.t -> (Unix.file_descr * Do= main_restore_params.t) -> - ?async:'a -> unit -> domid =3D "stub_libxl_domain_create_restore" - external shutdown : ctx -> domid -> ?async:'a -> unit -> unit =3D "stub_l= ibxl_domain_shutdown" - external reboot : ctx -> domid -> ?async:'a -> unit -> unit =3D "stub_lib= xl_domain_reboot" - external destroy : ctx -> domid -> ?async:'a -> unit -> unit =3D "stub_li= bxl_domain_destroy" - external suspend : ctx -> domid -> Unix.file_descr -> ?async:'a -> unit -= > unit =3D "stub_libxl_domain_suspend" - external pause : ctx -> domid -> ?async:'a -> unit =3D "stub_libxl_domain= _pause" - external unpause : ctx -> domid -> ?async:'a -> unit =3D "stub_libxl_doma= in_unpause" - - external send_trigger : ctx -> domid -> trigger -> int -> ?async:'a -> un= it =3D "stub_xl_send_trigger" - external send_sysrq : ctx -> domid -> char -> unit =3D "stub_xl_send_sysr= q" -end - -module Host =3D struct - type console_reader - exception End_of_file - - external xen_console_read_start : ctx -> int -> console_reader =3D "stub= _libxl_xen_console_read_start" - external xen_console_read_line : ctx -> console_reader -> string =3D "stu= b_libxl_xen_console_read_line" - external xen_console_read_finish : ctx -> console_reader -> unit =3D "stu= b_libxl_xen_console_read_finish" - - external send_debug_keys : ctx -> string -> unit =3D "stub_xl_send_debug_= keys" -end - -module Async =3D struct - type for_libxl - type event_hooks - type osevent_hooks - - external osevent_register_hooks' : ctx -> 'a -> osevent_hooks =3D "stub_l= ibxl_osevent_register_hooks" - external osevent_occurred_fd : ctx -> for_libxl -> Unix.file_descr -> eve= nt list -> event list -> unit =3D "stub_libxl_osevent_occurred_fd" - external osevent_occurred_timeout : ctx -> for_libxl -> unit =3D "stub_li= bxl_osevent_occurred_timeout" - - let osevent_register_hooks ctx ~user ~fd_register ~fd_modify ~fd_deregist= er ~timeout_register ~timeout_fire_now =3D - Callback.register "libxl_fd_register" fd_register; - Callback.register "libxl_fd_modify" fd_modify; - Callback.register "libxl_fd_deregister" fd_deregister; - Callback.register "libxl_timeout_register" timeout_register; - Callback.register "libxl_timeout_fire_now" timeout_fire_now; - osevent_register_hooks' ctx user - - let async_register_callback ~async_callback =3D - Callback.register "libxl_async_callback" async_callback - - external evenable_domain_death : ctx -> domid -> int -> unit =3D "stub_li= bxl_evenable_domain_death" - external event_register_callbacks' : ctx -> 'a -> event_hooks =3D "stub_l= ibxl_event_register_callbacks" - - let event_register_callbacks ctx ~user ~event_occurs_callback ~event_disa= ster_callback =3D - Callback.register "libxl_event_occurs_callback" event_occurs_callback; - Callback.register "libxl_event_disaster_callback" event_disaster_callbac= k; - event_register_callbacks' ctx user -end - -let register_exceptions () =3D - Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, "")); - Callback.register_exception "Xenlight.Host.End_of_file" (Host.End_of_file) - diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenl= ight.mli.in deleted file mode 100644 index b98a3db7e777..000000000000 --- a/tools/ocaml/libs/xl/xenlight.mli.in +++ /dev/null @@ -1,93 +0,0 @@ -(* - * Copyright (C) 2009-2011 Citrix Ltd. - * Author Vincent Hanquez - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) - -type ctx -type domid =3D int -type devid =3D int - -(* @@LIBXL_TYPES@@ *) - -exception Error of (error * string) - -val register_exceptions: unit -> unit - -external ctx_alloc: Xentoollog.handle -> ctx =3D "stub_libxl_ctx_alloc" - -external test_raise_exception: unit -> unit =3D "stub_raise_exception" - -type event =3D - | POLLIN (* There is data to read *) - | POLLPRI (* There is urgent data to read *) - | POLLOUT (* Writing now will not block *) - | POLLERR (* Error condition (revents only) *) - | POLLHUP (* Device has been disconnected (revents only) *) - | POLLNVAL (* Invalid request: fd not open (revents only). *) - -module Domain : sig - external create_new : ctx -> Domain_config.t -> ?async:'a -> unit -> domi= d =3D "stub_libxl_domain_create_new" - external create_restore : ctx -> Domain_config.t -> (Unix.file_descr * Do= main_restore_params.t) -> - ?async:'a -> unit -> domid =3D "stub_libxl_domain_create_restore" - external shutdown : ctx -> domid -> ?async:'a -> unit -> unit =3D "stub_l= ibxl_domain_shutdown" - external reboot : ctx -> domid -> ?async:'a -> unit -> unit =3D "stub_lib= xl_domain_reboot" - external destroy : ctx -> domid -> ?async:'a -> unit -> unit =3D "stub_li= bxl_domain_destroy" - external suspend : ctx -> domid -> Unix.file_descr -> ?async:'a -> unit -= > unit =3D "stub_libxl_domain_suspend" - external pause : ctx -> domid -> ?async:'a -> unit =3D "stub_libxl_domain= _pause" - external unpause : ctx -> domid -> ?async:'a -> unit =3D "stub_libxl_doma= in_unpause" - - external send_trigger : ctx -> domid -> trigger -> int -> ?async:'a -> un= it =3D "stub_xl_send_trigger" - external send_sysrq : ctx -> domid -> char -> unit =3D "stub_xl_send_sysr= q" -end - -module Host : sig - type console_reader - exception End_of_file - - external xen_console_read_start : ctx -> int -> console_reader =3D "stub= _libxl_xen_console_read_start" - external xen_console_read_line : ctx -> console_reader -> string =3D "stu= b_libxl_xen_console_read_line" - external xen_console_read_finish : ctx -> console_reader -> unit =3D "stu= b_libxl_xen_console_read_finish" - - external send_debug_keys : ctx -> string -> unit =3D "stub_xl_send_debug_= keys" -end - -module Async : sig - type for_libxl - type event_hooks - type osevent_hooks - - val osevent_register_hooks : ctx -> - user:'a -> - fd_register:('a -> Unix.file_descr -> event list -> for_libxl -> 'b) -> - fd_modify:('a -> Unix.file_descr -> 'b -> event list -> 'b) -> - fd_deregister:('a -> Unix.file_descr -> 'b -> unit) -> - timeout_register:('a -> int64 -> int64 -> for_libxl -> 'c) -> - timeout_fire_now:('a -> 'c -> 'c) -> - osevent_hooks - - external osevent_occurred_fd : ctx -> for_libxl -> Unix.file_descr -> eve= nt list -> event list -> unit =3D "stub_libxl_osevent_occurred_fd" - external osevent_occurred_timeout : ctx -> for_libxl -> unit =3D "stub_li= bxl_osevent_occurred_timeout" - - val async_register_callback : - async_callback:(result:error option -> user:'a -> unit) -> - unit - - external evenable_domain_death : ctx -> domid -> int -> unit =3D "stub_li= bxl_evenable_domain_death" - - val event_register_callbacks : ctx -> - user:'a -> - event_occurs_callback:('a -> Event.t -> unit) -> - event_disaster_callback:('a -> event_type -> string -> int -> unit) -> - event_hooks -end - diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xen= light_stubs.c deleted file mode 100644 index 45b8af61c74a..000000000000 --- a/tools/ocaml/libs/xl/xenlight_stubs.c +++ /dev/null @@ -1,1663 +0,0 @@ -/* - * Copyright (C) 2009-2011 Citrix Ltd. - * Author Vincent Hanquez - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - */ - -#include - -#define CAML_NAME_SPACE -#include -#include -#include -#include -#include -#include - -#include -#include -#include - -#include -#include - -#include -#include - -#include "caml_xentoollog.h" - -/* - * Starting with ocaml-3.09.3, CAMLreturn can only be used for ``value'' - * types. CAMLreturnT was only added in 3.09.4, so we define our own - * version here if needed. - */ -#ifndef CAMLreturnT -#define CAMLreturnT(type, result) do { \ - type caml__temp_result =3D (result); \ - caml_local_roots =3D caml__frame; \ - return (caml__temp_result); \ -} while (0) -#endif - -/* The following is equal to the CAMLreturn macro, but without the return = */ -#define CAMLdone do{ \ -caml_local_roots =3D caml__frame; \ -}while (0) - -#define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x))) -#define CTX ((libxl_ctx *) Ctx_val(ctx)) - -static char * dup_String_val(value s) -{ - int len; - char *c; - len =3D caml_string_length(s); - c =3D calloc(len + 1, sizeof(char)); - if (!c) - caml_raise_out_of_memory(); - memcpy(c, String_val(s), len); - return c; -} - -/* Forward reference: this is defined in the auto-generated include file b= elow. */ -static value Val_error (libxl_error error_c); - -static void failwith_xl(int error, char *fname) -{ - CAMLparam0(); - CAMLlocal1(arg); - static const value *exc =3D NULL; - - /* First time around, lookup by name */ - if (!exc) - exc =3D caml_named_value("Xenlight.Error"); - - if (!exc) - caml_invalid_argument("Exception Xenlight.Error not initialized, please = link xenlight.cma"); - - arg =3D caml_alloc(2, 0); - - Store_field(arg, 0, Val_error(error)); - Store_field(arg, 1, caml_copy_string(fname)); - - caml_raise_with_arg(*exc, arg); - CAMLreturn0; -} - -CAMLprim value stub_raise_exception(value unit) -{ - CAMLparam1(unit); - failwith_xl(ERROR_FAIL, "test exception"); - CAMLreturn(Val_unit); -} - -void ctx_finalize(value ctx) -{ - libxl_ctx_free(CTX); -} - -static struct custom_operations libxl_ctx_custom_operations =3D { - "libxl_ctx_custom_operations", - ctx_finalize /* custom_finalize_default */, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; - -CAMLprim value stub_libxl_ctx_alloc(value logger) -{ - CAMLparam1(logger); - CAMLlocal1(handle); - libxl_ctx *ctx; - int ret; - - ret =3D libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (xentoollog_logger *) Xtl= _val(logger)); - if (ret !=3D 0) \ - failwith_xl(ERROR_FAIL, "cannot init context"); - - handle =3D caml_alloc_custom(&libxl_ctx_custom_operations, sizeof(ctx), 0= , 1); - Ctx_val(handle) =3D ctx; - - CAMLreturn(handle); -} - -static int list_len(value v) -{ - int len =3D 0; - while ( v !=3D Val_emptylist ) { - len++; - v =3D Field(v, 1); - } - return len; -} - -static int libxl_key_value_list_val(libxl_key_value_list *c_val, - value v) -{ - CAMLparam1(v); - CAMLlocal1(elem); - int nr, i; - libxl_key_value_list array; - - nr =3D list_len(v); - - array =3D calloc((nr + 1) * 2, sizeof(char *)); - if (!array) - caml_raise_out_of_memory(); - - for (i=3D0; v !=3D Val_emptylist; i++, v =3D Field(v, 1) ) { - elem =3D Field(v, 0); - - array[i * 2] =3D dup_String_val(Field(elem, 0)); - array[i * 2 + 1] =3D dup_String_val(Field(elem, 1)); - } - - *c_val =3D array; - CAMLreturn(0); -} - -static value Val_key_value_list(libxl_key_value_list *c_val) -{ - CAMLparam0(); - CAMLlocal5(list, cons, key, val, kv); - int i; - - list =3D Val_emptylist; - for (i =3D libxl_string_list_length((libxl_string_list *) c_val) - 1; i >= =3D 0; i -=3D 2) { - val =3D caml_copy_string((*c_val)[i]); - key =3D caml_copy_string((*c_val)[i - 1]); - kv =3D caml_alloc_tuple(2); - Store_field(kv, 0, key); - Store_field(kv, 1, val); - - cons =3D caml_alloc(2, 0); - Store_field(cons, 0, kv); // head - Store_field(cons, 1, list); // tail - list =3D cons; - } - - CAMLreturn(list); -} - -static int libxl_string_list_val(libxl_string_list *c_val, value v) -{ - CAMLparam1(v); - int nr, i; - libxl_string_list array; - - nr =3D list_len(v); - - array =3D calloc(nr + 1, sizeof(char *)); - if (!array) - caml_raise_out_of_memory(); - - for (i=3D0; v !=3D Val_emptylist; i++, v =3D Field(v, 1) ) - array[i] =3D dup_String_val(Field(v, 0)); - - *c_val =3D array; - CAMLreturn(0); -} - -static value Val_string_list(libxl_string_list *c_val) -{ - CAMLparam0(); - CAMLlocal3(list, cons, string); - int i; - - list =3D Val_emptylist; - for (i =3D libxl_string_list_length(c_val) - 1; i >=3D 0; i--) { - string =3D caml_copy_string((*c_val)[i]); - cons =3D caml_alloc(2, 0); - Store_field(cons, 0, string); // head - Store_field(cons, 1, list); // tail - list =3D cons; - } - - CAMLreturn(list); -} - -/* Option type support as per http://www.linux-nantes.org/~fmonnier/ocaml/= ocaml-wrapping-c.php */ -#ifndef Val_none -#define Val_none Val_int(0) -#endif -#ifndef Some_val -#define Some_val(v) Field(v,0) -#endif - -static value Val_some(value v) -{ - CAMLparam1(v); - CAMLlocal1(some); - some =3D caml_alloc(1, 0); - Store_field(some, 0, v); - CAMLreturn(some); -} - -static value Val_mac (libxl_mac *c_val) -{ - CAMLparam0(); - CAMLlocal1(v); - int i; - - v =3D caml_alloc_tuple(6); - - for(i=3D0; i<6; i++) - Store_field(v, i, Val_int((*c_val)[i])); - - CAMLreturn(v); -} - -static int Mac_val(libxl_mac *c_val, value v) -{ - CAMLparam1(v); - int i; - - for(i=3D0; i<6; i++) - (*c_val)[i] =3D Int_val(Field(v, i)); - - CAMLreturn(0); -} - -static value Val_bitmap (libxl_bitmap *c_val) -{ - CAMLparam0(); - CAMLlocal1(v); - int i; - - if (c_val->size =3D=3D 0) - v =3D Atom(0); - else { - v =3D caml_alloc(8 * (c_val->size), 0); - libxl_for_each_bit(i, *c_val) { - if (libxl_bitmap_test(c_val, i)) - Store_field(v, i, Val_true); - else - Store_field(v, i, Val_false); - } - } - CAMLreturn(v); -} - -static int Bitmap_val(libxl_ctx *ctx, libxl_bitmap *c_val, value v) -{ - CAMLparam1(v); - int i, len =3D Wosize_val(v); - - c_val->size =3D 0; - if (len > 0 && libxl_bitmap_alloc(ctx, c_val, len)) - failwith_xl(ERROR_NOMEM, "cannot allocate bitmap"); - for (i=3D0; ibytes[i])); - - CAMLreturn(v); -} - -static int Ms_vm_genid_val(libxl_ms_vm_genid *c_val, value v) -{ - CAMLparam1(v); - int i; - - for(i=3D0; ibytes[i] =3D Int_val(Field(v, i)); - - CAMLreturn(0); -} - -static value Val_string_option(const char *c_val) -{ - CAMLparam0(); - CAMLlocal2(tmp1, tmp2); - if (c_val) { - tmp1 =3D caml_copy_string(c_val); - tmp2 =3D Val_some(tmp1); - CAMLreturn(tmp2); - } - else - CAMLreturn(Val_none); -} - -static char *String_option_val(value v) -{ - CAMLparam1(v); - char *s =3D NULL; - if (v !=3D Val_none) - s =3D dup_String_val(Some_val(v)); - CAMLreturnT(char *, s); -} - -#include "_libxl_types.inc" - -void async_callback(libxl_ctx *ctx, int rc, void *for_callback) -{ - caml_leave_blocking_section(); - CAMLparam0(); - CAMLlocal2(error, tmp); - static const value *func =3D NULL; - value *p =3D (value *) for_callback; - - if (func =3D=3D NULL) { - /* First time around, lookup by name */ - func =3D caml_named_value("libxl_async_callback"); - } - - if (rc =3D=3D 0) - error =3D Val_none; - else { - tmp =3D Val_error(rc); - error =3D Val_some(tmp); - } - - /* for_callback is a pointer to a "value" that was malloc'ed and - * registered with the OCaml GC. The value is handed back to OCaml - * in the following callback, after which the pointer is unregistered - * and freed. */ - caml_callback2(*func, error, *p); - - caml_remove_global_root(p); - free(p); - - CAMLdone; - caml_enter_blocking_section(); -} - -static libxl_asyncop_how *aohow_val(value async) -{ - CAMLparam1(async); - libxl_asyncop_how *ao_how =3D NULL; - value *p; - - if (async !=3D Val_none) { - /* for_callback must be a pointer to a "value" that is malloc'ed and - * registered with the OCaml GC. This ensures that the GC does not remove - * the corresponding OCaml heap blocks, and allows the GC to update the = value - * when blocks are moved around, while libxl is free to copy the pointer= if - * it needs to. - * The for_callback pointer must always be non-NULL. */ - p =3D malloc(sizeof(value)); - if (!p) - failwith_xl(ERROR_NOMEM, "cannot allocate value"); - *p =3D Some_val(async); - caml_register_global_root(p); - ao_how =3D malloc(sizeof(*ao_how)); - ao_how->callback =3D async_callback; - ao_how->u.for_callback =3D (void *) p; - } - - CAMLreturnT(libxl_asyncop_how *, ao_how); -} - -value stub_libxl_domain_create_new(value ctx, value domain_config, value a= sync, value unit) -{ - CAMLparam4(ctx, async, domain_config, unit); - int ret; - libxl_domain_config c_dconfig; - uint32_t c_domid; - libxl_asyncop_how *ao_how; - - libxl_domain_config_init(&c_dconfig); - ret =3D domain_config_val(CTX, &c_dconfig, domain_config); - if (ret !=3D 0) { - libxl_domain_config_dispose(&c_dconfig); - failwith_xl(ret, "domain_create_new"); - } - - ao_how =3D aohow_val(async); - - caml_enter_blocking_section(); - ret =3D libxl_domain_create_new(CTX, &c_dconfig, &c_domid, ao_how, NULL); - caml_leave_blocking_section(); - - free(ao_how); - libxl_domain_config_dispose(&c_dconfig); - - if (ret !=3D 0) - failwith_xl(ret, "domain_create_new"); - - CAMLreturn(Val_int(c_domid)); -} - -value stub_libxl_domain_create_restore(value ctx, value domain_config, val= ue params, - value async, value unit) -{ - CAMLparam5(ctx, domain_config, params, async, unit); - int ret; - libxl_domain_config c_dconfig; - libxl_domain_restore_params c_params; - uint32_t c_domid; - libxl_asyncop_how *ao_how; - int restore_fd; - - libxl_domain_config_init(&c_dconfig); - ret =3D domain_config_val(CTX, &c_dconfig, domain_config); - if (ret !=3D 0) { - libxl_domain_config_dispose(&c_dconfig); - failwith_xl(ret, "domain_create_restore"); - } - - libxl_domain_restore_params_init(&c_params); - ret =3D domain_restore_params_val(CTX, &c_params, Field(params, 1)); - if (ret !=3D 0) { - libxl_domain_restore_params_dispose(&c_params); - failwith_xl(ret, "domain_create_restore"); - } - - ao_how =3D aohow_val(async); - restore_fd =3D Int_val(Field(params, 0)); - - caml_enter_blocking_section(); - ret =3D libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, restore_fd, - -1, &c_params, ao_how, NULL); - caml_leave_blocking_section(); - - free(ao_how); - libxl_domain_config_dispose(&c_dconfig); - libxl_domain_restore_params_dispose(&c_params); - - if (ret !=3D 0) - failwith_xl(ret, "domain_create_restore"); - - CAMLreturn(Val_int(c_domid)); -} - -value stub_libxl_domain_shutdown(value ctx, value domid, value async, valu= e unit) -{ - CAMLparam4(ctx, domid, async, unit); - int ret; - uint32_t c_domid =3D Int_val(domid); - libxl_asyncop_how *ao_how =3D aohow_val(async); - - caml_enter_blocking_section(); - ret =3D libxl_domain_shutdown(CTX, c_domid, ao_how); - caml_leave_blocking_section(); - - free(ao_how); - - if (ret !=3D 0) - failwith_xl(ret, "domain_shutdown"); - - CAMLreturn(Val_unit); -} - -value stub_libxl_domain_reboot(value ctx, value domid, value async, value = unit) -{ - CAMLparam4(ctx, domid, async, unit); - int ret; - uint32_t c_domid =3D Int_val(domid); - libxl_asyncop_how *ao_how =3D aohow_val(async); - - caml_enter_blocking_section(); - ret =3D libxl_domain_reboot(CTX, c_domid, ao_how); - caml_leave_blocking_section(); - - free(ao_how); - - if (ret !=3D 0) - failwith_xl(ret, "domain_reboot"); - - CAMLreturn(Val_unit); -} - -value stub_libxl_domain_destroy(value ctx, value domid, value async, value= unit) -{ - CAMLparam4(ctx, domid, async, unit); - int ret; - uint32_t c_domid =3D Int_val(domid); - libxl_asyncop_how *ao_how =3D aohow_val(async); - - caml_enter_blocking_section(); - ret =3D libxl_domain_destroy(CTX, c_domid, ao_how); - caml_leave_blocking_section(); - - free(ao_how); - - if (ret !=3D 0) - failwith_xl(ret, "domain_destroy"); - - CAMLreturn(Val_unit); -} - -value stub_libxl_domain_suspend(value ctx, value domid, value fd, value as= ync, value unit) -{ - CAMLparam5(ctx, domid, fd, async, unit); - int ret; - uint32_t c_domid =3D Int_val(domid); - int c_fd =3D Int_val(fd); - libxl_asyncop_how *ao_how =3D aohow_val(async); - - caml_enter_blocking_section(); - ret =3D libxl_domain_suspend(CTX, c_domid, c_fd, 0, ao_how); - caml_leave_blocking_section(); - - free(ao_how); - - if (ret !=3D 0) - failwith_xl(ret, "domain_suspend"); - - CAMLreturn(Val_unit); -} - -value stub_libxl_domain_pause(value ctx, value domid, value async) -{ - CAMLparam3(ctx, domid, async); - int ret; - uint32_t c_domid =3D Int_val(domid); - libxl_asyncop_how *ao_how =3D aohow_val(async); - - caml_enter_blocking_section(); - ret =3D libxl_domain_pause(CTX, c_domid, ao_how); - caml_leave_blocking_section(); - - free(ao_how); - - if (ret !=3D 0) - failwith_xl(ret, "domain_pause"); - - CAMLreturn(Val_unit); -} - -value stub_libxl_domain_unpause(value ctx, value domid, value async) -{ - CAMLparam3(ctx, domid, async); - int ret; - uint32_t c_domid =3D Int_val(domid); - libxl_asyncop_how *ao_how =3D aohow_val(async); - - caml_enter_blocking_section(); - ret =3D libxl_domain_unpause(CTX, c_domid, ao_how); - caml_leave_blocking_section(); - - free(ao_how); - - if (ret !=3D 0) - failwith_xl(ret, "domain_unpause"); - - CAMLreturn(Val_unit); -} - -#define _STRINGIFY(x) #x -#define STRINGIFY(x) _STRINGIFY(x) - -#define _DEVICE_ADDREMOVE(type,fn,op) \ -value stub_xl_device_##type##_##op(value ctx, value info, value domid, \ - value async, value unit) \ -{ \ - CAMLparam5(ctx, info, domid, async, unit); \ - libxl_device_##type c_info; \ - int ret, marker_var; \ - uint32_t c_domid =3D Int_val(domid); \ - libxl_asyncop_how *ao_how =3D aohow_val(async); \ - \ - device_##type##_val(CTX, &c_info, info); \ - \ - caml_enter_blocking_section(); \ - ret =3D libxl_##fn##_##op(CTX, c_domid, &c_info, ao_how); \ - caml_leave_blocking_section(); \ - \ - free(ao_how); \ - libxl_device_##type##_dispose(&c_info); \ - \ - if (ret !=3D 0) \ - failwith_xl(ret, STRINGIFY(type) "_" STRINGIFY(op)); \ - \ - CAMLreturn(Val_unit); \ -} - -#define DEVICE_ADDREMOVE(type) \ - _DEVICE_ADDREMOVE(type, device_##type, add) \ - _DEVICE_ADDREMOVE(type, device_##type, remove) \ - _DEVICE_ADDREMOVE(type, device_##type, destroy) - -DEVICE_ADDREMOVE(disk) -DEVICE_ADDREMOVE(nic) -DEVICE_ADDREMOVE(vfb) -DEVICE_ADDREMOVE(vkb) -DEVICE_ADDREMOVE(pci) -_DEVICE_ADDREMOVE(disk, cdrom, insert) - -value stub_xl_device_nic_of_devid(value ctx, value domid, value devid) -{ - CAMLparam3(ctx, domid, devid); - CAMLlocal1(nic); - libxl_device_nic c_nic; - uint32_t c_domid =3D Int_val(domid); - int c_devid =3D Int_val(devid); - - caml_enter_blocking_section(); - libxl_devid_to_device_nic(CTX, c_domid, c_devid, &c_nic); - caml_leave_blocking_section(); - - nic =3D Val_device_nic(&c_nic); - libxl_device_nic_dispose(&c_nic); - - CAMLreturn(nic); -} - -value stub_xl_device_nic_list(value ctx, value domid) -{ - CAMLparam2(ctx, domid); - CAMLlocal2(list, temp); - libxl_device_nic *c_list; - int i, nb; - uint32_t c_domid =3D Int_val(domid); - - caml_enter_blocking_section(); - c_list =3D libxl_device_nic_list(CTX, c_domid, &nb); - caml_leave_blocking_section(); - - if (!c_list) - failwith_xl(ERROR_FAIL, "nic_list"); - - list =3D temp =3D Val_emptylist; - for (i =3D 0; i < nb; i++) { - list =3D caml_alloc_small(2, Tag_cons); - Field(list, 0) =3D Val_int(0); - Field(list, 1) =3D temp; - temp =3D list; - Store_field(list, 0, Val_device_nic(&c_list[i])); - } - libxl_device_nic_list_free(c_list, nb); - - CAMLreturn(list); -} - -value stub_xl_device_disk_list(value ctx, value domid) -{ - CAMLparam2(ctx, domid); - CAMLlocal2(list, temp); - libxl_device_disk *c_list; - int i, nb; - uint32_t c_domid =3D Int_val(domid); - - caml_enter_blocking_section(); - c_list =3D libxl_device_disk_list(CTX, c_domid, &nb); - caml_leave_blocking_section(); - - if (!c_list) - failwith_xl(ERROR_FAIL, "disk_list"); - - list =3D temp =3D Val_emptylist; - for (i =3D 0; i < nb; i++) { - list =3D caml_alloc_small(2, Tag_cons); - Field(list, 0) =3D Val_int(0); - Field(list, 1) =3D temp; - temp =3D list; - Store_field(list, 0, Val_device_disk(&c_list[i])); - } - libxl_device_disk_list_free(c_list, nb); - - CAMLreturn(list); -} - -value stub_xl_device_disk_of_vdev(value ctx, value domid, value vdev) -{ - CAMLparam3(ctx, domid, vdev); - CAMLlocal1(disk); - libxl_device_disk c_disk; - char *c_vdev; - uint32_t c_domid =3D Int_val(domid); - - c_vdev =3D strdup(String_val(vdev)); - - caml_enter_blocking_section(); - libxl_vdev_to_device_disk(CTX, c_domid, c_vdev, &c_disk); - caml_leave_blocking_section(); - - disk =3D Val_device_disk(&c_disk); - libxl_device_disk_dispose(&c_disk); - free(c_vdev); - - CAMLreturn(disk); -} - -value stub_xl_device_pci_list(value ctx, value domid) -{ - CAMLparam2(ctx, domid); - CAMLlocal2(list, temp); - libxl_device_pci *c_list; - int i, nb; - uint32_t c_domid =3D Int_val(domid); - - caml_enter_blocking_section(); - c_list =3D libxl_device_pci_list(CTX, c_domid, &nb); - caml_leave_blocking_section(); - - if (!c_list) - failwith_xl(ERROR_FAIL, "pci_list"); - - list =3D temp =3D Val_emptylist; - for (i =3D 0; i < nb; i++) { - list =3D caml_alloc_small(2, Tag_cons); - Field(list, 0) =3D Val_int(0); - Field(list, 1) =3D temp; - temp =3D list; - Store_field(list, 0, Val_device_pci(&c_list[i])); - libxl_device_pci_dispose(&c_list[i]); - } - free(c_list); - - CAMLreturn(list); -} - -value stub_xl_device_pci_assignable_add(value ctx, value info, value rebin= d) -{ - CAMLparam3(ctx, info, rebind); - libxl_device_pci c_info; - int ret, marker_var; - int c_rebind =3D (int) Bool_val(rebind); - - device_pci_val(CTX, &c_info, info); - - caml_enter_blocking_section(); - ret =3D libxl_device_pci_assignable_add(CTX, &c_info, c_rebind); - caml_leave_blocking_section(); - - libxl_device_pci_dispose(&c_info); - - if (ret !=3D 0) - failwith_xl(ret, "pci_assignable_add"); - - CAMLreturn(Val_unit); -} - -value stub_xl_device_pci_assignable_remove(value ctx, value info, value re= bind) -{ - CAMLparam3(ctx, info, rebind); - libxl_device_pci c_info; - int ret, marker_var; - int c_rebind =3D (int) Bool_val(rebind); - - device_pci_val(CTX, &c_info, info); - - caml_enter_blocking_section(); - ret =3D libxl_device_pci_assignable_remove(CTX, &c_info, c_rebind); - caml_leave_blocking_section(); - - libxl_device_pci_dispose(&c_info); - - if (ret !=3D 0) - failwith_xl(ret, "pci_assignable_remove"); - - CAMLreturn(Val_unit); -} - -value stub_xl_device_pci_assignable_list(value ctx) -{ - CAMLparam1(ctx); - CAMLlocal2(list, temp); - libxl_device_pci *c_list; - int i, nb; - uint32_t c_domid; - - caml_enter_blocking_section(); - c_list =3D libxl_device_pci_assignable_list(CTX, &nb); - caml_leave_blocking_section(); - - if (!c_list) - failwith_xl(ERROR_FAIL, "pci_assignable_list"); - - list =3D temp =3D Val_emptylist; - for (i =3D 0; i < nb; i++) { - list =3D caml_alloc_small(2, Tag_cons); - Field(list, 0) =3D Val_int(0); - Field(list, 1) =3D temp; - temp =3D list; - Store_field(list, 0, Val_device_pci(&c_list[i])); - } - libxl_device_pci_assignable_list_free(c_list, nb); - - CAMLreturn(list); -} - -value stub_xl_physinfo_get(value ctx) -{ - CAMLparam1(ctx); - CAMLlocal1(physinfo); - libxl_physinfo c_physinfo; - int ret; - - caml_enter_blocking_section(); - ret =3D libxl_get_physinfo(CTX, &c_physinfo); - caml_leave_blocking_section(); - - if (ret !=3D 0) - failwith_xl(ret, "get_physinfo"); - - physinfo =3D Val_physinfo(&c_physinfo); - - libxl_physinfo_dispose(&c_physinfo); - - CAMLreturn(physinfo); -} - -value stub_xl_cputopology_get(value ctx) -{ - CAMLparam1(ctx); - CAMLlocal3(topology, v, v0); - libxl_cputopology *c_topology; - int i, nr; - - caml_enter_blocking_section(); - c_topology =3D libxl_get_cpu_topology(CTX, &nr); - caml_leave_blocking_section(); - - if (!c_topology) - failwith_xl(ERROR_FAIL, "get_cpu_topologyinfo"); - - topology =3D caml_alloc_tuple(nr); - for (i =3D 0; i < nr; i++) { - if (c_topology[i].core !=3D LIBXL_CPUTOPOLOGY_INVALID_ENTRY) { - v0 =3D Val_cputopology(&c_topology[i]); - v =3D Val_some(v0); - } - else - v =3D Val_none; - Store_field(topology, i, v); - } - - libxl_cputopology_list_free(c_topology, nr); - - CAMLreturn(topology); -} - -value stub_xl_dominfo_list(value ctx) -{ - CAMLparam1(ctx); - CAMLlocal2(domlist, temp); - libxl_dominfo *c_domlist; - int i, nb; - - caml_enter_blocking_section(); - c_domlist =3D libxl_list_domain(CTX, &nb); - caml_leave_blocking_section(); - - if (!c_domlist) - failwith_xl(ERROR_FAIL, "dominfo_list"); - - domlist =3D temp =3D Val_emptylist; - for (i =3D nb - 1; i >=3D 0; i--) { - domlist =3D caml_alloc_small(2, Tag_cons); - Field(domlist, 0) =3D Val_int(0); - Field(domlist, 1) =3D temp; - temp =3D domlist; - - Store_field(domlist, 0, Val_dominfo(&c_domlist[i])); - } - - libxl_dominfo_list_free(c_domlist, nb); - - CAMLreturn(domlist); -} - -value stub_xl_dominfo_get(value ctx, value domid) -{ - CAMLparam2(ctx, domid); - CAMLlocal1(dominfo); - libxl_dominfo c_dominfo; - int ret; - uint32_t c_domid =3D Int_val(domid); - - caml_enter_blocking_section(); - ret =3D libxl_domain_info(CTX, &c_dominfo, c_domid); - caml_leave_blocking_section(); - - if (ret !=3D 0) - failwith_xl(ERROR_FAIL, "domain_info"); - dominfo =3D Val_dominfo(&c_dominfo); - - CAMLreturn(dominfo); -} - -value stub_xl_domain_sched_params_get(value ctx, value domid) -{ - CAMLparam2(ctx, domid); - CAMLlocal1(scinfo); - libxl_domain_sched_params c_scinfo; - int ret; - uint32_t c_domid =3D Int_val(domid); - - caml_enter_blocking_section(); - ret =3D libxl_domain_sched_params_get(CTX, c_domid, &c_scinfo); - caml_leave_blocking_section(); - - if (ret !=3D 0) - failwith_xl(ret, "domain_sched_params_get"); - - scinfo =3D Val_domain_sched_params(&c_scinfo); - - libxl_domain_sched_params_dispose(&c_scinfo); - - CAMLreturn(scinfo); -} - -value stub_xl_domain_sched_params_set(value ctx, value domid, value scinfo) -{ - CAMLparam3(ctx, domid, scinfo); - libxl_domain_sched_params c_scinfo; - int ret; - uint32_t c_domid =3D Int_val(domid); - - domain_sched_params_val(CTX, &c_scinfo, scinfo); - - caml_enter_blocking_section(); - ret =3D libxl_domain_sched_params_set(CTX, c_domid, &c_scinfo); - caml_leave_blocking_section(); - - libxl_domain_sched_params_dispose(&c_scinfo); - - if (ret !=3D 0) - failwith_xl(ret, "domain_sched_params_set"); - - CAMLreturn(Val_unit); -} - -value stub_xl_send_trigger(value ctx, value domid, value trigger, value vc= puid, value async) -{ - CAMLparam5(ctx, domid, trigger, vcpuid, async); - int ret; - uint32_t c_domid =3D Int_val(domid); - libxl_trigger c_trigger =3D LIBXL_TRIGGER_UNKNOWN; - int c_vcpuid =3D Int_val(vcpuid); - libxl_asyncop_how *ao_how =3D aohow_val(async); - - trigger_val(CTX, &c_trigger, trigger); - - caml_enter_blocking_section(); - ret =3D libxl_send_trigger(CTX, c_domid, c_trigger, c_vcpuid, ao_how); - caml_leave_blocking_section(); - - free(ao_how); - - if (ret !=3D 0) - failwith_xl(ret, "send_trigger"); - - CAMLreturn(Val_unit); -} - -value stub_xl_send_sysrq(value ctx, value domid, value sysrq) -{ - CAMLparam3(ctx, domid, sysrq); - int ret; - uint32_t c_domid =3D Int_val(domid); - int c_sysrq =3D Int_val(sysrq); - - caml_enter_blocking_section(); - ret =3D libxl_send_sysrq(CTX, c_domid, c_sysrq); - caml_leave_blocking_section(); - - if (ret !=3D 0) - failwith_xl(ret, "send_sysrq"); - - CAMLreturn(Val_unit); -} - -value stub_xl_send_debug_keys(value ctx, value keys) -{ - CAMLparam2(ctx, keys); - int ret; - char *c_keys; - - c_keys =3D dup_String_val(keys); - - caml_enter_blocking_section(); - ret =3D libxl_send_debug_keys(CTX, c_keys); - caml_leave_blocking_section(); - - free(c_keys); - - if (ret !=3D 0) - failwith_xl(ret, "send_debug_keys"); - - CAMLreturn(Val_unit); -} - -static struct custom_operations libxl_console_reader_custom_operations =3D= { - "libxl_console_reader_custom_operations", - custom_finalize_default, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; - -#define Console_reader_val(x)(*((libxl_xen_console_reader **) Data_custom_= val(x))) - -value stub_libxl_xen_console_read_start(value ctx, value clear) -{ - CAMLparam2(ctx, clear); - CAMLlocal1(handle); - int c_clear =3D Int_val(clear); - libxl_xen_console_reader *cr; - - caml_enter_blocking_section(); - cr =3D libxl_xen_console_read_start(CTX, c_clear); - caml_leave_blocking_section(); - - handle =3D caml_alloc_custom(&libxl_console_reader_custom_operations, siz= eof(cr), 0, 1); - Console_reader_val(handle) =3D cr; - - CAMLreturn(handle); -} - -static void raise_eof(void) -{ - static const value *exc =3D NULL; - - /* First time around, lookup by name */ - if (!exc) - exc =3D caml_named_value("Xenlight.Host.End_of_file"); - - if (!exc) - caml_invalid_argument("Exception Xenlight.Host.End_of_file not initializ= ed, please link xenlight.cma"); - - caml_raise_constant(*exc); -} - -value stub_libxl_xen_console_read_line(value ctx, value reader) -{ - CAMLparam2(ctx, reader); - CAMLlocal1(line); - int ret; - char *c_line; - libxl_xen_console_reader *cr =3D (libxl_xen_console_reader *) Console_rea= der_val(reader); - - caml_enter_blocking_section(); - ret =3D libxl_xen_console_read_line(CTX, cr, &c_line); - caml_leave_blocking_section(); - - if (ret < 0) - failwith_xl(ret, "xen_console_read_line"); - if (ret =3D=3D 0) - raise_eof(); - - line =3D caml_copy_string(c_line); - - CAMLreturn(line); -} - -value stub_libxl_xen_console_read_finish(value ctx, value reader) -{ - CAMLparam2(ctx, reader); - libxl_xen_console_reader *cr =3D (libxl_xen_console_reader *) Console_rea= der_val(reader); - - caml_enter_blocking_section(); - libxl_xen_console_read_finish(CTX, cr); - caml_leave_blocking_section(); - - CAMLreturn(Val_unit); -} - -/* Event handling */ - -short Poll_val(value event) -{ - CAMLparam1(event); - short res =3D -1; - - switch (Int_val(event)) { - case 0: res =3D POLLIN; break; - case 1: res =3D POLLPRI; break; - case 2: res =3D POLLOUT; break; - case 3: res =3D POLLERR; break; - case 4: res =3D POLLHUP; break; - case 5: res =3D POLLNVAL; break; - } - - CAMLreturn(res); -} - -short Poll_events_val(value event_list) -{ - CAMLparam1(event_list); - short events =3D 0; - - while (event_list !=3D Val_emptylist) { - events |=3D Poll_val(Field(event_list, 0)); - event_list =3D Field(event_list, 1); - } - - CAMLreturn(events); -} - -value Val_poll(short event) -{ - CAMLparam0(); - CAMLlocal1(res); - - switch (event) { - case POLLIN: res =3D Val_int(0); break; - case POLLPRI: res =3D Val_int(1); break; - case POLLOUT: res =3D Val_int(2); break; - case POLLERR: res =3D Val_int(3); break; - case POLLHUP: res =3D Val_int(4); break; - case POLLNVAL: res =3D Val_int(5); break; - default: failwith_xl(ERROR_FAIL, "cannot convert poll event value"); bre= ak; - } - - CAMLreturn(res); -} - -value add_event(value event_list, short event) -{ - CAMLparam1(event_list); - CAMLlocal1(new_list); - - new_list =3D caml_alloc(2, 0); - Store_field(new_list, 0, Val_poll(event)); - Store_field(new_list, 1, event_list); - - CAMLreturn(new_list); -} - -value Val_poll_events(short events) -{ - CAMLparam0(); - CAMLlocal1(event_list); - - event_list =3D Val_emptylist; - if (events & POLLIN) - event_list =3D add_event(event_list, POLLIN); - if (events & POLLPRI) - event_list =3D add_event(event_list, POLLPRI); - if (events & POLLOUT) - event_list =3D add_event(event_list, POLLOUT); - if (events & POLLERR) - event_list =3D add_event(event_list, POLLERR); - if (events & POLLHUP) - event_list =3D add_event(event_list, POLLHUP); - if (events & POLLNVAL) - event_list =3D add_event(event_list, POLLNVAL); - - CAMLreturn(event_list); -} - -/* The process for dealing with the for_app_registration_ values in the - * callbacks below (GC registrations etc) is similar to the way for_callba= ck is - * handled in the asynchronous operations above. */ - -int fd_register(void *user, int fd, void **for_app_registration_out, - short events, void *for_libxl) -{ - caml_leave_blocking_section(); - CAMLparam0(); - CAMLlocalN(args, 4); - int ret =3D 0; - static const value *func =3D NULL; - value *p =3D (value *) user; - value *for_app; - - if (func =3D=3D NULL) { - /* First time around, lookup by name */ - func =3D caml_named_value("libxl_fd_register"); - } - - args[0] =3D *p; - args[1] =3D Val_int(fd); - args[2] =3D Val_poll_events(events); - args[3] =3D (value) for_libxl; - - for_app =3D malloc(sizeof(value)); - if (!for_app) { - ret =3D ERROR_OSEVENT_REG_FAIL; - goto err; - } - - *for_app =3D caml_callbackN_exn(*func, 4, args); - if (Is_exception_result(*for_app)) { - ret =3D ERROR_OSEVENT_REG_FAIL; - free(for_app); - goto err; - } - - caml_register_global_root(for_app); - *for_app_registration_out =3D for_app; - -err: - CAMLdone; - caml_enter_blocking_section(); - return ret; -} - -int fd_modify(void *user, int fd, void **for_app_registration_update, - short events) -{ - caml_leave_blocking_section(); - CAMLparam0(); - CAMLlocalN(args, 4); - int ret =3D 0; - static const value *func =3D NULL; - value *p =3D (value *) user; - value *for_app =3D *for_app_registration_update; - - /* If for_app =3D=3D NULL, then something is very wrong */ - assert(for_app); - - if (func =3D=3D NULL) { - /* First time around, lookup by name */ - func =3D caml_named_value("libxl_fd_modify"); - } - - args[0] =3D *p; - args[1] =3D Val_int(fd); - args[2] =3D *for_app; - args[3] =3D Val_poll_events(events); - - *for_app =3D caml_callbackN_exn(*func, 4, args); - if (Is_exception_result(*for_app)) { - /* If an exception is caught, *for_app_registration_update is not - * changed. It remains a valid pointer to a value that is registered - * with the GC. */ - ret =3D ERROR_OSEVENT_REG_FAIL; - goto err; - } - - *for_app_registration_update =3D for_app; - -err: - CAMLdone; - caml_enter_blocking_section(); - return ret; -} - -void fd_deregister(void *user, int fd, void *for_app_registration) -{ - caml_leave_blocking_section(); - CAMLparam0(); - CAMLlocalN(args, 3); - static const value *func =3D NULL; - value *p =3D (value *) user; - value *for_app =3D for_app_registration; - - /* If for_app =3D=3D NULL, then something is very wrong */ - assert(for_app); - - if (func =3D=3D NULL) { - /* First time around, lookup by name */ - func =3D caml_named_value("libxl_fd_deregister"); - } - - args[0] =3D *p; - args[1] =3D Val_int(fd); - args[2] =3D *for_app; - - caml_callbackN_exn(*func, 3, args); - /* This hook does not return error codes, so the best thing we can do - * to avoid trouble, if we catch an exception from the app, is abort. */ - if (Is_exception_result(*for_app)) - abort(); - - caml_remove_global_root(for_app); - free(for_app); - - CAMLdone; - caml_enter_blocking_section(); -} - -struct timeout_handles { - void *for_libxl; - value for_app; -}; - -int timeout_register(void *user, void **for_app_registration_out, - struct timeval abs, void *for_libxl) -{ - caml_leave_blocking_section(); - CAMLparam0(); - CAMLlocal2(sec, usec); - CAMLlocalN(args, 4); - int ret =3D 0; - static const value *func =3D NULL; - value *p =3D (value *) user; - struct timeout_handles *handles; - - if (func =3D=3D NULL) { - /* First time around, lookup by name */ - func =3D caml_named_value("libxl_timeout_register"); - } - - sec =3D caml_copy_int64(abs.tv_sec); - usec =3D caml_copy_int64(abs.tv_usec); - - /* This struct of "handles" will contain "for_libxl" as well as "for_app". - * We'll give a pointer to the struct to the app, and get it back in - * occurred_timeout, where we can clean it all up. */ - handles =3D malloc(sizeof(*handles)); - if (!handles) { - ret =3D ERROR_OSEVENT_REG_FAIL; - goto err; - } - - handles->for_libxl =3D for_libxl; - - args[0] =3D *p; - args[1] =3D sec; - args[2] =3D usec; - args[3] =3D (value) handles; - - handles->for_app =3D caml_callbackN_exn(*func, 4, args); - if (Is_exception_result(handles->for_app)) { - ret =3D ERROR_OSEVENT_REG_FAIL; - free(handles); - goto err; - } - - caml_register_global_root(&handles->for_app); - *for_app_registration_out =3D handles; - -err: - CAMLdone; - caml_enter_blocking_section(); - return ret; -} - -int timeout_modify(void *user, void **for_app_registration_update, - struct timeval abs) -{ - caml_leave_blocking_section(); - CAMLparam0(); - CAMLlocal1(for_app_update); - CAMLlocalN(args, 2); - int ret =3D 0; - static const value *func =3D NULL; - value *p =3D (value *) user; - struct timeout_handles *handles =3D *for_app_registration_update; - - /* If for_app =3D=3D NULL, then something is very wrong */ - assert(handles->for_app); - - /* Libxl currently promises that timeout_modify is only ever called with - * abs=3D{0,0}, meaning "right away". We cannot deal with other values. */ - assert(abs.tv_sec =3D=3D 0 && abs.tv_usec =3D=3D 0); - - if (func =3D=3D NULL) { - /* First time around, lookup by name */ - func =3D caml_named_value("libxl_timeout_fire_now"); - } - - args[0] =3D *p; - args[1] =3D handles->for_app; - - for_app_update =3D caml_callbackN_exn(*func, 2, args); - if (Is_exception_result(for_app_update)) { - /* If an exception is caught, *for_app_registration_update is not - * changed. It remains a valid pointer to a value that is registered - * with the GC. */ - ret =3D ERROR_OSEVENT_REG_FAIL; - goto err; - } - - handles->for_app =3D for_app_update; - -err: - CAMLdone; - caml_enter_blocking_section(); - return ret; -} - -void timeout_deregister(void *user, void *for_app_registration) -{ - /* This hook will never be called by libxl. */ - abort(); -} - -value stub_libxl_osevent_register_hooks(value ctx, value user) -{ - CAMLparam2(ctx, user); - CAMLlocal1(result); - libxl_osevent_hooks *hooks; - value *p; - - hooks =3D malloc(sizeof(*hooks)); - if (!hooks) - failwith_xl(ERROR_NOMEM, "cannot allocate osevent hooks"); - hooks->fd_register =3D fd_register; - hooks->fd_modify =3D fd_modify; - hooks->fd_deregister =3D fd_deregister; - hooks->timeout_register =3D timeout_register; - hooks->timeout_modify =3D timeout_modify; - hooks->timeout_deregister =3D timeout_deregister; - - p =3D malloc(sizeof(value)); - if (!p) - failwith_xl(ERROR_NOMEM, "cannot allocate value"); - *p =3D user; - caml_register_global_root(p); - - caml_enter_blocking_section(); - libxl_osevent_register_hooks(CTX, hooks, (void *) p); - caml_leave_blocking_section(); - - result =3D caml_alloc(1, Abstract_tag); - *((libxl_osevent_hooks **) result) =3D hooks; - - CAMLreturn(result); -} - -value stub_libxl_osevent_occurred_fd(value ctx, value for_libxl, value fd, - value events, value revents) -{ - CAMLparam5(ctx, for_libxl, fd, events, revents); - int c_fd =3D Int_val(fd); - short c_events =3D Poll_events_val(events); - short c_revents =3D Poll_events_val(revents); - - caml_enter_blocking_section(); - libxl_osevent_occurred_fd(CTX, (void *) for_libxl, c_fd, c_events, c_reve= nts); - caml_leave_blocking_section(); - - CAMLreturn(Val_unit); -} - -value stub_libxl_osevent_occurred_timeout(value ctx, value handles) -{ - CAMLparam1(ctx); - struct timeout_handles *c_handles =3D (struct timeout_handles *) handles; - - caml_enter_blocking_section(); - libxl_osevent_occurred_timeout(CTX, (void *) c_handles->for_libxl); - caml_leave_blocking_section(); - - caml_remove_global_root(&c_handles->for_app); - free(c_handles); - - CAMLreturn(Val_unit); -} - -struct user_with_ctx { - libxl_ctx *ctx; - value user; -}; - -void event_occurs(void *user, libxl_event *event) -{ - caml_leave_blocking_section(); - CAMLparam0(); - CAMLlocalN(args, 2); - struct user_with_ctx *c_user =3D (struct user_with_ctx *) user; - static const value *func =3D NULL; - - if (func =3D=3D NULL) { - /* First time around, lookup by name */ - func =3D caml_named_value("libxl_event_occurs_callback"); - } - - args[0] =3D c_user->user; - args[1] =3D Val_event(event); - libxl_event_free(c_user->ctx, event); - - caml_callbackN(*func, 2, args); - CAMLdone; - caml_enter_blocking_section(); -} - -void disaster(void *user, libxl_event_type type, - const char *msg, int errnoval) -{ - caml_leave_blocking_section(); - CAMLparam0(); - CAMLlocalN(args, 4); - struct user_with_ctx *c_user =3D (struct user_with_ctx *) user; - static const value *func =3D NULL; - - if (func =3D=3D NULL) { - /* First time around, lookup by name */ - func =3D caml_named_value("libxl_event_disaster_callback"); - } - - args[0] =3D c_user->user; - args[1] =3D Val_event_type(type); - args[2] =3D caml_copy_string(msg); - args[3] =3D Val_int(errnoval); - - caml_callbackN(*func, 4, args); - CAMLdone; - caml_enter_blocking_section(); -} - -value stub_libxl_event_register_callbacks(value ctx, value user) -{ - CAMLparam2(ctx, user); - CAMLlocal1(result); - struct user_with_ctx *c_user =3D NULL; - libxl_event_hooks *hooks; - - c_user =3D malloc(sizeof(*c_user)); - if (!c_user) - failwith_xl(ERROR_NOMEM, "cannot allocate user value"); - c_user->user =3D user; - c_user->ctx =3D CTX; - caml_register_global_root(&c_user->user); - - hooks =3D malloc(sizeof(*hooks)); - if (!hooks) - failwith_xl(ERROR_NOMEM, "cannot allocate event hooks"); - hooks->event_occurs_mask =3D LIBXL_EVENTMASK_ALL; - hooks->event_occurs =3D event_occurs; - hooks->disaster =3D disaster; - - caml_enter_blocking_section(); - libxl_event_register_callbacks(CTX, hooks, (void *) c_user); - caml_leave_blocking_section(); - - result =3D caml_alloc(1, Abstract_tag); - *((libxl_event_hooks **) result) =3D hooks; - - CAMLreturn(result); -} - -value stub_libxl_evenable_domain_death(value ctx, value domid, value user) -{ - CAMLparam3(ctx, domid, user); - uint32_t c_domid =3D Int_val(domid); - int c_user =3D Int_val(user); - libxl_evgen_domain_death *evgen_out; - - caml_enter_blocking_section(); - libxl_evenable_domain_death(CTX, c_domid, c_user, &evgen_out); - caml_leave_blocking_section(); - - CAMLreturn(Val_unit); -} - -/* - * Local variables: - * indent-tabs-mode: t - * c-basic-offset: 8 - * tab-width: 8 - * End: - */ diff --git a/tools/ocaml/test/Makefile b/tools/ocaml/test/Makefile deleted file mode 100644 index 256c830c512b..000000000000 --- a/tools/ocaml/test/Makefile +++ /dev/null @@ -1,55 +0,0 @@ -XEN_ROOT =3D $(CURDIR)/../../.. -OCAML_TOPLEVEL =3D $(CURDIR)/.. -include $(OCAML_TOPLEVEL)/common.make - -CFLAGS +=3D $(APPEND_CFLAGS) - -OCAMLINCLUDE +=3D \ - -I $(OCAML_TOPLEVEL)/libs/xentoollog \ - -I $(OCAML_TOPLEVEL)/libs/xl - -OBJS =3D xtl send_debug_keys list_domains raise_exception dmesg - -PROGRAMS =3D xtl send_debug_keys list_domains raise_exception dmesg - -xtl_LIBS =3D \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs= /xentoollog/xentoollog.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenl= ight.cmxa - -xtl_OBJS =3D xtl - -send_debug_keys_LIBS =3D \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs= /xentoollog/xentoollog.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenl= ight.cmxa - -send_debug_keys_OBJS =3D xtl send_debug_keys - -list_domains_LIBS =3D \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs= /xentoollog/xentoollog.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenl= ight.cmxa - -list_domains_OBJS =3D xtl list_domains - -raise_exception_LIBS =3D \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs= /xentoollog/xentoollog.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenl= ight.cmxa - -raise_exception_OBJS =3D raise_exception - -dmesg_LIBS =3D \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs= /xentoollog/xentoollog.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenl= ight.cmxa - -dmesg_OBJS =3D xtl dmesg - -OCAML_PROGRAM =3D xtl send_debug_keys list_domains raise_exception dmesg - -all: $(PROGRAMS) - -bins: $(PROGRAMS) - -install: - -uninstall: - -include $(OCAML_TOPLEVEL)/Makefile.rules diff --git a/tools/ocaml/test/dmesg.ml b/tools/ocaml/test/dmesg.ml deleted file mode 100644 index f9efe5dc3066..000000000000 --- a/tools/ocaml/test/dmesg.ml +++ /dev/null @@ -1,17 +0,0 @@ - -let _ =3D - Xenlight.register_exceptions (); - let logger =3D Xtl.create_stdio_logger ~level:Xentoollog.Debug () in - let ctx =3D Xenlight.ctx_alloc logger in - - let open Xenlight.Host in - let reader =3D xen_console_read_start ctx 0 in - (try - while true do - let line =3D xen_console_read_line ctx reader in - print_string line - done - with End_of_file -> ()); - let _ =3D xen_console_read_finish ctx reader in - () - diff --git a/tools/ocaml/test/list_domains.ml b/tools/ocaml/test/list_domai= ns.ml deleted file mode 100644 index 94f1cec05043..000000000000 --- a/tools/ocaml/test/list_domains.ml +++ /dev/null @@ -1,26 +0,0 @@ -open Printf - -let bool_as_char b c =3D if b then c else '-' - -let print_dominfo dominfo =3D - let id =3D dominfo.Xenlight.Dominfo.domid - and running =3D bool_as_char dominfo.Xenlight.Dominfo.running 'r' - and blocked =3D bool_as_char dominfo.Xenlight.Dominfo.blocked 'b' - and paused =3D bool_as_char dominfo.Xenlight.Dominfo.paused 'p' - and shutdown =3D bool_as_char dominfo.Xenlight.Dominfo.shutdown 's' - and dying =3D bool_as_char dominfo.Xenlight.Dominfo.dying 'd' - and memory =3D dominfo.Xenlight.Dominfo.current_memkb - in - printf "Dom %d: %c%c%c%c%c %LdKB\n" id running blocked paused shutdown d= ying memory - -let _ =3D - let logger =3D Xtl.create_stdio_logger (*~level:Xentoollog.Debug*) () in - let ctx =3D Xenlight.ctx_alloc logger in - try - let domains =3D Xenlight.Dominfo.list ctx in - List.iter (fun d -> print_dominfo d) domains - with Xenlight.Error(err, fn) -> begin - printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) f= n; - end - - diff --git a/tools/ocaml/test/raise_exception.ml b/tools/ocaml/test/raise_e= xception.ml deleted file mode 100644 index 8c24c3555b58..000000000000 --- a/tools/ocaml/test/raise_exception.ml +++ /dev/null @@ -1,9 +0,0 @@ -open Printf - -let _ =3D - try - Xenlight.test_raise_exception () - with Xenlight.Error(err, fn) -> begin - printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) f= n; - end - diff --git a/tools/ocaml/test/send_debug_keys.ml b/tools/ocaml/test/send_de= bug_keys.ml deleted file mode 100644 index 67b1605dfe20..000000000000 --- a/tools/ocaml/test/send_debug_keys.ml +++ /dev/null @@ -1,13 +0,0 @@ -open Printf - -let send_keys ctx s =3D - printf "Sending debug key %s\n" s; - Xenlight.Host.send_debug_keys ctx s; - () - -let _ =3D - let logger =3D Xtl.create_stdio_logger () in - let ctx =3D Xenlight.ctx_alloc logger in - Arg.parse [ - ] (fun s -> send_keys ctx s) "usage: send_debug_keys " - diff --git a/tools/ocaml/test/xtl.ml b/tools/ocaml/test/xtl.ml deleted file mode 100644 index 458b11bbaac2..000000000000 --- a/tools/ocaml/test/xtl.ml +++ /dev/null @@ -1,39 +0,0 @@ -open Printf -open Xentoollog - -let stdio_vmessage min_level level errno ctx msg =3D - let level_str =3D level_to_string level - and errno_str =3D match errno with None -> "" | Some s -> sprintf ": err= no=3D%d" s - and ctx_str =3D match ctx with None -> "" | Some s -> sprintf ": %s" s in - if compare min_level level <=3D 0 then begin - printf "%s%s%s: %s\n" level_str ctx_str errno_str msg; - flush stdout; - end - -let stdio_progress _ctx what percent dne total =3D - let nl =3D if dne =3D total then "\n" else "" in - printf "\rProgress %s %d%% (%Ld/%Ld)%s" what percent dne total nl; - flush stdout - -let create_stdio_logger ?(level=3DInfo) () =3D - let cbs =3D { - vmessage =3D stdio_vmessage level; - progress =3D stdio_progress; } in - create "Xentoollog.stdio_logger" cbs - -let do_test level =3D - let lgr =3D create_stdio_logger ~level:level () in - begin - test lgr; - end - -let () =3D - let debug_level =3D ref Info in - let speclist =3D [ - ("-v", Arg.Unit (fun () -> debug_level :=3D Debug), "Verbose"); - ("-q", Arg.Unit (fun () -> debug_level :=3D Critical), "Quiet"); - ] in - let usage_msg =3D "usage: xtl [OPTIONS]" in - Arg.parse speclist (fun _ -> ()) usage_msg; - - do_test !debug_level --=20 2.11.0