generator/wrappi_c_impl.ml

   1 (* wrappi
   2  * Copyright (C) 2011 Red Hat Inc.
   3  *
   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.
   8  *
   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.
  13  *
  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.
  17  *)
  18
  19 open Camlp4.PreCast
  20
  21 open Wrappi_utils
  22 open Wrappi_types
  23 open Wrappi_boilerplate
  24 open Wrappi_pr
  25
  26 open Printf
  27
  28 let inputs = ["wrappi_c_impl.ml"]
  29
  30 let c_of_ptype ~param = function
  31   | TBool -> "int"
  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 *)
  37   | TInt32 -> "int32_t"
  38   | TInt64 -> "int64_t"
  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 *"
  43   | TStruct name ->
  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
  50
  51 let c_of_rtype = function
  52   | RVoid -> "void"
  53   | RStaticString -> "const char *"
  54   | Return t -> c_of_ptype ~param:false t
  55
  56 let pr_defn ?(impl = false) ep =
  57   let ret, req, opt = ep.ep_ftype in
  58
  59   if not impl then (
  60     pr "%s\n" (c_of_rtype ret);
  61     pr "wrap_%s (wrap_h *w" ep.ep_name
  62   ) else (
  63     pr "static %s\n" (c_of_rtype ret);
  64     pr "impl_%s (struct wrap_internal_h *w" ep.ep_name
  65   );
  66
  67   (* Required parameters. *)
  68   List.iter (
  69     fun (name, t, _) ->
  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
  75   ) req;
  76
  77   (* Optional parameters. *)
  78   if opt <> [] then
  79     pr ", ...";
  80
  81   pr ")\n"
  82
  83 let generate_implementation ep =
  84   generate_header inputs CStyle LGPLv2plus;
  85
  86   pr "\
  87 /* Automatically generated implementation of '%s'.
  88 " ep.ep_name;
  89
  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);
  93
  94   pr " */
  95
  96 #include <config.h>
  97
  98 #include <stdio.h>
  99 #include <stdlib.h>
 100 #include <stdint.h>
 101 #include <string.h>
 102 #include <assert.h>
 103 ";
 104   List.iter (pr "#include <%s>\n") ep.ep_includes;
 105
 106 pr "\
 107
 108 #include \"wrappi.h\"
 109 #include \"internal.h\"
 110
 111 ";
 112
 113   pr_defn ~impl:(not ep.ep_local) ep;
 114
 115   pr "{\n";
 116
 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
 122      * assign to.
 123      *)
 124     let ret, _, _ = ep.ep_ftype in
 125     (match ret with
 126     | Return (TStruct name) ->
 127       pr "  struct wrap_%s *ret = malloc (sizeof *ret);\n" name;
 128       pr "  if (!ret) {\n";
 129       pr "    set_error_errno (\"malloc: struct wrap_%%s\", \"%s\");\n" name;
 130       pr "    return NULL;\n";
 131       pr "  }\n"
 132     | _ -> () (* XXX union, list, etc. *)
 133     );
 134
 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);
 138
 139     pr "%s" code
 140   );
 141
 142   pr "}\n";
 143
 144   (* For remote functions only, we now need to generate the
 145    * local binding code.
 146    *)
 147   if not ep.ep_local then (
 148     pr "\n";
 149
 150     pr_defn ep;
 151
 152     pr "{\n";
 153     pr "  /* XXX Argument precondition checks here. */\n";
 154     pr "\n";
 155     pr "  if (w->scheme == WRAP_SCHEME_LOCAL) {\n";
 156     pr "    /* Local connection. */\n";
 157     pr "    ";
 158
 159     let name = ep.ep_name in
 160     let ret, req, opt = ep.ep_ftype in
 161
 162     (match ret with
 163     | RVoid -> ()
 164     | _ -> pr "return "
 165     );
 166
 167     pr "impl_%s ((struct wrap_internal_h *)w" name;
 168
 169     (* Required parameters. *)
 170     List.iter (fun (n, _, _) -> pr ", %s" n) req;
 171
 172     (* Optional parameters. *)
 173     if opt <> [] then
 174       assert false; (* XXX not implemented *)
 175
 176     pr ");\n";
 177
 178     (match ret with
 179     | RVoid -> pr "    return;\n"
 180     | _ -> ()
 181     );
 182
 183     pr "  } else {\n";
 184     pr "    /* Remote connection. */\n";
 185     pr "    struct wrap_%s_args args;\n" name;
 186     pr "    struct wrap_%s_ret ret;\n" name;
 187     pr "\n";
 188     List.iter (fun (n, _, _) -> pr "    args.%s = %s;\n" n n) req;
 189
 190     if opt <> [] then assert false; (* XXX not implemented *)
 191     pr "\n";
 192
 193     pr "    memset (&ret, 0, sizeof ret);\n";
 194     pr "\n";
 195
 196     pr "    wrap_int_make_request (w, wrap_int_%s_num,\n" name;
 197     pr "                           &args, &ret);\n";
 198
 199     (match ret with
 200     | RVoid -> ()
 201     | _ ->
 202       pr "\n";
 203       pr "    return ret.r;\n"
 204     );
 205
 206     pr "  }\n";
 207
 208     pr "}\n"
 209   )
 210
 211 let generate_lib_internal_procs_h api =
 212   generate_header inputs CStyle LGPLv2plus;
 213
 214   pr "\
 215 #ifndef WRAPPI_INTERNAL_PROCS_H_
 216 #define WRAPPI_INTERNAL_PROCS_H_
 217
 218 ";
 219
 220   pr "\
 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.
 225  */
 226 enum {
 227 ";
 228
 229   iter_entry_points api (
 230     fun ep -> pr "  wrap_int_%s_num,\n" ep.ep_name
 231   );
 232
 233   pr "};\n";
 234   pr "\n";
 235
 236   pr "#define wrap_int_nr_procs %d\n" (StringMap.cardinal api.api_entry_points);
 237
 238   pr "\n";
 239   pr "#endif /* WRAPPI_INTERNAL_PROCS_H_ */\n"
 240
 241 let generate_lib_internal_procs_c api =
 242   generate_header inputs CStyle LGPLv2plus;
 243
 244   pr "\
 245 #include <config.h>
 246
 247 #include <stdlib.h>
 248
 249 #include \"wrappi.h\"
 250 #include \"internal.h\"
 251
 252 /* Defined in lib/call.c */
 253 ";
 254
 255   iter_entry_points api (
 256     fun ep ->
 257       pr "extern void wrap_int_call_%s (wrap_h *w, const void *args, void *ret);\n" ep.ep_name
 258   );
 259   pr "\n";
 260
 261   pr "/* Defined in lib/xdr.c */\n";
 262
 263   iter_entry_points api (
 264     fun ep ->
 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
 268   );
 269   pr "\n";
 270
 271   pr "const struct proc_table wrap_int_proc_table[] = {\n";
 272
 273   iter_entry_points api (
 274     fun ep ->
 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;
 283       pr "  },\n"
 284   );
 285
 286   pr "};\n"
 287
 288 let generate_lib_internal_procs_lookup_gperf api =
 289   generate_header inputs CStyle LGPLv2plus;
 290
 291   pr "\
 292 %%language=ANSI-C
 293 %%define lookup-function-name wrap_int_gperf_lookup_proc_entry
 294 %%readonly-tables
 295 %%null-strings
 296
 297 %%{
 298 #include <config.h>
 299
 300 #include <stdlib.h>
 301 #include <string.h>
 302
 303 #include \"wrappi.h\"
 304 #include \"internal.h\"
 305 %%}
 306
 307 struct proc_entry;
 308
 309 %%%%
 310 ";
 311
 312   iter_entry_points api (
 313     fun ep ->
 314       let name = ep.ep_name in
 315       pr "%s, wrap_int_%s_num\n" name name
 316   )
 317
 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
 322   let filename =
 323     try Filename.chop_extension filename
 324     with Invalid_argument _ -> filename in
 325   let filename = sprintf "%s-%s.c" filename ep.ep_name in
 326   filename
 327
 328 let generate_lib_implementation_files_mk api =
 329   generate_header inputs HashStyle GPLv2plus;
 330
 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
 335
 336   let rec loop = function
 337     | [] -> ()
 338     | [ep] -> pr "\t%s\n" (filename_of_ep ep)
 339     | ep :: eps -> pr "\t%s \\\n" (filename_of_ep ep); loop eps
 340   in
 341
 342   pr "local_implementation_files := \\\n";
 343
 344   loop (List.filter (fun ep -> ep.ep_local && ep.ep_code <> None) eps);
 345
 346   pr "\n";
 347   pr "remote_implementation_files := \\\n";
 348
 349   loop (List.filter (fun ep -> not ep.ep_local) eps)
 350
 351 let generate api =
 352   let gitignores = ref [] in
 353
 354   iter_entry_points api (
 355     fun ep ->
 356       (* Local entry points which don't have associated code are
 357        * assumed to be implemented in hand-written code elsewhere under
 358        * lib/.
 359        *)
 360       if not ep.ep_local || ep.ep_code <> None then (
 361         let filename = filename_of_ep ep in
 362
 363         gitignores := ("/" ^ filename) :: !gitignores;
 364
 365         output_to ("lib/" ^ filename) generate_implementation ep
 366       )
 367   );
 368
 369   output_to "lib/internal-procs.h"
 370     generate_lib_internal_procs_h api;
 371
 372   output_to "lib/internal-procs.c"
 373     generate_lib_internal_procs_c api;
 374
 375   output_to "lib/internal-procs-lookup.gperf"
 376     generate_lib_internal_procs_lookup_gperf api;
 377
 378   output_to "lib/implementation_files.mk"
 379     generate_lib_implementation_files_mk api;
 380
 381   let gitignores = List.rev !gitignores in
 382   output_to "lib/.gitignore"
 383     (fun () -> List.iter (pr "%s\n") gitignores) ()