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.
23 open Wrappi_boilerplate
28 let inputs = ["wrappi_c_impl.ml"]
30 let c_of_ptype ~param = function
32 | TBuffer -> assert false (* XXX not implemented *)
33 | TEnum name -> sprintf "wrap_%s_enum" name
34 | TFile -> if param then "const char *" else "char *"
35 | THash t -> if param then "char * const *" else "char **"
36 | TInt -> "int" (* XXX not int, correct type depends on preconditions *)
39 | TList t -> assert false (* XXX not implemented *)
40 | TNullable TString -> if param then "const char *" else "char *"
41 | TNullable _ -> assert false (* XXX may be implemented in future *)
42 | TString -> if param then "const char *" else "char *"
44 if param then sprintf "const struct wrap_%s *" name
45 else sprintf "struct wrap_%s *" name
46 | TTypedef name -> assert false (* should never happen *)
47 | TUInt32 -> "uint32_t"
48 | TUInt64 -> "uint64_t"
49 | TUnion name -> sprintf "union wrap_%s" name
51 let c_of_rtype = function
53 | RStaticString -> "const char *"
54 | Return t -> c_of_ptype ~param:false t
56 let pr_defn ?(impl = false) ep =
57 let ret, req, opt = ep.ep_ftype in
60 pr "%s\n" (c_of_rtype ret);
61 pr "wrap_%s (wrap_h *w" ep.ep_name
63 pr "static %s\n" (c_of_rtype ret);
64 pr "impl_%s (struct wrap_internal_h *w" ep.ep_name
67 (* Required parameters. *)
70 let t = c_of_ptype ~param:true t in
71 let sep = (* "const char *" - omit space after asterisk *)
72 let len = String.length t in
73 if isalnum t.[len-1] then " " else "" in
74 pr ", %s%s%s" t sep name
77 (* Optional parameters. *)
83 let generate_implementation ep =
84 generate_header inputs CStyle LGPLv2plus;
87 /* Automatically generated implementation of '%s'.
90 if not (Loc.is_ghost ep.ep_loc) then
91 pr " * This API was defined in '%s' at line %d.\n"
92 (Loc.file_name ep.ep_loc) (Loc.start_line ep.ep_loc);
104 List.iter (pr "#include <%s>\n") ep.ep_includes;
108 #include \"wrappi.h\"
109 #include \"internal.h\"
113 pr_defn ~impl:(not ep.ep_local) ep;
117 (match ep.ep_code with
118 | None -> () (* XXX implicit code *)
119 | Some { cc_loc = loc; cc_code = code } ->
120 (* If the return is a struct/union/list then allocate the structure
121 * in a local variable called 'ret' which the function should
124 let ret, _, _ = ep.ep_ftype in
126 | Return (TStruct name) ->
127 pr " struct wrap_%s *ret = malloc (sizeof *ret);\n" name;
129 pr " set_error_errno (\"malloc: struct wrap_%%s\", \"%s\");\n" name;
130 pr " return NULL;\n";
132 | _ -> () (* XXX union, list, etc. *)
135 (* Make sure included code has correct line numbers. *)
136 if not (Loc.is_ghost loc) then
137 pr "#line %d \"%s\"\n" (Loc.start_line loc) (Loc.file_name loc);
144 (* For remote functions only, we now need to generate the
145 * local binding code.
147 if not ep.ep_local then (
153 pr " /* XXX Argument precondition checks here. */\n";
155 pr " if (w->scheme == WRAP_SCHEME_LOCAL) {\n";
156 pr " /* Local connection. */\n";
159 let name = ep.ep_name in
160 let ret, req, opt = ep.ep_ftype in
167 pr "impl_%s ((struct wrap_internal_h *)w" name;
169 (* Required parameters. *)
170 List.iter (fun (n, _, _) -> pr ", %s" n) req;
172 (* Optional parameters. *)
174 assert false; (* XXX not implemented *)
179 | RVoid -> pr " return;\n"
184 pr " /* Remote connection. */\n";
185 pr " struct wrap_%s_args args;\n" name;
186 pr " struct wrap_%s_ret ret;\n" name;
188 List.iter (fun (n, _, _) -> pr " args.%s = %s;\n" n n) req;
190 if opt <> [] then assert false; (* XXX not implemented *)
193 pr " memset (&ret, 0, sizeof ret);\n";
196 pr " wrap_int_make_request (w, wrap_int_%s_num,\n" name;
197 pr " &args, &ret);\n";
203 pr " return ret.r;\n"
211 let generate_lib_internal_procs_h api =
212 generate_header inputs CStyle LGPLv2plus;
215 #ifndef WRAPPI_INTERNAL_PROCS_H_
216 #define WRAPPI_INTERNAL_PROCS_H_
221 /* NOTE: These constants can change with each run of the generator.
222 * They are only for internal use within the library, eg. for indexing
223 * arrays. The constants must not 'escape' from the library into
224 * on-the-wire formats etc.
229 iter_entry_points api (
230 fun ep -> pr " wrap_int_%s_num,\n" ep.ep_name
236 pr "#define wrap_int_nr_procs %d\n" (StringMap.cardinal api.api_entry_points);
239 pr "#endif /* WRAPPI_INTERNAL_PROCS_H_ */\n"
241 let generate_lib_internal_procs_c api =
242 generate_header inputs CStyle LGPLv2plus;
249 #include \"wrappi.h\"
250 #include \"internal.h\"
252 /* Defined in lib/call.c */
255 iter_entry_points api (
257 pr "extern void wrap_int_call_%s (wrap_h *w, const void *args, void *ret);\n" ep.ep_name
261 pr "/* Defined in lib/xdr.c */\n";
263 iter_entry_points api (
265 let name = ep.ep_name in
266 pr "extern bool_t wrap_int_xdr_%s_args (XDR *, struct wrap_%s_args *);\n" name name;
267 pr "extern bool_t wrap_int_xdr_%s_ret (XDR *, struct wrap_%s_ret *);\n" name name
271 pr "const struct proc_table wrap_int_proc_table[] = {\n";
273 iter_entry_points api (
275 let name = ep.ep_name in
276 pr " [wrap_int_%s_num] = {\n" name;
277 pr " .name = \"%s\",\n" name;
278 pr " .args_struct_size = sizeof (struct wrap_%s_args),\n" name;
279 pr " .ret_struct_size = sizeof (struct wrap_%s_ret),\n" name;
280 pr " .call = &wrap_int_call_%s,\n" name;
281 pr " .args_xdrproc = (xdrproc_t) &wrap_int_xdr_%s_args,\n" name;
282 pr " .ret_xdrproc = (xdrproc_t) &wrap_int_xdr_%s_ret,\n" name;
288 let generate_lib_internal_procs_lookup_gperf api =
289 generate_header inputs CStyle LGPLv2plus;
293 %%define lookup-function-name wrap_int_gperf_lookup_proc_entry
303 #include \"wrappi.h\"
304 #include \"internal.h\"
312 iter_entry_points api (
314 let name = ep.ep_name in
315 pr "%s, wrap_int_%s_num\n" name name
318 (* Make a unique, reproducible filename for each entry point. *)
319 let filename_of_ep ep =
320 let filename = Loc.file_name ep.ep_loc in
321 let filename = Filename.basename filename in
323 try Filename.chop_extension filename
324 with Invalid_argument _ -> filename in
325 let filename = sprintf "%s-%s.c" filename ep.ep_name in
328 let generate_lib_implementation_files_mk api =
329 generate_header inputs HashStyle GPLv2plus;
331 let eps = StringMap.bindings api.api_entry_points in
332 let cmp (a, _) (b, _) = compare a b in
333 let eps = List.sort cmp eps in
334 let eps = List.map snd eps in
336 let rec loop = function
338 | [ep] -> pr "\t%s\n" (filename_of_ep ep)
339 | ep :: eps -> pr "\t%s \\\n" (filename_of_ep ep); loop eps
342 pr "local_implementation_files := \\\n";
344 loop (List.filter (fun ep -> ep.ep_local && ep.ep_code <> None) eps);
347 pr "remote_implementation_files := \\\n";
349 loop (List.filter (fun ep -> not ep.ep_local) eps)
352 let gitignores = ref [] in
354 iter_entry_points api (
356 (* Local entry points which don't have associated code are
357 * assumed to be implemented in hand-written code elsewhere under
360 if not ep.ep_local || ep.ep_code <> None then (
361 let filename = filename_of_ep ep in
363 gitignores := ("/" ^ filename) :: !gitignores;
365 output_to ("lib/" ^ filename) generate_implementation ep
369 output_to "lib/internal-procs.h"
370 generate_lib_internal_procs_h api;
372 output_to "lib/internal-procs.c"
373 generate_lib_internal_procs_c api;
375 output_to "lib/internal-procs-lookup.gperf"
376 generate_lib_internal_procs_lookup_gperf api;
378 output_to "lib/implementation_files.mk"
379 generate_lib_implementation_files_mk api;
381 let gitignores = List.rev !gitignores in
382 output_to "lib/.gitignore"
383 (fun () -> List.iter (pr "%s\n") gitignores) ()