2 * Copyright (C) 2011 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 (* Please read generator/README first. *)
26 open Generator_docstrings
27 open Generator_optgroups
28 open Generator_actions
29 open Generator_structs
33 let rec generate_erlang_erl () =
34 generate_header ErlangStyle LGPLv2plus;
36 pr "-module(guestfs).\n";
38 pr "-export([create/0, create/1, close/1, init/1]).\n";
41 (* Export the public actions. *)
43 fun (name, (_, args, optargs), _, _, _, _, _) ->
44 let nr_args = List.length args in
46 pr "-export([%s/%d]).\n" name (nr_args+1)
48 pr "-export([%s/%d, %s/%d]).\n" name (nr_args+1) name (nr_args+2)
49 ) all_functions_sorted;
55 create(\"erl-guestfs\").
58 G = spawn(?MODULE, init, [ExtProg]),
66 G ! {call, self(), Args},
73 process_flag(trap_exit, true),
74 Port = open_port({spawn, ExtProg}, [{packet, 4}, binary]),
78 {call, Caller, Args} ->
79 Port ! { self(), {command, term_to_binary(Args)}},
81 {Port, {data, Result}} ->
82 Caller ! { guestfs, binary_to_term(Result)}
88 { 'EXIT', Port, _ } ->
94 (* These bindings just marshal the parameters and call the back-end
95 * process which dispatches them to the port.
98 fun (name, (_, args, optargs), _, _, _, _, _) ->
102 pr ", %s" (String.capitalize (name_of_argt arg))
104 if optargs <> [] then
108 pr " call_port(G, {%s" name;
111 pr ", %s" (String.capitalize (name_of_argt arg))
113 if optargs <> [] then
117 (* For functions with optional arguments, make a variant that
118 * has no optarg array, which just calls the function above with
119 * an empty list as the final arg.
121 if optargs <> [] then (
125 pr ", %s" (String.capitalize (name_of_argt arg))
132 pr ", %s" (String.capitalize (name_of_argt arg))
139 ) all_functions_sorted
141 and generate_erlang_c () =
142 generate_header CStyle GPLv2plus;
150 #include <erl_interface.h>
153 #include \"guestfs.h\"
157 extern ETERM *dispatch (ETERM *message);
158 extern int atom_equals (ETERM *atom, const char *name);
159 extern ETERM *make_error (const char *funname);
160 extern ETERM *unknown_optarg (const char *funname, ETERM *optargname);
161 extern ETERM *unknown_function (ETERM *fun);
162 extern ETERM *make_string_list (char **r);
163 extern ETERM *make_table (char **r);
164 extern ETERM *make_bool (int r);
165 extern char **get_string_list (ETERM *term);
166 extern int get_bool (ETERM *term);
167 extern void free_strings (char **r);
169 #define ARG(i) (ERL_TUPLE_ELEMENT(message,(i)+1))
173 (* Struct copy functions. *)
174 let emit_copy_list_function typ =
175 pr "static ETERM *\n";
176 pr "make_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
178 pr " ETERM *t[%ss->len];\n" typ;
181 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
182 pr " t[i] = make_%s (&%ss->val[i]);\n" typ typ;
184 pr " return erl_mk_list (t, %ss->len);\n" typ;
191 pr "static ETERM *\n";
192 pr "make_%s (const struct guestfs_%s *%s)\n" typ typ typ;
194 pr " ETERM *t[%d];\n" (List.length cols);
200 pr " t[%d] = erl_mk_string (%s->%s);\n" i typ name
202 pr " t[%d] = erl_mk_estring (%s->%s, %s->%s_len);\n"
205 pr " t[%d] = erl_mk_estring (%s->%s, 32);\n" i typ name
206 | name, (FBytes|FInt64|FUInt64) ->
207 pr " t[%d] = erl_mk_longlong (%s->%s);\n" i typ name
208 | name, (FInt32|FUInt32) ->
209 pr " t[%d] = erl_mk_int (%s->%s);\n" i typ name
210 | name, FOptPercent ->
211 pr " if (%s->%s >= 0)\n" typ name;
212 pr " t[%d] = erl_mk_float (%s->%s);\n" i typ name;
214 pr " t[%d] = erl_mk_atom (\"undefined\");\n" i;
216 pr " t[%d] = erl_mk_int (%s->%s);\n" i typ name
220 pr " return erl_mk_list (t, %d);\n" (List.length cols);
225 (* Emit a copy_TYPE_list function definition only if that function is used. *)
228 | typ, (RStructListOnly | RStructAndList) ->
229 (* generate the function for typ *)
230 emit_copy_list_function typ
231 | typ, _ -> () (* empty *)
232 ) (rstructs_used_by all_functions);
234 (* The wrapper functions. *)
236 fun (name, ((ret, args, optargs) as style), _, _, _, _, _) ->
237 pr "static ETERM *\n";
238 pr "run_%s (ETERM *message)\n" name;
245 | Device n | Dev_or_Path n
250 pr " char *%s = erl_iolist_to_string (ARG (%d));\n" n i
253 pr " if (atom_equals (ARG (%d), \"undefined\"))\n" i;
254 pr " %s = NULL;\n" n;
256 pr " %s = erl_iolist_to_string (ARG (%d));\n" n i
258 pr " size_t %s_size = erl_iolist_length (ARG (%d));\n" n i;
259 pr " char *%s = erl_iolist_to_string (ARG (%d));\n" n i
260 | StringList n | DeviceList n ->
261 pr " char **%s = get_string_list (ARG (%d));\n" n i
263 pr " int %s = get_bool (ARG (%d));\n" n i
265 pr " int %s = ERL_INT_VALUE (ARG (%d));\n" n i
267 pr " int64_t %s = ERL_LL_VALUE (ARG (%d));\n" n i
272 let uc_name = String.uppercase name in
274 (* Optional arguments. *)
275 if optargs <> [] then (
277 pr " struct guestfs_%s_argv optargs_s = { .bitmask = 0 };\n" name;
278 pr " struct guestfs_%s_argv *optargs = &optargs_s;\n" name;
279 pr " ETERM *optargst = ARG (%d);\n" (List.length args);
280 pr " while (!ERL_IS_EMPTY_LIST (optargst)) {\n";
281 pr " ETERM *hd = ERL_CONS_HEAD (optargst);\n";
282 pr " ETERM *hd_name = ERL_TUPLE_ELEMENT (hd, 0);\n";
283 pr " ETERM *hd_value = ERL_TUPLE_ELEMENT (hd, 1);\n";
287 let n = name_of_argt argt in
288 let uc_n = String.uppercase n in
289 pr " if (atom_equals (hd_name, \"%s\")) {\n" n;
290 pr " optargs_s.bitmask |= GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
291 pr " optargs_s.%s = " n;
293 | Bool _ -> pr "get_bool (hd_value)"
294 | Int _ -> pr "ERL_INT_VALUE (hd_value)"
295 | Int64 _ -> pr "ERL_LL_VALUE (hd_value)"
296 | String _ -> pr "erl_iolist_to_string (hd_value)"
303 pr " return unknown_optarg (\"%s\", hd_name);\n" name;
304 pr " optargst = ERL_CONS_TAIL (optargst);\n";
310 | RErr -> pr " int r;\n"
311 | RInt _ -> pr " int r;\n"
312 | RInt64 _ -> pr " int64_t r;\n"
313 | RBool _ -> pr " int r;\n"
314 | RConstString _ | RConstOptString _ ->
315 pr " const char *r;\n"
316 | RString _ -> pr " char *r;\n"
320 | RStruct (_, typ) ->
321 pr " struct guestfs_%s *r;\n" typ
322 | RStructList (_, typ) ->
323 pr " struct guestfs_%s_list *r;\n" typ
334 pr " r = guestfs_%s " name
336 pr " r = guestfs_%s_argv " name;
337 generate_c_call_args ~handle:"g" style;
340 (* Free strings if we copied them above. *)
343 | Pathname n | Device n | Dev_or_Path n | String n | OptString n
344 | FileIn n | FileOut n | BufferIn n | Key n ->
346 | StringList n | DeviceList n ->
347 pr " free_strings (%s);\n" n;
348 | Bool _ | Int _ | Int64 _ | Pointer _ -> ()
353 let uc_n = String.uppercase n in
354 pr " if ((optargs_s.bitmask & GUESTFS_%s_%s_BITMASK))\n"
356 pr " free ((char *) optargs_s.%s);\n" n
357 | Bool _ | Int _ | Int64 _
358 | Pathname _ | Device _ | Dev_or_Path _ | OptString _
359 | FileIn _ | FileOut _ | BufferIn _ | Key _
360 | StringList _ | DeviceList _ | Pointer _ -> ()
363 (match errcode_of_ret ret with
364 | `CannotReturnError -> ()
365 | `ErrorIsMinusOne ->
366 pr " if (r == -1)\n";
367 pr " return make_error (\"%s\");\n" name;
369 pr " if (r == NULL)\n";
370 pr " return make_error (\"%s\");\n" name;
375 | RErr -> pr " return erl_mk_atom (\"ok\");\n"
376 | RInt _ -> pr " return erl_mk_int (r);\n"
377 | RInt64 _ -> pr " return erl_mk_longlong (r);\n"
378 | RBool _ -> pr " return make_bool (r);\n"
379 | RConstString _ -> pr " return erl_mk_string (r);\n"
380 | RConstOptString _ ->
383 pr " rt = erl_mk_string (r);\n";
385 pr " rt = erl_mk_atom (\"undefined\");\n";
388 pr " ETERM *rt = erl_mk_string (r);\n";
392 pr " ETERM *rt = make_string_list (r);\n";
393 pr " free_strings (r);\n\n";
395 | RStruct (_, typ) ->
396 pr " ETERM *rt = make_%s (r);\n" typ;
397 pr " guestfs_free_%s (r);\n" typ;
399 | RStructList (_, typ) ->
400 pr " ETERM *rt = make_%s_list (r);\n" typ;
401 pr " guestfs_free_%s_list (r);\n" typ;
404 pr " ETERM *rt = make_table (r);\n";
405 pr " free_strings (r);\n";
408 pr " ETERM *rt = erl_mk_estring (r, size);\n";
415 ) all_functions_sorted;
420 dispatch (ETERM *message)
424 fun = ERL_TUPLE_ELEMENT (message, 0);
426 /* XXX We should use gperf here. */
430 fun (name, (ret, args, optargs), _, _, _, _, _) ->
431 pr "if (atom_equals (fun, \"%s\"))\n" name;
432 pr " return run_%s (message);\n" name;
434 ) all_functions_sorted;
436 pr "return unknown_function (fun);