From 63bf7692c8cd8a1a6960cb24f3cdac24c61d5cf1 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 27 Aug 2008 11:26:45 +0000 Subject: [PATCH] Added: - Bitstring.compare, Bitstring.equals - Bitstring.t as a synonym for Bitstring.bitstring type - get and set functions for mutating individual bits (rarely used) - Bitstring.concat --- bitstring.ml | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- bitstring.mli | 58 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 134 insertions(+), 1 deletion(-) diff --git a/bitstring.ml b/bitstring.ml index 7ed7a58..156dec1 100644 --- a/bitstring.ml +++ b/bitstring.ml @@ -38,6 +38,8 @@ exception Construct_failure of string * string * int * int *) type bitstring = string * int * int +type t = bitstring + (* Functions to create and load bitstrings. *) let empty_bitstring = "", 0, 0 @@ -1009,9 +1011,14 @@ let construct_bitstring buf (data, off, len) = Buffer.add_bits buf data len +(* Concatenate bitstrings. *) +let concat bs = + let buf = Buffer.create () in + List.iter (construct_bitstring buf) bs; + Buffer.contents buf + (*----------------------------------------------------------------------*) (* Extract a string from a bitstring. *) - let string_of_bitstring (data, off, len) = if off land 7 = 0 && len land 7 = 0 then (* Easy case: everything is byte-aligned. *) @@ -1060,6 +1067,74 @@ let bitstring_to_file bits filename = raise exn (*----------------------------------------------------------------------*) +(* Comparison. *) +let compare ((data1, off1, len1) as bs1) ((data2, off2, len2) as bs2) = + (* In the fully-aligned case, this is reduced to string comparison ... *) + if off1 land 7 = 0 && len1 land 7 = 0 && off2 land 7 = 0 && len2 land 7 = 0 + then ( + (* ... but we have to do that by hand because the bits may + * not extend to the full length of the underlying string. + *) + let off1 = off1 lsr 3 and off2 = off2 lsr 3 + and len1 = len1 lsr 3 and len2 = len2 lsr 3 in + let rec loop i = + if i < len1 && i < len2 then ( + let c1 = String.unsafe_get data1 (off1 + i) + and c2 = String.unsafe_get data2 (off2 + i) in + let r = compare c1 c2 in + if r <> 0 then r + else loop (i+1) + ) + else len1 - len2 + in + loop 0 + ) + else ( + (* Slow/unaligned. *) + let str1 = string_of_bitstring bs1 + and str2 = string_of_bitstring bs2 in + let r = String.compare str1 str2 in + if r <> 0 then r else len1 - len2 + ) + +let equals ((_, _, len1) as bs1) ((_, _, len2) as bs2) = + if len1 <> len2 then false + else if bs1 = bs2 then true + else 0 = compare bs1 bs2 + +(*----------------------------------------------------------------------*) +(* Bit get/set functions. *) + +let index_out_of_bounds () = invalid_arg "index out of bounds" + +let put (data, off, len) n v = + if n < 0 || off+n >= len then index_out_of_bounds () + else ( + let i = off+n in + let si = i lsr 3 and mask = 0x80 lsr (i land 7) in + let c = Char.code data.[si] in + let c = if v <> 0 then c lor mask else c land (lnot mask) in + data.[si] <- Char.unsafe_chr c + ) + +let set bits n = put bits n 1 + +let clear bits n = put bits n 0 + +let get (data, off, len) n = + if n < 0 || off+n >= len then index_out_of_bounds () + else ( + let i = off+n in + let si = i lsr 3 and mask = 0x80 lsr (i land 7) in + let c = Char.code data.[si] in + c land mask + ) + +let is_set bits n = get bits n <> 0 + +let is_clear bits n = get bits n = 0 + +(*----------------------------------------------------------------------*) (* Display functions. *) let isprint c = diff --git a/bitstring.mli b/bitstring.mli index 1e271f5..a29cb03 100644 --- a/bitstring.mli +++ b/bitstring.mli @@ -667,6 +667,12 @@ type bitstring = string * int * int {!hexdump_bitstring}, {!bitstring_length}. *) +type t = bitstring +(** [t] is a synonym for the {!bitstring} type. + + This allows you to use this module with functors like + [Set] and [Map] from the stdlib. *) + (** {3 Exceptions} *) exception Construct_failure of string * string * int * int @@ -683,6 +689,24 @@ exception Construct_failure of string * string * int * int location of the [BITSTRING] constructor that failed. *) +(** {3 Bitstring comparison} *) + +val compare : bitstring -> bitstring -> int +(** [compare bs1 bs2] compares two bitstrings and returns zero + if they are equal, a negative number if [bs1 < bs2], or a + positive number if [bs1 > bs2]. + + This tests "semantic equality" which is not affected by + the offset or alignment of the underlying representation + (see {!bitstring}). + + The ordering is total and lexicographic. *) + +val equals : bitstring -> bitstring -> bool +(** [equals] returns true if and only if the two bitstrings are + semantically equal. It is the same as calling [compare] and + testing if the result is [0], but usually more efficient. *) + (** {3 Bitstring manipulation} *) val bitstring_length : bitstring -> int @@ -722,6 +746,10 @@ val takebits : int -> bitstring -> bitstring Note that this function just changes the offset and length fields of the {!bitstring} tuple, so is very efficient. *) +val concat : bitstring list -> bitstring +(** Concatenate a list of bitstrings together into a single + bitstring. *) + (** {3 Constructing bitstrings} *) val empty_bitstring : bitstring @@ -850,6 +878,36 @@ end may also be useful for end users. They work much like the standard library [Buffer] module. *) +(** {3 Get/set bits} + + These functions let you manipulate individual bits in the + bitstring. However they are not particularly efficient and you + should generally use the [bitmatch] and [BITSTRING] operators when + building and parsing bitstrings. + + These functions all raise [Invalid_argument "index out of bounds"] + if the index is out of range of the bitstring. +*) + +val set : bitstring -> int -> unit + (** [set bits n] sets the [n]th bit in the bitstring to 1. *) + +val clear : bitstring -> int -> unit + (** [clear bits n] sets the [n]th bit in the bitstring to 0. *) + +val is_set : bitstring -> int -> bool + (** [is_set bits n] is true if the [n]th bit is set to 1. *) + +val is_clear : bitstring -> int -> bool + (** [is_clear bits n] is true if the [n]th bit is set to 0. *) + +val put : bitstring -> int -> int -> unit + (** [put bits n v] sets the [n]th bit in the bitstring to 1 + if [v] is not zero, or to 0 if [v] is zero. *) + +val get : bitstring -> int -> int + (** [get bits n] returns the [n]th bit (returns non-zero or 0). *) + (** {3 Miscellaneous} *) val package : string -- 1.8.3.1