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.
22 open Wrappi_boilerplate
26 let inputs = ["wrappi_c.ml"]
28 let c_of_ptype ~param = function
30 | TBuffer -> assert false (* XXX not implemented *)
31 | TEnum name -> sprintf "wrap_%s_enum" name
32 | TFile -> if param then "const char *" else "char *"
33 | THash t -> if param then "char * const *" else "char **"
34 | TInt -> "int" (* XXX not int, correct type depends on preconditions *)
37 | TList t -> assert false (* XXX not implemented *)
38 | TNullable TString -> if param then "const char *" else "char *"
39 | TNullable _ -> assert false (* XXX may be implemented in future *)
40 | TString -> if param then "const char *" else "char *"
42 if param then sprintf "const struct wrap_%s *" name
43 else sprintf "struct wrap_%s *" name
44 | TTypedef name -> assert false (* should never happen *)
45 | TUInt32 -> "uint32_t"
46 | TUInt64 -> "uint64_t"
47 | TUnion name -> sprintf "union wrap_%s" name
49 let c_of_rtype = function
51 | RStaticString -> "const char *"
52 | Return t -> c_of_ptype ~param:false t
54 let field_of_ptype = function
56 | TBuffer -> assert false (* XXX not implemented *)
57 | TEnum name -> sprintf "wrap_%s_enum" name
58 | TFile -> assert false (* cannot occur in a struct *)
59 | THash t -> "char **"
60 | TInt -> "int" (* XXX not int, correct type depends on preconditions *)
63 | TList t -> assert false (* XXX not implemented *)
64 | TNullable TString -> "char *"
65 | TNullable _ -> assert false (* XXX may be implemented in future *)
67 | TStruct name -> assert false (* we don't allow struct/union here *)
68 | TTypedef name -> assert false (* should never happen *)
69 | TUInt32 -> "uint32_t"
70 | TUInt64 -> "uint64_t"
71 | TUnion name -> assert false (* we don't allow struct/union here *)
73 (* Print the extern... declaration of a single entry point. *)
74 let pr_extern_decl ep =
75 let ret, req, opt = ep.ep_ftype in
76 pr "extern %s wrap_%s (wrap_h *w" (c_of_rtype ret) ep.ep_name;
78 (* Required parameters. *)
81 let t = c_of_ptype ~param:true t in
82 let sep = (* "const char *" - omit space after asterisk *)
83 let len = String.length t in
84 if isalnum t.[len-1] then " " else "" in
85 pr ", %s%s%s" t sep name
88 (* Optional parameters. *)
94 let generate_lib_wrappi_h api =
95 generate_header inputs CStyle LGPLv2plus;
98 /* Please read the wrappi(1) man page for full documentation. If you
99 * are not familiar with man pages or don't have the documentation
100 * installed, it is also available online at http://wrappi.org/
113 typedef struct wrap_h wrap_h;
120 let name = en.en_name in
122 (* The C compiler may choose to declare the sizeof(enum) ==
123 * sizeof(char), and adding fields to such an enum later could
124 * cause ABI breakage. (See the gcc --fshort-enums option for one
125 * example of this). Therefore use the enum just to declare the
126 * values, and typedef the enum as an int.
132 pr " WRAP_%s_%s = %d,\n"
133 (String.uppercase name) (String.uppercase id) i
136 pr "typedef int wrap_%s_enum;\n" name;
142 let name = sd.sd_name in
144 pr "struct wrap_%s {\n" name;
148 pr " %s %s;\n" (field_of_ptype t) name
151 pr "void wrap_free_%s (struct wrap_%s *);\n" name name;
156 /* Connection management. */
157 extern wrap_h *wrap_create (void);
158 extern void wrap_close (wrap_h *w);
162 (* Separate the local and remote functions. *)
164 /* Handle functions. */
166 iter_entry_points api (fun ep -> if ep.ep_local then pr_extern_decl ep);
170 /* API entry points. */
172 iter_entry_points api (fun ep -> if not ep.ep_local then pr_extern_decl ep);
176 /* C API introspection. */
178 iter_entry_points api (
180 let name = ep.ep_name in
181 let ret, req, opt = ep.ep_ftype in
183 pr "struct wrap_%s_args {\n" name;
186 let t = c_of_ptype ~param:true t in
187 let sep = (* "const char *" - omit space after asterisk *)
188 let len = String.length t in
189 if isalnum t.[len-1] then " " else "" in
190 pr " %s%s%s;\n" t sep n
195 if opt <> [] then assert false; (* XXX not implemented *)
197 pr "struct wrap_%s_ret {\n" name;
200 | RStaticString -> pr " const char *r;\n";
202 let t = c_of_ptype ~param:false t in
203 let sep = (* "const char *" - omit space after asterisk *)
204 let len = String.length t in
205 if isalnum t.[len-1] then " " else "" in
214 extern void wrap_call (wrap_h *w, const char *name, const void *args, void *ret);
215 extern size_t wrap_call_get_args_struct_size (wrap_h *w, const char *name);
216 extern size_t wrap_call_get_ret_struct_size (wrap_h *w, const char *name);
217 extern /* xdrproc_t */ void *wrap_call_get_args_xdrproc (wrap_h *w, const char *name);
218 extern /* xdrproc_t */ void *wrap_call_get_ret_xdrproc (wrap_h *w, const char *name);
224 #endif /* WRAPPI_H_ */
227 let generate_lib_call_c api =
228 generate_header inputs CStyle LGPLv2plus;
235 #include \"wrappi.h\"
236 #include \"internal.h\"
239 wrap_call (wrap_h *w, const char *name, const void *args, void *ret)
243 proc = wrap_int_lookup_proc_entry (name);
245 set_error (\"procedure not found: %%s\", name);
249 /* This ends up calling wrap_int_call_<name>. */
250 wrap_int_proc_table[proc].call (w, args, ret);
254 wrap_call_get_args_struct_size (wrap_h *w, const char *name)
258 proc = wrap_int_lookup_proc_entry (name);
260 set_error (\"procedure not found: %%s\", name);
264 return wrap_int_proc_table[proc].args_struct_size;
268 wrap_call_get_ret_struct_size (wrap_h *w, const char *name)
272 proc = wrap_int_lookup_proc_entry (name);
274 set_error (\"procedure not found: %%s\", name);
278 return wrap_int_proc_table[proc].ret_struct_size;
281 /* Really this returns xdrproc_t but we don't want to have to include
282 * XDR headers in the public API.
285 wrap_call_get_args_xdrproc (wrap_h *w, const char *name)
289 proc = wrap_int_lookup_proc_entry (name);
291 set_error (\"procedure not found: %%s\", name);
295 return wrap_int_proc_table[proc].args_xdrproc;
298 /* Really this returns xdrproc_t but we don't want to have to include
299 * XDR headers in the public API.
302 wrap_call_get_ret_xdrproc (wrap_h *w, const char *name)
306 proc = wrap_int_lookup_proc_entry (name);
308 set_error (\"procedure not found: %%s\", name);
312 return wrap_int_proc_table[proc].ret_xdrproc;
316 iter_entry_points api (
320 let name = ep.ep_name in
321 let ret, req, opt = ep.ep_ftype in
324 pr "wrap_int_call_%s (wrap_h *w, const void *argsv, void *retv)\n" name;
326 if req <> [] || opt <> [] then
327 pr " const struct wrap_%s_args *args = argsv;\n" name;
329 pr " struct wrap_%s_ret *ret = retv;\n" name;
335 | _ -> pr "ret->r = "
338 pr "wrap_%s (w" name;
339 List.iter (fun (n, _, _) -> pr ", args->%s" n) req;
341 if opt <> [] then assert false; (* XXX not implemented *)
347 (* Functions for freeing structs are part of the C bindings. We don't
348 * want them to be exposed in other languages, although they will be
349 * used by other bindings.
351 let generate_lib_free_structs_c api =
352 generate_header inputs CStyle LGPLv2plus;
359 #include \"wrappi.h\"
366 let name = sd.sd_name in
369 pr "wrap_free_%s (struct wrap_%s *v)\n" name name;
375 | TBool | TEnum _ | TInt | TInt32 | TInt64 | TUInt32 | TUInt64 ->
376 () (* these don't need to be freed *)
377 | TBuffer -> assert false (* XXX not implemented *)
381 pr " free (v->%s);\n" n
382 | THash t -> assert false (* XXX not implemented *)
383 | TList t -> assert false (* XXX not implemented *)
384 | TNullable _ -> assert false (* XXX may be implemented in future *)
385 | TStruct name -> assert false (* cannot occur in structs *)
386 | TTypedef name -> assert false (* should never happen *)
387 | TUnion name -> assert false (* cannot occur in structs *)
394 output_to "lib/wrappi.h" generate_lib_wrappi_h api;
395 output_to "lib/call.c" generate_lib_call_c api;
396 output_to "lib/free_structs.c" generate_lib_free_structs_c api