From 97cd7dd22059a1c5ca72852130ac430aa713e968 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Sun, 18 May 2008 18:32:01 +0000 Subject: [PATCH] Implement the nativeendian version of some functions. --- .depend | 4 +- MANIFEST | 2 + Makefile.in | 22 +++++---- bitmatch.ml | 36 +++++++++++++++ bitmatch.mli | 23 +++++++++ bitmatch_config.ml.in | 30 ++++++++++++ bitmatch_types.ml | 26 +++++++++++ configure.ac | 10 +++- pa_bitmatch.ml | 126 ++++++++++++++++++++++++++------------------------ 9 files changed, 206 insertions(+), 73 deletions(-) create mode 100644 bitmatch_config.ml.in create mode 100644 bitmatch_types.ml diff --git a/.depend b/.depend index 4797d7b..4756662 100644 --- a/.depend +++ b/.depend @@ -1,2 +1,2 @@ -bitmatch.cmo: bitmatch.cmi -bitmatch.cmx: bitmatch.cmi +bitmatch.cmo: bitmatch_types.cmo bitmatch_config.cmo bitmatch.cmi +bitmatch.cmx: bitmatch_types.cmx bitmatch_config.cmx bitmatch.cmi diff --git a/MANIFEST b/MANIFEST index a9cea91..58d4f08 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,6 +1,8 @@ aclocal.m4 bitmatch.ml bitmatch.mli +bitmatch_config.ml.in +bitmatch_types.ml .depend configure.ac COPYING.LIB diff --git a/Makefile.in b/Makefile.in index fcc1dcc..21b9952 100644 --- a/Makefile.in +++ b/Makefile.in @@ -36,24 +36,26 @@ EXAMPLES = $(wildcard examples/*.ml) TESTS = $(patsubst %.ml,%,$(wildcard tests/*.ml)) -all: pa_bitmatch.cmo bitmatch.cma bitmatch.cmxa +all: bitmatch.cma bitmatch.cmxa pa_bitmatch.cmo -pa_bitmatch.cmo: pa_bitmatch.ml - $(OCAMLFIND) ocamlc -I +camlp4 camlp4lib.cma \ - -pp camlp4of.opt -c $< -o $@ - -bitmatch.cma: bitmatch.cmo +bitmatch.cma: bitmatch_types.cmo bitmatch_config.cmo bitmatch.cmo $(OCAMLFIND) ocamlc -a -o $@ $^ -bitmatch.cmxa: bitmatch.cmx +bitmatch.cmxa: bitmatch_types.cmx bitmatch_config.cmx bitmatch.cmx $(OCAMLFIND) ocamlopt -a -o $@ $^ +pa_bitmatch.cmo: pa_bitmatch.ml bitmatch.cma + $(OCAMLFIND) ocamlc bitmatch.cma -I +camlp4 camlp4lib.cma \ + -pp camlp4of.opt -c $< -o $@ + # Tests and examples. +PP = -pp "camlp4o bitmatch.cma pa_bitmatch.cmo" + test: pa_bitmatch.cmo bitmatch.cma @for f in $(TESTS); do \ echo Test: $$f; \ - $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -pp "camlp4o pa_bitmatch.cmo" \ + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) $(PP) \ -package unix -linkpkg -I . bitmatch.cma $$f.ml -o $$f; \ if [ $$? -ne 0 ]; then exit 1; fi; \ $$f; \ @@ -63,7 +65,7 @@ test: pa_bitmatch.cmo bitmatch.cma print-tests: pa_bitmatch.cmo @for f in $(TESTS); do \ echo Test: $$f.ml; \ - cmd="camlp4o pa_bitmatch.cmo -printer pr_o.cmo $$f.ml"; \ + cmd="camlp4o bitmatch.cma pa_bitmatch.cmo -printer pr_o.cmo $$f.ml"; \ echo $$cmd; \ $$cmd; \ done @@ -71,7 +73,7 @@ print-tests: pa_bitmatch.cmo print-examples: pa_bitmatch.cmo @for f in $(EXAMPLES); do \ echo Example: $$f; \ - camlp4o pa_bitmatch.cmo -printer pr_o.cmo $$f; \ + camlp4o bitmatch.cma pa_bitmatch.cmo -printer pr_o.cmo $$f; \ if [ $$? -ne 0 ]; then exit 1; fi; \ done diff --git a/bitmatch.ml b/bitmatch.ml index 39d7743..f16d490 100644 --- a/bitmatch.ml +++ b/bitmatch.ml @@ -20,6 +20,9 @@ open Printf +include Bitmatch_types +include Bitmatch_config + (* Enable runtime debug messages. Must also have been enabled * in pa_bitmatch.ml. *) @@ -408,6 +411,11 @@ let extract_int_le_unsigned data off len flen = let v = I.byteswap v flen in v, off, len +let extract_int_ne_unsigned = + if nativeendian = BigEndian + then extract_int_be_unsigned + else extract_int_le_unsigned + let _make_int32_be c0 c1 c2 c3 = Int32.logor (Int32.logor @@ -463,6 +471,11 @@ let extract_int32_le_unsigned data off len flen = let v = I32.byteswap v flen in v, off, len +let extract_int32_ne_unsigned = + if nativeendian = BigEndian + then extract_int32_be_unsigned + else extract_int32_le_unsigned + let _make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 = Int64.logor (Int64.logor @@ -570,6 +583,11 @@ let extract_int64_le_unsigned data off len flen = ) in word, off+flen, len-flen +let extract_int64_ne_unsigned = + if nativeendian = BigEndian + then extract_int64_be_unsigned + else extract_int64_le_unsigned + (*----------------------------------------------------------------------*) (* Constructor functions. *) @@ -689,6 +707,12 @@ let construct_int_be_unsigned buf v flen exn = (* Add the bytes. *) I.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen +let construct_int_ne_unsigned = + if nativeendian = BigEndian + then construct_int_be_unsigned + else (*construct_int_le_unsigned*) + fun _ _ _ _ -> failwith "construct_int_le_unsigned" + (* Construct a field of exactly 32 bits. *) let construct_int32_be_unsigned buf v flen _ = Buffer.add_byte buf @@ -700,6 +724,12 @@ let construct_int32_be_unsigned buf v flen _ = Buffer.add_byte buf (Int32.to_int (Int32.logand v 0xff_l)) +let construct_int32_ne_unsigned = + if nativeendian = BigEndian + then construct_int32_be_unsigned + else (*construct_int32_le_unsigned*) + fun _ _ _ _ -> failwith "construct_int32_le_unsigned" + (* Construct a field of up to 64 bits. *) let construct_int64_be_unsigned buf v flen exn = (* Check value is within range. *) @@ -707,6 +737,12 @@ let construct_int64_be_unsigned buf v flen exn = (* Add the bytes. *) I64.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen +let construct_int64_ne_unsigned = + if nativeendian = BigEndian + then construct_int64_be_unsigned + else (*construct_int64_le_unsigned*) + fun _ _ _ _ -> failwith "construct_int64_le_unsigned" + (* Construct from a string of bytes, exact multiple of 8 bits * in length of course. *) diff --git a/bitmatch.mli b/bitmatch.mli index 90f6acc..979e591 100644 --- a/bitmatch.mli +++ b/bitmatch.mli @@ -526,6 +526,11 @@ Bitmatch.hexdump_bitstring stdout bits ;; {3 Types} *) +type endian = BigEndian | LittleEndian | NativeEndian + +val string_of_endian : endian -> string +(** Endianness. *) + type bitstring = string * int * int (** [bitstring] is the basic type used to store bitstrings. @@ -654,6 +659,12 @@ end (** {3 Miscellaneous} *) +val package : string +(** The package name, always ["ocaml-bitmatch"] *) + +val version : string +(** The package version as a string. *) + val debug : bool ref (** Set this variable to true to enable extended debugging. This only works if debugging was also enabled in the @@ -678,22 +689,34 @@ val extract_int_be_unsigned : string -> int -> int -> int -> int * int * int val extract_int_le_unsigned : string -> int -> int -> int -> int * int * int +val extract_int_ne_unsigned : string -> int -> int -> int -> int * int * int + val extract_int32_be_unsigned : string -> int -> int -> int -> int32 * int * int val extract_int32_le_unsigned : string -> int -> int -> int -> int32 * int * int +val extract_int32_ne_unsigned : string -> int -> int -> int -> int32 * int * int + val extract_int64_be_unsigned : string -> int -> int -> int -> int64 * int * int val extract_int64_le_unsigned : string -> int -> int -> int -> int64 * int * int +val extract_int64_ne_unsigned : string -> int -> int -> int -> int64 * int * int + val construct_bit : Buffer.t -> bool -> int -> exn -> unit val construct_char_unsigned : Buffer.t -> int -> int -> exn -> unit val construct_int_be_unsigned : Buffer.t -> int -> int -> exn -> unit +val construct_int_ne_unsigned : Buffer.t -> int -> int -> exn -> unit + val construct_int32_be_unsigned : Buffer.t -> int32 -> int -> exn -> unit +val construct_int32_ne_unsigned : Buffer.t -> int32 -> int -> exn -> unit + val construct_int64_be_unsigned : Buffer.t -> int64 -> int -> exn -> unit +val construct_int64_ne_unsigned : Buffer.t -> int64 -> int -> exn -> unit + val construct_string : Buffer.t -> string -> unit diff --git a/bitmatch_config.ml.in b/bitmatch_config.ml.in new file mode 100644 index 0000000..9645f0d --- /dev/null +++ b/bitmatch_config.ml.in @@ -0,0 +1,30 @@ +(* Bitmatch library. + * Copyright (C) 2008 Red Hat Inc., Richard W.M. Jones + * + * @configure_input@ + * + * 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 + * + * $Id: bitmatch.ml,v 1.14 2008-05-12 20:32:55 rjones Exp $ + *) + +(* This file contains general configuration settings, set by the + * configure script. + *) + +let nativeendian = Bitmatch_types.@NATIVEENDIAN@ + +let package = "@PACKAGE_NAME@" +let version = "@PACKAGE_VERSION@" diff --git a/bitmatch_types.ml b/bitmatch_types.ml new file mode 100644 index 0000000..74f4a90 --- /dev/null +++ b/bitmatch_types.ml @@ -0,0 +1,26 @@ +(* Bitmatch library. + * 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 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 + * + * $Id: bitmatch.ml,v 1.14 2008-05-12 20:32:55 rjones Exp $ + *) + +type endian = BigEndian | LittleEndian | NativeEndian + +let string_of_endian = function + | BigEndian -> "bigendian" + | LittleEndian -> "littleendian" + | NativeEndian -> "nativeendian" diff --git a/configure.ac b/configure.ac index 4829833..91d9c3a 100644 --- a/configure.ac +++ b/configure.ac @@ -29,6 +29,14 @@ test "x$U" != "x" && AC_MSG_ERROR(Compiler not ANSI compliant) AC_PROG_CC_C_O +dnl Check for endianness. +AC_C_BIGENDIAN( + [NATIVEENDIAN=BigEndian], + [NATIVEENDIAN=LittleEndian], + [AC_MSG_ERROR([Machine endianness could not be determined])] +) +AC_SUBST(NATIVEENDIAN) + dnl Check for basic OCaml environment & findlib. AC_PROG_OCAML AC_PROG_FINDLIB @@ -45,5 +53,5 @@ fi dnl Produce output files. AC_CONFIG_HEADERS([config.h]) -AC_CONFIG_FILES([Makefile META]) +AC_CONFIG_FILES([Makefile META bitmatch_config.ml]) AC_OUTPUT diff --git a/pa_bitmatch.ml b/pa_bitmatch.ml index 9a25da8..f769582 100644 --- a/pa_bitmatch.ml +++ b/pa_bitmatch.ml @@ -74,13 +74,12 @@ let rec expr_is_constant = function type 'a field = { field : 'a; (* field ('a is either patt or expr) *) flen : expr; (* length in bits, may be non-const *) - endian : endian; (* endianness *) + endian : Bitmatch.endian; (* endianness *) signed : bool; (* true if signed, false if unsigned *) t : t; (* type *) _loc : Loc.t; (* location in source code *) printer : 'a -> string; (* turn the field into a string *) } -and endian = BigEndian | LittleEndian | NativeEndian and t = Int | String | Bitstring (* Generate a fresh, unique symbol each time called. *) @@ -103,21 +102,21 @@ let parse_field _loc field flen qs printer = if endian <> None then Loc.raise _loc (Failure "an endian flag has been set already") else ( - let endian = Some BigEndian in + let endian = Some Bitmatch.BigEndian in (endian, signed, t) ) | "littleendian" -> if endian <> None then Loc.raise _loc (Failure "an endian flag has been set already") else ( - let endian = Some LittleEndian in + let endian = Some Bitmatch.LittleEndian in (endian, signed, t) ) | "nativeendian" -> if endian <> None then Loc.raise _loc (Failure "an endian flag has been set already") else ( - let endian = Some NativeEndian in + let endian = Some Bitmatch.NativeEndian in (endian, signed, t) ) | "signed" -> @@ -169,7 +168,7 @@ let parse_field _loc field flen qs printer = ); (* Default endianness, signedness, type. *) - let endian = match endian with None -> BigEndian | Some e -> e in + let endian = match endian with None -> Bitmatch.BigEndian | Some e -> e in let signed = match signed with None -> false | Some s -> s in let t = match t with None -> Int | Some t -> t in @@ -183,11 +182,6 @@ let parse_field _loc field flen qs printer = printer = printer; } -let string_of_endian = function - | BigEndian -> "bigendian" - | LittleEndian -> "littleendian" - | NativeEndian -> "nativeendian" - let string_of_t = function | Int -> "int" | String -> "string" @@ -209,7 +203,7 @@ let string_of_field { field = field; flen = flen; match expr_is_constant flen with | Some i -> string_of_int i | None -> "[non-const-len]" in - let endian = string_of_endian endian in + let endian = Bitmatch.string_of_endian endian in let signed = if signed then "signed" else "unsigned" in let t = string_of_t t in let loc_fname = Loc.file_name _loc in @@ -257,36 +251,42 @@ let output_constructor _loc fields = | (1, _, _) -> "construct_bit" | ((2|3|4|5|6|7|8), _, false) -> "construct_char_unsigned" | ((2|3|4|5|6|7|8), _, true) -> "construct_char_signed" - | (i, BigEndian, false) when i <= 31 -> "construct_int_be_unsigned" - | (i, BigEndian, true) when i <= 31 -> "construct_int_be_signed" - | (i, LittleEndian, false) when i <= 31 -> "construct_int_le_unsigned" - | (i, LittleEndian, true) when i <= 31 -> "construct_int_le_signed" - | (i, NativeEndian, false) when i <= 31 -> "construct_int_ne_unsigned" - | (i, NativeEndian, true) when i <= 31 -> "construct_int_ne_signed" - | (32, BigEndian, false) -> "construct_int32_be_unsigned" - | (32, BigEndian, true) -> "construct_int32_be_signed" - | (32, LittleEndian, false) -> "construct_int32_le_unsigned" - | (32, LittleEndian, true) -> "construct_int32_le_signed" - | (32, NativeEndian, false) -> "construct_int32_ne_unsigned" - | (32, NativeEndian, true) -> "construct_int32_ne_signed" - | (_, BigEndian, false) -> "construct_int64_be_unsigned" - | (_, BigEndian, true) -> "construct_int64_be_signed" - | (_, LittleEndian, false) -> "construct_int64_le_unsigned" - | (_, LittleEndian, true) -> "construct_int64_le_signed" - | (_, NativeEndian, false) -> "construct_int64_ne_unsigned" - | (_, NativeEndian, true) -> "construct_int64_ne_signed" + | (i, Bitmatch.BigEndian, false) when i <= 31 -> + "construct_int_be_unsigned" + | (i, Bitmatch.BigEndian, true) when i <= 31 -> + "construct_int_be_signed" + | (i, Bitmatch.LittleEndian, false) when i <= 31 -> + "construct_int_le_unsigned" + | (i, Bitmatch.LittleEndian, true) when i <= 31 -> + "construct_int_le_signed" + | (i, Bitmatch.NativeEndian, false) when i <= 31 -> + "construct_int_ne_unsigned" + | (i, Bitmatch.NativeEndian, true) when i <= 31 -> + "construct_int_ne_signed" + | (32, Bitmatch.BigEndian, false) -> "construct_int32_be_unsigned" + | (32, Bitmatch.BigEndian, true) -> "construct_int32_be_signed" + | (32, Bitmatch.LittleEndian, false) -> "construct_int32_le_unsigned" + | (32, Bitmatch.LittleEndian, true) -> "construct_int32_le_signed" + | (32, Bitmatch.NativeEndian, false) -> "construct_int32_ne_unsigned" + | (32, Bitmatch.NativeEndian, true) -> "construct_int32_ne_signed" + | (_, Bitmatch.BigEndian, false) -> "construct_int64_be_unsigned" + | (_, Bitmatch.BigEndian, true) -> "construct_int64_be_signed" + | (_, Bitmatch.LittleEndian, false) -> "construct_int64_le_unsigned" + | (_, Bitmatch.LittleEndian, true) -> "construct_int64_le_signed" + | (_, Bitmatch.NativeEndian, false) -> "construct_int64_ne_unsigned" + | (_, Bitmatch.NativeEndian, true) -> "construct_int64_ne_signed" in let name_of_int_construct = function (* XXX As an enhancement we should allow users to * specify that a field length can fit into a char/int/int32 * (of course, this would have to be checked at runtime). *) - | (BigEndian, false) -> "construct_int64_be_unsigned" - | (BigEndian, true) -> "construct_int64_be_signed" - | (LittleEndian, false) -> "construct_int64_le_unsigned" - | (LittleEndian, true) -> "construct_int64_le_signed" - | (NativeEndian, false) -> "construct_int64_ne_unsigned" - | (NativeEndian, true) -> "construct_int64_ne_signed" + | (Bitmatch.BigEndian, false) -> "construct_int64_be_unsigned" + | (Bitmatch.BigEndian, true) -> "construct_int64_be_signed" + | (Bitmatch.LittleEndian, false) -> "construct_int64_le_unsigned" + | (Bitmatch.LittleEndian, true) -> "construct_int64_le_signed" + | (Bitmatch.NativeEndian, false) -> "construct_int64_ne_unsigned" + | (Bitmatch.NativeEndian, true) -> "construct_int64_ne_signed" in let expr = @@ -516,36 +516,42 @@ let output_bitmatch _loc bs cases = | (1, _, _) -> "extract_bit" | ((2|3|4|5|6|7|8), _, false) -> "extract_char_unsigned" | ((2|3|4|5|6|7|8), _, true) -> "extract_char_signed" - | (i, BigEndian, false) when i <= 31 -> "extract_int_be_unsigned" - | (i, BigEndian, true) when i <= 31 -> "extract_int_be_signed" - | (i, LittleEndian, false) when i <= 31 -> "extract_int_le_unsigned" - | (i, LittleEndian, true) when i <= 31 -> "extract_int_le_signed" - | (i, NativeEndian, false) when i <= 31 -> "extract_int_ne_unsigned" - | (i, NativeEndian, true) when i <= 31 -> "extract_int_ne_signed" - | (32, BigEndian, false) -> "extract_int32_be_unsigned" - | (32, BigEndian, true) -> "extract_int32_be_signed" - | (32, LittleEndian, false) -> "extract_int32_le_unsigned" - | (32, LittleEndian, true) -> "extract_int32_le_signed" - | (32, NativeEndian, false) -> "extract_int32_ne_unsigned" - | (32, NativeEndian, true) -> "extract_int32_ne_signed" - | (_, BigEndian, false) -> "extract_int64_be_unsigned" - | (_, BigEndian, true) -> "extract_int64_be_signed" - | (_, LittleEndian, false) -> "extract_int64_le_unsigned" - | (_, LittleEndian, true) -> "extract_int64_le_signed" - | (_, NativeEndian, false) -> "extract_int64_ne_unsigned" - | (_, NativeEndian, true) -> "extract_int64_ne_signed" + | (i, Bitmatch.BigEndian, false) when i <= 31 -> + "extract_int_be_unsigned" + | (i, Bitmatch.BigEndian, true) when i <= 31 -> + "extract_int_be_signed" + | (i, Bitmatch.LittleEndian, false) when i <= 31 -> + "extract_int_le_unsigned" + | (i, Bitmatch.LittleEndian, true) when i <= 31 -> + "extract_int_le_signed" + | (i, Bitmatch.NativeEndian, false) when i <= 31 -> + "extract_int_ne_unsigned" + | (i, Bitmatch.NativeEndian, true) when i <= 31 -> + "extract_int_ne_signed" + | (32, Bitmatch.BigEndian, false) -> "extract_int32_be_unsigned" + | (32, Bitmatch.BigEndian, true) -> "extract_int32_be_signed" + | (32, Bitmatch.LittleEndian, false) -> "extract_int32_le_unsigned" + | (32, Bitmatch.LittleEndian, true) -> "extract_int32_le_signed" + | (32, Bitmatch.NativeEndian, false) -> "extract_int32_ne_unsigned" + | (32, Bitmatch.NativeEndian, true) -> "extract_int32_ne_signed" + | (_, Bitmatch.BigEndian, false) -> "extract_int64_be_unsigned" + | (_, Bitmatch.BigEndian, true) -> "extract_int64_be_signed" + | (_, Bitmatch.LittleEndian, false) -> "extract_int64_le_unsigned" + | (_, Bitmatch.LittleEndian, true) -> "extract_int64_le_signed" + | (_, Bitmatch.NativeEndian, false) -> "extract_int64_ne_unsigned" + | (_, Bitmatch.NativeEndian, true) -> "extract_int64_ne_signed" in let name_of_int_extract = function (* XXX As an enhancement we should allow users to * specify that a field length can fit into a char/int/int32 * (of course, this would have to be checked at runtime). *) - | (BigEndian, false) -> "extract_int64_be_unsigned" - | (BigEndian, true) -> "extract_int64_be_signed" - | (LittleEndian, false) -> "extract_int64_le_unsigned" - | (LittleEndian, true) -> "extract_int64_le_signed" - | (NativeEndian, false) -> "extract_int64_ne_unsigned" - | (NativeEndian, true) -> "extract_int64_ne_signed" + | (Bitmatch.BigEndian, false) -> "extract_int64_be_unsigned" + | (Bitmatch.BigEndian, true) -> "extract_int64_be_signed" + | (Bitmatch.LittleEndian, false) -> "extract_int64_le_unsigned" + | (Bitmatch.LittleEndian, true) -> "extract_int64_le_signed" + | (Bitmatch.NativeEndian, false) -> "extract_int64_ne_unsigned" + | (Bitmatch.NativeEndian, true) -> "extract_int64_ne_signed" in let expr = -- 1.8.3.1