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 #
  12 # This library is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # Lesser General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU Lesser General Public
  18 # License along with this library; if not, write to the Free Software
  19 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
  20
  21 # This generates libvirt_c.c (the core of the bindings).  You don't
  22 # need to run this program unless you are extending the bindings
  23 # themselves (eg. because libvirt has been extended).
  24
  25 use strict;
  26
  27 #----------------------------------------------------------------------
  28
  29 # The functions in the libvirt API that we can generate.
  30
  31 my @functions = (
  32     { name => "virConnectClose", sig => "conn : free" },
  33     { name => "virConnectGetHostname", sig => "conn : string", weak => 1 },
  34     { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
  35     { name => "virConnectGetType", sig => "conn : static string" },
  36     { name => "virConnectNumOfDomains", sig => "conn : int" },
  37     { name => "virConnectListDomains", sig => "conn, int : int array" },
  38     { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
  39     { name => "virConnectListDefinedDomains",
  40       sig => "conn, int : string array" },
  41     { name => "virConnectNumOfNetworks", sig => "conn : int" },
  42     { name => "virConnectListNetworks", sig => "conn, int : string array" },
  43     { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
  44     { name => "virConnectListDefinedNetworks",
  45       sig => "conn, int : string array" },
  46     { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 },
  47     { name => "virConnectListStoragePools",
  48       sig => "conn, int : string array", weak => 1 },
  49     { name => "virConnectNumOfDefinedStoragePools",
  50       sig => "conn : int", weak => 1 },
  51     { name => "virConnectListDefinedStoragePools",
  52       sig => "conn, int : string array", weak => 1 },
  53     { name => "virConnectGetCapabilities", sig => "conn : string" },
  54
  55     { name => "virDomainFree", sig => "dom : free" },
  56     { name => "virDomainDestroy", sig => "dom : free" },
  57     { name => "virDomainLookupByName", sig => "conn, string : dom" },
  58     { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
  59     { name => "virDomainGetName", sig => "dom : static string" },
  60     { name => "virDomainGetOSType", sig => "dom : string" },
  61     { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
  62     { name => "virDomainGetUUID", sig => "dom : uuid" },
  63     { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
  64     { name => "virDomainSuspend", sig => "dom : unit" },
  65     { name => "virDomainResume", sig => "dom : unit" },
  66     { name => "virDomainShutdown", sig => "dom : unit" },
  67     { name => "virDomainReboot", sig => "dom, 0 : unit" },
  68     { name => "virDomainUndefine", sig => "dom : unit" },
  69     { name => "virDomainCreate", sig => "dom : unit" },
  70     { name => "virDomainGetAutostart", sig => "dom : bool" },
  71     { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
  72
  73     { name => "virNetworkFree", sig => "net : free" },
  74     { name => "virNetworkDestroy", sig => "net : free" },
  75     { name => "virNetworkLookupByName", sig => "conn, string : net" },
  76     { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
  77     { name => "virNetworkGetName", sig => "net : static string" },
  78     { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
  79     { name => "virNetworkGetBridgeName", sig => "net : string" },
  80     { name => "virNetworkGetUUID", sig => "net : uuid" },
  81     { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
  82     { name => "virNetworkUndefine", sig => "net : unit" },
  83     { name => "virNetworkCreate", sig => "net : unit" },
  84     { name => "virNetworkGetAutostart", sig => "net : bool" },
  85     { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
  86
  87     { name => "virStoragePoolFree",
  88       sig => "pool : free", weak => 1 },
  89     { name => "virStoragePoolDestroy",
  90       sig => "pool : free", weak => 1 },
  91     { name => "virStoragePoolLookupByName",
  92       sig => "conn, string : pool", weak => 1 },
  93     { name => "virStoragePoolLookupByUUIDString",
  94       sig => "conn, string : pool", weak => 1 },
  95     { name => "virStoragePoolGetName",
  96       sig => "pool : static string", weak => 1 },
  97     { name => "virStoragePoolGetXMLDesc",
  98       sig => "pool, 0 : string", weak => 1 },
  99     { name => "virStoragePoolGetUUID",
 100       sig => "pool : uuid", weak => 1 },
 101     { name => "virStoragePoolGetUUIDString",
 102       sig => "pool : uuid string", weak => 1 },
 103     { name => "virStoragePoolUndefine",
 104       sig => "pool : unit", weak => 1 },
 105     { name => "virStoragePoolCreate",
 106       sig => "pool : unit", weak => 1 },
 107     { name => "virStoragePoolShutdown",
 108       sig => "pool : unit", weak => 1 },
 109     { name => "virStoragePoolRefresh",
 110       sig => "pool, 0U : unit", weak => 1 },
 111     { name => "virStoragePoolGetAutostart",
 112       sig => "pool : bool", weak => 1 },
 113     { name => "virStoragePoolSetAutostart",
 114       sig => "pool, bool : unit", weak => 1 },
 115
 116     { name => "virStorageVolFree", sig => "vol : free" },
 117     { name => "virStorageVolDestroy", sig => "vol : free" },
 118 #    { name => "virStorageVolLookupByName", XXX see libvir-list posting
 119 #      sig => "pool, string : vol", weak => 1 },
 120     { name => "virStorageVolLookupByKey",
 121       sig => "conn, string : vol", weak => 1 },
 122     { name => "virStorageVolLookupByPath",
 123       sig => "conn, string : vol", weak => 1 },
 124     { name => "virStorageVolGetXMLDesc",
 125       sig => "vol, 0 : string", weak => 1 },
 126     { name => "virStorageVolGetPath",
 127       sig => "vol : string", weak => 1 },
 128     { name => "virStorageVolGetKey",
 129       sig => "vol : static string", weak => 1 },
 130     { name => "virStorageVolGetName",
 131       sig => "vol : static string", weak => 1 },
 132
 133     );
 134
 135 # Functions we haven't implemented anywhere yet.
 136 # We create stubs for these, but they need to either be moved ^^ so they
 137 # are auto-generated or implementations written in libvirt_c_oneoffs.c.
 138
 139 my @unimplemented = (
 140     "ocaml_libvirt_domain_create_job",
 141     "ocaml_libvirt_domain_core_dump_job",
 142     "ocaml_libvirt_domain_restore_job",
 143     "ocaml_libvirt_domain_save_job",
 144     "ocaml_libvirt_connect_create_linux_job",
 145     "ocaml_libvirt_network_create_job",
 146     "ocaml_libvirt_network_create_xml_job",
 147     "ocaml_libvirt_storage_pool_get_info",
 148     "ocaml_libvirt_storage_pool_define_xml",
 149     "ocaml_libvirt_storage_pool_create_xml",
 150     "ocaml_libvirt_storage_pool_lookup_by_uuid",
 151     "ocaml_libvirt_storage_vol_lookup_by_name", # XXX
 152     "ocaml_libvirt_storage_vol_create_xml",
 153     "ocaml_libvirt_storage_vol_get_info",
 154     "ocaml_libvirt_pool_of_volume",
 155     "ocaml_libvirt_job_cancel",
 156     "ocaml_libvirt_job_get_network",
 157     "ocaml_libvirt_job_get_domain",
 158     "ocaml_libvirt_job_get_info",
 159     );
 160
 161 #----------------------------------------------------------------------
 162
 163 # Open the output file.
 164
 165 my $filename = "libvirt_c.c";
 166 open F, ">$filename" or die "$filename: $!";
 167
 168 # Write the prologue.
 169
 170 print F <<'END';
 171 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
 172  *
 173  * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
 174  *
 175  * Any changes you make to this file may be overwritten.
 176  */
 177
 178 /* OCaml bindings for libvirt.
 179  * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
 180  * http://libvirt.org/
 181  *
 182  * This library is free software; you can redistribute it and/or
 183  * modify it under the terms of the GNU Lesser General Public
 184  * License as published by the Free Software Foundation; either
 185  * version 2 of the License, or (at your option) any later version.
 186  *
 187  * This library is distributed in the hope that it will be useful,
 188  * but WITHOUT ANY WARRANTY; without even the implied warranty of
 189  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 190  * Lesser General Public License for more details.
 191  *
 192  * You should have received a copy of the GNU Lesser General Public
 193  * License along with this library; if not, write to the Free Software
 194  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
 195  */
 196
 197 #include "config.h"
 198
 199 #include <stdio.h>
 200 #include <stdlib.h>
 201 #include <string.h>
 202
 203 #include <libvirt/libvirt.h>
 204 #include <libvirt/virterror.h>
 205
 206 #include <caml/config.h>
 207 #include <caml/alloc.h>
 208 #include <caml/callback.h>
 209 #include <caml/custom.h>
 210 #include <caml/fail.h>
 211 #include <caml/memory.h>
 212 #include <caml/misc.h>
 213 #include <caml/mlvalues.h>
 214 #include <caml/signals.h>
 215
 216 #include "libvirt_c_prologue.c"
 217
 218 #include "libvirt_c_oneoffs.c"
 219
 220 END
 221
 222 #----------------------------------------------------------------------
 223
 224 sub camel_case_to_underscores
 225 {
 226     my $name = shift;
 227
 228     $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
 229     my @subs = split (/,/, $name);
 230     @subs = map { lc($_) } @subs;
 231     join "_", @subs
 232 }
 233
 234 # Helper functions dealing with signatures.
 235
 236 sub short_name_to_c_type
 237 {
 238     local $_ = shift;
 239
 240     if ($_ eq "conn") { "virConnectPtr" }
 241     elsif ($_ eq "dom") { "virDomainPtr" }
 242     elsif ($_ eq "net") { "virNetworkPtr" }
 243     elsif ($_ eq "pool") { "virStoragePoolPtr" }
 244     elsif ($_ eq "vol") { "virStorageVolPtr" }
 245     else {
 246         die "unknown short name $_"
 247     }
 248 }
 249
 250 sub gen_c_signature
 251 {
 252     my $sig = shift;
 253     my $c_name = shift;
 254
 255     if ($sig =~ /^(\w+) : string$/) {
 256         my $c_type = short_name_to_c_type ($1);
 257         "char *$c_name ($c_type $1)"
 258     } elsif ($sig =~ /^(\w+) : static string$/) {
 259         my $c_type = short_name_to_c_type ($1);
 260         "const char *$c_name ($c_type $1)"
 261     } elsif ($sig =~ /^(\w+) : int$/) {
 262         my $c_type = short_name_to_c_type ($1);
 263         "int $c_name ($c_type $1)"
 264     } elsif ($sig =~ /^(\w+) : uuid$/) {
 265         my $c_type = short_name_to_c_type ($1);
 266         "int $c_name ($c_type $1, unsigned char *)"
 267     } elsif ($sig =~ /^(\w+) : uuid string$/) {
 268         my $c_type = short_name_to_c_type ($1);
 269         "int $c_name ($c_type $1, char *)"
 270     } elsif ($sig =~ /^(\w+) : bool$/) {
 271         my $c_type = short_name_to_c_type ($1);
 272         "int $c_name ($c_type $1, int *r)"
 273     } elsif ($sig =~ /^(\w+), bool : unit$/) {
 274         my $c_type = short_name_to_c_type ($1);
 275         "int $c_name ($c_type $1, int b)"
 276     } elsif ($sig eq "conn, int : int array") {
 277         "int $c_name (virConnectPtr conn, int *ids, int maxids)"
 278     } elsif ($sig eq "conn, int : string array") {
 279         "int $c_name (virConnectPtr conn, char **const names, int maxnames)"
 280     } elsif ($sig =~ /^(\w+), 0(U?) : string$/) {
 281         my $c_type = short_name_to_c_type ($1);
 282         my $unsigned = $2 eq "U" ? "unsigned " : "";
 283         "char *$c_name ($c_type $1, $unsigned int flags)"
 284     } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) {
 285         my $c_type = short_name_to_c_type ($1);
 286         my $unsigned = $2 eq "U" ? "unsigned " : "";
 287         "int $c_name ($c_type $1, $unsigned int flags)"
 288     } elsif ($sig =~ /^(\w+) : unit$/) {
 289         my $c_type = short_name_to_c_type ($1);
 290         "int $c_name ($c_type $1)"
 291     } elsif ($sig =~ /^(\w+) : free$/) {
 292         my $c_type = short_name_to_c_type ($1);
 293         "int $c_name ($c_type $1)"
 294     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 295         my $c_type = short_name_to_c_type ($1);
 296         my $c_ret_type = short_name_to_c_type ($2);
 297         "$c_ret_type $c_name ($c_type $1, const char *str)"
 298     } else {
 299         die "unknown signature $sig"
 300     }
 301 }
 302
 303 sub gen_arg_names
 304 {
 305     my $sig = shift;
 306
 307     if ($sig =~ /^(\w+) : string$/) {
 308         ( "$1v" )
 309     } elsif ($sig =~ /^(\w+) : static string$/) {
 310         ( "$1v" )
 311     } elsif ($sig =~ /^(\w+) : int$/) {
 312         ( "$1v" )
 313     } elsif ($sig =~ /^(\w+) : uuid$/) {
 314         ( "$1v" )
 315     } elsif ($sig =~ /^(\w+) : uuid string$/) {
 316         ( "$1v" )
 317     } elsif ($sig =~ /^(\w+) : bool$/) {
 318         ( "$1v" )
 319     } elsif ($sig =~ /^(\w+), bool : unit$/) {
 320         ( "$1v", "bv" )
 321     } elsif ($sig eq "conn, int : int array") {
 322         ( "connv", "iv" )
 323     } elsif ($sig eq "conn, int : string array") {
 324         ( "connv", "iv" )
 325     } elsif ($sig =~ /^(\w+), 0U? : string$/) {
 326         ( "$1v" )
 327     } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
 328         ( "$1v" )
 329     } elsif ($sig =~ /^(\w+) : unit$/) {
 330         ( "$1v" )
 331     } elsif ($sig =~ /^(\w+) : free$/) {
 332         ( "$1v" )
 333     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 334         ( "$1v", "strv" )
 335     } else {
 336         die "unknown signature $sig"
 337     }
 338 }
 339
 340 sub gen_unpack_args
 341 {
 342     local $_ = shift;
 343
 344     if ($_ eq "conn") {
 345         "virConnectPtr conn = Connect_val (connv);"
 346     } elsif ($_ eq "dom") {
 347         "virDomainPtr dom = Domain_val (domv);\n".
 348         "  virConnectPtr conn = Connect_domv (domv);"
 349     } elsif ($_ eq "net") {
 350         "virNetworkPtr net = Network_val (netv);\n".
 351         "  virConnectPtr conn = Connect_netv (netv);"
 352     } elsif ($_ eq "pool") {
 353         "virStoragePoolPtr pool = Pool_val (poolv);\n".
 354         "  virConnectPtr conn = Connect_polv (poolv);"
 355     } elsif ($_ eq "vol") {
 356         "virStorageVolPtr vol = Volume_val (volv);\n".
 357         "  virConnectPtr conn = Connect_volv (volv);"
 358     } else {
 359         die "unknown short name $_"
 360     }
 361 }
 362
 363 sub gen_pack_result
 364 {
 365     local $_ = shift;
 366
 367     if ($_ eq "dom") {     "rv = Val_domain (r, connv);" }
 368     elsif ($_ eq "net") {  "rv = Val_network (r, connv);" }
 369     elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
 370     elsif ($_ eq "vol") {  "rv = Val_volume (r, connv);" }
 371     else {
 372         die "unknown short name $_"
 373     }
 374 }
 375
 376 sub gen_free_arg
 377 {
 378     local $_ = shift;
 379
 380     if ($_ eq "conn") {     "Connect_val (connv) = NULL;" }
 381     elsif ($_ eq "dom") {   "Domain_val (domv) = NULL;" }
 382     elsif ($_ eq "net") {   "Network_val (netv) = NULL;" }
 383     elsif ($_ eq "pool") {  "Pool_val (poolv) = NULL;" }
 384     elsif ($_ eq "vol") {   "Volume_val (volv) = NULL;" }
 385     else {
 386         die "unknown short name $_"
 387     }
 388 }
 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   rv = caml_copy_string ((char *) uuid);
 441   CAMLreturn (rv);
 442 "
 443     } elsif ($sig =~ /^(\w+) : uuid string$/) {
 444         "\
 445   CAMLlocal1 (rv);
 446   " . gen_unpack_args ($1) . "
 447   char uuid[VIR_UUID_STRING_BUFLEN];
 448   int r;
 449
 450   NONBLOCKING (r = $c_name ($1, uuid));
 451   CHECK_ERROR (r == -1, conn, \"$c_name\");
 452
 453   rv = caml_copy_string (uuid);
 454   CAMLreturn (rv);
 455 "
 456     } elsif ($sig =~ /^(\w+) : bool$/) {
 457         "\
 458   " . gen_unpack_args ($1) . "
 459   int r, b;
 460
 461   NONBLOCKING (r = $c_name ($1, &b));
 462   CHECK_ERROR (r == -1, conn, \"$c_name\");
 463
 464   CAMLreturn (b ? Val_true : Val_false);
 465 "
 466     } elsif ($sig =~ /^(\w+), bool : unit$/) {
 467         "\
 468   " . gen_unpack_args ($1) . "
 469   int r, b;
 470
 471   b = bv == Val_true ? 1 : 0;
 472
 473   NONBLOCKING (r = $c_name ($1, b));
 474   CHECK_ERROR (r == -1, conn, \"$c_name\");
 475
 476   CAMLreturn (Val_unit);
 477 "
 478     } elsif ($sig eq "conn, int : int array") {
 479         "\
 480   CAMLlocal1 (rv);
 481   virConnectPtr conn = Connect_val (connv);
 482   int i = Int_val (iv);
 483   int ids[i], r;
 484
 485   NONBLOCKING (r = $c_name (conn, ids, i));
 486   CHECK_ERROR (r == -1, conn, \"$c_name\");
 487
 488   rv = caml_alloc (r, 0);
 489   for (i = 0; i < r; ++i)
 490     Store_field (rv, i, Val_int (ids[i]));
 491
 492   CAMLreturn (rv);
 493 "
 494     } elsif ($sig eq "conn, int : string array") {
 495         "\
 496   CAMLlocal2 (rv, strv);
 497   virConnectPtr conn = Connect_val (connv);
 498   int i = Int_val (iv);
 499   char *names[i];
 500   int r;
 501
 502   NONBLOCKING (r = $c_name (conn, names, i));
 503   CHECK_ERROR (r == -1, conn, \"$c_name\");
 504
 505   rv = caml_alloc (r, 0);
 506   for (i = 0; i < r; ++i) {
 507     strv = caml_copy_string (names[i]);
 508     Store_field (rv, i, strv);
 509     free (names[i]);
 510   }
 511
 512   CAMLreturn (rv);
 513 "
 514     } elsif ($sig =~ /^(\w+), 0U? : string$/) {
 515         "\
 516   CAMLlocal1 (rv);
 517   " . gen_unpack_args ($1) . "
 518   char *r;
 519
 520   NONBLOCKING (r = $c_name ($1, 0));
 521   CHECK_ERROR (!r, conn, \"$c_name\");
 522
 523   rv = caml_copy_string (r);
 524   free (r);
 525   CAMLreturn (rv);
 526 "
 527     } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
 528         "\
 529   " . gen_unpack_args ($1) . "
 530   int r;
 531
 532   NONBLOCKING (r = $c_name ($1, 0));
 533   CHECK_ERROR (r == -1, conn, \"$c_name\");
 534
 535   CAMLreturn (Val_unit);
 536 "
 537     } elsif ($sig =~ /^(\w+) : unit$/) {
 538         "\
 539   " . gen_unpack_args ($1) . "
 540   int r;
 541
 542   NONBLOCKING (r = $c_name ($1));
 543   CHECK_ERROR (r == -1, conn, \"$c_name\");
 544
 545   CAMLreturn (Val_unit);
 546 "
 547     } elsif ($sig =~ /^(\w+) : free$/) {
 548         "\
 549   " . gen_unpack_args ($1) . "
 550   int r;
 551
 552   NONBLOCKING (r = $c_name ($1));
 553   CHECK_ERROR (r == -1, conn, \"$c_name\");
 554
 555   /* So that we don't double-free in the finalizer: */
 556   " . gen_free_arg ($1) . "
 557
 558   CAMLreturn (Val_unit);
 559 "
 560     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 561         my $c_ret_type = short_name_to_c_type ($2);
 562         "\
 563   CAMLlocal1 (rv);
 564   " . gen_unpack_args ($1) . "
 565   char *str = String_val (strv);
 566   $c_ret_type r;
 567
 568   NONBLOCKING (r = $c_name ($1, str));
 569   CHECK_ERROR (!r, conn, \"$c_name\");
 570
 571   " . gen_pack_result ($2) . "
 572
 573   CAMLreturn (rv);
 574 "
 575     } else {
 576         die "unknown signature $sig"
 577     }
 578 }
 579
 580 # Generate each function.
 581
 582 foreach my $function (@functions) {
 583     my $c_name = $function->{name};
 584     my $is_weak = $function->{weak};
 585     my $sig = $function->{sig};
 586
 587     my $is_pool_func = $c_name =~ /^virStoragePool/;
 588     my $is_vol_func = $c_name =~ /^virStorageVol/;
 589
 590     # Generate an equivalent C-external name for the function, unless
 591     # one is defined already.
 592     my $c_external_name;
 593     if (exists ($function->{c_external_name})) {
 594         $c_external_name = $function->{c_external_name};
 595     } elsif ($c_name =~ /^vir/) {
 596         $c_external_name = substr $c_name, 3;
 597         $c_external_name = camel_case_to_underscores ($c_external_name);
 598         $c_external_name = "ocaml_libvirt_" . $c_external_name;
 599     } else {
 600         die "cannot convert c_name $c_name to c_external_name"
 601     }
 602
 603     # Generate a full function prototype if the function is weak.
 604     my $have_name = "HAVE_" . uc ($c_name);
 605     if ($is_weak) {
 606         my $c_sig = gen_c_signature ($sig, $c_name);
 607         print F <<END;
 608 #ifdef HAVE_WEAK_SYMBOLS
 609 #ifdef $have_name
 610 extern $c_sig __attribute__((weak));
 611 #endif
 612 #endif
 613
 614 END
 615     }
 616
 617     my @arg_names = gen_arg_names ($sig);
 618     my $nr_arg_names = scalar @arg_names;
 619     my $arg_names = join ", ", @arg_names;
 620     my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
 621
 622     # Generate the start of the function, arguments.
 623     print F <<END;
 624 CAMLprim value
 625 $c_external_name ($arg_names_as_values)
 626 {
 627   CAMLparam$nr_arg_names ($arg_names);
 628 END
 629
 630     # If weak, check the function exists at compile time or runtime.
 631     if ($is_weak) {
 632         print F <<END;
 633 #ifndef $have_name
 634   /* Symbol $c_name not found at compile time. */
 635   not_supported ("$c_name");
 636   /* Suppresses a compiler warning. */
 637   (void) caml__frame;
 638 #else
 639   /* Check that the symbol $c_name
 640    * is in runtime version of libvirt.
 641    */
 642   WEAK_SYMBOL_CHECK ($c_name);
 643 END
 644     }
 645
 646     # Generate the internals of the function.
 647     print F (gen_c_code ($sig, $c_name));
 648
 649     # Finish off weak #ifdef.
 650     if ($is_weak) {
 651         print F <<END;
 652 #endif
 653 END
 654     }
 655
 656     # Finish off the function.
 657     print F <<END;
 658 }
 659
 660 END
 661 }
 662
 663 #----------------------------------------------------------------------
 664
 665 # Unimplemented functions.
 666
 667 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
 668
 669 print F <<'END';
 670 /* The following functions are unimplemented and always fail.
 671  * See generator.pl '@unimplemented'
 672  */
 673
 674 END
 675
 676 foreach my $c_external_name (@unimplemented) {
 677     print F <<END
 678 CAMLprim value
 679 $c_external_name ()
 680 {
 681   failwith ("$c_external_name is unimplemented");
 682 }
 683
 684 END
 685 }
 686
 687 #----------------------------------------------------------------------
 688
 689 # Write the epilogue.
 690
 691 print F <<'END';
 692 #include "libvirt_c_epilogue.c"
 693
 694 /* EOF */
 695 END
 696
 697 close F;
 698 print "$0: written $filename\n"
 699