X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=libvirt%2Fgenerator.pl;h=4fbace6dab365e06a384ac4e20751848512d0f3b;hb=e9fa5a983e2e4c92676022a5912eaa4458ffd4c9;hp=a54bd945732a0f1eec75734a21c95542f18c2e68;hpb=43b894e0ef93f380dcd8b1b20a3cd6626a8f3b7d;p=virt-top.git diff --git a/libvirt/generator.pl b/libvirt/generator.pl index a54bd94..4fbace6 100755 --- a/libvirt/generator.pl +++ b/libvirt/generator.pl @@ -21,6 +21,8 @@ # This generates libvirt_c.c (the core of the bindings). You don't # need to run this program unless you are extending the bindings # themselves (eg. because libvirt has been extended). +# +# Please read libvirt/README. use strict; @@ -28,7 +30,15 @@ use strict; # The functions in the libvirt API that we can generate. +# The 'sig' (signature) doesn't have a meaning or any internal structure. +# 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 => "virConnectGetType", sig => "conn : static string" }, @@ -51,82 +61,145 @@ my @functions = ( sig => "conn, int : string array", weak => 1 }, { name => "virConnectGetCapabilities", sig => "conn : string" }, + { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" }, + { name => "virDomainCreateLinuxJob", + sig => "conn, string, 0U : job", weak => 1 }, + { name => "virDomainFree", sig => "dom : free" }, + { name => "virDomainDestroy", sig => "dom : free" }, + { name => "virDomainLookupByName", sig => "conn, string : dom" }, + { name => "virDomainLookupByID", sig => "conn, int : dom" }, + { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" }, + { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" }, { name => "virDomainGetName", sig => "dom : static string" }, { name => "virDomainGetOSType", sig => "dom : string" }, { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" }, + { name => "virDomainGetUUID", sig => "dom : uuid" }, + { name => "virDomainGetUUIDString", sig => "dom : uuid string" }, + { name => "virDomainGetMaxVcpus", sig => "dom : int" }, + { name => "virDomainSave", sig => "dom, string : unit" }, + { name => "virDomainSaveJob", + sig => "dom, string : job from dom", weak => 1 }, + { name => "virDomainRestore", sig => "conn, string : unit" }, + { name => "virDomainRestoreJob", + sig => "conn, string : job", weak => 1 }, + { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" }, + { name => "virDomainCoreDumpJob", + sig => "dom, string, 0 : job from dom", weak => 1 }, { name => "virDomainSuspend", sig => "dom : unit" }, { name => "virDomainResume", sig => "dom : unit" }, { name => "virDomainShutdown", sig => "dom : unit" }, { name => "virDomainReboot", sig => "dom, 0 : unit" }, + { name => "virDomainDefineXML", sig => "conn, string : dom" }, { name => "virDomainUndefine", sig => "dom : unit" }, { name => "virDomainCreate", sig => "dom : unit" }, - + { name => "virDomainCreateJob", + sig => "dom, 0U : job from dom", weak => 1 }, + { name => "virDomainAttachDevice", sig => "dom, string : unit" }, + { name => "virDomainDetachDevice", sig => "dom, string : unit" }, + { name => "virDomainGetAutostart", sig => "dom : bool" }, + { name => "virDomainSetAutostart", sig => "dom, bool : unit" }, + + { name => "virNetworkFree", sig => "net : free" }, + { name => "virNetworkDestroy", sig => "net : free" }, + { name => "virNetworkLookupByName", sig => "conn, string : net" }, + { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" }, + { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" }, { name => "virNetworkGetName", sig => "net : static string" }, { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" }, { name => "virNetworkGetBridgeName", sig => "net : string" }, + { name => "virNetworkGetUUID", sig => "net : uuid" }, + { name => "virNetworkGetUUIDString", sig => "net : uuid string" }, { name => "virNetworkUndefine", sig => "net : unit" }, + { name => "virNetworkCreateXML", sig => "conn, string : net" }, + { name => "virNetworkCreateXMLJob", + sig => "conn, string : job", weak => 1 }, + { name => "virNetworkDefineXML", sig => "conn, string : net" }, { name => "virNetworkCreate", sig => "net : unit" }, - + { name => "virNetworkCreateJob", + sig => "net : job from net", weak => 1 }, + { 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 => "virStoragePoolLookupByName", + sig => "conn, string : pool", weak => 1 }, + { name => "virStoragePoolLookupByUUID", + sig => "conn, uuid : pool", weak => 1 }, + { name => "virStoragePoolLookupByUUIDString", + sig => "conn, string : pool", weak => 1 }, { name => "virStoragePoolGetName", sig => "pool : static string", weak => 1 }, { name => "virStoragePoolGetXMLDesc", - sig => "pool, 0 : string", weak => 1 }, + sig => "pool, 0U : string", weak => 1 }, + { name => "virStoragePoolGetUUID", + sig => "pool : uuid", weak => 1 }, + { name => "virStoragePoolGetUUIDString", + sig => "pool : uuid string", weak => 1 }, + { name => "virStoragePoolCreateXML", + sig => "conn, string, 0U : pool", weak => 1 }, + { name => "virStoragePoolDefineXML", + sig => "conn, string, 0U : pool", weak => 1 }, + { name => "virStoragePoolBuild", + sig => "pool, uint : unit", weak => 1 }, { name => "virStoragePoolUndefine", - sig => "pool : string", weak => 1 }, + sig => "pool : unit", weak => 1 }, { name => "virStoragePoolCreate", - sig => "pool : string", weak => 1 }, - { name => "virStoragePoolShutdown", - sig => "pool : string", weak => 1 }, + sig => "pool, 0U : unit", weak => 1 }, + { name => "virStoragePoolDelete", + sig => "pool, uint : unit", weak => 1 }, { name => "virStoragePoolRefresh", - sig => "pool, 0 : string", weak => 1 }, - + sig => "pool, 0U : unit", weak => 1 }, + { name => "virStoragePoolGetAutostart", + sig => "pool : bool", weak => 1 }, + { name => "virStoragePoolSetAutostart", + sig => "pool, bool : unit", weak => 1 }, + { name => "virStoragePoolNumOfVolumes", + sig => "pool : int", weak => 1 }, + { name => "virStoragePoolListVolumes", + sig => "pool, int : string array", weak => 1 }, + + { name => "virStorageVolFree", sig => "vol : free", weak => 1 }, + { name => "virStorageVolDelete", + sig => "vol, uint : unit", weak => 1 }, + { name => "virStorageVolLookupByName", + sig => "pool, string : vol from pool", weak => 1 }, + { name => "virStorageVolLookupByKey", + sig => "conn, string : vol", weak => 1 }, + { name => "virStorageVolLookupByPath", + sig => "conn, string : vol", weak => 1 }, + { name => "virStorageVolCreateXML", + sig => "pool, string, 0U : vol from pool", weak => 1 }, { name => "virStorageVolGetXMLDesc", - sig => "pool, 0 : string", weak => 1 }, + sig => "vol, 0U : string", weak => 1 }, { name => "virStorageVolGetPath", - sig => "pool : string", weak => 1 }, + sig => "vol : string", weak => 1 }, { name => "virStorageVolGetKey", - sig => "pool : static string", weak => 1 }, + sig => "vol : static string", weak => 1 }, { name => "virStorageVolGetName", - sig => "pool : static string", weak => 1 }, + sig => "vol : static string", weak => 1 }, + { name => "virStoragePoolLookupByVolume", + sig => "vol : pool from vol", weak => 1 }, + + { name => "virJobFree", + sig => "job : free", weak => 1 }, + { name => "virJobCancel", + sig => "job : unit", weak => 1 }, + { name => "virJobGetNetwork", + sig => "job : net from job", weak => 1 }, + { name => "virJobGetDomain", + sig => "job : dom from job", weak => 1 }, ); -# Functions we haven't implemented anywhere yet. -# We create stubs for these, but they need to either be moved ^^ so they -# are auto-generated or implementations written in libvirt_c_oneoffs.c. +# Functions we haven't implemented anywhere yet but which are mentioned +# in 'libvirt.ml'. +# +# We create stubs for these, but eventually they need to either be +# moved ^^^ so they are auto-generated, or implementations of them +# written in 'libvirt_c_oneoffs.c'. my @unimplemented = ( - "ocaml_libvirt_domain_create_job", - "ocaml_libvirt_domain_core_dump_job", - "ocaml_libvirt_domain_restore_job", - "ocaml_libvirt_domain_save_job", - "ocaml_libvirt_connect_create_linux_job", - "ocaml_libvirt_network_create_job", - "ocaml_libvirt_network_create_xml_job", - "ocaml_libvirt_storage_pool_set_autostart", - "ocaml_libvirt_storage_pool_get_autostart", - "ocaml_libvirt_storage_pool_get_info", - "ocaml_libvirt_storage_pool_get_uuid_string", - "ocaml_libvirt_storage_pool_get_uuid", - "ocaml_libvirt_storage_pool_free", - "ocaml_libvirt_storage_pool_destroy", - "ocaml_libvirt_storage_pool_define_xml", - "ocaml_libvirt_storage_pool_create_xml", - "ocaml_libvirt_storage_pool_lookup_by_uuid_string", - "ocaml_libvirt_storage_pool_lookup_by_uuid", - "ocaml_libvirt_storage_pool_lookup_by_name", - "ocaml_libvirt_storage_vol_free", - "ocaml_libvirt_storage_vol_destroy", - "ocaml_libvirt_storage_vol_create_xml", - "ocaml_libvirt_storage_vol_get_info", - "ocaml_libvirt_pool_of_volume", - "ocaml_libvirt_storage_vol_lookup_by_path", - "ocaml_libvirt_storage_vol_lookup_by_key", - "ocaml_libvirt_storage_vol_lookup_by_name", - "ocaml_libvirt_job_cancel", - "ocaml_libvirt_job_get_network", - "ocaml_libvirt_job_get_domain", - "ocaml_libvirt_job_get_info", ); #---------------------------------------------------------------------- @@ -139,7 +212,10 @@ open F, ">$filename" or die "$filename: $!"; # Write the prologue. print F <<'END'; -/* WARNING: THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'. +/* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!! + * + * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'. + * * Any changes you make to this file may be overwritten. */ @@ -193,7 +269,7 @@ sub camel_case_to_underscores { my $name = shift; - $name =~ s/([A-Z][a-z]+|XML|URI|OS)/$1,/g; + $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g; my @subs = split (/,/, $name); @subs = map { lc($_) } @subs; join "_", @subs @@ -210,11 +286,15 @@ sub short_name_to_c_type elsif ($_ eq "net") { "virNetworkPtr" } elsif ($_ eq "pool") { "virStoragePoolPtr" } elsif ($_ eq "vol") { "virStorageVolPtr" } + elsif ($_ eq "job") { "virJobPtr" } else { die "unknown short name $_" } } +# Generate a C signature for the original function. Used when building +# weak bindings. + sub gen_c_signature { my $sig = shift; @@ -229,24 +309,100 @@ sub gen_c_signature } 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 eq "conn, int : string array") { - "int $c_name (virConnectPtr conn, char **const names, int maxnames)" - } elsif ($sig =~ /^(\w+), 0 : string$/) { + } 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); - "char *$c_name ($c_type $1, int flags)" - } elsif ($sig =~ /^(\w+), 0 : unit$/) { + 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); - "int $c_name ($c_type $1, int flags)" + 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 dom)" + "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 { my $sig = shift; @@ -257,21 +413,57 @@ sub gen_arg_names ( "$1v" ) } elsif ($sig =~ /^(\w+) : int$/) { ( "$1v" ) + } elsif ($sig =~ /^(\w+) : uuid$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : uuid string$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : bool$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+), bool : unit$/) { + ( "$1v", "bv" ) } elsif ($sig eq "conn, int : int array") { ( "connv", "iv" ) - } elsif ($sig eq "conn, int : string array") { - ( "connv", "iv" ) - } elsif ($sig =~ /^(\w+), 0 : string$/) { + } elsif ($sig =~ /^(\w+), int : string array$/) { + ( "$1v", "iv" ) + } elsif ($sig =~ /^(\w+), 0U? : string$/) { ( "$1v" ) - } elsif ($sig =~ /^(\w+), 0 : unit$/) { + } elsif ($sig =~ /^(\w+), 0U? : unit$/) { ( "$1v" ) } elsif ($sig =~ /^(\w+) : unit$/) { ( "$1v" ) + } elsif ($sig =~ /^(\w+) : free$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+), string : unit$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string : (\w+)$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) { + ( "$1v", "iv" ) + } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { + ( "$1v", "uuidv" ) + } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : (\w+)$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { + ( "$1v" ) } else { die "unknown signature $sig" } } +# Unpack the first (object) argument. + sub gen_unpack_args { local $_ = shift; @@ -290,11 +482,47 @@ sub gen_unpack_args } elsif ($_ eq "vol") { "virStorageVolPtr vol = Volume_val (volv);\n". " virConnectPtr conn = Connect_volv (volv);" + } elsif ($_ eq "job") { + "virJobPtr job = Job_val (jobv);\n". + " virConnectPtr conn = Connect_jobv (jobv);" } else { die "unknown short name $_" } } +# Pack the result if it's an object. + +sub gen_pack_result +{ + local $_ = shift; + + if ($_ eq "dom") { "rv = Val_domain (r, connv);" } + elsif ($_ eq "net") { "rv = Val_network (r, connv);" } + elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" } + elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" } + elsif ($_ eq "job") { "rv = Val_job (r, connv);" } + else { + die "unknown short name $_" + } +} + +sub gen_free_arg +{ + local $_ = shift; + + if ($_ eq "conn") { "Connect_val (connv) = NULL;" } + elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" } + elsif ($_ eq "net") { "Network_val (netv) = NULL;" } + elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" } + elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" } + elsif ($_ eq "job") { "Job_val (jobv) = NULL;" } + else { + die "unknown short name $_" + } +} + +# Generate the C body for each signature (class of function). + sub gen_c_code { my $sig = shift; @@ -335,6 +563,56 @@ sub gen_c_code CAMLreturn (Val_int (r)); " + } elsif ($sig =~ /^(\w+) : uuid$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + unsigned char uuid[VIR_UUID_BUFLEN]; + int r; + + NONBLOCKING (r = $c_name ($1, uuid)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + /* UUIDs are byte arrays with a fixed length. */ + rv = caml_alloc_string (VIR_UUID_BUFLEN); + memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : uuid string$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char uuid[VIR_UUID_STRING_BUFLEN]; + int r; + + NONBLOCKING (r = $c_name ($1, uuid)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + rv = caml_copy_string (uuid); + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : bool$/) { + "\ + " . gen_unpack_args ($1) . " + int r, b; + + NONBLOCKING (r = $c_name ($1, &b)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + CAMLreturn (b ? Val_true : Val_false); +" + } elsif ($sig =~ /^(\w+), bool : unit$/) { + "\ + " . gen_unpack_args ($1) . " + int r, b; + + b = bv == Val_true ? 1 : 0; + + NONBLOCKING (r = $c_name ($1, b)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" } elsif ($sig eq "conn, int : int array") { "\ CAMLlocal1 (rv); @@ -351,15 +629,15 @@ sub gen_c_code CAMLreturn (rv); " - } elsif ($sig eq "conn, int : string array") { + } elsif ($sig =~ /^(\w+), int : string array$/) { "\ CAMLlocal2 (rv, strv); - virConnectPtr conn = Connect_val (connv); + " . gen_unpack_args ($1) . " int i = Int_val (iv); char *names[i]; int r; - NONBLOCKING (r = $c_name (conn, names, i)); + NONBLOCKING (r = $c_name ($1, names, i)); CHECK_ERROR (r == -1, conn, \"$c_name\"); rv = caml_alloc (r, 0); @@ -371,7 +649,7 @@ sub gen_c_code CAMLreturn (rv); " - } elsif ($sig =~ /^(\w+), 0 : string$/) { + } elsif ($sig =~ /^(\w+), 0U? : string$/) { "\ CAMLlocal1 (rv); " . gen_unpack_args ($1) . " @@ -384,6 +662,16 @@ sub gen_c_code free (r); CAMLreturn (rv); " + } elsif ($sig =~ /^(\w+), 0U? : unit$/) { + "\ + " . gen_unpack_args ($1) . " + int r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" } elsif ($sig =~ /^(\w+) : unit$/) { "\ " . gen_unpack_args ($1) . " @@ -394,16 +682,205 @@ sub gen_c_code CAMLreturn (Val_unit); " - } elsif ($sig =~ /^(\w+), 0 : unit$/) { + } elsif ($sig =~ /^(\w+) : free$/) { "\ " . gen_unpack_args ($1) . " int r; - NONBLOCKING (r = $c_name ($1, 0)); + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + /* So that we don't double-free in the finalizer: */ + " . gen_free_arg ($1) . " + + CAMLreturn (Val_unit); +" + } elsif ($sig =~ /^(\w+), string : unit$/) { + "\ + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + int r; + + NONBLOCKING (r = $c_name ($1, str)); CHECK_ERROR (r == -1, conn, \"$c_name\"); CAMLreturn (Val_unit); " + } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + int r; + + NONBLOCKING (r = $c_name ($1, str, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" + } elsif ($sig =~ /^(\w+), string : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), (u?)int : unit$/) { + my $unsigned = $2 eq "u" ? "unsigned " : ""; + "\ + " . gen_unpack_args ($1) . " + ${unsigned}int i = Int_val (iv); + int r; + + NONBLOCKING (r = $c_name ($1, i)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" + } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($3); + my $unsigned = $2 eq "u" ? "unsigned " : ""; + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + ${unsigned}int i = Int_val (iv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, i)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($3) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + unsigned char *uuid = (unsigned char *) String_val (uuidv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, uuid)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" } else { die "unknown signature $sig" } @@ -416,8 +893,10 @@ foreach my $function (@functions) { my $is_weak = $function->{weak}; my $sig = $function->{sig}; - my $is_pool_func = $c_name =~ /^virStoragePool/; - my $is_vol_func = $c_name =~ /^virStorageVol/; + #print "generating $c_name with sig \"$sig\" ...\n"; + + #my $is_pool_func = $c_name =~ /^virStoragePool/; + #my $is_vol_func = $c_name =~ /^virStorageVol/; # Generate an equivalent C-external name for the function, unless # one is defined already. @@ -432,6 +911,13 @@ foreach my $function (@functions) { die "cannot convert c_name $c_name to c_external_name" } + print F <