(* Import a C header file.
* Copyright (C) 2008 Red Hat Inc., Richard W.M. Jones
*
- * 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 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 library is distributed in the hope that it will be useful,
+ * 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
- * Lesser General Public License for more details.
+ * 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 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
+ * 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., 675 Mass Ave, Cambridge, MA 02139, USA.
*
* $Id$
*)
open Printf
open ExtList
open ExtString
+
open Cil
+module P = Bitmatch_persistent
+
+let (//) = Filename.concat
+
let () =
(* Parse command line arguments. *)
let debug = ref false in
printf "bitmatch-import-c %s" Bitmatch.version;
exit 1
in
+ let cpp_args = ref [] in
+ let cpp_arg2 name value =
+ cpp_args := (name ^ value) :: !cpp_args
+ in
let argspec = Arg.align [
"--debug", Arg.Set debug,
" Debug messages";
- "-save-temps", Arg.Set save_temps,
- " Save temporary files";
"--version", Arg.Unit version,
" Display version and exit";
+ "-save-temps", Arg.Set save_temps,
+ " Save temporary files";
+ "-I", Arg.String (cpp_arg2 "-I"),
+ "dir Specify extra include directory for cpp";
+ "-D", Arg.String (cpp_arg2 "-D"),
+ "name=value Define value in cpp";
+ "-U", Arg.String (cpp_arg2 "-U"),
+ "name Undefine value in cpp";
] in
let input_file = ref None in
| None ->
eprintf "bitmatch-import-c: no input file specified\n";
exit 1 in
+ let cpp_args = List.rev !cpp_args in
(* Grab the file and pass it to the preprocessor, and then read the
* C code into memory using CIL.
) in
let cmd =
- sprintf "cpp -include bitmatch-import-prefix.h %s > %s"
+ sprintf "cpp %s -I %s -include bitmatch-import-prefix.h %s > %s"
+ (String.concat " " (List.map Filename.quote cpp_args))
+ (Filename.quote (Bitmatch_config.ocamllibdir // "bitmatch"))
(Filename.quote input_file) (Filename.quote tmp) in
if debug then prerr_endline cmd;
if Sys.command cmd <> 0 then (
) structs;
);
+(*
+ (* Output constants.
+ * XXX Disabled at the moment until we work out where to put them XXX
+ *)
+ List.iter (
+ fun (vname, vinit, loc) ->
+ printf "let %s = 0x%LX\n" vname vinit
+ ) constants;
+*)
+
+ (* Output structures. *)
+ List.iter (
+ fun (tname, ttype, loc) ->
+ (* Uncomment the next line if you want to really print the
+ * complete CIL structure of the type (for debugging etc.).
+ * The ASTs printed here are usually quite large.
+ *)
+ (*Errormsg.log "%a: %s %a\n" d_loc loc tname d_plaintype ttype;*)
+
+ (* Recursive function to generate a persistent pattern from a
+ * C struct or union. Quite a few limitations at the moment:
+ * (1) Structure elements must be in order.
+ * (2) Doesn't really work with unions [XXX].
+ *
+ * Parameters:
+ * ?names List of names of parent structs. Used in the
+ * recursive case for nested structs.
+ * ?offset Offset of struct within parent, usually NoOffset. Used
+ * in the recursive case for nested structs.
+ * ?endian Inherited endianness, usually None. Used for C
+ * __attribute__((bitwise)).
+ * ttype CIL type of struct.
+ * Returns:
+ * pattern A bitmatch persistent pattern.
+ *)
+ let rec pattern_of_struct ?(names=[]) ?(offset=NoOffset) ?(endian=None)
+ ttype =
+ match ttype with
+ (* Some types contain attributes to indicate their
+ * endianness. See many examples from <linux/types.h>.
+ *)
+ | (TNamed ({ tname = tname;
+ ttype = TNamed (_, attrs) },
+ _) as t)
+ when hasAttribute "bitwise" attrs ->
+ let endian =
+ if String.starts_with tname "__le" then
+ Some Bitmatch.LittleEndian
+ else if String.starts_with tname "__be" then
+ Some Bitmatch.BigEndian
+ else (
+ Errormsg.warn "%a: unknown bitwise attribute typename: %s\n"
+ d_loc loc tname;
+ endian
+ ) in
+ pattern_of_struct ~names ~offset ~endian (unrollType t)
+
+ (* See into named types. *)
+ | (TNamed _ as t) ->
+ pattern_of_struct ~names ~offset ~endian (unrollType t)
+
+ (* struct or union *)
+ | TComp ({ cdefined = true; cfields = cfields }, _) ->
+ let cfields =
+ List.map (
+ fun ({ fname = fname; ftype = ftype } as finfo) ->
+ let offset = Field (finfo, offset) in
+ let names = fname :: names in
+ pattern_of_struct ~names ~offset ~endian ftype
+ ) cfields in
+ List.flatten cfields
+
+ (* int array with constant length *)
+ | TArray (basetype, (Some _ as len), _) when isIntegralType basetype ->
+ let nr_elems = lenOfArray len in
+ let bitsoffset, totalwidth = bitsOffset ttype offset in
+ let bitswidth = totalwidth / nr_elems (* of the element *) in
+ let basetype = unrollType basetype in
+ let ikind =
+ match basetype with
+ | TInt (ikind, _) -> ikind
+ | t ->
+ Errormsg.unimp "%a: unhandled type: %a" d_loc loc d_type t;
+ IInt in
+ let fname = String.concat "_" (List.rev names) in
+
+ (* If the base type is 8 bits then we always translate this to
+ * a string (whether the C type is signed or unsigned). There
+ * is no endianness in bytes so ignore that.
+ *)
+ if bitswidth = 8 then
+ [pattern_field_of_string fname bitsoffset nr_elems]
+ else (
+ (* XXX Realistically we don't handle arrays well at
+ * the moment. Perhaps we should give up and match
+ * this to a bitstring?
+ *)
+ let signed = isSigned ikind in
+ if debug then
+ eprintf "--> array %s: nr_elems=%d signed=%b\n"
+ fname nr_elems signed;
+ [] (* XXX *)
+ )
+
+ (* basic integer type *)
+ | TInt (ikind, _) ->
+ let bitsoffset, bitswidth = bitsOffset ttype offset in
+ (*if debug then (
+ let name = String.concat "." (List.rev names) in
+ Errormsg.log "%s: int: %d, %d\n" name bitsoffset bitswidth
+ );*)
+ let fname = String.concat "_" (List.rev names) in
+ let field =
+ pattern_field_of_int fname bitsoffset bitswidth ikind endian in
+ [field]
+
+ (* a pointer - in this mapping we assume this is an address
+ * (endianness and wordsize come from function parameters),
+ * in other words we DON'T try to follow pointers, we just
+ * note that they are there.
+ *)
+ | TPtr _ ->
+ let bitsoffset, bitswidth = bitsOffset ttype offset in
+ let fname = String.concat "_" (List.rev names) in
+ if debug then
+ eprintf "--> pointer %s: bitsoffset=%d bitswidth=%d\n"
+ fname bitsoffset bitswidth;
+ [] (* XXX *)
+
+ | t ->
+ Errormsg.warn "pattern_of_struct: %a: unhandled type: %a"
+ d_loc loc d_type t;
+ []
+
+ (* Convert a single int field into a pattern field.
+ * Could be a bitfield, byte, short, etc.
+ *)
+ and pattern_field_of_int fname bitsoffset bitswidth ikind endian =
+ let signed = isSigned ikind in
+ let _loc = camlp4_loc_of_cil_loc loc in
+
+ let field = P.create_pattern_field _loc in
+ let field = P.set_lident_patt field fname in
+ let field = P.set_type_int field in
+ let field = P.set_length_int field bitswidth in
+ let field = P.set_offset_int field bitsoffset in
+ let field = P.set_signed field signed in
+ let field =
+ match endian with
+ | Some endian -> P.set_endian field endian
+ | None -> P.set_endian field Bitmatch.NativeEndian in
+
+ field
+
+ and pattern_field_of_string fname bitsoffset nr_elems =
+ let _loc = camlp4_loc_of_cil_loc loc in
+ let field = P.create_pattern_field _loc in
+ let field = P.set_lident_patt field fname in
+ let field = P.set_type_string field in
+ let field = P.set_length_int field (nr_elems*8) in
+ let field = P.set_offset_int field bitsoffset in
+ field
+
+ (* Convert a CIL location into a camlp4 location. Grrr these
+ * should be compatible!
+ *)
+ and camlp4_loc_of_cil_loc loc =
+ let _loc = Camlp4.PreCast.Syntax.Ast.Loc.mk loc.file in
+ Camlp4.PreCast.Syntax.Ast.Loc.move_line loc.line _loc
+ in
+
+ (* Match on the type of this structure, and from it generate
+ * a single parsing function.
+ *)
+ match ttype with
+ (* struct or union *)
+ | TComp ({ cdefined = true; cname = cname }, _) ->
+ let pattern = pattern_of_struct ttype in
+ let named_pattern = cname, P.Pattern pattern in
+ P.named_to_channel stdout named_pattern
+
+ (* An undefined struct or union -- means one which was only ever
+ * defined with 'struct foo;'. This is an error.
+ *)
+ | TComp ({ cdefined = false; cname = cname }, _) ->
+ Errormsg.error
+ "%a: struct or union has no definition: %s" d_loc loc cname
+
+ (* Types which are not allowed, eg. void, int, arrays. *)
+ | TVoid _ | TInt _ | TFloat _ | TPtr _ | TArray _ | TFun _
+ | TNamed _ | TBuiltin_va_list _ ->
+ Errormsg.error
+ "%a: not a struct or union: %a" d_loc loc d_type ttype
+
+ (* Types which we might implement in the future.
+ * For enum we should probably split out enums separately
+ * from structs above, since enums are more like constants.
+ *)
+ | TEnum ({ ename = ename }, _) ->
+ Errormsg.unimp "%a: %a" d_loc loc d_type ttype
+
+ ) structs;
+
+ if !Errormsg.hadErrors then exit 1;
+
+ exit 0
git.annexia.org / ocaml-bitstring.git / blobdiff