";
List.iter (
- fun (name, style, _, _, _, _, _) ->
- (match fst style with
+ fun (name, (ret, args, optargs as style), _, _, _, _, _) ->
+ (match ret with
| RErr -> pr "void\n"
| RInt _ -> pr "SV *\n"
| RInt64 _ -> pr "SV *\n"
pr "%s (g" name;
List.iter (
fun arg -> pr ", %s" (name_of_argt arg)
- ) (snd style);
+ ) args;
+ if optargs <> [] then
+ pr ", ...";
pr ")\n";
pr " guestfs_h *g;\n";
iteri (
| Bool n -> pr " int %s;\n" n
| Int n -> pr " int %s;\n" n
| Int64 n -> pr " int64_t %s;\n" n
- ) (snd style);
+ ) args;
- let do_cleanups () =
- List.iter (
- function
- | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
- | Bool _ | Int _ | Int64 _
- | FileIn _ | FileOut _
- | BufferIn _ | Key _ -> ()
- | StringList n | DeviceList n -> pr " free (%s);\n" n
- ) (snd style)
- in
-
- (* Code. *)
- (match fst style with
+ (* PREINIT section (local variable declarations). *)
+ pr "PREINIT:\n";
+ (match ret with
| RErr ->
- pr "PREINIT:\n";
pr " int r;\n";
+ | RInt _
+ | RBool _ ->
+ pr " int r;\n";
+ | RInt64 _ ->
+ pr " int64_t r;\n";
+ | RConstString _ ->
+ pr " const char *r;\n";
+ | RConstOptString _ ->
+ pr " const char *r;\n";
+ | RString _ ->
+ pr " char *r;\n";
+ | RStringList _ | RHashtable _ ->
+ pr " char **r;\n";
+ pr " size_t i, n;\n";
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *r;\n" typ;
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ;
+ pr " size_t i;\n";
+ pr " HV *hv;\n";
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ );
+
+ if optargs <> [] then (
+ pr " struct guestfs_%s_argv optargs_s = { .bitmask = 0 };\n" name;
+ pr " struct guestfs_%s_argv *optargs = &optargs_s;\n" name;
+ pr " size_t items_i;\n";
+ );
+
+ (* CODE or PPCODE section. PPCODE is used where we are
+ * returning void, or where we push the return value on the stack
+ * ourselves. Using CODE means we will manipulate RETVAL.
+ *)
+ (match ret with
+ | RErr ->
pr " PPCODE:\n";
- pr " r = guestfs_%s " name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
+ | RInt n
+ | RBool n ->
+ pr " CODE:\n";
+ | RInt64 n ->
+ pr " CODE:\n";
+ | RConstString n ->
+ pr " CODE:\n";
+ | RConstOptString n ->
+ pr " CODE:\n";
+ | RString n ->
+ pr " CODE:\n";
+ | RStringList n | RHashtable n ->
+ pr " PPCODE:\n";
+ | RBufferOut n ->
+ pr " CODE:\n";
+ | RStruct _
+ | RStructList _ ->
+ pr " PPCODE:\n";
+ );
+
+ (* For optional arguments, convert these from the XSUB "items"
+ * variable by hand.
+ *)
+ if optargs <> [] then (
+ let uc_name = String.uppercase name in
+ let skip = List.length args + 1 in
+ pr " if (((items - %d) & 1) != 0)\n" skip;
+ pr " croak (\"expecting an even number of extra parameters\");\n";
+ pr " for (items_i = %d; items_i < items; items_i += 2) {\n" skip;
+ pr " uint64_t this_mask;\n";
+ pr " const char *this_arg;\n";
+ pr "\n";
+ pr " this_arg = SvPV_nolen (ST (items_i));\n";
+ pr " ";
+ List.iter (
+ fun argt ->
+ let n = name_of_argt argt in
+ let uc_n = String.uppercase n in
+ pr "if (strcmp (this_arg, \"%s\") == 0) {\n" n;
+ pr " optargs_s.%s = " n;
+ (match argt with
+ | Bool _
+ | Int _
+ | Int64 _ -> pr "SvIV (ST (items_i+1))"
+ | String _ -> pr "SvPV_nolen (ST (items_i+1))"
+ | _ -> assert false
+ );
+ pr ";\n";
+ pr " this_mask = GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
+ pr " }\n";
+ pr " else ";
+ ) optargs;
+ pr "croak (\"unknown optional argument '%%s'\", this_arg);\n";
+ pr " if (optargs_s.bitmask & this_mask)\n";
+ pr " croak (\"optional argument '%%s' given twice\",\n";
+ pr " this_arg);\n";
+ pr " optargs_s.bitmask |= this_mask;\n";
+ pr " }\n";
+ pr "\n";
+ );
+
+ (* The call to the C function. *)
+ if optargs = [] then
+ pr " r = guestfs_%s " name
+ else
+ pr " r = guestfs_%s_argv " name;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+
+ (* Cleanup any arguments. *)
+ List.iter (
+ function
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
+ | Bool _ | Int _ | Int64 _
+ | FileIn _ | FileOut _
+ | BufferIn _ | Key _ -> ()
+ | StringList n | DeviceList n -> pr " free (%s);\n" n
+ ) args;
+
+ (* Check return value for errors and return it if necessary. *)
+ (match ret with
+ | RErr ->
pr " if (r == -1)\n";
pr " croak (\"%%s\", guestfs_last_error (g));\n";
| RInt n
| RBool n ->
- pr "PREINIT:\n";
- pr " int %s;\n" n;
- pr " CODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
- pr " if (%s == -1)\n" n;
+ pr " if (r == -1)\n";
pr " croak (\"%%s\", guestfs_last_error (g));\n";
- pr " RETVAL = newSViv (%s);\n" n;
+ pr " RETVAL = newSViv (r);\n";
pr " OUTPUT:\n";
pr " RETVAL\n"
| RInt64 n ->
- pr "PREINIT:\n";
- pr " int64_t %s;\n" n;
- pr " CODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
- pr " if (%s == -1)\n" n;
+ pr " if (r == -1)\n";
pr " croak (\"%%s\", guestfs_last_error (g));\n";
- pr " RETVAL = my_newSVll (%s);\n" n;
+ pr " RETVAL = my_newSVll (r);\n";
pr " OUTPUT:\n";
pr " RETVAL\n"
| RConstString n ->
- pr "PREINIT:\n";
- pr " const char *%s;\n" n;
- pr " CODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
- pr " if (%s == NULL)\n" n;
+ pr " if (r == NULL)\n";
pr " croak (\"%%s\", guestfs_last_error (g));\n";
- pr " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " RETVAL = newSVpv (r, 0);\n";
pr " OUTPUT:\n";
pr " RETVAL\n"
| RConstOptString n ->
- pr "PREINIT:\n";
- pr " const char *%s;\n" n;
- pr " CODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
- pr " if (%s == NULL)\n" n;
+ pr " if (r == NULL)\n";
pr " RETVAL = &PL_sv_undef;\n";
pr " else\n";
- pr " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " RETVAL = newSVpv (r, 0);\n";
pr " OUTPUT:\n";
pr " RETVAL\n"
| RString n ->
- pr "PREINIT:\n";
- pr " char *%s;\n" n;
- pr " CODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
- pr " if (%s == NULL)\n" n;
+ pr " if (r == NULL)\n";
pr " croak (\"%%s\", guestfs_last_error (g));\n";
- pr " RETVAL = newSVpv (%s, 0);\n" n;
- pr " free (%s);\n" n;
+ pr " RETVAL = newSVpv (r, 0);\n";
+ pr " free (r);\n";
pr " OUTPUT:\n";
pr " RETVAL\n"
| RStringList n | RHashtable n ->
- pr "PREINIT:\n";
- pr " char **%s;\n" n;
- pr " size_t i, n;\n";
- pr " PPCODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
- pr " if (%s == NULL)\n" n;
+ pr " if (r == NULL)\n";
pr " croak (\"%%s\", guestfs_last_error (g));\n";
- pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
+ pr " for (n = 0; r[n] != NULL; ++n) /**/;\n";
pr " EXTEND (SP, n);\n";
pr " for (i = 0; i < n; ++i) {\n";
- pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
- pr " free (%s[i]);\n" n;
+ pr " PUSHs (sv_2mortal (newSVpv (r[i], 0)));\n";
+ pr " free (r[i]);\n";
pr " }\n";
- pr " free (%s);\n" n;
+ pr " free (r);\n";
| RStruct (n, typ) ->
let cols = cols_of_struct typ in
- generate_perl_struct_code typ cols name style n do_cleanups
+ generate_perl_struct_code typ cols name style n
| RStructList (n, typ) ->
let cols = cols_of_struct typ in
- generate_perl_struct_list_code typ cols name style n do_cleanups
+ generate_perl_struct_list_code typ cols name style n
| RBufferOut n ->
- pr "PREINIT:\n";
- pr " char *%s;\n" n;
- pr " size_t size;\n";
- pr " CODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
- pr " if (%s == NULL)\n" n;
+ pr " if (r == NULL)\n";
pr " croak (\"%%s\", guestfs_last_error (g));\n";
- pr " RETVAL = newSVpvn (%s, size);\n" n;
- pr " free (%s);\n" n;
+ pr " RETVAL = newSVpvn (r, size);\n";
+ pr " free (r);\n";
pr " OUTPUT:\n";
pr " RETVAL\n"
);
pr "\n"
) all_functions
-and generate_perl_struct_list_code typ cols name style n do_cleanups =
- pr "PREINIT:\n";
- pr " struct guestfs_%s_list *%s;\n" typ n;
- pr " size_t i;\n";
- pr " HV *hv;\n";
- pr " PPCODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
- pr " if (%s == NULL)\n" n;
+and generate_perl_struct_list_code typ cols name style n =
+ pr " if (r == NULL)\n";
pr " croak (\"%%s\", guestfs_last_error (g));\n";
- pr " EXTEND (SP, %s->len);\n" n;
- pr " for (i = 0; i < %s->len; ++i) {\n" n;
+ pr " EXTEND (SP, r->len);\n";
+ pr " for (i = 0; i < r->len; ++i) {\n";
pr " hv = newHV ();\n";
List.iter (
function
| name, FString ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (r->val[i].%s, 0), 0);\n"
+ name (String.length name) name
| name, FUUID ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (r->val[i].%s, 32), 0);\n"
+ name (String.length name) name
| name, FBuffer ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
- name (String.length name) n name n name
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpvn (r->val[i].%s, r->val[i].%s_len), 0);\n"
+ name (String.length name) name name
| name, (FBytes|FUInt64) ->
- pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (r->val[i].%s), 0);\n"
+ name (String.length name) name
| name, FInt64 ->
- pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (r->val[i].%s), 0);\n"
+ name (String.length name) name
| name, (FInt32|FUInt32) ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, newSVnv (r->val[i].%s), 0);\n"
+ name (String.length name) name
| name, FChar ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (&r->val[i].%s, 1), 0);\n"
+ name (String.length name) name
| name, FOptPercent ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, newSVnv (r->val[i].%s), 0);\n"
+ name (String.length name) name
) cols;
pr " PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
pr " }\n";
- pr " guestfs_free_%s_list (%s);\n" typ n
-
-and generate_perl_struct_code typ cols name style n do_cleanups =
- pr "PREINIT:\n";
- pr " struct guestfs_%s *%s;\n" typ n;
- pr " PPCODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_c_call_args ~handle:"g" style;
- pr ";\n";
- do_cleanups ();
- pr " if (%s == NULL)\n" n;
+ pr " guestfs_free_%s_list (r);\n" typ
+
+and generate_perl_struct_code typ cols name style n =
+ pr " if (r == NULL)\n";
pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " EXTEND (SP, 2 * %d);\n" (List.length cols);
List.iter (
match col with
| name, FString ->
- pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
- n name
+ pr " PUSHs (sv_2mortal (newSVpv (r->%s, 0)));\n"
+ name
| name, FBuffer ->
- pr " PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
- n name n name
+ pr " PUSHs (sv_2mortal (newSVpvn (r->%s, r->%s_len)));\n"
+ name name
| name, FUUID ->
- pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
- n name
+ pr " PUSHs (sv_2mortal (newSVpv (r->%s, 32)));\n"
+ name
| name, (FBytes|FUInt64) ->
- pr " PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
- n name
+ pr " PUSHs (sv_2mortal (my_newSVull (r->%s)));\n"
+ name
| name, FInt64 ->
- pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
- n name
+ pr " PUSHs (sv_2mortal (my_newSVll (r->%s)));\n"
+ name
| name, (FInt32|FUInt32) ->
- pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
- n name
+ pr " PUSHs (sv_2mortal (newSVnv (r->%s)));\n"
+ name
| name, FChar ->
- pr " PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
- n name
+ pr " PUSHs (sv_2mortal (newSVpv (&r->%s, 1)));\n"
+ name
| name, FOptPercent ->
- pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
- n name
+ pr " PUSHs (sv_2mortal (newSVnv (r->%s)));\n"
+ name
) cols;
- pr " free (%s);\n" n
+ pr " free (r);\n"
(* Generate Sys/Guestfs.pm. *)
and generate_perl_pm () =
use Sys::Guestfs;
my $h = Sys::Guestfs->new ();
- $h->add_drive ('guest.img');
+ $h->add_drive_opts ('guest.img', format => 'raw');
$h->launch ();
- $h->mount ('/dev/sda1', '/');
+ $h->mount_options ('', '/dev/sda1', '/');
$h->touch ('/hello');
$h->sync ();
=cut
" copyright_years
-and generate_perl_prototype name style =
- (match fst style with
+and generate_perl_prototype name (ret, args, optargs) =
+ (match ret with
| RErr -> ()
| RBool n
| RInt n
pr "$%s" n
| StringList n | DeviceList n ->
pr "\\@%s" n
- ) (snd style);
+ ) args;
+ List.iter (
+ fun arg ->
+ if !comma then pr " [, " else pr "[";
+ comma := true;
+ let n = name_of_argt arg in
+ pr "%s => $%s]" n n
+ ) optargs;
pr ");"
git.annexia.org / libguestfs.git / blobdiff