/generator/generator
/generator/stamp-generator
/install-sh
+/lib/free_structs.c
/lib/wrappi.h
/libtool
/local*
--- /dev/null
+(* wrappi -*- tuareg -*-
+ * Copyright (C) 2011-2012 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+struct timeval {
+ time_t tv_sec;
+ uint32 tv_usec
+}
+
+entry_point
+struct timeval gettimeofday ()
+<<
+ int r;
+ struct timeval tv;
+
+ r = gettimeofday (&tv, NULL);
+ if (r == -1) {
+ set_error_errno ("gettimeofday");
+ return NULL;
+ }
+ ret->tv_sec = tv.tv_sec;
+ ret->tv_usec = tv.tv_usec;
+ return ret;
+>>
+includes ["sys/time.h"]
entry_point local void connect ()
-enum scheme ["local"; "ssh"] ;;
+enum scheme ["local"; "ssh"]
entry_point local void set_scheme (enum scheme scheme)
entry_point local void set_hostname (string hostname)
--- /dev/null
+(* wrappi -*- tuareg -*-
+ * Copyright (C) 2011-2012 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+(* Signed so we can represent times before the epoch, and 64 bit so we
+ * don't suffer from 2K38 bugs.
+ *)
+typedef int64 time_t
fun sd ->
let fields = sd.sd_fields in
let fields =
- Array.map (resolve_typedefs "enum" sd.sd_name sd.sd_loc) fields in
+ Array.map (
+ fun (name, t) ->
+ let t = resolve_typedefs "enum" sd.sd_name sd.sd_loc t in
+ (name, t)
+ ) fields in
{ sd with sd_fields = fields }
) sds in
fun un ->
let fields = un.un_fields in
let fields =
- Array.map (resolve_typedefs "union" un.un_name un.un_loc) fields in
+ Array.map (
+ fun (name, t) ->
+ let t = resolve_typedefs "union" un.un_name un.un_loc t in
+ (name, t)
+ ) fields in
{ un with un_fields = fields }
) uns in
type struct_decl = {
sd_loc : Camlp4.PreCast.Loc.t;
sd_name : string;
- sd_identifiers : string array;
- sd_fields : ptype array;
+ sd_fields : (string * ptype) array;
}
type union = {
un_loc : Camlp4.PreCast.Loc.t;
un_name : string;
- un_identifiers : string array;
- un_fields : ptype array;
+ un_fields : (string * ptype) array;
}
type api = {
type struct_decl = {
sd_loc : Camlp4.PreCast.Loc.t;
sd_name : string;
- sd_identifiers : string array;
- sd_fields : ptype array;
+ sd_fields : (string * ptype) array;
}
(** A struct declaration. *)
type union = {
un_loc : Camlp4.PreCast.Loc.t;
un_name : string;
- un_identifiers : string array;
- un_fields : ptype array;
+ un_fields : (string * ptype) array;
}
(** A qualified union declaration. *)
Wrappi_accumulator.add_enum en
>>
+let add_struct _loc name fields =
+ let loc = expr_of_loc _loc _loc in
+
+ let fields = List.map (
+ fun (name, t) -> <:expr< ($str:name$, $t$) >>
+ ) fields in
+ let fields = expr_of_list _loc fields in
+
+ <:str_item<
+ let sd = { Wrappi_types.sd_loc = $loc$;
+ sd_name = $str:name$;
+ sd_fields = Array.of_list $fields$ } in
+ Wrappi_accumulator.add_struct sd
+ >>
+
let () =
(* Quotation expander for C code. *)
let c_quotation_expander _loc _ code =
(* A single function parameter. XXX Preconditions. *)
parameter: [[ t = ptype; name = LIDENT -> (name, t) ]];
+ (* A single struct field. XXX Preconditions. *)
+ struct_field: [[ t = ptype; name = LIDENT -> (name, t) ]];
+
str_item: LEVEL "top" [
[ "entry_point";
local = OPT "local";
add_enum _loc name identifiers
]
+ | [ "struct"; name = LIDENT; "{";
+ fields = LIST0 struct_field SEP ";";
+ "}" ->
+ add_struct _loc name fields
+ ]
+
| [ "typedef"; t = ptype; name = LIDENT ->
add_typedef _loc name t
]
wrappi_enums.cmi:
wrappi_enums.cmo: wrappi_enums.cmi
wrappi_enums.cmx: wrappi_enums.cmi
-wrappi_main.cmo: wrappi_pr.cmi wrappi_enums.cmi wrappi_c_impl.cmi wrappi_c.cmi
-wrappi_main.cmx: wrappi_pr.cmx wrappi_enums.cmx wrappi_c_impl.cmx wrappi_c.cmx
+wrappi_main.cmo: wrappi_structs.cmi wrappi_pr.cmi wrappi_enums.cmi wrappi_c_impl.cmi wrappi_c.cmi
+wrappi_main.cmx: wrappi_structs.cmx wrappi_pr.cmx wrappi_enums.cmx wrappi_c_impl.cmx wrappi_c.cmx
wrappi_pr.cmi:
wrappi_pr.cmo: wrappi_pr.cmi
wrappi_pr.cmx: wrappi_pr.cmi
+wrappi_structs.cmi:
+wrappi_structs.cmo: wrappi_structs.cmi
+wrappi_structs.cmx: wrappi_structs.cmi
wrappi_enums.ml \
wrappi_main.ml \
wrappi_pr.mli \
- wrappi_pr.ml
+ wrappi_pr.ml \
+ wrappi_structs.mli \
+ wrappi_structs.ml
# In dependency order.
OBJECTS = \
wrappi_pr.cmo \
wrappi_boilerplate.cmo \
wrappi_enums.cmo \
+ wrappi_structs.cmo \
wrappi_c_impl.cmo \
wrappi_c.cmo \
wrappi_main.cmo
| TNullable TString -> if param then "const char *" else "char *"
| TNullable _ -> assert false (* XXX may be implemented in future *)
| TString -> if param then "const char *" else "char *"
- | TStruct name -> sprintf "struct wrap_%s" name
+ | TStruct name ->
+ if param then sprintf "const struct wrap_%s *" name
+ else sprintf "struct wrap_%s *" name
| TTypedef name -> assert false (* should never happen *)
| TUInt32 -> "uint32_t"
| TUInt64 -> "uint64_t"
| RStaticString -> "const char *"
| Return t -> c_of_ptype ~param:false t
+let field_of_ptype = function
+ | TBool -> "int"
+ | TBuffer -> assert false (* XXX not implemented *)
+ | TEnum name -> sprintf "wrap_%s_enum" name
+ | TFile -> assert false (* cannot occur in a struct *)
+ | THash t -> "char **"
+ | TInt -> "int" (* XXX not int, correct type depends on preconditions *)
+ | TInt32 -> "int32_t"
+ | TInt64 -> "int64_t"
+ | TList t -> assert false (* XXX not implemented *)
+ | TNullable TString -> "char *"
+ | TNullable _ -> assert false (* XXX may be implemented in future *)
+ | TString -> "char *"
+ | TStruct name -> assert false (* we don't allow struct/union here *)
+ | TTypedef name -> assert false (* should never happen *)
+ | TUInt32 -> "uint32_t"
+ | TUInt64 -> "uint64_t"
+ | TUnion name -> assert false (* we don't allow struct/union here *)
+
(* Print the extern... declaration of a single entry point. *)
let pr_extern_decl ep =
let ret, req, opt = ep.ep_ftype in
pr "\n";
);
+ iter_structs api (
+ fun sd ->
+ let name = sd.sd_name in
+
+ pr "struct wrap_%s {\n" name;
+
+ Array.iter (
+ fun (name, t) ->
+ pr " %s %s;\n" (field_of_ptype t) name
+ ) sd.sd_fields;
+ pr "};\n";
+ pr "void wrap_free_%s (struct wrap_%s *);\n" name name;
+ pr "\n"
+ );
+
pr "\
/* Connection management. */
extern wrap_h *wrap_create (void);
#endif /* WRAPPI_H_ */
"
+(* Functions for freeing structs are part of the C bindings. We don't
+ * want them to be exposed in other languages, although they will be
+ * used by other bindings.
+ *)
+let generate_lib_free_structs_c api =
+ generate_header inputs CStyle LGPLv2plus;
+
+ pr "\
+#include <stdlib.h>
+
+#include \"wrappi.h\"
+";
+
+ iter_structs api (
+ fun sd ->
+ pr "\n";
+
+ let name = sd.sd_name in
+
+ pr "void\n";
+ pr "wrap_free_%s (struct wrap_%s *v)\n" name name;
+ pr "{\n";
+
+ Array.iter (
+ fun (n, t) ->
+ match t with
+ | TBool | TEnum _ | TInt | TInt32 | TInt64 | TUInt32 | TUInt64 ->
+ () (* these don't need to be freed *)
+ | TBuffer -> assert false (* XXX not implemented *)
+ | TFile
+ | TNullable TString
+ | TString ->
+ pr " free (v->%s);\n" n
+ | THash t -> assert false (* XXX not implemented *)
+ | TList t -> assert false (* XXX not implemented *)
+ | TNullable _ -> assert false (* XXX may be implemented in future *)
+ | TStruct name -> assert false (* cannot occur in structs *)
+ | TTypedef name -> assert false (* should never happen *)
+ | TUnion name -> assert false (* cannot occur in structs *)
+ ) sd.sd_fields;
+ pr " free (v);\n";
+ pr "}\n"
+ )
+
let generate api =
- output_to "lib/wrappi.h" generate_lib_wrappi_h api
+ output_to "lib/wrappi.h" generate_lib_wrappi_h api;
+ output_to "lib/free_structs.c" generate_lib_free_structs_c api
| TNullable TString -> if param then "const char *" else "char *"
| TNullable _ -> assert false (* XXX may be implemented in future *)
| TString -> if param then "const char *" else "char *"
- | TStruct name -> sprintf "struct wrap_%s" name
+ | TStruct name ->
+ if param then sprintf "const struct wrap_%s *" name
+ else sprintf "struct wrap_%s *" name
| TTypedef name -> assert false (* should never happen *)
| TUInt32 -> "uint32_t"
| TUInt64 -> "uint64_t"
(match ep.ep_code with
| None -> () (* XXX implicit code *)
| Some { cc_loc = loc; cc_code = code } ->
+ (* If the return is a struct/union/list then allocate the structure
+ * in a local variable called 'ret' which the function should
+ * assign to.
+ *)
+ let ret, _, _ = ep.ep_ftype in
+ (match ret with
+ | Return (TStruct name) ->
+ pr " struct wrap_%s *ret = malloc (sizeof *ret);\n" name;
+ pr " if (!ret) {\n";
+ pr " set_error_errno (\"malloc: struct wrap_%%s\", \"%s\");\n" name;
+ pr " return NULL;\n";
+ pr " }\n"
+ | _ -> () (* XXX union, list, etc. *)
+ );
+
+ (* Make sure included code has correct line numbers. *)
if not (Loc.is_ghost loc) then
pr "#line %d \"%s\"\n" (Loc.start_line loc) (Loc.file_name loc);
+
pr "%s" code
);
* generated from other things, eg. from enums.
*)
let api = Wrappi_enums.extend_api api
+let api = Wrappi_structs.extend_api api
let dump_and_exit () =
printf "typedefs (%d):\n" nr_tds;
--- /dev/null
+(* wrappi
+ * Copyright (C) 2011 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Camlp4.PreCast
+
+open Wrappi_types
+open Wrappi_utils
+
+open Printf
+
+(* Nothing at the moment, but for Perl it'd be useful to have a way
+ * to get a list of the fields in a struct. XXX
+ *)
+let extend_api api =
+ api
--- /dev/null
+(* wrappi
+ * Copyright (C) 2011 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** Add some functions to the API for handling structs. *)
+
+val extend_api : Wrappi_types.api -> Wrappi_types.api
/error-get_errno.c
/error-get_error.c
/error-get_error_func.c
+/gettimeofday-gettimeofday.c
/mkdir-mkdir.c
/mknod-mknod_char.c
/ghost-location-scheme_enum_nr.c
wrappi.h \
wrappi.c \
connect.c \
+ free_structs.c \
$(local_implementation_files) \
$(remote_implementation_files)
libwrappi_la_CFLAGS = $(WARN_CFLAGS) $(WERROR_CFLAGS)
remote_implementation_files := \
filesize-filesize.c \
+ gettimeofday-gettimeofday.c \
mkdir-mkdir.c \
mknod-mknod_char.c
git.annexia.org / wrappi.git / commitdiff