WARNING - OLD ARCHIVES

This is an archived copy of the Xen.org mailing list, which we have preserved to ensure that existing links to archives are not broken. The live archive, which contains the latest emails, can be found at http://lists.xen.org/
   
 
 
Xen 
 
Home Products Support Community News
 
   
 

xen-devel

[Xen-devel] [PATCH 24 of 24] tools: ocaml: autogenerate xl datatype defi

To: xen-devel@xxxxxxxxxxxxxxxxxxx
Subject: [Xen-devel] [PATCH 24 of 24] tools: ocaml: autogenerate xl datatype definitions and ocaml<->C conversion
From: Ian Campbell <ian.campbell@xxxxxxxxxx>
Date: Wed, 13 Apr 2011 15:37:05 +0100
Cc: Vincent Hanquez <Vincent.Hanquez@xxxxxxxxxxxxx>, Dave Scott <Dave.Scott@xxxxxxxxxxxxx>
Delivery-date: Wed, 13 Apr 2011 08:07:47 -0700
Envelope-to: www-data@xxxxxxxxxxxxxxxxxxx
In-reply-to: <patchbomb.1302705401@xxxxxxxxxxxxxxxxxxxxxxxxx>
List-help: <mailto:xen-devel-request@lists.xensource.com?subject=help>
List-id: Xen developer discussion <xen-devel.lists.xensource.com>
List-post: <mailto:xen-devel@lists.xensource.com>
List-subscribe: <http://lists.xensource.com/mailman/listinfo/xen-devel>, <mailto:xen-devel-request@lists.xensource.com?subject=subscribe>
List-unsubscribe: <http://lists.xensource.com/mailman/listinfo/xen-devel>, <mailto:xen-devel-request@lists.xensource.com?subject=unsubscribe>
References: <patchbomb.1302705401@xxxxxxxxxxxxxxxxxxxxxxxxx>
Sender: xen-devel-bounces@xxxxxxxxxxxxxxxxxxx
User-agent: Mercurial-patchbomb/1.6.4
# HG changeset patch
# User Ian Campbell <ian.campbell@xxxxxxxxxx>
# Date 1302698152 -3600
# Node ID 12c05af7227399ac7f2f7897b4fdf0b972a42892
# Parent  5bbea737a0dc092bf377129a057b01b15944b041
tools: ocaml: autogenerate xl datatype definitions and ocaml<->C conversion

The method by which ocaml converts between ocaml types and C
datastructures is based around explicit matching of field indexes
within the ocaml data type to C structure members which is error prone
to write and fragile to maintain (as evidenced by the difference
between the existing hand coded support and the autogenerated code
which shows how out of date the ocaml bindings have
become). Autogenerating these types should reduce these problems.

There is a short list of types which are blacklisted and not
autogenerated because I expect them to change significantly in the
future due to changes to the IDL type (fixing up the TaggedUnion
class).

Signed-off-by: Ian Campbell <ian.campbell@xxxxxxxxxx>

diff -r 5bbea737a0dc -r 12c05af72273 tools/ocaml/libs/xl/Makefile
--- a/tools/ocaml/libs/xl/Makefile      Wed Apr 13 13:35:52 2011 +0100
+++ b/tools/ocaml/libs/xl/Makefile      Wed Apr 13 13:35:52 2011 +0100
@@ -2,6 +2,8 @@ TOPLEVEL=$(CURDIR)/../..
 XEN_ROOT=$(TOPLEVEL)/../..
 include $(TOPLEVEL)/common.make
 
+# ignore unused generated functions
+CFLAGS += -Wno-unused
 CFLAGS += $(CFLAGS_libxenlight)
 
 OBJS = xl
diff -r 5bbea737a0dc -r 12c05af72273 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py    Wed Apr 13 13:35:52 2011 +0100
+++ b/tools/ocaml/libs/xl/genwrap.py    Wed Apr 13 13:35:52 2011 +0100
@@ -4,6 +4,218 @@ import sys,os
 
 import libxltypes
 
+# typename -> ( ocaml_type, c_from_ocaml, ocaml_from_c )
+builtins = {
+    "bool":                 ("bool",                   "%(c)s = 
Bool_val(%(o)s)",           "Val_bool(%(c)s)" ),
+    "int":                  ("int",                    "%(c)s = 
Int_val(%(o)s)",            "Val_int(%(c)s)"  ),
+    "long":                 ("int",                    "%(c)s = 
Int_val(%(o)s)",            "Val_int(%(c)s)"  ),
+    "unsigned int":         ("int",                    "%(c)s = 
Int_val(%(o)s)",            "Val_int(%(c)s)"  ),
+    "unsigned long":        ("int",                    "%(c)s = 
Int_val(%(o)s)",            "Val_int(%(c)s)"  ),
+    "char *":               ("string",                 "%(c)s = 
dup_String_val(gc, %(o)s)", "caml_copy_string(%(c)s)"),
+    "libxl_domid":          ("domid",                  "%(c)s = 
Int_val(%(o)s)",            "Val_int(%(c)s)"  ),
+    "libxl_uuid":           ("int array",              "Uuid_val(gc, lg, 
&%(c)s, %(o)s)",   "Val_uuid(&%(c)s)"),
+    "libxl_key_value_list": ("(string * string) list", None,                   
             None),
+    "libxl_mac":            ("int array",              "Mac_val(gc, lg, 
&%(c)s, %(o)s)",    "Val_mac(&%(c)s)"),
+    "libxl_hwcap":          ("int32 array",            None,                   
             "Val_hwcap(&%(c)s)"),
+    }
+
+functions = {
+    "device_disk":    [ "external add : t -> domid -> unit = 
\"stub_xl_device_disk_add\"",
+                        "external del : t -> domid -> unit = 
\"stub_xl_device_disk_del\"",
+                      ],
+    "device_nic":     [ "external add : t -> domid -> unit = 
\"stub_xl_device_nic_add\"",
+                        "external del : t -> domid -> unit = 
\"stub_xl_device_nic_del\"",
+                      ],
+    "device_vfb":     [ "external add : t -> domid -> unit = 
\"stub_xl_device_vfb_add\"",
+                        "external clean_shutdown : domid -> unit = 
\"stub_xl_device_vfb_clean_shutdown\"",
+                        "external hard_shutdown : domid -> unit = 
\"stub_xl_device_vfb_hard_shutdown\"",
+                      ],
+    "device_vkb":     [ "external add : t -> domid -> unit = 
\"stub_xl_device_vkb_add\"",
+                        "external clean_shutdown : domid -> unit = 
\"stub_xl_device_vkb_clean_shutdown\"",
+                        "external hard_shutdown : domid -> unit = 
\"stub_xl_device_vkb_hard_shutdown\"",
+                      ],
+    "device_pci":     [ "external add : t -> domid -> unit = 
\"stub_xl_device_pci_add\"",
+                        "external remove : t -> domid -> unit = 
\"stub_xl_device_pci_remove\"",
+                        "external shutdown : domid -> unit = 
\"stub_xl_device_pci_shutdown\"",
+                      ],
+    "physinfo":       [ "external get : unit -> t = \"stub_xl_physinfo\"",
+                      ],
+    "sched_credit":   [ "external domain_get : domid -> t = 
\"stub_xl_sched_credit_domain_get\"",
+                        "external domain_set : domid -> t -> unit = 
\"stub_xl_sched_credit_domain_set\"",
+                      ],
+}
+
+def ocaml_type_of(ty):
+    if ty.rawname == "domid":
+        return "domid"
+    elif isinstance(ty,libxltypes.UInt):
+        # standard ocaml "int" type is 31-bit signed.
+        if ty.width > 64:
+            raise NotImplementedError("Cannot handle %d-bit int" % ty.width)
+        elif ty.width > 32:
+            return "int64"
+        else:
+            return "int32"
+    elif isinstance(ty,libxltypes.Builtin):
+        if not builtins.has_key(ty.typename):
+            raise NotImplementedError("Unknown Builtin %s (%s)" % 
(ty.typename, type(ty)))
+        typename,_,_ = builtins[ty.typename]
+        if not typename:
+            raise NotImplementedError("No typename for Builtin %s (%s)" % 
(ty.typename, type(ty)))
+        return typename
+    else:
+        return ty.rawname
+
+def ocaml_instance_of(type, name):
+    return "%s : %s" % (name, ocaml_type_of(type))
+
+def gen_ocaml_ml(ty, interface, indent=""):
+
+    if interface:
+        s = ("""(* %s interface *)\n""" % ty.typename)
+    else:
+        s = ("""(* %s implementation *)\n""" % ty.typename)
+    if isinstance(ty, libxltypes.Enumeration):
+        s = "type %s = \n" % ty.rawname
+        for v in ty.values:
+            s += "\t | %s\n" % v.rawname
+    elif isinstance(ty, libxltypes.Aggregate):
+        s = ""
+        if ty.typename is None:
+            raise NotImplementedError("%s has no typename" % type(ty))
+        else:
+
+            module_name = ty.rawname[0].upper() + ty.rawname[1:]
+
+            if interface:
+                s += "module %s : sig\n" % module_name
+            else:
+                s += "module %s = struct\n" % module_name
+            s += "\ttype t =\n"
+            s += "\t{\n"
+            
+        for f in ty.fields:
+            x = ocaml_instance_of(f.type, f.name)
+            x = x.replace("\n", "\n\t\t")
+            s += "\t\t" + x + ";\n"
+
+        s += "\t}\n"
+        
+        if functions.has_key(ty.rawname):
+            for fn in functions[ty.rawname]:
+                s += "\t%s\n" % fn
+        
+        s += "end\n"
+
+    else:
+        raise NotImplementedError("%s" % type(ty))
+    return s.replace("\n", "\n%s" % indent)
+
+def c_val(ty, c, o, indent="", parent = None):
+    if ty.passby == libxltypes.PASS_BY_REFERENCE:
+        makeref = ""
+    else:
+        makeref = "&"
+
+    s = indent
+    if isinstance(ty,libxltypes.UInt):
+        s += "%s = Int_val(%s);" % (c, o)
+    elif isinstance(ty,libxltypes.Builtin):
+        if not builtins.has_key(ty.typename):
+            raise NotImplementedError("Unknown Builtin %s (%s)" % 
(ty.typename, type(ty)))
+        _,fn,_ = builtins[ty.typename]
+        if not fn:
+            raise NotImplementedError("No c_val fn for Builtin %s (%s)" % 
(ty.typename, type(ty)))
+        s += "%s;" % (fn % { "o": o, "c": c })
+    elif isinstance(ty,libxltypes.Enumeration) and (parent is None):
+        n = 0
+        s += "switch(Int_val(%s)) {\n" % o
+        for e in ty.values:
+            s += "    case %d: *%s = %s; break;\n" % (n, c, e.name)
+            n += 1
+        s += "    default: failwith_xl(\"cannot convert value to %s\", lg); 
break;\n" % ty.typename
+        s += "}"
+    elif isinstance(ty, libxltypes.Aggregate) and (parent is None):
+        n = 0
+        for f in ty.fields:
+            s += "%s\n" % c_val(f.type, "%s->%s" % (c, f.name), "Field(%s, 
%d)" % (o,n), parent="%s->" % (c))
+            n = n + 1
+    else:
+        s += "%s_val(gc, lg, %s, %s);" % (ty.rawname, makeref + c, o)
+    
+    return s.replace("\n", "\n%s" % indent)
+
+def gen_c_val(ty, indent=""):
+    s = ""
+    
+    s += "static int %s_val (caml_gc *gc, struct caml_logger *lg, %s *c_val, 
value v)\n" % (ty.rawname, ty.typename)
+    s += "{\n"
+    s += "\tCAMLparam1(v);\n"
+    s += "\n"
+
+    s += c_val(ty, "c_val", "v", indent="\t") + "\n"
+    
+    s += "\tCAMLreturn(0);\n"
+    s += "}\n"
+    
+    return s.replace("\n", "\n%s" % indent)
+
+def ocaml_Val(ty, o, c, indent="", parent = None):
+    if ty.passby == libxltypes.PASS_BY_REFERENCE:
+        makeref = ""
+    else:
+        makeref = "&"
+    
+    s = indent
+    if isinstance(ty,libxltypes.UInt):
+        s += "%s = Val_int(%s);" % (o, c)
+    elif isinstance(ty,libxltypes.Builtin):
+        if not builtins.has_key(ty.typename):
+            raise NotImplementedError("Unknown Builtin %s (%s)" % 
(ty.typename, type(ty)))
+        _,_,fn = builtins[ty.typename]
+        if not fn:
+            raise NotImplementedError("No ocaml_Val fn for Builtin %s (%s)" % 
(ty.typename, type(ty)))
+        s += "%s = %s;" % (o, fn % { "c": c })
+    elif isinstance(ty,libxltypes.Enumeration) and (parent is None):
+        n = 0
+        s += "switch(*%s) {\n" % c
+        for e in ty.values:
+            s += "    case %s: %s = Int_val(%d); break;\n" % (e.name, o, n)
+            n += 1
+        s += "    default: failwith_xl(\"cannot convert value from %s\", lg); 
break;\n" % ty.typename
+        s += "}"
+    elif isinstance(ty,libxltypes.Aggregate) and (parent is None):
+        s += "{\n"
+        s += "\tvalue %s_field;\n" % ty.rawname
+        s += "\n"
+        s += "\t%s = caml_alloc_tuple(%d);\n" % (o, len(ty.fields))
+        
+        n = 0
+        for f in ty.fields:
+            s += "\n"
+            s += "\t%s\n" % ocaml_Val(f.type, "%s_field" % ty.rawname, 
"%s->%s" % (c,f.name), parent="%s->" % c)
+            s += "\tStore_field(%s, %d, %s);\n" % (o, n, "%s_field" % 
ty.rawname)
+            n = n + 1
+        s += "}"
+    else:
+        s += "%s = Val_%s(gc, lg, %s);" % (o, ty.rawname, makeref + c)
+    
+    return s.replace("\n", "\n%s" % indent).rstrip(indent)
+
+def gen_Val_ocaml(ty, indent=""):
+    s = ""
+
+    s += "static value Val_%s (caml_gc *gc, struct caml_logger *lg, %s 
*%s_c)\n" % (ty.rawname, ty.typename, ty.rawname)
+    s += "{\n"
+    s += "\tCAMLparam0();\n"
+    s += "\tCAMLlocal1(%s_ocaml);\n" % ty.rawname
+
+    s += ocaml_Val(ty, "%s_ocaml" % ty.rawname, "%s_c" % ty.rawname, 
indent="\t") + "\n"
+    
+    s += "\tCAMLreturn(%s_ocaml);\n" % ty.rawname
+    s += "}\n"
+    return s.replace("\n", "\n%s" % indent)
+
 def autogen_header(open_comment, close_comment):
     s = open_comment + " AUTO-GENERATED FILE DO NOT EDIT " + close_comment + 
"\n"
     s += open_comment + " autogenerated by \n"
@@ -20,6 +232,19 @@ if __name__ == '__main__':
     idl = sys.argv[1]
     (_,types) = libxltypes.parse(idl)
 
+    # Do not generate these yet.
+    blacklist = [
+        "cpupoolinfo",
+        "domain_create_info",
+        "domain_build_info",
+        "domain_build_state",
+        "device_model_info",
+        "device_console",
+        "vcpuinfo",
+        "topologyinfo",
+        ]
+
+    types = [ty for ty in types if not ty.rawname in blacklist]
     
     _ml = sys.argv[3]
     ml = open(_ml, 'w')
@@ -33,8 +258,22 @@ if __name__ == '__main__':
     cinc = open(_cinc, 'w')
     cinc.write(autogen_header("/*", "*/"))
 
-    # TODO: autogenerate something
+    for ty in types:
+        #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")
+        if ty.marshal_out():
+            cinc.write(gen_Val_ocaml(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")
diff -r 5bbea737a0dc -r 12c05af72273 tools/ocaml/libs/xl/xl.ml.in
--- a/tools/ocaml/libs/xl/xl.ml.in      Wed Apr 13 13:35:52 2011 +0100
+++ b/tools/ocaml/libs/xl/xl.ml.in      Wed Apr 13 13:35:52 2011 +0100
@@ -19,135 +19,6 @@ type domid = int
 
 (* @@LIBXL_TYPES@@ *)
 
-type console_type =
-       | CONSOLETYPE_XENCONSOLED
-       | CONSOLETYPE_IOEMU
-
-type disk_phystype =
-       | PHYSTYPE_QCOW
-       | PHYSTYPE_QCOW2
-       | PHYSTYPE_VHD
-       | PHYSTYPE_AIO
-       | PHYSTYPE_FILE
-       | PHYSTYPE_PHY
-
-type nic_type =
-       | NICTYPE_IOEMU
-       | NICTYPE_VIF
-
-type button =
-       | Button_Power
-       | Button_Sleep
-
-module Device_vfb = struct
-       type t =
-       {
-               backend_domid : domid;
-               devid : int;
-               vnc : bool;
-               vnclisten : string;
-               vncpasswd : string;
-               vncdisplay : int;
-               vncunused : bool;
-               keymap : string;
-               sdl : bool;
-               opengl : bool;
-               display : string;
-               xauthority : string;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_vfb_add"
-       external clean_shutdown : domid -> unit = 
"stub_xl_device_vfb_clean_shutdown"
-       external hard_shutdown : domid -> unit = 
"stub_xl_device_vfb_hard_shutdown"
-end
-
-module Device_vkb = struct
-       type t =
-       {
-               backend_domid : domid;
-               devid : int;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_vkb_add"
-       external clean_shutdown : domid -> unit = 
"stub_xl_device_vkb_clean_shutdown"
-       external hard_shutdown : domid -> unit = 
"stub_xl_device_vkb_hard_shutdown"
-end
-
-module Device_disk = struct
-       type t =
-       {
-               backend_domid : domid;
-               physpath : string;
-               phystype : disk_phystype;
-               virtpath : string;
-               unpluggable : bool;
-               readwrite : bool;
-               is_cdrom : bool;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_disk_add"
-       external del : t -> domid -> unit = "stub_xl_device_disk_del"
-end
-
-module Device_nic = struct
-       type t =
-       {
-               backend_domid : domid;
-               devid : int;
-               mtu : int;
-               model : string;
-               mac : int array;
-               bridge : string;
-               ifname : string;
-               script : string;
-               nictype : nic_type;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_nic_add"
-       external del : t -> domid -> unit = "stub_xl_device_nic_del"
-end
-
-module Device_pci = struct
-       type t =
-       {
-               func : int;
-               dev : int;
-               bus : int;
-               domain : int;
-               vdevfn : int;
-               msitranslate : bool;
-               power_mgmt : bool;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_pci_add"
-       external remove : t -> domid -> unit = "stub_xl_device_pci_remove"
-       external shutdown : domid -> unit = "stub_xl_device_pci_shutdown"
-end
-
-module Physinfo = struct
-       type t =
-       {
-               threads_per_core : int;
-               cores_per_socket : int;
-               max_cpu_id : int;
-               nr_cpus : int;
-               cpu_khz : int;
-               total_pages : int64;
-               free_pages : int64;
-               scrub_pages : int64;
-               nr_nodes : int;
-               hwcap : int32 array;
-               physcap : int32;
-       }
-       external get : unit -> t = "stub_xl_physinfo"
-
-end
-
-module Sched_credit = struct
-       type t =
-       {
-               weight : int;
-               cap : int;
-       }
-       external domain_get : domid -> t = "stub_xl_sched_credit_domain_get"
-       external domain_set : domid -> t -> unit = 
"stub_xl_sched_credit_domain_set"
-end
-
 module Device_build_state = struct
        type t =
        {
diff -r 5bbea737a0dc -r 12c05af72273 tools/ocaml/libs/xl/xl.mli.in
--- a/tools/ocaml/libs/xl/xl.mli.in     Wed Apr 13 13:35:52 2011 +0100
+++ b/tools/ocaml/libs/xl/xl.mli.in     Wed Apr 13 13:35:52 2011 +0100
@@ -19,134 +19,6 @@ type domid = int
 
 (* @@LIBXL_TYPES@@ *)
 
-type console_type =
-       | CONSOLETYPE_XENCONSOLED
-       | CONSOLETYPE_IOEMU
-
-type disk_phystype =
-       | PHYSTYPE_QCOW
-       | PHYSTYPE_QCOW2
-       | PHYSTYPE_VHD
-       | PHYSTYPE_AIO
-       | PHYSTYPE_FILE
-       | PHYSTYPE_PHY
-
-type nic_type =
-       | NICTYPE_IOEMU
-       | NICTYPE_VIF
-
-type button =
-       | Button_Power
-       | Button_Sleep
-
-module Device_vfb : sig
-       type t =
-       {
-               backend_domid : domid;
-               devid : int;
-               vnc : bool;
-               vnclisten : string;
-               vncpasswd : string;
-               vncdisplay : int;
-               vncunused : bool;
-               keymap : string;
-               sdl : bool;
-               opengl : bool;
-               display : string;
-               xauthority : string;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_vfb_add"
-       external clean_shutdown : domid -> unit = 
"stub_xl_device_vfb_clean_shutdown"
-       external hard_shutdown : domid -> unit = 
"stub_xl_device_vfb_hard_shutdown"
-end
-
-module Device_vkb : sig
-       type t =
-       {
-               backend_domid : domid;
-               devid : int;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_vkb_add"
-       external clean_shutdown : domid -> unit = 
"stub_xl_device_vkb_clean_shutdown"
-       external hard_shutdown : domid -> unit = 
"stub_xl_device_vkb_hard_shutdown"
-end
-
-module Device_disk : sig
-       type t =
-       {
-               backend_domid : domid;
-               physpath : string;
-               phystype : disk_phystype;
-               virtpath : string;
-               unpluggable : bool;
-               readwrite : bool;
-               is_cdrom : bool;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_disk_add"
-       external del : t -> domid -> unit = "stub_xl_device_disk_del"
-end
-
-module Device_nic : sig
-       type t =
-       {
-               backend_domid : domid;
-               devid : int;
-               mtu : int;
-               model : string;
-               mac : int array;
-               bridge : string;
-               ifname : string;
-               script : string;
-               nictype : nic_type;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_nic_add"
-       external del : t -> domid -> unit = "stub_xl_device_nic_del"
-end
-
-module Device_pci : sig
-       type t =
-       {
-               func : int;
-               dev : int;
-               bus : int;
-               domain : int;
-               vdevfn : int;
-               msitranslate : bool;
-               power_mgmt : bool;
-       }
-       external add : t -> domid -> unit = "stub_xl_device_pci_add"
-       external remove : t -> domid -> unit = "stub_xl_device_pci_remove"
-       external shutdown : domid -> unit = "stub_xl_device_pci_shutdown"
-end
-
-module Physinfo : sig
-       type t =
-       {
-               threads_per_core : int;
-               cores_per_socket : int;
-               max_cpu_id : int;
-               nr_cpus : int;
-               cpu_khz : int;
-               total_pages : int64;
-               free_pages : int64;
-               scrub_pages : int64;
-               nr_nodes : int;
-               hwcap : int32 array;
-               physcap : int32;
-       }
-       external get : unit -> t = "stub_xl_physinfo"
-end
-
-module Sched_credit : sig
-       type t =
-       {
-               weight : int;
-               cap : int;
-       }
-       external domain_get : domid -> t = "stub_xl_sched_credit_domain_get"
-       external domain_set : domid -> t -> unit = 
"stub_xl_sched_credit_domain_set"
-end
-
 module Device_build_state : sig
        type t =
        {
diff -r 5bbea737a0dc -r 12c05af72273 tools/ocaml/libs/xl/xl_stubs.c
--- a/tools/ocaml/libs/xl/xl_stubs.c    Wed Apr 13 13:35:52 2011 +0100
+++ b/tools/ocaml/libs/xl/xl_stubs.c    Wed Apr 13 13:35:52 2011 +0100
@@ -130,55 +130,76 @@ static int string_string_tuple_array_val
 
 #endif
 
-#include "_libxl_types.inc"
+static value Val_mac (libxl_mac *c_val)
+{
+       CAMLparam0();
+       CAMLlocal1(v);
+       int i;
 
-static int device_disk_val(caml_gc *gc, libxl_device_disk *c_val, value v)
+       v = caml_alloc_tuple(6);
+
+       for(i=0; i<6; i++)
+               Store_field(v, i, Val_int((*c_val)[i]));
+
+       CAMLreturn(v);
+}
+
+static int Mac_val(caml_gc *gc, struct caml_logger *lg, libxl_mac *c_val, 
value v)
 {
        CAMLparam1(v);
+       int i;
 
-       c_val->backend_domid = Int_val(Field(v, 0));
-       c_val->pdev_path = dup_String_val(gc, Field(v, 1));
-       c_val->vdev = dup_String_val(gc, Field(v, 2));
-        c_val->backend = (Int_val(Field(v, 3)));
-        c_val->format = (Int_val(Field(v, 4)));
-       c_val->unpluggable = Bool_val(Field(v, 5));
-       c_val->readwrite = Bool_val(Field(v, 6));
-       c_val->is_cdrom = Bool_val(Field(v, 7));
+       for(i=0; i<6; i++)
+               (*c_val)[i] = Int_val(Field(v, i));
 
        CAMLreturn(0);
 }
 
-static int device_nic_val(caml_gc *gc, libxl_device_nic *c_val, value v)
+static value Val_uuid (libxl_uuid *c_val)
+{
+       CAMLparam0();
+       CAMLlocal1(v);
+       uint8_t *uuid = libxl_uuid_bytearray(c_val);
+       int i;
+
+       v = caml_alloc_tuple(16);
+
+       for(i=0; i<16; i++)
+               Store_field(v, i, Val_int(uuid[i]));
+
+       CAMLreturn(v);
+}
+
+static int Uuid_val(caml_gc *gc, struct caml_logger *lg, libxl_uuid *c_val, 
value v)
 {
        CAMLparam1(v);
        int i;
-       int ret = 0;
-       c_val->backend_domid = Int_val(Field(v, 0));
-       c_val->devid = Int_val(Field(v, 1));
-       c_val->mtu = Int_val(Field(v, 2));
-       c_val->model = dup_String_val(gc, Field(v, 3));
+       uint8_t *uuid = libxl_uuid_bytearray(c_val);
 
-       if (Wosize_val(Field(v, 4)) != 6) {
-               ret = 1;
-               goto out;
-       }
-       for (i = 0; i < 6; i++)
-               c_val->mac[i] = Int_val(Field(Field(v, 4), i));
+       for(i=0; i<16; i++)
+               uuid[i] = Int_val(Field(v, i));
 
-       /* not handling c_val->ip */
-       c_val->bridge = dup_String_val(gc, Field(v, 5));
-       c_val->ifname = dup_String_val(gc, Field(v, 6));
-       c_val->script = dup_String_val(gc, Field(v, 7));
-       c_val->nictype = (Int_val(Field(v, 8))) + LIBXL_NIC_TYPE_IOEMU;
+       CAMLreturn(0);
+}
 
-out:
-       CAMLreturn(ret);
+static value Val_hwcap(libxl_hwcap *c_val)
+{
+       CAMLparam0();
+       CAMLlocal1(hwcap);
+       int i;
+
+       hwcap = caml_alloc_tuple(8);
+       for (i = 0; i < 8; i++)
+               Store_field(hwcap, i, caml_copy_int32((*c_val)[i]));
+
+       CAMLreturn(hwcap);
 }
 
+#include "_libxl_types.inc"
+
 static int device_console_val(caml_gc *gc, libxl_device_console *c_val, value 
v)
 {
        CAMLparam1(v);
-
        c_val->backend_domid = Int_val(Field(v, 0));
        c_val->devid = Int_val(Field(v, 1));
        c_val->consback = (Int_val(Field(v, 2))) + 
LIBXL_CONSOLE_BACKEND_XENCONSOLED;
@@ -186,59 +207,6 @@ static int device_console_val(caml_gc *g
        CAMLreturn(0);
 }
 
-static int device_vkb_val(caml_gc *gc, libxl_device_vkb *c_val, value v)
-{
-       CAMLparam1(v);
-
-       c_val->backend_domid = Int_val(Field(v, 0));
-       c_val->devid = Int_val(Field(v, 1));
-
-       CAMLreturn(0);
-}
-
-static int device_vfb_val(caml_gc *gc, libxl_device_vfb *c_val, value v)
-{
-       CAMLparam1(v);
-
-       c_val->backend_domid = Int_val(Field(v, 0));
-       c_val->devid = Int_val(Field(v, 1));
-       c_val->vnc = Bool_val(Field(v, 2));
-       c_val->vnclisten = dup_String_val(gc, Field(v, 3));
-       c_val->vncpasswd = dup_String_val(gc, Field(v, 4));
-       c_val->vncdisplay = Int_val(Field(v, 5));
-       c_val->keymap = dup_String_val(gc, Field(v, 6));
-       c_val->sdl = Bool_val(Field(v, 7));
-       c_val->opengl = Bool_val(Field(v, 8));
-       c_val->display = dup_String_val(gc, Field(v, 9));
-       c_val->xauthority = dup_String_val(gc, Field(v, 10));
-
-       CAMLreturn(0);
-}
-
-static int device_pci_val(caml_gc *gc, libxl_device_pci *c_val, value v)
-{
-       CAMLparam1(v);
-
-       c_val->func = Int_val(Field(v, 0));
-       c_val->dev = Int_val(Field(v, 1));
-       c_val->bus = Int_val(Field(v, 2));
-
-       c_val->domain = Int_val(Field(v, 3));
-       c_val->vdevfn = Int_val(Field(v, 4));
-       c_val->msitranslate = Bool_val(Field(v, 5));
-       c_val->power_mgmt = Bool_val(Field(v, 6));
-
-       CAMLreturn(0);
-}
-
-static int sched_credit_val(caml_gc *gc, libxl_sched_credit *c_val, value v)
-{
-       CAMLparam1(v);
-       c_val->weight = Int_val(Field(v, 0));
-       c_val->cap = Int_val(Field(v, 1));
-       CAMLreturn(0);
-}
-
 static int domain_build_state_val(caml_gc *gc, libxl_domain_build_state 
*c_val, value v)
 {
        CAMLparam1(v);
@@ -251,45 +219,6 @@ static int domain_build_state_val(caml_g
        CAMLreturn(0);
 }
 
-static value Val_sched_credit(libxl_sched_credit *c_val)
-{
-       CAMLparam0();
-       CAMLlocal1(v);
-
-       v = caml_alloc_tuple(2);
-
-       Store_field(v, 0, Val_int(c_val->weight));
-       Store_field(v, 1, Val_int(c_val->cap));
-
-       CAMLreturn(v);
-}
-
-static value Val_physinfo(libxl_physinfo *c_val)
-{
-       CAMLparam0();
-       CAMLlocal2(v, hwcap);
-       int i;
-
-       hwcap = caml_alloc_tuple(8);
-       for (i = 0; i < 8; i++)
-               Store_field(hwcap, i, caml_copy_int32(c_val->hw_cap[i]));
-
-       v = caml_alloc_tuple(11);
-       Store_field(v, 0, Val_int(c_val->threads_per_core));
-       Store_field(v, 1, Val_int(c_val->cores_per_socket));
-       Store_field(v, 2, Val_int(c_val->max_cpu_id));
-       Store_field(v, 3, Val_int(c_val->nr_cpus));
-       Store_field(v, 4, Val_int(c_val->cpu_khz));
-       Store_field(v, 5, caml_copy_int64(c_val->total_pages));
-       Store_field(v, 6, caml_copy_int64(c_val->free_pages));
-       Store_field(v, 7, caml_copy_int64(c_val->scrub_pages));
-       Store_field(v, 8, Val_int(c_val->nr_nodes));
-       Store_field(v, 9, hwcap);
-       Store_field(v, 10, caml_copy_int32(c_val->phys_cap));
-
-       CAMLreturn(v);
-}
-
 static value Val_topologyinfo(libxl_topologyinfo *c_val)
 {
        CAMLparam0();
@@ -320,7 +249,7 @@ value stub_xl_device_disk_add(value info
        int ret;
        INIT_STRUCT();
 
-       device_disk_val(&gc, &c_info, info);
+       device_disk_val(&gc, &lg, &c_info, info);
 
        INIT_CTX();
        ret = libxl_device_disk_add(ctx, Int_val(domid), &c_info);
@@ -337,7 +266,7 @@ value stub_xl_device_disk_del(value info
        int ret;
        INIT_STRUCT();
 
-       device_disk_val(&gc, &c_info, info);
+       device_disk_val(&gc, &lg, &c_info, info);
 
        INIT_CTX();
        ret = libxl_device_disk_del(ctx, Int_val(domid), &c_info, 0);
@@ -354,7 +283,7 @@ value stub_xl_device_nic_add(value info,
        int ret;
        INIT_STRUCT();
 
-       device_nic_val(&gc, &c_info, info);
+       device_nic_val(&gc, &lg, &c_info, info);
 
        INIT_CTX();
        ret = libxl_device_nic_add(ctx, Int_val(domid), &c_info);
@@ -371,7 +300,7 @@ value stub_xl_device_nic_del(value info,
        int ret;
        INIT_STRUCT();
 
-       device_nic_val(&gc, &c_info, info);
+       device_nic_val(&gc, &lg, &c_info, info);
 
        INIT_CTX();
        ret = libxl_device_nic_del(ctx, Int_val(domid), &c_info, 0);
@@ -408,7 +337,7 @@ value stub_xl_device_vkb_add(value info,
        int ret;
        INIT_STRUCT();
 
-       device_vkb_val(&gc, &c_info, info);
+       device_vkb_val(&gc, &lg, &c_info, info);
 
        INIT_CTX();
        ret = libxl_device_vkb_add(ctx, Int_val(domid), &c_info);
@@ -456,7 +385,7 @@ value stub_xl_device_vfb_add(value info,
        int ret;
        INIT_STRUCT();
 
-       device_vfb_val(&gc, &c_info, info);
+       device_vfb_val(&gc, &lg, &c_info, info);
 
        INIT_CTX();
        ret = libxl_device_vfb_add(ctx, Int_val(domid), &c_info);
@@ -504,7 +433,7 @@ value stub_xl_device_pci_add(value info,
        int ret;
        INIT_STRUCT();
 
-       device_pci_val(&gc, &c_info, info);
+       device_pci_val(&gc, &lg, &c_info, info);
 
        INIT_CTX();
        ret = libxl_device_pci_add(ctx, Int_val(domid), &c_info);
@@ -522,7 +451,7 @@ value stub_xl_device_pci_remove(value in
        int ret;
        INIT_STRUCT();
 
-       device_pci_val(&gc, &c_info, info);
+       device_pci_val(&gc, &lg, &c_info, info);
 
        INIT_CTX();
        ret = libxl_device_pci_remove(ctx, Int_val(domid), &c_info, 0);
@@ -577,7 +506,7 @@ value stub_xl_physinfo(value unit)
                failwith_xl("physinfo", &lg);
        FREE_CTX();
        
-       physinfo = Val_physinfo(&c_physinfo);
+       physinfo = Val_physinfo(&gc, &lg, &c_physinfo);
        CAMLreturn(physinfo);
 }
 
@@ -613,7 +542,7 @@ value stub_xl_sched_credit_domain_get(va
                failwith_xl("sched_credit_domain_get", &lg);
        FREE_CTX();
        
-       scinfo = Val_sched_credit(&c_scinfo);
+       scinfo = Val_sched_credit(&gc, &lg, &c_scinfo);
        CAMLreturn(scinfo);
 }
 
@@ -624,7 +553,7 @@ value stub_xl_sched_credit_domain_set(va
        int ret;
        INIT_STRUCT();
 
-       sched_credit_val(&gc, &c_scinfo, scinfo);
+       sched_credit_val(&gc, &lg, &c_scinfo, scinfo);
 
        INIT_CTX();
        ret = libxl_sched_credit_domain_set(ctx, Int_val(domid), &c_scinfo);

_______________________________________________
Xen-devel mailing list
Xen-devel@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/xen-devel

<Prev in Thread] Current Thread [Next in Thread>