libvirt/generator.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # OCaml bindings for libvirt.
   4 # (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
   5 # http://libvirt.org/
   6 #
   7 # This library is free software; you can redistribute it and/or
   8 # modify it under the terms of the GNU Lesser General Public
   9 # License as published by the Free Software Foundation; either
  10 # version 2 of the License, or (at your option) any later version,
  11 # with the OCaml linking exception described in ../COPYING.LIB.
  12 #
  13 # This library is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # Lesser General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU Lesser General Public
  19 # License along with this library; if not, write to the Free Software
  20 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
  21
  22 # This generates libvirt_c.c (the core of the bindings).  You don't
  23 # need to run this program unless you are extending the bindings
  24 # themselves (eg. because libvirt has been extended).
  25 #
  26 # Please read libvirt/README.
  27
  28 use strict;
  29
  30 #----------------------------------------------------------------------
  31
  32 # The functions in the libvirt API that we can generate.
  33
  34 # The 'sig' (signature) doesn't have a meaning or any internal structure.
  35 # It is interpreted by the generation functions below to indicate what
  36 # "class" the function falls into, and to generate the right class of
  37 # binding.
  38
  39 my @functions = (
  40     { name => "virConnectClose", sig => "conn : free" },
  41     { name => "virConnectGetHostname", sig => "conn : string" },
  42     { name => "virConnectGetURI", sig => "conn : string" },
  43     { name => "virConnectGetType", sig => "conn : static string" },
  44     { name => "virConnectNumOfDomains", sig => "conn : int" },
  45     { name => "virConnectListDomains", sig => "conn, int : int array" },
  46     { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
  47     { name => "virConnectListDefinedDomains",
  48       sig => "conn, int : string array" },
  49     { name => "virConnectNumOfNetworks", sig => "conn : int" },
  50     { name => "virConnectListNetworks", sig => "conn, int : string array" },
  51     { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
  52     { name => "virConnectListDefinedNetworks",
  53       sig => "conn, int : string array" },
  54     { name => "virConnectNumOfStoragePools", sig => "conn : int" },
  55     { name => "virConnectListStoragePools",
  56       sig => "conn, int : string array" },
  57     { name => "virConnectNumOfDefinedStoragePools",
  58       sig => "conn : int" },
  59     { name => "virConnectListDefinedStoragePools",
  60       sig => "conn, int : string array" },
  61     { name => "virConnectGetCapabilities", sig => "conn : string" },
  62     { name => "virConnectDomainEventDeregisterAny",
  63       sig => "conn, int : unit" },
  64
  65     { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
  66     { name => "virDomainFree", sig => "dom : free" },
  67     { name => "virDomainDestroy", sig => "dom : free" },
  68     { name => "virDomainLookupByName", sig => "conn, string : dom" },
  69     { name => "virDomainLookupByID", sig => "conn, int : dom" },
  70     { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" },
  71     { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
  72     { name => "virDomainGetName", sig => "dom : static string" },
  73     { name => "virDomainGetOSType", sig => "dom : string" },
  74     { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
  75     { name => "virDomainGetUUID", sig => "dom : uuid" },
  76     { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
  77     { name => "virDomainGetMaxVcpus", sig => "dom : int" },
  78     { name => "virDomainSave", sig => "dom, string : unit" },
  79     { name => "virDomainRestore", sig => "conn, string : unit" },
  80     { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" },
  81     { name => "virDomainSuspend", sig => "dom : unit" },
  82     { name => "virDomainResume", sig => "dom : unit" },
  83     { name => "virDomainShutdown", sig => "dom : unit" },
  84     { name => "virDomainReboot", sig => "dom, 0 : unit" },
  85     { name => "virDomainDefineXML", sig => "conn, string : dom" },
  86     { name => "virDomainUndefine", sig => "dom : unit" },
  87     { name => "virDomainCreate", sig => "dom : unit" },
  88     { name => "virDomainAttachDevice", sig => "dom, string : unit" },
  89     { name => "virDomainDetachDevice", sig => "dom, string : unit" },
  90     { name => "virDomainGetAutostart", sig => "dom : bool" },
  91     { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
  92
  93     { name => "virNetworkFree", sig => "net : free" },
  94     { name => "virNetworkDestroy", sig => "net : free" },
  95     { name => "virNetworkLookupByName", sig => "conn, string : net" },
  96     { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" },
  97     { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
  98     { name => "virNetworkGetName", sig => "net : static string" },
  99     { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
 100     { name => "virNetworkGetBridgeName", sig => "net : string" },
 101     { name => "virNetworkGetUUID", sig => "net : uuid" },
 102     { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
 103     { name => "virNetworkUndefine", sig => "net : unit" },
 104     { name => "virNetworkCreateXML", sig => "conn, string : net" },
 105     { name => "virNetworkDefineXML", sig => "conn, string : net" },
 106     { name => "virNetworkCreate", sig => "net : unit" },
 107     { name => "virNetworkGetAutostart", sig => "net : bool" },
 108     { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
 109
 110     { name => "virStoragePoolFree", sig => "pool : free" },
 111     { name => "virStoragePoolDestroy", sig => "pool : free" },
 112     { name => "virStoragePoolLookupByName",
 113       sig => "conn, string : pool" },
 114     { name => "virStoragePoolLookupByUUID",
 115       sig => "conn, uuid : pool" },
 116     { name => "virStoragePoolLookupByUUIDString",
 117       sig => "conn, string : pool" },
 118     { name => "virStoragePoolGetName",
 119       sig => "pool : static string" },
 120     { name => "virStoragePoolGetXMLDesc",
 121       sig => "pool, 0U : string" },
 122     { name => "virStoragePoolGetUUID",
 123       sig => "pool : uuid" },
 124     { name => "virStoragePoolGetUUIDString",
 125       sig => "pool : uuid string" },
 126     { name => "virStoragePoolCreateXML",
 127       sig => "conn, string, 0U : pool" },
 128     { name => "virStoragePoolDefineXML",
 129       sig => "conn, string, 0U : pool" },
 130     { name => "virStoragePoolBuild",
 131       sig => "pool, uint : unit" },
 132     { name => "virStoragePoolUndefine",
 133       sig => "pool : unit" },
 134     { name => "virStoragePoolCreate",
 135       sig => "pool, 0U : unit" },
 136     { name => "virStoragePoolDelete",
 137       sig => "pool, uint : unit" },
 138     { name => "virStoragePoolRefresh",
 139       sig => "pool, 0U : unit" },
 140     { name => "virStoragePoolGetAutostart",
 141       sig => "pool : bool" },
 142     { name => "virStoragePoolSetAutostart",
 143       sig => "pool, bool : unit" },
 144     { name => "virStoragePoolNumOfVolumes",
 145       sig => "pool : int" },
 146     { name => "virStoragePoolListVolumes",
 147       sig => "pool, int : string array" },
 148
 149     { name => "virStorageVolFree", sig => "vol : free" },
 150     { name => "virStorageVolDelete",
 151       sig => "vol, uint : unit" },
 152     { name => "virStorageVolLookupByName",
 153       sig => "pool, string : vol from pool" },
 154     { name => "virStorageVolLookupByKey",
 155       sig => "conn, string : vol" },
 156     { name => "virStorageVolLookupByPath",
 157       sig => "conn, string : vol" },
 158     { name => "virStorageVolCreateXML",
 159       sig => "pool, string, 0U : vol from pool" },
 160     { name => "virStorageVolGetXMLDesc",
 161       sig => "vol, 0U : string" },
 162     { name => "virStorageVolGetPath",
 163       sig => "vol : string" },
 164     { name => "virStorageVolGetKey",
 165       sig => "vol : static string" },
 166     { name => "virStorageVolGetName",
 167       sig => "vol : static string" },
 168     { name => "virStoragePoolLookupByVolume",
 169       sig => "vol : pool from vol" },
 170
 171     );
 172
 173 # Functions we haven't implemented anywhere yet but which are mentioned
 174 # in 'libvirt.ml'.
 175 #
 176 # We create stubs for these, but eventually they need to either be
 177 # moved ^^^ so they are auto-generated, or implementations of them
 178 # written in 'libvirt_c_oneoffs.c'.
 179
 180 my @unimplemented = (
 181     );
 182
 183 #----------------------------------------------------------------------
 184
 185 # Open the output file.
 186
 187 my $filename = "libvirt_c.c";
 188 open F, ">$filename" or die "$filename: $!";
 189
 190 # Write the prologue.
 191
 192 print F <<'END';
 193 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
 194  *
 195  * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
 196  *
 197  * Any changes you make to this file may be overwritten.
 198  */
 199
 200 /* OCaml bindings for libvirt.
 201  * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
 202  * http://libvirt.org/
 203  *
 204  * This library is free software; you can redistribute it and/or
 205  * modify it under the terms of the GNU Lesser General Public
 206  * License as published by the Free Software Foundation; either
 207  * version 2 of the License, or (at your option) any later version,
 208  * with the OCaml linking exception described in ../COPYING.LIB.
 209  *
 210  * This library is distributed in the hope that it will be useful,
 211  * but WITHOUT ANY WARRANTY; without even the implied warranty of
 212  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 213  * Lesser General Public License for more details.
 214  *
 215  * You should have received a copy of the GNU Lesser General Public
 216  * License along with this library; if not, write to the Free Software
 217  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
 218  */
 219
 220 #include "config.h"
 221
 222 #include <stdio.h>
 223 #include <stdlib.h>
 224 #include <string.h>
 225
 226 #include <libvirt/libvirt.h>
 227 #include <libvirt/virterror.h>
 228
 229 #include <caml/config.h>
 230 #include <caml/alloc.h>
 231 #include <caml/callback.h>
 232 #include <caml/custom.h>
 233 #include <caml/fail.h>
 234 #include <caml/memory.h>
 235 #include <caml/misc.h>
 236 #include <caml/mlvalues.h>
 237 #include <caml/signals.h>
 238
 239 #include "libvirt_c_prologue.c"
 240
 241 #include "libvirt_c_oneoffs.c"
 242
 243 END
 244
 245 #----------------------------------------------------------------------
 246
 247 sub camel_case_to_underscores
 248 {
 249     my $name = shift;
 250
 251     $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
 252     my @subs = split (/,/, $name);
 253     @subs = map { lc($_) } @subs;
 254     join "_", @subs
 255 }
 256
 257 # Helper functions dealing with signatures.
 258
 259 sub short_name_to_c_type
 260 {
 261     local $_ = shift;
 262
 263     if ($_ eq "conn") { "virConnectPtr" }
 264     elsif ($_ eq "dom") { "virDomainPtr" }
 265     elsif ($_ eq "net") { "virNetworkPtr" }
 266     elsif ($_ eq "pool") { "virStoragePoolPtr" }
 267     elsif ($_ eq "vol") { "virStorageVolPtr" }
 268     else {
 269         die "unknown short name $_"
 270     }
 271 }
 272
 273 # OCaml argument names.
 274
 275 sub gen_arg_names
 276 {
 277     my $sig = shift;
 278
 279     if ($sig =~ /^(\w+) : string$/) {
 280         ( "$1v" )
 281     } elsif ($sig =~ /^(\w+) : static string$/) {
 282         ( "$1v" )
 283     } elsif ($sig =~ /^(\w+) : int$/) {
 284         ( "$1v" )
 285     } elsif ($sig =~ /^(\w+) : uuid$/) {
 286         ( "$1v" )
 287     } elsif ($sig =~ /^(\w+) : uuid string$/) {
 288         ( "$1v" )
 289     } elsif ($sig =~ /^(\w+) : bool$/) {
 290         ( "$1v" )
 291     } elsif ($sig =~ /^(\w+), bool : unit$/) {
 292         ( "$1v", "bv" )
 293     } elsif ($sig eq "conn, int : int array") {
 294         ( "connv", "iv" )
 295     } elsif ($sig =~ /^(\w+), int : string array$/) {
 296         ( "$1v", "iv" )
 297     } elsif ($sig =~ /^(\w+), 0U? : string$/) {
 298         ( "$1v" )
 299     } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
 300         ( "$1v" )
 301     } elsif ($sig =~ /^(\w+) : unit$/) {
 302         ( "$1v" )
 303     } elsif ($sig =~ /^(\w+) : free$/) {
 304         ( "$1v" )
 305     } elsif ($sig =~ /^(\w+), string : unit$/) {
 306         ( "$1v", "strv" )
 307     } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
 308         ( "$1v", "strv" )
 309     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 310         ( "$1v", "strv" )
 311     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
 312         ( "$1v", "strv" )
 313     } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) {
 314         ( "$1v", "iv" )
 315     } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
 316         ( "$1v", "uuidv" )
 317     } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
 318         ( "$1v" )
 319     } elsif ($sig =~ /^(\w+) : (\w+)$/) {
 320         ( "$1v" )
 321     } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
 322         ( "$1v", "strv" )
 323     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) {
 324         ( "$1v", "strv" )
 325     } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) {
 326         ( "$1v" )
 327     } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
 328         ( "$1v" )
 329     } else {
 330         die "unknown signature $sig"
 331     }
 332 }
 333
 334 # Unpack the first (object) argument.
 335
 336 sub gen_unpack_args
 337 {
 338     local $_ = shift;
 339
 340     if ($_ eq "conn") {
 341         "virConnectPtr conn = Connect_val (connv);"
 342     } elsif ($_ eq "dom") {
 343         "virDomainPtr dom = Domain_val (domv);\n".
 344         "  virConnectPtr conn = Connect_domv (domv);"
 345     } elsif ($_ eq "net") {
 346         "virNetworkPtr net = Network_val (netv);\n".
 347         "  virConnectPtr conn = Connect_netv (netv);"
 348     } elsif ($_ eq "pool") {
 349         "virStoragePoolPtr pool = Pool_val (poolv);\n".
 350         "  virConnectPtr conn = Connect_polv (poolv);"
 351     } elsif ($_ eq "vol") {
 352         "virStorageVolPtr vol = Volume_val (volv);\n".
 353         "  virConnectPtr conn = Connect_volv (volv);"
 354     } else {
 355         die "unknown short name $_"
 356     }
 357 }
 358
 359 # Pack the result if it's an object.
 360
 361 sub gen_pack_result
 362 {
 363     local $_ = shift;
 364
 365     if ($_ eq "dom") {     "rv = Val_domain (r, connv);" }
 366     elsif ($_ eq "net") {  "rv = Val_network (r, connv);" }
 367     elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
 368     elsif ($_ eq "vol") {  "rv = Val_volume (r, connv);" }
 369     else {
 370         die "unknown short name $_"
 371     }
 372 }
 373
 374 sub gen_free_arg
 375 {
 376     local $_ = shift;
 377
 378     if ($_ eq "conn") {     "Connect_val (connv) = NULL;" }
 379     elsif ($_ eq "dom") {   "Domain_val (domv) = NULL;" }
 380     elsif ($_ eq "net") {   "Network_val (netv) = NULL;" }
 381     elsif ($_ eq "pool") {  "Pool_val (poolv) = NULL;" }
 382     elsif ($_ eq "vol") {   "Volume_val (volv) = NULL;" }
 383     else {
 384         die "unknown short name $_"
 385     }
 386 }
 387
 388 # Generate the C body for each signature (class of function).
 389
 390 sub gen_c_code
 391 {
 392     my $sig = shift;
 393     my $c_name = shift;
 394
 395     if ($sig =~ /^(\w+) : string$/) {
 396         "\
 397   CAMLlocal1 (rv);
 398   " . gen_unpack_args ($1) . "
 399   char *r;
 400
 401   NONBLOCKING (r = $c_name ($1));
 402   CHECK_ERROR (!r, conn, \"$c_name\");
 403
 404   rv = caml_copy_string (r);
 405   free (r);
 406   CAMLreturn (rv);
 407 "
 408     } elsif ($sig =~ /^(\w+) : static string$/) {
 409         "\
 410   CAMLlocal1 (rv);
 411   " . gen_unpack_args ($1) . "
 412   const char *r;
 413
 414   NONBLOCKING (r = $c_name ($1));
 415   CHECK_ERROR (!r, conn, \"$c_name\");
 416
 417   rv = caml_copy_string (r);
 418   CAMLreturn (rv);
 419 "
 420     } elsif ($sig =~ /^(\w+) : int$/) {
 421         "\
 422   " . gen_unpack_args ($1) . "
 423   int r;
 424
 425   NONBLOCKING (r = $c_name ($1));
 426   CHECK_ERROR (r == -1, conn, \"$c_name\");
 427
 428   CAMLreturn (Val_int (r));
 429 "
 430     } elsif ($sig =~ /^(\w+) : uuid$/) {
 431         "\
 432   CAMLlocal1 (rv);
 433   " . gen_unpack_args ($1) . "
 434   unsigned char uuid[VIR_UUID_BUFLEN];
 435   int r;
 436
 437   NONBLOCKING (r = $c_name ($1, uuid));
 438   CHECK_ERROR (r == -1, conn, \"$c_name\");
 439
 440   /* UUIDs are byte arrays with a fixed length. */
 441   rv = caml_alloc_string (VIR_UUID_BUFLEN);
 442   memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN);
 443   CAMLreturn (rv);
 444 "
 445     } elsif ($sig =~ /^(\w+) : uuid string$/) {
 446         "\
 447   CAMLlocal1 (rv);
 448   " . gen_unpack_args ($1) . "
 449   char uuid[VIR_UUID_STRING_BUFLEN];
 450   int r;
 451
 452   NONBLOCKING (r = $c_name ($1, uuid));
 453   CHECK_ERROR (r == -1, conn, \"$c_name\");
 454
 455   rv = caml_copy_string (uuid);
 456   CAMLreturn (rv);
 457 "
 458     } elsif ($sig =~ /^(\w+) : bool$/) {
 459         "\
 460   " . gen_unpack_args ($1) . "
 461   int r, b;
 462
 463   NONBLOCKING (r = $c_name ($1, &b));
 464   CHECK_ERROR (r == -1, conn, \"$c_name\");
 465
 466   CAMLreturn (b ? Val_true : Val_false);
 467 "
 468     } elsif ($sig =~ /^(\w+), bool : unit$/) {
 469         "\
 470   " . gen_unpack_args ($1) . "
 471   int r, b;
 472
 473   b = bv == Val_true ? 1 : 0;
 474
 475   NONBLOCKING (r = $c_name ($1, b));
 476   CHECK_ERROR (r == -1, conn, \"$c_name\");
 477
 478   CAMLreturn (Val_unit);
 479 "
 480     } elsif ($sig eq "conn, int : int array") {
 481         "\
 482   CAMLlocal1 (rv);
 483   virConnectPtr conn = Connect_val (connv);
 484   int i = Int_val (iv);
 485   int ids[i], r;
 486
 487   /* Some libvirt List* functions still throw exceptions if i == 0,
 488    * so catch that and return an empty array directly.  This changes
 489    * the semantics slightly (masking other failures) but it's
 490    * unlikely anyone will care.  RWMJ 2008/06/10
 491    */
 492   if (i == 0) {
 493     rv = caml_alloc (0, 0);
 494     CAMLreturn (rv);
 495   }
 496
 497   NONBLOCKING (r = $c_name (conn, ids, i));
 498   CHECK_ERROR (r == -1, conn, \"$c_name\");
 499
 500   rv = caml_alloc (r, 0);
 501   for (i = 0; i < r; ++i)
 502     Store_field (rv, i, Val_int (ids[i]));
 503
 504   CAMLreturn (rv);
 505 "
 506     } elsif ($sig =~ /^(\w+), int : string array$/) {
 507         "\
 508   CAMLlocal2 (rv, strv);
 509   " . gen_unpack_args ($1) . "
 510   int i = Int_val (iv);
 511   char *names[i];
 512   int r;
 513
 514   /* Some libvirt List* functions still throw exceptions if i == 0,
 515    * so catch that and return an empty array directly.  This changes
 516    * the semantics slightly (masking other failures) but it's
 517    * unlikely anyone will care.  RWMJ 2008/06/10
 518    */
 519   if (i == 0) {
 520     rv = caml_alloc (0, 0);
 521     CAMLreturn (rv);
 522   }
 523
 524   NONBLOCKING (r = $c_name ($1, names, i));
 525   CHECK_ERROR (r == -1, conn, \"$c_name\");
 526
 527   rv = caml_alloc (r, 0);
 528   for (i = 0; i < r; ++i) {
 529     strv = caml_copy_string (names[i]);
 530     Store_field (rv, i, strv);
 531     free (names[i]);
 532   }
 533
 534   CAMLreturn (rv);
 535 "
 536     } elsif ($sig =~ /^(\w+), 0U? : string$/) {
 537         "\
 538   CAMLlocal1 (rv);
 539   " . gen_unpack_args ($1) . "
 540   char *r;
 541
 542   NONBLOCKING (r = $c_name ($1, 0));
 543   CHECK_ERROR (!r, conn, \"$c_name\");
 544
 545   rv = caml_copy_string (r);
 546   free (r);
 547   CAMLreturn (rv);
 548 "
 549     } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
 550         "\
 551   " . gen_unpack_args ($1) . "
 552   int r;
 553
 554   NONBLOCKING (r = $c_name ($1, 0));
 555   CHECK_ERROR (r == -1, conn, \"$c_name\");
 556
 557   CAMLreturn (Val_unit);
 558 "
 559     } elsif ($sig =~ /^(\w+) : unit$/) {
 560         "\
 561   " . gen_unpack_args ($1) . "
 562   int r;
 563
 564   NONBLOCKING (r = $c_name ($1));
 565   CHECK_ERROR (r == -1, conn, \"$c_name\");
 566
 567   CAMLreturn (Val_unit);
 568 "
 569     } elsif ($sig =~ /^(\w+) : free$/) {
 570         "\
 571   " . gen_unpack_args ($1) . "
 572   int r;
 573
 574   NONBLOCKING (r = $c_name ($1));
 575   CHECK_ERROR (r == -1, conn, \"$c_name\");
 576
 577   /* So that we don't double-free in the finalizer: */
 578   " . gen_free_arg ($1) . "
 579
 580   CAMLreturn (Val_unit);
 581 "
 582     } elsif ($sig =~ /^(\w+), string : unit$/) {
 583         "\
 584   " . gen_unpack_args ($1) . "
 585   char *str = String_val (strv);
 586   int r;
 587
 588   NONBLOCKING (r = $c_name ($1, str));
 589   CHECK_ERROR (r == -1, conn, \"$c_name\");
 590
 591   CAMLreturn (Val_unit);
 592 "
 593     } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
 594         "\
 595   CAMLlocal1 (rv);
 596   " . gen_unpack_args ($1) . "
 597   char *str = String_val (strv);
 598   int r;
 599
 600   NONBLOCKING (r = $c_name ($1, str, 0));
 601   CHECK_ERROR (!r, conn, \"$c_name\");
 602
 603   CAMLreturn (Val_unit);
 604 "
 605     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 606         my $c_ret_type = short_name_to_c_type ($2);
 607         "\
 608   CAMLlocal1 (rv);
 609   " . gen_unpack_args ($1) . "
 610   char *str = String_val (strv);
 611   $c_ret_type r;
 612
 613   NONBLOCKING (r = $c_name ($1, str));
 614   CHECK_ERROR (!r, conn, \"$c_name\");
 615
 616   " . gen_pack_result ($2) . "
 617
 618   CAMLreturn (rv);
 619 "
 620     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
 621         my $c_ret_type = short_name_to_c_type ($2);
 622         "\
 623   CAMLlocal1 (rv);
 624   " . gen_unpack_args ($1) . "
 625   char *str = String_val (strv);
 626   $c_ret_type r;
 627
 628   NONBLOCKING (r = $c_name ($1, str, 0));
 629   CHECK_ERROR (!r, conn, \"$c_name\");
 630
 631   " . gen_pack_result ($2) . "
 632
 633   CAMLreturn (rv);
 634 "
 635     } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
 636         my $unsigned = $2 eq "u" ? "unsigned " : "";
 637         "\
 638   " . gen_unpack_args ($1) . "
 639   ${unsigned}int i = Int_val (iv);
 640   int r;
 641
 642   NONBLOCKING (r = $c_name ($1, i));
 643   CHECK_ERROR (r == -1, conn, \"$c_name\");
 644
 645   CAMLreturn (Val_unit);
 646 "
 647     } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) {
 648         my $c_ret_type = short_name_to_c_type ($3);
 649         my $unsigned = $2 eq "u" ? "unsigned " : "";
 650         "\
 651   CAMLlocal1 (rv);
 652   " . gen_unpack_args ($1) . "
 653   ${unsigned}int i = Int_val (iv);
 654   $c_ret_type r;
 655
 656   NONBLOCKING (r = $c_name ($1, i));
 657   CHECK_ERROR (!r, conn, \"$c_name\");
 658
 659   " . gen_pack_result ($3) . "
 660
 661   CAMLreturn (rv);
 662 "
 663     } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
 664         my $c_ret_type = short_name_to_c_type ($2);
 665         "\
 666   CAMLlocal1 (rv);
 667   " . gen_unpack_args ($1) . "
 668   unsigned char *uuid = (unsigned char *) String_val (uuidv);
 669   $c_ret_type r;
 670
 671   NONBLOCKING (r = $c_name ($1, uuid));
 672   CHECK_ERROR (!r, conn, \"$c_name\");
 673
 674   " . gen_pack_result ($2) . "
 675
 676   CAMLreturn (rv);
 677 "
 678     } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
 679         my $c_ret_type = short_name_to_c_type ($2);
 680         "\
 681   CAMLlocal1 (rv);
 682   " . gen_unpack_args ($1) . "
 683   $c_ret_type r;
 684
 685   NONBLOCKING (r = $c_name ($1, 0));
 686   CHECK_ERROR (!r, conn, \"$c_name\");
 687
 688   " . gen_pack_result ($2) . "
 689
 690   CAMLreturn (rv);
 691 "
 692     } elsif ($sig =~ /^(\w+) : (\w+)$/) {
 693         my $c_ret_type = short_name_to_c_type ($2);
 694         "\
 695   CAMLlocal1 (rv);
 696   " . gen_unpack_args ($1) . "
 697   $c_ret_type r;
 698
 699   NONBLOCKING (r = $c_name ($1));
 700   CHECK_ERROR (!r, conn, \"$c_name\");
 701
 702   " . gen_pack_result ($2) . "
 703
 704   CAMLreturn (rv);
 705 "
 706     } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) {
 707         my $c_ret_type = short_name_to_c_type ($2);
 708         "\
 709   CAMLlocal2 (rv, connv);
 710   " . gen_unpack_args ($1) . "
 711   char *str = String_val (strv);
 712   $c_ret_type r;
 713
 714   NONBLOCKING (r = $c_name ($1, str));
 715   CHECK_ERROR (!r, conn, \"$c_name\");
 716
 717   connv = Field ($3v, 1);
 718   " . gen_pack_result ($2) . "
 719
 720   CAMLreturn (rv);
 721 "
 722     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) {
 723         my $c_ret_type = short_name_to_c_type ($2);
 724         "\
 725   CAMLlocal2 (rv, connv);
 726   " . gen_unpack_args ($1) . "
 727   char *str = String_val (strv);
 728   $c_ret_type r;
 729
 730   NONBLOCKING (r = $c_name ($1, str, 0));
 731   CHECK_ERROR (!r, conn, \"$c_name\");
 732
 733   connv = Field ($3v, 1);
 734   " . gen_pack_result ($2) . "
 735
 736   CAMLreturn (rv);
 737 "
 738     } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) {
 739         my $c_ret_type = short_name_to_c_type ($2);
 740         "\
 741   CAMLlocal2 (rv, connv);
 742   " . gen_unpack_args ($1) . "
 743   $c_ret_type r;
 744
 745   NONBLOCKING (r = $c_name ($1, 0));
 746   CHECK_ERROR (!r, conn, \"$c_name\");
 747
 748   connv = Field ($3v, 1);
 749   " . gen_pack_result ($2) . "
 750
 751   CAMLreturn (rv);
 752 "
 753     } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) {
 754         my $c_ret_type = short_name_to_c_type ($2);
 755         "\
 756   CAMLlocal2 (rv, connv);
 757   " . gen_unpack_args ($1) . "
 758   $c_ret_type r;
 759
 760   NONBLOCKING (r = $c_name ($1));
 761   CHECK_ERROR (!r, conn, \"$c_name\");
 762
 763   connv = Field ($3v, 1);
 764   " . gen_pack_result ($2) . "
 765
 766   CAMLreturn (rv);
 767 "
 768     } else {
 769         die "unknown signature $sig"
 770     }
 771 }
 772
 773 # Generate each function.
 774
 775 foreach my $function (@functions) {
 776     my $c_name = $function->{name};
 777     my $sig = $function->{sig};
 778
 779     #print "generating $c_name with sig \"$sig\" ...\n";
 780
 781     #my $is_pool_func = $c_name =~ /^virStoragePool/;
 782     #my $is_vol_func = $c_name =~ /^virStorageVol/;
 783
 784     # Generate an equivalent C-external name for the function, unless
 785     # one is defined already.
 786     my $c_external_name;
 787     if (exists ($function->{c_external_name})) {
 788         $c_external_name = $function->{c_external_name};
 789     } elsif ($c_name =~ /^vir/) {
 790         $c_external_name = substr $c_name, 3;
 791         $c_external_name = camel_case_to_underscores ($c_external_name);
 792         $c_external_name = "ocaml_libvirt_" . $c_external_name;
 793     } else {
 794         die "cannot convert c_name $c_name to c_external_name"
 795     }
 796
 797     print F <<END;
 798 /* Automatically generated binding for $c_name.
 799  * In generator.pl this function has signature "$sig".
 800  */
 801
 802 END
 803
 804     my @arg_names = gen_arg_names ($sig);
 805     my $nr_arg_names = scalar @arg_names;
 806     my $arg_names = join ", ", @arg_names;
 807     my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
 808
 809     # Generate the start of the function, arguments.
 810     print F <<END;
 811 CAMLprim value
 812 $c_external_name ($arg_names_as_values)
 813 {
 814   CAMLparam$nr_arg_names ($arg_names);
 815 END
 816
 817     # Generate the internals of the function.
 818     print F (gen_c_code ($sig, $c_name));
 819
 820     # Finish off the function.
 821     print F <<END;
 822 }
 823
 824 END
 825 }
 826
 827 #----------------------------------------------------------------------
 828
 829 # Unimplemented functions.
 830
 831 if (@unimplemented) {
 832     printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
 833
 834     print F <<'END';
 835 /* The following functions are unimplemented and always fail.
 836  * See generator.pl '@unimplemented'
 837  */
 838
 839 END
 840
 841     foreach my $c_external_name (@unimplemented) {
 842         print F <<END;
 843 CAMLprim value
 844 $c_external_name ()
 845 {
 846   failwith ("$c_external_name is unimplemented");
 847 }
 848
 849 END
 850     } # end foreach
 851 } # end if @unimplemented
 852
 853 #----------------------------------------------------------------------
 854
 855 # Write the epilogue.
 856
 857 print F <<'END';
 858 #include "libvirt_c_epilogue.c"
 859
 860 /* EOF */
 861 END
 862
 863 close F;
 864 print "$0: written $filename\n"
 865