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.
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.
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
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).
25 # Please read libvirt/README.
29 #----------------------------------------------------------------------
31 # The functions in the libvirt API that we can generate.
33 # The 'sig' (signature) doesn't have a meaning or any internal structure.
34 # It is interpreted by the generation functions below to indicate what
35 # "class" the function falls into, and to generate the right class of
38 # Any function added since libvirt 0.2.1 must be marked weak.
41 { name => "virConnectClose", sig => "conn : free" },
42 { name => "virConnectGetHostname", sig => "conn : string", weak => 1 },
43 { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
44 { name => "virConnectGetType", sig => "conn : static string" },
45 { name => "virConnectNumOfDomains", sig => "conn : int" },
46 { name => "virConnectListDomains", sig => "conn, int : int array" },
47 { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
48 { name => "virConnectListDefinedDomains",
49 sig => "conn, int : string array" },
50 { name => "virConnectNumOfNetworks", sig => "conn : int" },
51 { name => "virConnectListNetworks", sig => "conn, int : string array" },
52 { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
53 { name => "virConnectListDefinedNetworks",
54 sig => "conn, int : string array" },
55 { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 },
56 { name => "virConnectListStoragePools",
57 sig => "conn, int : string array", weak => 1 },
58 { name => "virConnectNumOfDefinedStoragePools",
59 sig => "conn : int", weak => 1 },
60 { name => "virConnectListDefinedStoragePools",
61 sig => "conn, int : string array", weak => 1 },
62 { name => "virConnectGetCapabilities", sig => "conn : string" },
64 { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
65 { name => "virDomainCreateLinuxJob",
66 sig => "conn, string, 0U : job", weak => 1 },
67 { name => "virDomainFree", sig => "dom : free" },
68 { name => "virDomainDestroy", sig => "dom : free" },
69 { name => "virDomainLookupByName", sig => "conn, string : dom" },
70 { name => "virDomainLookupByID", sig => "conn, int : dom" },
71 { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" },
72 { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
73 { name => "virDomainGetName", sig => "dom : static string" },
74 { name => "virDomainGetOSType", sig => "dom : string" },
75 { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
76 { name => "virDomainGetUUID", sig => "dom : uuid" },
77 { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
78 { name => "virDomainGetMaxVcpus", sig => "dom : int" },
79 { name => "virDomainSave", sig => "dom, string : unit" },
80 { name => "virDomainSaveJob",
81 sig => "dom, string : job from dom", weak => 1 },
82 { name => "virDomainRestore", sig => "conn, string : unit" },
83 { name => "virDomainRestoreJob",
84 sig => "conn, string : job", weak => 1 },
85 { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" },
86 { name => "virDomainCoreDumpJob",
87 sig => "dom, string, 0 : job from dom", weak => 1 },
88 { name => "virDomainSuspend", sig => "dom : unit" },
89 { name => "virDomainResume", sig => "dom : unit" },
90 { name => "virDomainShutdown", sig => "dom : unit" },
91 { name => "virDomainReboot", sig => "dom, 0 : unit" },
92 { name => "virDomainDefineXML", sig => "conn, string : dom" },
93 { name => "virDomainUndefine", sig => "dom : unit" },
94 { name => "virDomainCreate", sig => "dom : unit" },
95 { name => "virDomainCreateJob",
96 sig => "dom, 0U : job from dom", weak => 1 },
97 { name => "virDomainAttachDevice", sig => "dom, string : unit" },
98 { name => "virDomainDetachDevice", sig => "dom, string : unit" },
99 { name => "virDomainGetAutostart", sig => "dom : bool" },
100 { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
102 { name => "virNetworkFree", sig => "net : free" },
103 { name => "virNetworkDestroy", sig => "net : free" },
104 { name => "virNetworkLookupByName", sig => "conn, string : net" },
105 { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" },
106 { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
107 { name => "virNetworkGetName", sig => "net : static string" },
108 { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
109 { name => "virNetworkGetBridgeName", sig => "net : string" },
110 { name => "virNetworkGetUUID", sig => "net : uuid" },
111 { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
112 { name => "virNetworkUndefine", sig => "net : unit" },
113 { name => "virNetworkCreateXML", sig => "conn, string : net" },
114 { name => "virNetworkCreateXMLJob",
115 sig => "conn, string : job", weak => 1 },
116 { name => "virNetworkDefineXML", sig => "conn, string : net" },
117 { name => "virNetworkCreate", sig => "net : unit" },
118 { name => "virNetworkCreateJob",
119 sig => "net : job from net", weak => 1 },
120 { name => "virNetworkGetAutostart", sig => "net : bool" },
121 { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
123 { name => "virStoragePoolFree", sig => "pool : free", weak => 1 },
124 { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 },
125 { name => "virStoragePoolLookupByName",
126 sig => "conn, string : pool", weak => 1 },
127 { name => "virStoragePoolLookupByUUID",
128 sig => "conn, uuid : pool", weak => 1 },
129 { name => "virStoragePoolLookupByUUIDString",
130 sig => "conn, string : pool", weak => 1 },
131 { name => "virStoragePoolGetName",
132 sig => "pool : static string", weak => 1 },
133 { name => "virStoragePoolGetXMLDesc",
134 sig => "pool, 0 : string", weak => 1 },
135 { name => "virStoragePoolGetUUID",
136 sig => "pool : uuid", weak => 1 },
137 { name => "virStoragePoolGetUUIDString",
138 sig => "pool : uuid string", weak => 1 },
139 { name => "virStoragePoolCreateXML",
140 sig => "conn, string : pool", weak => 1 },
141 { name => "virStoragePoolDefineXML",
142 sig => "conn, string : pool", weak => 1 },
143 { name => "virStoragePoolUndefine",
144 sig => "pool : unit", weak => 1 },
145 { name => "virStoragePoolCreate",
146 sig => "pool : unit", weak => 1 },
147 { name => "virStoragePoolShutdown",
148 sig => "pool : unit", weak => 1 },
149 { name => "virStoragePoolRefresh",
150 sig => "pool, 0U : unit", weak => 1 },
151 { name => "virStoragePoolGetAutostart",
152 sig => "pool : bool", weak => 1 },
153 { name => "virStoragePoolSetAutostart",
154 sig => "pool, bool : unit", weak => 1 },
156 { name => "virStorageVolFree", sig => "vol : free", weak => 1 },
157 { name => "virStorageVolDestroy", sig => "vol : free", weak => 1 },
158 # { name => "virStorageVolLookupByName", XXX see libvir-list posting
159 # sig => "pool, string : vol", weak => 1 },
160 { name => "virStorageVolLookupByKey",
161 sig => "conn, string : vol", weak => 1 },
162 { name => "virStorageVolLookupByPath",
163 sig => "conn, string : vol", weak => 1 },
164 # { name => "virStorageVolCreateXML",
165 # sig => "pool, string : vol", weak => 1 }, XXX
166 { name => "virStorageVolGetXMLDesc",
167 sig => "vol, 0 : string", weak => 1 },
168 { name => "virStorageVolGetPath",
169 sig => "vol : string", weak => 1 },
170 { name => "virStorageVolGetKey",
171 sig => "vol : static string", weak => 1 },
172 { name => "virStorageVolGetName",
173 sig => "vol : static string", weak => 1 },
174 { name => "virStoragePoolLookupByVolume",
175 sig => "vol : pool from vol", weak => 1 },
177 { name => "virJobFree",
178 sig => "job : free", weak => 1 },
179 { name => "virJobCancel",
180 sig => "job : unit", weak => 1 },
181 { name => "virJobGetNetwork",
182 sig => "job : net from job", weak => 1 },
183 { name => "virJobGetDomain",
184 sig => "job : dom from job", weak => 1 },
188 # Functions we haven't implemented anywhere yet but which are mentioned
191 # We create stubs for these, but eventually they need to either be
192 # moved ^^^ so they are auto-generated, or implementations of them
193 # written in 'libvirt_c_oneoffs.c'.
195 my @unimplemented = (
196 "ocaml_libvirt_storage_pool_get_info",
197 "ocaml_libvirt_storage_vol_lookup_by_name", # XXX see above
198 "ocaml_libvirt_storage_vol_create_xml", # XXX see above
199 "ocaml_libvirt_storage_vol_get_info",
200 "ocaml_libvirt_job_get_info",
203 #----------------------------------------------------------------------
205 # Open the output file.
207 my $filename = "libvirt_c.c";
208 open F, ">$filename" or die "$filename: $!";
210 # Write the prologue.
213 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
215 * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
217 * Any changes you make to this file may be overwritten.
220 /* OCaml bindings for libvirt.
221 * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
222 * http://libvirt.org/
224 * This library is free software; you can redistribute it and/or
225 * modify it under the terms of the GNU Lesser General Public
226 * License as published by the Free Software Foundation; either
227 * version 2 of the License, or (at your option) any later version.
229 * This library is distributed in the hope that it will be useful,
230 * but WITHOUT ANY WARRANTY; without even the implied warranty of
231 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
232 * Lesser General Public License for more details.
234 * You should have received a copy of the GNU Lesser General Public
235 * License along with this library; if not, write to the Free Software
236 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
245 #include <libvirt/libvirt.h>
246 #include <libvirt/virterror.h>
248 #include <caml/config.h>
249 #include <caml/alloc.h>
250 #include <caml/callback.h>
251 #include <caml/custom.h>
252 #include <caml/fail.h>
253 #include <caml/memory.h>
254 #include <caml/misc.h>
255 #include <caml/mlvalues.h>
256 #include <caml/signals.h>
258 #include "libvirt_c_prologue.c"
260 #include "libvirt_c_oneoffs.c"
264 #----------------------------------------------------------------------
266 sub camel_case_to_underscores
270 $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
271 my @subs = split (/,/, $name);
272 @subs = map { lc($_) } @subs;
276 # Helper functions dealing with signatures.
278 sub short_name_to_c_type
282 if ($_ eq "conn") { "virConnectPtr" }
283 elsif ($_ eq "dom") { "virDomainPtr" }
284 elsif ($_ eq "net") { "virNetworkPtr" }
285 elsif ($_ eq "pool") { "virStoragePoolPtr" }
286 elsif ($_ eq "vol") { "virStorageVolPtr" }
287 elsif ($_ eq "job") { "virJobPtr" }
289 die "unknown short name $_"
293 # Generate a C signature for the original function. Used when building
301 if ($sig =~ /^(\w+) : string$/) {
302 my $c_type = short_name_to_c_type ($1);
303 "char *$c_name ($c_type $1)"
304 } elsif ($sig =~ /^(\w+) : static string$/) {
305 my $c_type = short_name_to_c_type ($1);
306 "const char *$c_name ($c_type $1)"
307 } elsif ($sig =~ /^(\w+) : int$/) {
308 my $c_type = short_name_to_c_type ($1);
309 "int $c_name ($c_type $1)"
310 } elsif ($sig =~ /^(\w+) : uuid$/) {
311 my $c_type = short_name_to_c_type ($1);
312 "int $c_name ($c_type $1, unsigned char *)"
313 } elsif ($sig =~ /^(\w+) : uuid string$/) {
314 my $c_type = short_name_to_c_type ($1);
315 "int $c_name ($c_type $1, char *)"
316 } elsif ($sig =~ /^(\w+) : bool$/) {
317 my $c_type = short_name_to_c_type ($1);
318 "int $c_name ($c_type $1, int *r)"
319 } elsif ($sig =~ /^(\w+), bool : unit$/) {
320 my $c_type = short_name_to_c_type ($1);
321 "int $c_name ($c_type $1, int b)"
322 } elsif ($sig eq "conn, int : int array") {
323 "int $c_name (virConnectPtr conn, int *ids, int maxids)"
324 } elsif ($sig eq "conn, int : string array") {
325 "int $c_name (virConnectPtr conn, char **const names, int maxnames)"
326 } elsif ($sig =~ /^(\w+), 0(U?) : string$/) {
327 my $c_type = short_name_to_c_type ($1);
328 my $unsigned = $2 eq "U" ? "unsigned " : "";
329 "char *$c_name ($c_type $1, $unsigned int flags)"
330 } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) {
331 my $c_type = short_name_to_c_type ($1);
332 my $unsigned = $2 eq "U" ? "unsigned " : "";
333 "int $c_name ($c_type $1, $unsigned int flags)"
334 } elsif ($sig =~ /^(\w+) : unit$/) {
335 my $c_type = short_name_to_c_type ($1);
336 "int $c_name ($c_type $1)"
337 } elsif ($sig =~ /^(\w+) : free$/) {
338 my $c_type = short_name_to_c_type ($1);
339 "int $c_name ($c_type $1)"
340 } elsif ($sig =~ /^(\w+), string : unit$/) {
341 my $c_type = short_name_to_c_type ($1);
342 "int $c_name ($c_type $1, const char *str)"
343 } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) {
344 my $c_type = short_name_to_c_type ($1);
345 my $unsigned = $2 eq "U" ? "unsigned " : "";
346 "int $c_name ($c_type $1, const char *str, $unsigned int flags)"
347 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
348 my $c_type = short_name_to_c_type ($1);
349 my $c_ret_type = short_name_to_c_type ($2);
350 "$c_ret_type $c_name ($c_type $1, const char *str)"
351 } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) {
352 my $c_type = short_name_to_c_type ($1);
353 my $unsigned = $2 eq "U" ? "unsigned " : "";
354 my $c_ret_type = short_name_to_c_type ($3);
355 "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)"
356 } elsif ($sig =~ /^(\w+), int : (\w+)$/) {
357 my $c_type = short_name_to_c_type ($1);
358 my $c_ret_type = short_name_to_c_type ($2);
359 "$c_ret_type $c_name ($c_type $1, int i)"
360 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
361 my $c_type = short_name_to_c_type ($1);
362 my $c_ret_type = short_name_to_c_type ($2);
363 "$c_ret_type $c_name ($c_type $1, const unsigned char *str)"
364 } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) {
365 my $c_type = short_name_to_c_type ($1);
366 my $unsigned = $2 eq "U" ? "unsigned " : "";
367 my $c_ret_type = short_name_to_c_type ($3);
368 "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
369 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
370 my $c_type = short_name_to_c_type ($1);
371 my $c_ret_type = short_name_to_c_type ($2);
372 "$c_ret_type $c_name ($c_type $1)"
373 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
374 my $c_type = short_name_to_c_type ($1);
375 my $c_ret_type = short_name_to_c_type ($2);
376 "$c_ret_type $c_name ($c_type $1, const char *str)"
377 } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) {
378 my $c_type = short_name_to_c_type ($1);
379 my $unsigned = $2 eq "U" ? "unsigned " : "";
380 my $c_ret_type = short_name_to_c_type ($3);
381 "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)"
382 } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) {
383 my $c_type = short_name_to_c_type ($1);
384 my $unsigned = $2 eq "U" ? "unsigned " : "";
385 my $c_ret_type = short_name_to_c_type ($3);
386 "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
387 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
388 my $c_type = short_name_to_c_type ($1);
389 my $c_ret_type = short_name_to_c_type ($2);
390 "$c_ret_type $c_name ($c_type $1)"
392 die "unknown signature $sig"
396 # OCaml argument names.
402 if ($sig =~ /^(\w+) : string$/) {
404 } elsif ($sig =~ /^(\w+) : static string$/) {
406 } elsif ($sig =~ /^(\w+) : int$/) {
408 } elsif ($sig =~ /^(\w+) : uuid$/) {
410 } elsif ($sig =~ /^(\w+) : uuid string$/) {
412 } elsif ($sig =~ /^(\w+) : bool$/) {
414 } elsif ($sig =~ /^(\w+), bool : unit$/) {
416 } elsif ($sig eq "conn, int : int array") {
418 } elsif ($sig eq "conn, int : string array") {
420 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
422 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
424 } elsif ($sig =~ /^(\w+) : unit$/) {
426 } elsif ($sig =~ /^(\w+) : free$/) {
428 } elsif ($sig =~ /^(\w+), string : unit$/) {
430 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
432 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
434 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
436 } elsif ($sig =~ /^(\w+), int : (\w+)$/) {
438 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
440 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
442 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
444 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
446 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) {
448 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) {
450 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
453 die "unknown signature $sig"
457 # Unpack the first (object) argument.
464 "virConnectPtr conn = Connect_val (connv);"
465 } elsif ($_ eq "dom") {
466 "virDomainPtr dom = Domain_val (domv);\n".
467 " virConnectPtr conn = Connect_domv (domv);"
468 } elsif ($_ eq "net") {
469 "virNetworkPtr net = Network_val (netv);\n".
470 " virConnectPtr conn = Connect_netv (netv);"
471 } elsif ($_ eq "pool") {
472 "virStoragePoolPtr pool = Pool_val (poolv);\n".
473 " virConnectPtr conn = Connect_polv (poolv);"
474 } elsif ($_ eq "vol") {
475 "virStorageVolPtr vol = Volume_val (volv);\n".
476 " virConnectPtr conn = Connect_volv (volv);"
477 } elsif ($_ eq "job") {
478 "virJobPtr job = Job_val (jobv);\n".
479 " virConnectPtr conn = Connect_jobv (jobv);"
481 die "unknown short name $_"
485 # Pack the result if it's an object.
491 if ($_ eq "dom") { "rv = Val_domain (r, connv);" }
492 elsif ($_ eq "net") { "rv = Val_network (r, connv);" }
493 elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
494 elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" }
495 elsif ($_ eq "job") { "rv = Val_job (r, connv);" }
497 die "unknown short name $_"
505 if ($_ eq "conn") { "Connect_val (connv) = NULL;" }
506 elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" }
507 elsif ($_ eq "net") { "Network_val (netv) = NULL;" }
508 elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" }
509 elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" }
510 elsif ($_ eq "job") { "Job_val (jobv) = NULL;" }
512 die "unknown short name $_"
516 # Generate the C body for each signature (class of function).
523 if ($sig =~ /^(\w+) : string$/) {
526 " . gen_unpack_args ($1) . "
529 NONBLOCKING (r = $c_name ($1));
530 CHECK_ERROR (!r, conn, \"$c_name\");
532 rv = caml_copy_string (r);
536 } elsif ($sig =~ /^(\w+) : static string$/) {
539 " . gen_unpack_args ($1) . "
542 NONBLOCKING (r = $c_name ($1));
543 CHECK_ERROR (!r, conn, \"$c_name\");
545 rv = caml_copy_string (r);
548 } elsif ($sig =~ /^(\w+) : int$/) {
550 " . gen_unpack_args ($1) . "
553 NONBLOCKING (r = $c_name ($1));
554 CHECK_ERROR (r == -1, conn, \"$c_name\");
556 CAMLreturn (Val_int (r));
558 } elsif ($sig =~ /^(\w+) : uuid$/) {
561 " . gen_unpack_args ($1) . "
562 unsigned char uuid[VIR_UUID_BUFLEN];
565 NONBLOCKING (r = $c_name ($1, uuid));
566 CHECK_ERROR (r == -1, conn, \"$c_name\");
568 rv = caml_copy_string ((char *) uuid);
571 } elsif ($sig =~ /^(\w+) : uuid string$/) {
574 " . gen_unpack_args ($1) . "
575 char uuid[VIR_UUID_STRING_BUFLEN];
578 NONBLOCKING (r = $c_name ($1, uuid));
579 CHECK_ERROR (r == -1, conn, \"$c_name\");
581 rv = caml_copy_string (uuid);
584 } elsif ($sig =~ /^(\w+) : bool$/) {
586 " . gen_unpack_args ($1) . "
589 NONBLOCKING (r = $c_name ($1, &b));
590 CHECK_ERROR (r == -1, conn, \"$c_name\");
592 CAMLreturn (b ? Val_true : Val_false);
594 } elsif ($sig =~ /^(\w+), bool : unit$/) {
596 " . gen_unpack_args ($1) . "
599 b = bv == Val_true ? 1 : 0;
601 NONBLOCKING (r = $c_name ($1, b));
602 CHECK_ERROR (r == -1, conn, \"$c_name\");
604 CAMLreturn (Val_unit);
606 } elsif ($sig eq "conn, int : int array") {
609 virConnectPtr conn = Connect_val (connv);
610 int i = Int_val (iv);
613 NONBLOCKING (r = $c_name (conn, ids, i));
614 CHECK_ERROR (r == -1, conn, \"$c_name\");
616 rv = caml_alloc (r, 0);
617 for (i = 0; i < r; ++i)
618 Store_field (rv, i, Val_int (ids[i]));
622 } elsif ($sig eq "conn, int : string array") {
624 CAMLlocal2 (rv, strv);
625 virConnectPtr conn = Connect_val (connv);
626 int i = Int_val (iv);
630 NONBLOCKING (r = $c_name (conn, names, i));
631 CHECK_ERROR (r == -1, conn, \"$c_name\");
633 rv = caml_alloc (r, 0);
634 for (i = 0; i < r; ++i) {
635 strv = caml_copy_string (names[i]);
636 Store_field (rv, i, strv);
642 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
645 " . gen_unpack_args ($1) . "
648 NONBLOCKING (r = $c_name ($1, 0));
649 CHECK_ERROR (!r, conn, \"$c_name\");
651 rv = caml_copy_string (r);
655 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
657 " . gen_unpack_args ($1) . "
660 NONBLOCKING (r = $c_name ($1, 0));
661 CHECK_ERROR (r == -1, conn, \"$c_name\");
663 CAMLreturn (Val_unit);
665 } elsif ($sig =~ /^(\w+) : unit$/) {
667 " . gen_unpack_args ($1) . "
670 NONBLOCKING (r = $c_name ($1));
671 CHECK_ERROR (r == -1, conn, \"$c_name\");
673 CAMLreturn (Val_unit);
675 } elsif ($sig =~ /^(\w+) : free$/) {
677 " . gen_unpack_args ($1) . "
680 NONBLOCKING (r = $c_name ($1));
681 CHECK_ERROR (r == -1, conn, \"$c_name\");
683 /* So that we don't double-free in the finalizer: */
684 " . gen_free_arg ($1) . "
686 CAMLreturn (Val_unit);
688 } elsif ($sig =~ /^(\w+), string : unit$/) {
691 " . gen_unpack_args ($1) . "
692 char *str = String_val (strv);
695 NONBLOCKING (r = $c_name ($1, str));
696 CHECK_ERROR (r == -1, conn, \"$c_name\");
698 CAMLreturn (Val_unit);
700 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
703 " . gen_unpack_args ($1) . "
704 char *str = String_val (strv);
707 NONBLOCKING (r = $c_name ($1, str, 0));
708 CHECK_ERROR (!r, conn, \"$c_name\");
710 CAMLreturn (Val_unit);
712 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
713 my $c_ret_type = short_name_to_c_type ($2);
716 " . gen_unpack_args ($1) . "
717 char *str = String_val (strv);
720 NONBLOCKING (r = $c_name ($1, str));
721 CHECK_ERROR (!r, conn, \"$c_name\");
723 " . gen_pack_result ($2) . "
727 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
728 my $c_ret_type = short_name_to_c_type ($2);
731 " . gen_unpack_args ($1) . "
732 char *str = String_val (strv);
735 NONBLOCKING (r = $c_name ($1, str, 0));
736 CHECK_ERROR (!r, conn, \"$c_name\");
738 " . gen_pack_result ($2) . "
742 } elsif ($sig =~ /^(\w+), int : (\w+)$/) {
743 my $c_ret_type = short_name_to_c_type ($2);
746 " . gen_unpack_args ($1) . "
747 int i = Int_val (iv);
750 NONBLOCKING (r = $c_name ($1, i));
751 CHECK_ERROR (!r, conn, \"$c_name\");
753 " . gen_pack_result ($2) . "
757 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
758 my $c_ret_type = short_name_to_c_type ($2);
761 " . gen_unpack_args ($1) . "
762 unsigned char *uuid = (unsigned char *) String_val (uuidv);
765 NONBLOCKING (r = $c_name ($1, uuid));
766 CHECK_ERROR (!r, conn, \"$c_name\");
768 " . gen_pack_result ($2) . "
772 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
773 my $c_ret_type = short_name_to_c_type ($2);
776 " . gen_unpack_args ($1) . "
779 NONBLOCKING (r = $c_name ($1, 0));
780 CHECK_ERROR (!r, conn, \"$c_name\");
782 " . gen_pack_result ($2) . "
786 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
787 my $c_ret_type = short_name_to_c_type ($2);
790 " . gen_unpack_args ($1) . "
793 NONBLOCKING (r = $c_name ($1));
794 CHECK_ERROR (!r, conn, \"$c_name\");
796 " . gen_pack_result ($2) . "
800 } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) {
801 my $c_ret_type = short_name_to_c_type ($2);
803 CAMLlocal2 (rv, connv);
804 " . gen_unpack_args ($1) . "
805 char *str = String_val (strv);
808 NONBLOCKING (r = $c_name ($1, str));
809 CHECK_ERROR (!r, conn, \"$c_name\");
811 connv = Field ($3v, 1);
812 " . gen_pack_result ($2) . "
816 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) {
817 my $c_ret_type = short_name_to_c_type ($2);
819 CAMLlocal2 (rv, connv);
820 " . gen_unpack_args ($1) . "
821 char *str = String_val (strv);
824 NONBLOCKING (r = $c_name ($1, str, 0));
825 CHECK_ERROR (!r, conn, \"$c_name\");
827 connv = Field ($3v, 1);
828 " . gen_pack_result ($2) . "
832 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) {
833 my $c_ret_type = short_name_to_c_type ($2);
835 CAMLlocal2 (rv, connv);
836 " . gen_unpack_args ($1) . "
839 NONBLOCKING (r = $c_name ($1, 0));
840 CHECK_ERROR (!r, conn, \"$c_name\");
842 connv = Field ($3v, 1);
843 " . gen_pack_result ($2) . "
847 } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) {
848 my $c_ret_type = short_name_to_c_type ($2);
850 CAMLlocal2 (rv, connv);
851 " . gen_unpack_args ($1) . "
854 NONBLOCKING (r = $c_name ($1));
855 CHECK_ERROR (!r, conn, \"$c_name\");
857 connv = Field ($3v, 1);
858 " . gen_pack_result ($2) . "
863 die "unknown signature $sig"
867 # Generate each function.
869 foreach my $function (@functions) {
870 my $c_name = $function->{name};
871 my $is_weak = $function->{weak};
872 my $sig = $function->{sig};
874 my $is_pool_func = $c_name =~ /^virStoragePool/;
875 my $is_vol_func = $c_name =~ /^virStorageVol/;
877 # Generate an equivalent C-external name for the function, unless
878 # one is defined already.
880 if (exists ($function->{c_external_name})) {
881 $c_external_name = $function->{c_external_name};
882 } elsif ($c_name =~ /^vir/) {
883 $c_external_name = substr $c_name, 3;
884 $c_external_name = camel_case_to_underscores ($c_external_name);
885 $c_external_name = "ocaml_libvirt_" . $c_external_name;
887 die "cannot convert c_name $c_name to c_external_name"
890 # Generate a full function prototype if the function is weak.
891 my $have_name = "HAVE_" . uc ($c_name);
893 my $c_sig = gen_c_signature ($sig, $c_name);
895 #ifdef HAVE_WEAK_SYMBOLS
897 extern $c_sig __attribute__((weak));
904 my @arg_names = gen_arg_names ($sig);
905 my $nr_arg_names = scalar @arg_names;
906 my $arg_names = join ", ", @arg_names;
907 my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
909 # Generate the start of the function, arguments.
912 $c_external_name ($arg_names_as_values)
914 CAMLparam$nr_arg_names ($arg_names);
917 # If weak, check the function exists at compile time or runtime.
921 /* Symbol $c_name not found at compile time. */
922 not_supported ("$c_name");
923 /* Suppresses a compiler warning. */
926 /* Check that the symbol $c_name
927 * is in runtime version of libvirt.
929 WEAK_SYMBOL_CHECK ($c_name);
933 # Generate the internals of the function.
934 print F (gen_c_code ($sig, $c_name));
936 # Finish off weak #ifdef.
943 # Finish off the function.
950 #----------------------------------------------------------------------
952 # Unimplemented functions.
954 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
956 if (@unimplemented) {
958 /* The following functions are unimplemented and always fail.
959 * See generator.pl '@unimplemented'
964 foreach my $c_external_name (@unimplemented) {
969 failwith ("$c_external_name is unimplemented");
974 } # end if @unimplemented
976 #----------------------------------------------------------------------
978 # Write the epilogue.
981 #include "libvirt_c_epilogue.c"
987 print "$0: written $filename\n"