3 # OCaml bindings for libvirt.
4 # (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
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.
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.
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
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).
26 # Please read libvirt/README.
30 #----------------------------------------------------------------------
32 # The functions in the libvirt API that we can generate.
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
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" },
63 { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
64 { name => "virDomainFree", sig => "dom : free" },
65 { name => "virDomainDestroy", sig => "dom : free" },
66 { name => "virDomainLookupByName", sig => "conn, string : dom" },
67 { name => "virDomainLookupByID", sig => "conn, int : dom" },
68 { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" },
69 { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
70 { name => "virDomainGetName", sig => "dom : static string" },
71 { name => "virDomainGetOSType", sig => "dom : string" },
72 { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
73 { name => "virDomainGetUUID", sig => "dom : uuid" },
74 { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
75 { name => "virDomainGetMaxVcpus", sig => "dom : int" },
76 { name => "virDomainSave", sig => "dom, string : unit" },
77 { name => "virDomainRestore", sig => "conn, string : unit" },
78 { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" },
79 { name => "virDomainSuspend", sig => "dom : unit" },
80 { name => "virDomainResume", sig => "dom : unit" },
81 { name => "virDomainShutdown", sig => "dom : unit" },
82 { name => "virDomainReboot", sig => "dom, 0 : unit" },
83 { name => "virDomainDefineXML", sig => "conn, string : dom" },
84 { name => "virDomainUndefine", sig => "dom : unit" },
85 { name => "virDomainCreate", sig => "dom : unit" },
86 { name => "virDomainAttachDevice", sig => "dom, string : unit" },
87 { name => "virDomainDetachDevice", sig => "dom, string : unit" },
88 { name => "virDomainGetAutostart", sig => "dom : bool" },
89 { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
91 { name => "virNetworkFree", sig => "net : free" },
92 { name => "virNetworkDestroy", sig => "net : free" },
93 { name => "virNetworkLookupByName", sig => "conn, string : net" },
94 { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" },
95 { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
96 { name => "virNetworkGetName", sig => "net : static string" },
97 { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
98 { name => "virNetworkGetBridgeName", sig => "net : string" },
99 { name => "virNetworkGetUUID", sig => "net : uuid" },
100 { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
101 { name => "virNetworkUndefine", sig => "net : unit" },
102 { name => "virNetworkCreateXML", sig => "conn, string : net" },
103 { name => "virNetworkDefineXML", sig => "conn, string : net" },
104 { name => "virNetworkCreate", sig => "net : unit" },
105 { name => "virNetworkGetAutostart", sig => "net : bool" },
106 { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
108 { name => "virStoragePoolFree", sig => "pool : free" },
109 { name => "virStoragePoolDestroy", sig => "pool : free" },
110 { name => "virStoragePoolLookupByName",
111 sig => "conn, string : pool" },
112 { name => "virStoragePoolLookupByUUID",
113 sig => "conn, uuid : pool" },
114 { name => "virStoragePoolLookupByUUIDString",
115 sig => "conn, string : pool" },
116 { name => "virStoragePoolGetName",
117 sig => "pool : static string" },
118 { name => "virStoragePoolGetXMLDesc",
119 sig => "pool, 0U : string" },
120 { name => "virStoragePoolGetUUID",
121 sig => "pool : uuid" },
122 { name => "virStoragePoolGetUUIDString",
123 sig => "pool : uuid string" },
124 { name => "virStoragePoolCreateXML",
125 sig => "conn, string, 0U : pool" },
126 { name => "virStoragePoolDefineXML",
127 sig => "conn, string, 0U : pool" },
128 { name => "virStoragePoolBuild",
129 sig => "pool, uint : unit" },
130 { name => "virStoragePoolUndefine",
131 sig => "pool : unit" },
132 { name => "virStoragePoolCreate",
133 sig => "pool, 0U : unit" },
134 { name => "virStoragePoolDelete",
135 sig => "pool, uint : unit" },
136 { name => "virStoragePoolRefresh",
137 sig => "pool, 0U : unit" },
138 { name => "virStoragePoolGetAutostart",
139 sig => "pool : bool" },
140 { name => "virStoragePoolSetAutostart",
141 sig => "pool, bool : unit" },
142 { name => "virStoragePoolNumOfVolumes",
143 sig => "pool : int" },
144 { name => "virStoragePoolListVolumes",
145 sig => "pool, int : string array" },
147 { name => "virStorageVolFree", sig => "vol : free" },
148 { name => "virStorageVolDelete",
149 sig => "vol, uint : unit" },
150 { name => "virStorageVolLookupByName",
151 sig => "pool, string : vol from pool" },
152 { name => "virStorageVolLookupByKey",
153 sig => "conn, string : vol" },
154 { name => "virStorageVolLookupByPath",
155 sig => "conn, string : vol" },
156 { name => "virStorageVolCreateXML",
157 sig => "pool, string, 0U : vol from pool" },
158 { name => "virStorageVolGetXMLDesc",
159 sig => "vol, 0U : string" },
160 { name => "virStorageVolGetPath",
161 sig => "vol : string" },
162 { name => "virStorageVolGetKey",
163 sig => "vol : static string" },
164 { name => "virStorageVolGetName",
165 sig => "vol : static string" },
166 { name => "virStoragePoolLookupByVolume",
167 sig => "vol : pool from vol" },
171 # Functions we haven't implemented anywhere yet but which are mentioned
174 # We create stubs for these, but eventually they need to either be
175 # moved ^^^ so they are auto-generated, or implementations of them
176 # written in 'libvirt_c_oneoffs.c'.
178 my @unimplemented = (
181 #----------------------------------------------------------------------
183 # Open the output file.
185 my $filename = "libvirt_c.c";
186 open F, ">$filename" or die "$filename: $!";
188 # Write the prologue.
191 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
193 * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
195 * Any changes you make to this file may be overwritten.
198 /* OCaml bindings for libvirt.
199 * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
200 * http://libvirt.org/
202 * This library is free software; you can redistribute it and/or
203 * modify it under the terms of the GNU Lesser General Public
204 * License as published by the Free Software Foundation; either
205 * version 2 of the License, or (at your option) any later version,
206 * with the OCaml linking exception described in ../COPYING.LIB.
208 * This library is distributed in the hope that it will be useful,
209 * but WITHOUT ANY WARRANTY; without even the implied warranty of
210 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
211 * Lesser General Public License for more details.
213 * You should have received a copy of the GNU Lesser General Public
214 * License along with this library; if not, write to the Free Software
215 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
224 #include <libvirt/libvirt.h>
225 #include <libvirt/virterror.h>
227 #include <caml/config.h>
228 #include <caml/alloc.h>
229 #include <caml/callback.h>
230 #include <caml/custom.h>
231 #include <caml/fail.h>
232 #include <caml/memory.h>
233 #include <caml/misc.h>
234 #include <caml/mlvalues.h>
235 #include <caml/signals.h>
237 #include "libvirt_c_prologue.c"
239 #include "libvirt_c_oneoffs.c"
243 #----------------------------------------------------------------------
245 sub camel_case_to_underscores
249 $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
250 my @subs = split (/,/, $name);
251 @subs = map { lc($_) } @subs;
255 # Helper functions dealing with signatures.
257 sub short_name_to_c_type
261 if ($_ eq "conn") { "virConnectPtr" }
262 elsif ($_ eq "dom") { "virDomainPtr" }
263 elsif ($_ eq "net") { "virNetworkPtr" }
264 elsif ($_ eq "pool") { "virStoragePoolPtr" }
265 elsif ($_ eq "vol") { "virStorageVolPtr" }
267 die "unknown short name $_"
271 # OCaml argument names.
277 if ($sig =~ /^(\w+) : string$/) {
279 } elsif ($sig =~ /^(\w+) : static string$/) {
281 } elsif ($sig =~ /^(\w+) : int$/) {
283 } elsif ($sig =~ /^(\w+) : uuid$/) {
285 } elsif ($sig =~ /^(\w+) : uuid string$/) {
287 } elsif ($sig =~ /^(\w+) : bool$/) {
289 } elsif ($sig =~ /^(\w+), bool : unit$/) {
291 } elsif ($sig eq "conn, int : int array") {
293 } elsif ($sig =~ /^(\w+), int : string array$/) {
295 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
297 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
299 } elsif ($sig =~ /^(\w+) : unit$/) {
301 } elsif ($sig =~ /^(\w+) : free$/) {
303 } elsif ($sig =~ /^(\w+), string : unit$/) {
305 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
307 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
309 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
311 } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) {
313 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
315 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
317 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
319 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
321 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) {
323 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) {
325 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
328 die "unknown signature $sig"
332 # Unpack the first (object) argument.
339 "virConnectPtr conn = Connect_val (connv);"
340 } elsif ($_ eq "dom") {
341 "virDomainPtr dom = Domain_val (domv);\n".
342 " virConnectPtr conn = Connect_domv (domv);"
343 } elsif ($_ eq "net") {
344 "virNetworkPtr net = Network_val (netv);\n".
345 " virConnectPtr conn = Connect_netv (netv);"
346 } elsif ($_ eq "pool") {
347 "virStoragePoolPtr pool = Pool_val (poolv);\n".
348 " virConnectPtr conn = Connect_polv (poolv);"
349 } elsif ($_ eq "vol") {
350 "virStorageVolPtr vol = Volume_val (volv);\n".
351 " virConnectPtr conn = Connect_volv (volv);"
353 die "unknown short name $_"
357 # Pack the result if it's an object.
363 if ($_ eq "dom") { "rv = Val_domain (r, connv);" }
364 elsif ($_ eq "net") { "rv = Val_network (r, connv);" }
365 elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
366 elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" }
368 die "unknown short name $_"
376 if ($_ eq "conn") { "Connect_val (connv) = NULL;" }
377 elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" }
378 elsif ($_ eq "net") { "Network_val (netv) = NULL;" }
379 elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" }
380 elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" }
382 die "unknown short name $_"
386 # Generate the C body for each signature (class of function).
393 if ($sig =~ /^(\w+) : string$/) {
396 " . gen_unpack_args ($1) . "
399 NONBLOCKING (r = $c_name ($1));
400 CHECK_ERROR (!r, conn, \"$c_name\");
402 rv = caml_copy_string (r);
406 } elsif ($sig =~ /^(\w+) : static string$/) {
409 " . gen_unpack_args ($1) . "
412 NONBLOCKING (r = $c_name ($1));
413 CHECK_ERROR (!r, conn, \"$c_name\");
415 rv = caml_copy_string (r);
418 } elsif ($sig =~ /^(\w+) : int$/) {
420 " . gen_unpack_args ($1) . "
423 NONBLOCKING (r = $c_name ($1));
424 CHECK_ERROR (r == -1, conn, \"$c_name\");
426 CAMLreturn (Val_int (r));
428 } elsif ($sig =~ /^(\w+) : uuid$/) {
431 " . gen_unpack_args ($1) . "
432 unsigned char uuid[VIR_UUID_BUFLEN];
435 NONBLOCKING (r = $c_name ($1, uuid));
436 CHECK_ERROR (r == -1, conn, \"$c_name\");
438 /* UUIDs are byte arrays with a fixed length. */
439 rv = caml_alloc_string (VIR_UUID_BUFLEN);
440 memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN);
443 } elsif ($sig =~ /^(\w+) : uuid string$/) {
446 " . gen_unpack_args ($1) . "
447 char uuid[VIR_UUID_STRING_BUFLEN];
450 NONBLOCKING (r = $c_name ($1, uuid));
451 CHECK_ERROR (r == -1, conn, \"$c_name\");
453 rv = caml_copy_string (uuid);
456 } elsif ($sig =~ /^(\w+) : bool$/) {
458 " . gen_unpack_args ($1) . "
461 NONBLOCKING (r = $c_name ($1, &b));
462 CHECK_ERROR (r == -1, conn, \"$c_name\");
464 CAMLreturn (b ? Val_true : Val_false);
466 } elsif ($sig =~ /^(\w+), bool : unit$/) {
468 " . gen_unpack_args ($1) . "
471 b = bv == Val_true ? 1 : 0;
473 NONBLOCKING (r = $c_name ($1, b));
474 CHECK_ERROR (r == -1, conn, \"$c_name\");
476 CAMLreturn (Val_unit);
478 } elsif ($sig eq "conn, int : int array") {
481 virConnectPtr conn = Connect_val (connv);
482 int i = Int_val (iv);
485 /* Some libvirt List* functions still throw exceptions if i == 0,
486 * so catch that and return an empty array directly. This changes
487 * the semantics slightly (masking other failures) but it's
488 * unlikely anyone will care. RWMJ 2008/06/10
491 rv = caml_alloc (0, 0);
495 NONBLOCKING (r = $c_name (conn, ids, i));
496 CHECK_ERROR (r == -1, conn, \"$c_name\");
498 rv = caml_alloc (r, 0);
499 for (i = 0; i < r; ++i)
500 Store_field (rv, i, Val_int (ids[i]));
504 } elsif ($sig =~ /^(\w+), int : string array$/) {
506 CAMLlocal2 (rv, strv);
507 " . gen_unpack_args ($1) . "
508 int i = Int_val (iv);
512 /* Some libvirt List* functions still throw exceptions if i == 0,
513 * so catch that and return an empty array directly. This changes
514 * the semantics slightly (masking other failures) but it's
515 * unlikely anyone will care. RWMJ 2008/06/10
518 rv = caml_alloc (0, 0);
522 NONBLOCKING (r = $c_name ($1, names, i));
523 CHECK_ERROR (r == -1, conn, \"$c_name\");
525 rv = caml_alloc (r, 0);
526 for (i = 0; i < r; ++i) {
527 strv = caml_copy_string (names[i]);
528 Store_field (rv, i, strv);
534 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
537 " . gen_unpack_args ($1) . "
540 NONBLOCKING (r = $c_name ($1, 0));
541 CHECK_ERROR (!r, conn, \"$c_name\");
543 rv = caml_copy_string (r);
547 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
549 " . gen_unpack_args ($1) . "
552 NONBLOCKING (r = $c_name ($1, 0));
553 CHECK_ERROR (r == -1, conn, \"$c_name\");
555 CAMLreturn (Val_unit);
557 } elsif ($sig =~ /^(\w+) : unit$/) {
559 " . gen_unpack_args ($1) . "
562 NONBLOCKING (r = $c_name ($1));
563 CHECK_ERROR (r == -1, conn, \"$c_name\");
565 CAMLreturn (Val_unit);
567 } elsif ($sig =~ /^(\w+) : free$/) {
569 " . gen_unpack_args ($1) . "
572 NONBLOCKING (r = $c_name ($1));
573 CHECK_ERROR (r == -1, conn, \"$c_name\");
575 /* So that we don't double-free in the finalizer: */
576 " . gen_free_arg ($1) . "
578 CAMLreturn (Val_unit);
580 } elsif ($sig =~ /^(\w+), string : unit$/) {
582 " . gen_unpack_args ($1) . "
583 char *str = String_val (strv);
586 NONBLOCKING (r = $c_name ($1, str));
587 CHECK_ERROR (r == -1, conn, \"$c_name\");
589 CAMLreturn (Val_unit);
591 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
594 " . gen_unpack_args ($1) . "
595 char *str = String_val (strv);
598 NONBLOCKING (r = $c_name ($1, str, 0));
599 CHECK_ERROR (!r, conn, \"$c_name\");
601 CAMLreturn (Val_unit);
603 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
604 my $c_ret_type = short_name_to_c_type ($2);
607 " . gen_unpack_args ($1) . "
608 char *str = String_val (strv);
611 NONBLOCKING (r = $c_name ($1, str));
612 CHECK_ERROR (!r, conn, \"$c_name\");
614 " . gen_pack_result ($2) . "
618 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
619 my $c_ret_type = short_name_to_c_type ($2);
622 " . gen_unpack_args ($1) . "
623 char *str = String_val (strv);
626 NONBLOCKING (r = $c_name ($1, str, 0));
627 CHECK_ERROR (!r, conn, \"$c_name\");
629 " . gen_pack_result ($2) . "
633 } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
634 my $unsigned = $2 eq "u" ? "unsigned " : "";
636 " . gen_unpack_args ($1) . "
637 ${unsigned}int i = Int_val (iv);
640 NONBLOCKING (r = $c_name ($1, i));
641 CHECK_ERROR (r == -1, conn, \"$c_name\");
643 CAMLreturn (Val_unit);
645 } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) {
646 my $c_ret_type = short_name_to_c_type ($3);
647 my $unsigned = $2 eq "u" ? "unsigned " : "";
650 " . gen_unpack_args ($1) . "
651 ${unsigned}int i = Int_val (iv);
654 NONBLOCKING (r = $c_name ($1, i));
655 CHECK_ERROR (!r, conn, \"$c_name\");
657 " . gen_pack_result ($3) . "
661 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
662 my $c_ret_type = short_name_to_c_type ($2);
665 " . gen_unpack_args ($1) . "
666 unsigned char *uuid = (unsigned char *) String_val (uuidv);
669 NONBLOCKING (r = $c_name ($1, uuid));
670 CHECK_ERROR (!r, conn, \"$c_name\");
672 " . gen_pack_result ($2) . "
676 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
677 my $c_ret_type = short_name_to_c_type ($2);
680 " . gen_unpack_args ($1) . "
683 NONBLOCKING (r = $c_name ($1, 0));
684 CHECK_ERROR (!r, conn, \"$c_name\");
686 " . gen_pack_result ($2) . "
690 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
691 my $c_ret_type = short_name_to_c_type ($2);
694 " . gen_unpack_args ($1) . "
697 NONBLOCKING (r = $c_name ($1));
698 CHECK_ERROR (!r, conn, \"$c_name\");
700 " . gen_pack_result ($2) . "
704 } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) {
705 my $c_ret_type = short_name_to_c_type ($2);
707 CAMLlocal2 (rv, connv);
708 " . gen_unpack_args ($1) . "
709 char *str = String_val (strv);
712 NONBLOCKING (r = $c_name ($1, str));
713 CHECK_ERROR (!r, conn, \"$c_name\");
715 connv = Field ($3v, 1);
716 " . gen_pack_result ($2) . "
720 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) {
721 my $c_ret_type = short_name_to_c_type ($2);
723 CAMLlocal2 (rv, connv);
724 " . gen_unpack_args ($1) . "
725 char *str = String_val (strv);
728 NONBLOCKING (r = $c_name ($1, str, 0));
729 CHECK_ERROR (!r, conn, \"$c_name\");
731 connv = Field ($3v, 1);
732 " . gen_pack_result ($2) . "
736 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) {
737 my $c_ret_type = short_name_to_c_type ($2);
739 CAMLlocal2 (rv, connv);
740 " . gen_unpack_args ($1) . "
743 NONBLOCKING (r = $c_name ($1, 0));
744 CHECK_ERROR (!r, conn, \"$c_name\");
746 connv = Field ($3v, 1);
747 " . gen_pack_result ($2) . "
751 } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) {
752 my $c_ret_type = short_name_to_c_type ($2);
754 CAMLlocal2 (rv, connv);
755 " . gen_unpack_args ($1) . "
758 NONBLOCKING (r = $c_name ($1));
759 CHECK_ERROR (!r, conn, \"$c_name\");
761 connv = Field ($3v, 1);
762 " . gen_pack_result ($2) . "
767 die "unknown signature $sig"
771 # Generate each function.
773 foreach my $function (@functions) {
774 my $c_name = $function->{name};
775 my $sig = $function->{sig};
777 #print "generating $c_name with sig \"$sig\" ...\n";
779 #my $is_pool_func = $c_name =~ /^virStoragePool/;
780 #my $is_vol_func = $c_name =~ /^virStorageVol/;
782 # Generate an equivalent C-external name for the function, unless
783 # one is defined already.
785 if (exists ($function->{c_external_name})) {
786 $c_external_name = $function->{c_external_name};
787 } elsif ($c_name =~ /^vir/) {
788 $c_external_name = substr $c_name, 3;
789 $c_external_name = camel_case_to_underscores ($c_external_name);
790 $c_external_name = "ocaml_libvirt_" . $c_external_name;
792 die "cannot convert c_name $c_name to c_external_name"
796 /* Automatically generated binding for $c_name.
797 * In generator.pl this function has signature "$sig".
802 my @arg_names = gen_arg_names ($sig);
803 my $nr_arg_names = scalar @arg_names;
804 my $arg_names = join ", ", @arg_names;
805 my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
807 # Generate the start of the function, arguments.
810 $c_external_name ($arg_names_as_values)
812 CAMLparam$nr_arg_names ($arg_names);
815 # Generate the internals of the function.
816 print F (gen_c_code ($sig, $c_name));
818 # Finish off the function.
825 #----------------------------------------------------------------------
827 # Unimplemented functions.
829 if (@unimplemented) {
830 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
833 /* The following functions are unimplemented and always fail.
834 * See generator.pl '@unimplemented'
839 foreach my $c_external_name (@unimplemented) {
844 failwith ("$c_external_name is unimplemented");
849 } # end if @unimplemented
851 #----------------------------------------------------------------------
853 # Write the epilogue.
856 #include "libvirt_c_epilogue.c"
862 print "$0: written $filename\n"