X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=libvirt%2Fgenerator.pl;h=34801ba27c982637aa50ceb79c26f8c81e38c28c;hb=bab7f84ade84ceaddb08b6948792d49b3d04b897;hp=8590ea7b91a4ce03cd65ae5a5fa8dc79f04eb80e;hpb=71815ab2e638e2c1121d40520ac5b888b1b48bd6;p=ocaml-libvirt.git diff --git a/libvirt/generator.pl b/libvirt/generator.pl index 8590ea7..34801ba 100755 --- a/libvirt/generator.pl +++ b/libvirt/generator.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl -w # # OCaml bindings for libvirt. -# (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. +# (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc. # http://libvirt.org/ # # This library is free software; you can redistribute it and/or @@ -35,13 +35,11 @@ use strict; # It is interpreted by the generation functions below to indicate what # "class" the function falls into, and to generate the right class of # binding. -# -# Any function added since libvirt 0.2.1 must be marked weak. my @functions = ( { name => "virConnectClose", sig => "conn : free" }, - { name => "virConnectGetHostname", sig => "conn : string", weak => 1 }, - { name => "virConnectGetURI", sig => "conn : string", weak => 1 }, + { name => "virConnectGetHostname", sig => "conn : string" }, + { name => "virConnectGetURI", sig => "conn : string" }, { name => "virConnectGetType", sig => "conn : static string" }, { name => "virConnectNumOfDomains", sig => "conn : int" }, { name => "virConnectListDomains", sig => "conn, int : int array" }, @@ -53,16 +51,19 @@ my @functions = ( { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" }, { name => "virConnectListDefinedNetworks", sig => "conn, int : string array" }, - { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 }, + { name => "virConnectNumOfStoragePools", sig => "conn : int" }, { name => "virConnectListStoragePools", - sig => "conn, int : string array", weak => 1 }, + sig => "conn, int : string array" }, { name => "virConnectNumOfDefinedStoragePools", - sig => "conn : int", weak => 1 }, + sig => "conn : int" }, { name => "virConnectListDefinedStoragePools", - sig => "conn, int : string array", weak => 1 }, + sig => "conn, int : string array" }, { name => "virConnectGetCapabilities", sig => "conn : string" }, + { name => "virConnectDomainEventDeregisterAny", + sig => "conn, int : unit" }, { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" }, + { name => "virDomainCreateXML", sig => "conn, string, unsigned : dom" }, { name => "virDomainFree", sig => "dom : free" }, { name => "virDomainDestroy", sig => "dom : free" }, { name => "virDomainLookupByName", sig => "conn, string : dom" }, @@ -107,66 +108,66 @@ my @functions = ( { name => "virNetworkGetAutostart", sig => "net : bool" }, { name => "virNetworkSetAutostart", sig => "net, bool : unit" }, - { name => "virStoragePoolFree", sig => "pool : free", weak => 1 }, - { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 }, + { name => "virStoragePoolFree", sig => "pool : free" }, + { name => "virStoragePoolDestroy", sig => "pool : free" }, { name => "virStoragePoolLookupByName", - sig => "conn, string : pool", weak => 1 }, + sig => "conn, string : pool" }, { name => "virStoragePoolLookupByUUID", - sig => "conn, uuid : pool", weak => 1 }, + sig => "conn, uuid : pool" }, { name => "virStoragePoolLookupByUUIDString", - sig => "conn, string : pool", weak => 1 }, + sig => "conn, string : pool" }, { name => "virStoragePoolGetName", - sig => "pool : static string", weak => 1 }, + sig => "pool : static string" }, { name => "virStoragePoolGetXMLDesc", - sig => "pool, 0U : string", weak => 1 }, + sig => "pool, 0U : string" }, { name => "virStoragePoolGetUUID", - sig => "pool : uuid", weak => 1 }, + sig => "pool : uuid" }, { name => "virStoragePoolGetUUIDString", - sig => "pool : uuid string", weak => 1 }, + sig => "pool : uuid string" }, { name => "virStoragePoolCreateXML", - sig => "conn, string, 0U : pool", weak => 1 }, + sig => "conn, string, 0U : pool" }, { name => "virStoragePoolDefineXML", - sig => "conn, string, 0U : pool", weak => 1 }, + sig => "conn, string, 0U : pool" }, { name => "virStoragePoolBuild", - sig => "pool, uint : unit", weak => 1 }, + sig => "pool, uint : unit" }, { name => "virStoragePoolUndefine", - sig => "pool : unit", weak => 1 }, + sig => "pool : unit" }, { name => "virStoragePoolCreate", - sig => "pool, 0U : unit", weak => 1 }, + sig => "pool, 0U : unit" }, { name => "virStoragePoolDelete", - sig => "pool, uint : unit", weak => 1 }, + sig => "pool, uint : unit" }, { name => "virStoragePoolRefresh", - sig => "pool, 0U : unit", weak => 1 }, + sig => "pool, 0U : unit" }, { name => "virStoragePoolGetAutostart", - sig => "pool : bool", weak => 1 }, + sig => "pool : bool" }, { name => "virStoragePoolSetAutostart", - sig => "pool, bool : unit", weak => 1 }, + sig => "pool, bool : unit" }, { name => "virStoragePoolNumOfVolumes", - sig => "pool : int", weak => 1 }, + sig => "pool : int" }, { name => "virStoragePoolListVolumes", - sig => "pool, int : string array", weak => 1 }, + sig => "pool, int : string array" }, - { name => "virStorageVolFree", sig => "vol : free", weak => 1 }, + { name => "virStorageVolFree", sig => "vol : free" }, { name => "virStorageVolDelete", - sig => "vol, uint : unit", weak => 1 }, + sig => "vol, uint : unit" }, { name => "virStorageVolLookupByName", - sig => "pool, string : vol from pool", weak => 1 }, + sig => "pool, string : vol from pool" }, { name => "virStorageVolLookupByKey", - sig => "conn, string : vol", weak => 1 }, + sig => "conn, string : vol" }, { name => "virStorageVolLookupByPath", - sig => "conn, string : vol", weak => 1 }, + sig => "conn, string : vol" }, { name => "virStorageVolCreateXML", - sig => "pool, string, 0U : vol from pool", weak => 1 }, + sig => "pool, string, 0U : vol from pool" }, { name => "virStorageVolGetXMLDesc", - sig => "vol, 0U : string", weak => 1 }, + sig => "vol, 0U : string" }, { name => "virStorageVolGetPath", - sig => "vol : string", weak => 1 }, + sig => "vol : string" }, { name => "virStorageVolGetKey", - sig => "vol : static string", weak => 1 }, + sig => "vol : static string" }, { name => "virStorageVolGetName", - sig => "vol : static string", weak => 1 }, + sig => "vol : static string" }, { name => "virStoragePoolLookupByVolume", - sig => "vol : pool from vol", weak => 1 }, + sig => "vol : pool from vol" }, ); @@ -198,7 +199,7 @@ print F <<'END'; */ /* OCaml bindings for libvirt. - * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + * (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc. * http://libvirt.org/ * * This library is free software; you can redistribute it and/or @@ -270,115 +271,6 @@ sub short_name_to_c_type } } -# Generate a C signature for the original function. Used when building -# weak bindings. - -sub gen_c_signature -{ - my $sig = shift; - my $c_name = shift; - - if ($sig =~ /^(\w+) : string$/) { - my $c_type = short_name_to_c_type ($1); - "char *$c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : static string$/) { - my $c_type = short_name_to_c_type ($1); - "const char *$c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : int$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : uuid$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, unsigned char *)" - } elsif ($sig =~ /^(\w+) : uuid string$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, char *)" - } elsif ($sig =~ /^(\w+) : bool$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, int *r)" - } elsif ($sig =~ /^(\w+), bool : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, int b)" - } elsif ($sig eq "conn, int : int array") { - "int $c_name (virConnectPtr conn, int *ids, int maxids)" - } elsif ($sig =~ /^(\w+), int : string array$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, char **const names, int maxnames)" - } elsif ($sig =~ /^(\w+), 0(U?) : string$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "char *$c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "int $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : free$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+), string : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, const char *str)" - } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "int $c_name ($c_type $1, const char *str, ${unsigned}int flags)" - } elsif ($sig =~ /^(\w+), string : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1, const char *str)" - } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, const char *str, ${unsigned}int flags)" - } elsif ($sig =~ /^(\w+), (u?)int : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "u" ? "unsigned " : ""; - "int $c_name ($c_type $1, ${unsigned}int i)" - } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "u" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, ${unsigned}int i)" - } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1, const unsigned char *str)" - } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1, const char *str)" - } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)" - } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1)" - } else { - die "unknown signature $sig" - } -} - # OCaml argument names. sub gen_arg_names @@ -419,6 +311,8 @@ sub gen_arg_names ( "$1v", "strv" ) } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) { + ( "$1v", "strv", "uv" ) } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) { ( "$1v", "iv" ) } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { @@ -449,17 +343,13 @@ sub gen_unpack_args if ($_ eq "conn") { "virConnectPtr conn = Connect_val (connv);" } elsif ($_ eq "dom") { - "virDomainPtr dom = Domain_val (domv);\n". - " virConnectPtr conn = Connect_domv (domv);" + "virDomainPtr dom = Domain_val (domv);" } elsif ($_ eq "net") { - "virNetworkPtr net = Network_val (netv);\n". - " virConnectPtr conn = Connect_netv (netv);" + "virNetworkPtr net = Network_val (netv);" } elsif ($_ eq "pool") { - "virStoragePoolPtr pool = Pool_val (poolv);\n". - " virConnectPtr conn = Connect_polv (poolv);" + "virStoragePoolPtr pool = Pool_val (poolv);" } elsif ($_ eq "vol") { - "virStorageVolPtr vol = Volume_val (volv);\n". - " virConnectPtr conn = Connect_volv (volv);" + "virStorageVolPtr vol = Volume_val (volv);" } else { die "unknown short name $_" } @@ -508,7 +398,7 @@ sub gen_c_code char *r; NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); rv = caml_copy_string (r); free (r); @@ -521,7 +411,7 @@ sub gen_c_code const char *r; NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); rv = caml_copy_string (r); CAMLreturn (rv); @@ -532,7 +422,7 @@ sub gen_c_code int r; NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); CAMLreturn (Val_int (r)); " @@ -544,7 +434,7 @@ sub gen_c_code int r; NONBLOCKING (r = $c_name ($1, uuid)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); /* UUIDs are byte arrays with a fixed length. */ rv = caml_alloc_string (VIR_UUID_BUFLEN); @@ -559,7 +449,7 @@ sub gen_c_code int r; NONBLOCKING (r = $c_name ($1, uuid)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); rv = caml_copy_string (uuid); CAMLreturn (rv); @@ -570,7 +460,7 @@ sub gen_c_code int r, b; NONBLOCKING (r = $c_name ($1, &b)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); CAMLreturn (b ? Val_true : Val_false); " @@ -582,7 +472,7 @@ sub gen_c_code b = bv == Val_true ? 1 : 0; NONBLOCKING (r = $c_name ($1, b)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); CAMLreturn (Val_unit); " @@ -604,7 +494,7 @@ sub gen_c_code } NONBLOCKING (r = $c_name (conn, ids, i)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); rv = caml_alloc (r, 0); for (i = 0; i < r; ++i) @@ -631,7 +521,7 @@ sub gen_c_code } NONBLOCKING (r = $c_name ($1, names, i)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); rv = caml_alloc (r, 0); for (i = 0; i < r; ++i) { @@ -649,7 +539,7 @@ sub gen_c_code char *r; NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); rv = caml_copy_string (r); free (r); @@ -661,7 +551,7 @@ sub gen_c_code int r; NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); CAMLreturn (Val_unit); " @@ -671,7 +561,7 @@ sub gen_c_code int r; NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); CAMLreturn (Val_unit); " @@ -681,7 +571,7 @@ sub gen_c_code int r; NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); /* So that we don't double-free in the finalizer: */ " . gen_free_arg ($1) . " @@ -695,7 +585,7 @@ sub gen_c_code int r; NONBLOCKING (r = $c_name ($1, str)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); CAMLreturn (Val_unit); " @@ -707,7 +597,7 @@ sub gen_c_code int r; NONBLOCKING (r = $c_name ($1, str, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); CAMLreturn (Val_unit); " @@ -720,7 +610,7 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1, str)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); " . gen_pack_result ($2) . " @@ -735,7 +625,23 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1, str, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + unsigned int u = Int_val (uv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str, u)); + CHECK_ERROR (!r, \"$c_name\"); " . gen_pack_result ($2) . " @@ -749,7 +655,7 @@ sub gen_c_code int r; NONBLOCKING (r = $c_name ($1, i)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (r == -1, \"$c_name\"); CAMLreturn (Val_unit); " @@ -763,7 +669,7 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1, i)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); " . gen_pack_result ($3) . " @@ -778,7 +684,7 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1, uuid)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); " . gen_pack_result ($2) . " @@ -792,7 +698,7 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); " . gen_pack_result ($2) . " @@ -806,7 +712,7 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); " . gen_pack_result ($2) . " @@ -821,7 +727,7 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1, str)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); connv = Field ($3v, 1); " . gen_pack_result ($2) . " @@ -837,7 +743,7 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1, str, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); connv = Field ($3v, 1); " . gen_pack_result ($2) . " @@ -852,7 +758,7 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); connv = Field ($3v, 1); " . gen_pack_result ($2) . " @@ -867,7 +773,7 @@ sub gen_c_code $c_ret_type r; NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); + CHECK_ERROR (!r, \"$c_name\"); connv = Field ($3v, 1); " . gen_pack_result ($2) . " @@ -883,7 +789,6 @@ sub gen_c_code foreach my $function (@functions) { my $c_name = $function->{name}; - my $is_weak = $function->{weak}; my $sig = $function->{sig}; #print "generating $c_name with sig \"$sig\" ...\n"; @@ -911,20 +816,6 @@ foreach my $function (@functions) { END - # Generate a full function prototype if the function is weak. - my $have_name = "HAVE_" . uc ($c_name); - if ($is_weak) { - my $c_sig = gen_c_signature ($sig, $c_name); - print F <