X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=libvirt%2Fgenerator.pl;h=ea1b2be57876ccca8ad7edc8a63997ce4245c603;hb=c27cacae2abac36e2ae89e3e354ec7b0ba8a70dc;hp=b4bd2c72552639222384ed59743a0cc9a5d63cab;hpb=6de624657b83a1792cf21393cb71f61a446a9c52;p=ocaml-libvirt.git diff --git a/libvirt/generator.pl b/libvirt/generator.pl index b4bd2c7..ea1b2be 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,18 +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 => "virDomainCreateLinuxJob", - sig => "conn, string, 0U : job", weak => 1 }, + { name => "virDomainCreateXML", sig => "conn, string, unsigned : dom" }, { name => "virDomainFree", sig => "dom : free" }, { name => "virDomainDestroy", sig => "dom : free" }, { name => "virDomainLookupByName", sig => "conn, string : dom" }, @@ -78,14 +77,8 @@ my @functions = ( { 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" }, @@ -93,8 +86,6 @@ my @functions = ( { 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" }, @@ -112,84 +103,71 @@ my @functions = ( { 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 => "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 }, - - { 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 }, + sig => "vol : pool from vol" }, ); @@ -221,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 @@ -288,121 +266,11 @@ 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; - 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 @@ -443,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+)$/) { @@ -473,20 +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);" - } elsif ($_ eq "job") { - "virJobPtr job = Job_val (jobv);\n". - " virConnectPtr conn = Connect_jobv (jobv);" + "virStorageVolPtr vol = Volume_val (volv);" } else { die "unknown short name $_" } @@ -502,7 +365,6 @@ sub gen_pack_result 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 $_" } @@ -517,7 +379,6 @@ sub gen_free_arg 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 $_" } @@ -537,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); @@ -550,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); @@ -561,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)); " @@ -573,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); @@ -588,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); @@ -599,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); " @@ -611,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); " @@ -620,7 +481,7 @@ sub gen_c_code CAMLlocal1 (rv); virConnectPtr conn = Connect_val (connv); int i = Int_val (iv); - int ids[i], r; + int *ids, r; /* Some libvirt List* functions still throw exceptions if i == 0, * so catch that and return an empty array directly. This changes @@ -632,12 +493,17 @@ sub gen_c_code CAMLreturn (rv); } + ids = malloc (sizeof (*ids) * i); + if (ids == NULL) + caml_raise_out_of_memory (); + NONBLOCKING (r = $c_name (conn, ids, i)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR_CLEANUP (r == -1, free (ids), \"$c_name\"); rv = caml_alloc (r, 0); for (i = 0; i < r; ++i) Store_field (rv, i, Val_int (ids[i])); + free (ids); CAMLreturn (rv); " @@ -646,7 +512,7 @@ sub gen_c_code CAMLlocal2 (rv, strv); " . gen_unpack_args ($1) . " int i = Int_val (iv); - char *names[i]; + char **names; int r; /* Some libvirt List* functions still throw exceptions if i == 0, @@ -659,8 +525,12 @@ sub gen_c_code CAMLreturn (rv); } + names = malloc (sizeof (*names) * i); + if (names == NULL) + caml_raise_out_of_memory (); + NONBLOCKING (r = $c_name ($1, names, i)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); + CHECK_ERROR_CLEANUP (r == -1, free (names), \"$c_name\"); rv = caml_alloc (r, 0); for (i = 0; i < r; ++i) { @@ -668,6 +538,7 @@ sub gen_c_code Store_field (rv, i, strv); free (names[i]); } + free (names); CAMLreturn (rv); " @@ -678,7 +549,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); @@ -690,7 +561,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); " @@ -700,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\"); CAMLreturn (Val_unit); " @@ -710,7 +581,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) . " @@ -724,7 +595,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); " @@ -736,7 +607,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); " @@ -749,7 +620,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) . " @@ -764,7 +635,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) . " @@ -778,7 +665,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); " @@ -792,7 +679,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) . " @@ -807,7 +694,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) . " @@ -821,7 +708,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) . " @@ -835,7 +722,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) . " @@ -850,7 +737,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) . " @@ -866,7 +753,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) . " @@ -881,7 +768,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) . " @@ -896,7 +783,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) . " @@ -912,7 +799,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"; @@ -940,20 +826,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 <