From 80fd187cbf946133e98ca32d351c33132ce3ea47 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 27 Aug 2008 11:28:42 +0000 Subject: [PATCH] Update coverage report. --- coverage-report/file0000.html | 10 +- coverage-report/file0001.html | 2079 +++++++++++++++++++++-------------------- coverage-report/file0002.html | 2 +- coverage-report/file0003.html | 2 +- coverage-report/index.html | 20 +- 5 files changed, 1094 insertions(+), 1019 deletions(-) diff --git a/coverage-report/file0000.html b/coverage-report/file0000.html index 80eba44..5eccb4d 100644 --- a/coverage-report/file0000.html +++ b/coverage-report/file0000.html @@ -52,13 +52,13 @@
000025|  * configure script.
000026|  *)
000027|  
-
000028| let nativeendian = (*[28]*)Bitstring_types.LittleEndian
+
000028| let nativeendian = (*[34]*)Bitstring_types.LittleEndian
000029|  
-
000030| let package = (*[28]*)"ocaml-bitstring"
-
000031| let version = (*[28]*)"1.9.7"
-
000032| let ocamllibdir = (*[28]*)"/usr/lib/ocaml"
+
000030| let package = (*[34]*)"ocaml-bitstring"
+
000031| let version = (*[34]*)"1.9.8"
+
000032| let ocamllibdir = (*[34]*)"/usr/lib/ocaml"
-

Generated by Bisect on 2008-08-26 10:36:20

+

Generated by Bisect on 2008-08-26 17:29:02

diff --git a/coverage-report/file0001.html b/coverage-report/file0001.html index 1f54bc0..2109a22 100644 --- a/coverage-report/file0001.html +++ b/coverage-report/file0001.html @@ -9,13 +9,13 @@

Statistics:

- - + + - - - - + + + + @@ -43,7 +43,7 @@
000016|  * License along with this library; if not, write to the Free Software
000017|  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
000018|  *
-
000019|  * $Id: bitstring.ml 153 2008-08-26 08:24:31Z richard.wm.jones $
+
000019|  * $Id: bitstring.ml 156 2008-08-26 09:42:05Z richard.wm.jones $
000020|  *)
000021|  
000022| open Printf
@@ -54,7 +54,7 @@
000027| (* Enable runtime debug messages.  Must also have been enabled
000028|  * in pa_bitstring.ml.
000029|  *)
-
000030| let debug = (*[28]*)ref false
+
000030| let debug = (*[34]*)ref false
000031|  
000032| (* Exceptions. *)
000033| exception Construct_failure of string * string * int * int
@@ -65,1072 +65,1147 @@
000038|  *)
000039| type bitstring = string * int * int
000040|  
-
000041| (* Functions to create and load bitstrings. *)
-
000042| let empty_bitstring = (*[28]*)"", 0, 0
-
000043|  
-
000044| let make_bitstring len c =
-
000045|   (*[1197538]*)if len >= 0 then (*[1197538]*)String.make ((len+7) lsr 3) c, 0, len
-
000046|   else
-
000047|     (*[0]*)invalid_arg (
-
000048|       sprintf "make_bitstring/create_bitstring: len %d < 0" len
-
000049|     )
-
000050|  
-
000051| let create_bitstring len = (*[1]*)make_bitstring len '\000'
+
000041| type t = bitstring
+
000042|  
+
000043| (* Functions to create and load bitstrings. *)
+
000044| let empty_bitstring = (*[34]*)"", 0, 0
+
000045|  
+
000046| let make_bitstring len c =
+
000047|   (*[1325857]*)if len >= 0 then (*[1325857]*)String.make ((len+7) lsr 3) c, 0, len
+
000048|   else
+
000049|     (*[0]*)invalid_arg (
+
000050|       sprintf "make_bitstring/create_bitstring: len %d < 0" len
+
000051|     )
000052|  
-
000053| let zeroes_bitstring = (*[28]*)create_bitstring
+
000053| let create_bitstring len = (*[42773]*)make_bitstring len '\000'
000054|  
-
000055| let ones_bitstring len = (*[1197537]*)make_bitstring len '\xff'
+
000055| let zeroes_bitstring = (*[34]*)create_bitstring
000056|  
-
000057| let bitstring_of_string str = (*[2]*)str, 0, String.length str lsl 3
+
000057| let ones_bitstring len = (*[1278457]*)make_bitstring len '\xff'
000058|  
-
000059| let bitstring_of_chan chan =
-
000060|   (*[0]*)let tmpsize = 16384 in
-
000061|   (*[0]*)let buf = Buffer.create tmpsize in
-
000062|   (*[0]*)let tmp = String.create tmpsize in
-
000063|   (*[0]*)let n = ref 0 in
-
000064|   (*[0]*)while (*[0]*)n := input chan tmp 0 tmpsize; !(*[0]*)n > 0 do
-
000065|     (*[0]*)Buffer.add_substring buf tmp 0 !n;
-
000066|   done;
-
000067|   (*[0]*)Buffer.contents buf, 0, Buffer.length buf lsl 3
-
000068|  
-
000069| let bitstring_of_chan_max chan max =
-
000070|   (*[0]*)let tmpsize = 16384 in
-
000071|   (*[0]*)let buf = Buffer.create tmpsize in
-
000072|   (*[0]*)let tmp = String.create tmpsize in
-
000073|   (*[0]*)let len = ref 0 in
-
000074|   (*[0]*)let rec loop () =
-
000075|     (*[0]*)if !len < max then (
-
000076|       (*[0]*)let r = min tmpsize (max - !len) in
-
000077|       (*[0]*)let n = input chan tmp 0 r in
-
000078|       (*[0]*)if n > 0 then (
-
000079|         (*[0]*)Buffer.add_substring buf tmp 0 n;
-
000080|         (*[0]*)len (*[0]*):= !len + n;
-
000081|         (*[0]*)loop ()
-
000082|       )
-
000083|     )
-
000084|   in
-
000085|   (*[0]*)loop (*[0]*)();
-
000086|   (*[0]*)Buffer.contents buf, 0, !len lsl 3
-
000087|  
-
000088| let bitstring_of_file_descr fd =
-
000089|   (*[0]*)let tmpsize = 16384 in
-
000090|   (*[0]*)let buf = Buffer.create tmpsize in
-
000091|   (*[0]*)let tmp = String.create tmpsize in
-
000092|   (*[0]*)let n = ref 0 in
-
000093|   (*[0]*)while (*[0]*)n := Unix.read fd tmp 0 tmpsize; !(*[0]*)n > 0 do
-
000094|     (*[0]*)Buffer.add_substring buf tmp 0 !n;
-
000095|   done;
-
000096|   (*[0]*)Buffer.contents buf, 0, Buffer.length buf lsl 3
-
000097|  
-
000098| let bitstring_of_file_descr_max fd max =
-
000099|   (*[0]*)let tmpsize = 16384 in
-
000100|   (*[0]*)let buf = Buffer.create tmpsize in
-
000101|   (*[0]*)let tmp = String.create tmpsize in
-
000102|   (*[0]*)let len = ref 0 in
-
000103|   (*[0]*)let rec loop () =
-
000104|     (*[0]*)if !len < max then (
-
000105|       (*[0]*)let r = min tmpsize (max - !len) in
-
000106|       (*[0]*)let n = Unix.read fd tmp 0 r in
-
000107|       (*[0]*)if n > 0 then (
-
000108|         (*[0]*)Buffer.add_substring buf tmp 0 n;
-
000109|         (*[0]*)len (*[0]*):= !len + n;
-
000110|         (*[0]*)loop ()
-
000111|       )
-
000112|     )
-
000113|   in
-
000114|   (*[0]*)loop (*[0]*)();
-
000115|   (*[0]*)Buffer.contents buf, 0, !len lsl 3
-
000116|  
-
000117| let bitstring_of_file fname =
-
000118|   (*[0]*)let chan = open_in_bin fname in
-
000119|   (*[0]*)try
-
000120|     (*[0]*)let bs = bitstring_of_chan chan in
-
000121|     (*[0]*)close_in (*[0]*)chan;
-
000122|     (*[0]*)bs
-
000123|   with exn ->
-
000124|     (*[0]*)close_in (*[0]*)chan;
-
000125|     (*[0]*)raise exn
-
000126|  
-
000127| let bitstring_length (_, _, len) = (*[1523677]*)len
+
000059| let bitstring_of_string str = (*[2]*)str, 0, String.length str lsl 3
+
000060|  
+
000061| let bitstring_of_chan chan =
+
000062|   (*[2]*)let tmpsize = 16384 in
+
000063|   (*[2]*)let buf = Buffer.create tmpsize in
+
000064|   (*[2]*)let tmp = String.create tmpsize in
+
000065|   (*[2]*)let n = ref 0 in
+
000066|   (*[2]*)while (*[4]*)n := input chan tmp 0 tmpsize; !(*[4]*)n > 0 do
+
000067|     (*[2]*)Buffer.add_substring buf tmp 0 !n;
+
000068|   done;
+
000069|   (*[2]*)Buffer.contents buf, 0, Buffer.length buf lsl 3
+
000070|  
+
000071| let bitstring_of_chan_max chan max =
+
000072|   (*[2]*)let tmpsize = 16384 in
+
000073|   (*[2]*)let buf = Buffer.create tmpsize in
+
000074|   (*[2]*)let tmp = String.create tmpsize in
+
000075|   (*[2]*)let len = ref 0 in
+
000076|   (*[2]*)let rec loop () =
+
000077|     (*[2]*)if !len < max then (
+
000078|       (*[2]*)let r = min tmpsize (max - !len) in
+
000079|       (*[2]*)let n = input chan tmp 0 r in
+
000080|       (*[0]*)if n > 0 then (
+
000081|         (*[2]*)Buffer.add_substring buf tmp 0 n;
+
000082|         (*[2]*)len (*[2]*):= !len + n;
+
000083|         (*[2]*)loop ()
+
000084|       )
+
000085|     )
+
000086|   in
+
000087|   (*[2]*)loop (*[2]*)();
+
000088|   (*[2]*)Buffer.contents buf, 0, !len lsl 3
+
000089|  
+
000090| let bitstring_of_file_descr fd =
+
000091|   (*[1]*)let tmpsize = 16384 in
+
000092|   (*[1]*)let buf = Buffer.create tmpsize in
+
000093|   (*[1]*)let tmp = String.create tmpsize in
+
000094|   (*[1]*)let n = ref 0 in
+
000095|   (*[1]*)while (*[2]*)n := Unix.read fd tmp 0 tmpsize; !(*[2]*)n > 0 do
+
000096|     (*[1]*)Buffer.add_substring buf tmp 0 !n;
+
000097|   done;
+
000098|   (*[1]*)Buffer.contents buf, 0, Buffer.length buf lsl 3
+
000099|  
+
000100| let bitstring_of_file_descr_max fd max =
+
000101|   (*[2]*)let tmpsize = 16384 in
+
000102|   (*[2]*)let buf = Buffer.create tmpsize in
+
000103|   (*[2]*)let tmp = String.create tmpsize in
+
000104|   (*[2]*)let len = ref 0 in
+
000105|   (*[2]*)let rec loop () =
+
000106|     (*[2]*)if !len < max then (
+
000107|       (*[2]*)let r = min tmpsize (max - !len) in
+
000108|       (*[2]*)let n = Unix.read fd tmp 0 r in
+
000109|       (*[0]*)if n > 0 then (
+
000110|         (*[2]*)Buffer.add_substring buf tmp 0 n;
+
000111|         (*[2]*)len (*[2]*):= !len + n;
+
000112|         (*[2]*)loop ()
+
000113|       )
+
000114|     )
+
000115|   in
+
000116|   (*[2]*)loop (*[2]*)();
+
000117|   (*[2]*)Buffer.contents buf, 0, !len lsl 3
+
000118|  
+
000119| let bitstring_of_file fname =
+
000120|   (*[1]*)let chan = open_in_bin fname in
+
000121|   (*[1]*)try
+
000122|     (*[1]*)let bs = bitstring_of_chan chan in
+
000123|     (*[1]*)close_in (*[1]*)chan;
+
000124|     (*[1]*)bs
+
000125|   with exn ->
+
000126|     (*[0]*)close_in (*[0]*)chan;
+
000127|     (*[0]*)raise exn
000128|  
-
000129| let subbitstring (data, off, len) off' len' =
-
000130|   (*[0]*)let off = off + off' in
-
000131|   (*[0]*)if len < off' + len' then (*[0]*)invalid_arg "subbitstring";
-
000132|   ((*[0]*)data, off, len')
-
000133|  
-
000134| let dropbits n (data, off, len) =
-
000135|   (*[335487]*)let off = off + n in
-
000136|   (*[335487]*)let len = len - n in
-
000137|   (*[335487]*)if len < 0 then (*[0]*)invalid_arg "dropbits";
-
000138|   ((*[335487]*)data, off, len)
-
000139|  
-
000140| let takebits n (data, off, len) =
-
000141|   (*[0]*)if len < n then (*[0]*)invalid_arg "takebits";
-
000142|   ((*[0]*)data, off, n)
-
000143|  
-
000144| (*----------------------------------------------------------------------*)
-
000145| (* Bitwise functions.
-
000146|  *
-
000147|  * We try to isolate all bitwise functions within these modules.
-
000148|  *)
-
000149|  
-
000150| module I = struct
-
000151|   (* Bitwise operations on ints.  Note that we assume int <= 31 bits. *)
-
000152|   external (<<<) : int -> int -> int = "%lslint"
-
000153|   external (>>>) : int -> int -> int = "%lsrint"
-
000154|   external to_int : int -> int = "%identity"
-
000155|   let zero = (*[28]*)0
-
000156|   let one = (*[28]*)1
-
000157|   let minus_one = (*[28]*)-1
-
000158|   let ff = (*[28]*)0xff
-
000159|  
-
000160|   (* Create a mask 0-31 bits wide. *)
-
000161|   let mask bits =
-
000162|     (*[2]*)if bits < 30 then
-
000163|       ((*[2]*)one <<< bits) - 1
-
000164|     else (*[0]*)if bits = 30 then
-
000165|       (*[0]*)max_int
-
000166|     else (*[0]*)if bits = 31 then
-
000167|       (*[0]*)minus_one
-
000168|     else
-
000169|       (*[0]*)invalid_arg "Bitstring.I.mask"
-
000170|  
-
000171|   (* Byte swap an int of a given size. *)
-
000172|   let byteswap v bits =
-
000173|     (*[0]*)if bits <= 8 then (*[0]*)v
-
000174|     else (*[0]*)if bits <= 16 then (
-
000175|       (*[0]*)let shift = bits-8 in
-
000176|       (*[0]*)let v1 = v >>> shift in
-
000177|       (*[0]*)let v2 = ((v land (mask shift)) <<< 8) in
-
000178|       v2 (*[0]*)lor v1
-
000179|     ) else (*[0]*)if bits <= 24 then (
-
000180|       (*[0]*)let shift = bits - 16 in
-
000181|       (*[0]*)let v1 = v >>> (8+shift) in
-
000182|       (*[0]*)let v2 = ((v >>> shift) land ff) <<< 8 in
-
000183|       (*[0]*)let v3 = (v land (mask shift)) <<< 16 in
-
000184|       v3 lor v2 (*[0]*)lor v1
-
000185|     ) else (
-
000186|       (*[0]*)let shift = bits - 24 in
-
000187|       (*[0]*)let v1 = v >>> (16+shift) in
-
000188|       (*[0]*)let v2 = ((v >>> (8+shift)) land ff) <<< 8 in
-
000189|       (*[0]*)let v3 = ((v >>> shift) land ff) <<< 16 in
-
000190|       (*[0]*)let v4 = (v land (mask shift)) <<< 24 in
-
000191|       v4 lor v3 lor v2 (*[0]*)lor v1
-
000192|     )
-
000193|  
-
000194|   (* Check a value is in range 0 .. 2^bits-1. *)
-
000195|   let range_unsigned v bits =
-
000196|     (*[2]*)let mask = lnot (mask bits) in
-
000197|     (v (*[2]*)land mask) = zero
-
000198|  
-
000199|   (* Call function g on the top bits, then f on each full byte
-
000200|    * (big endian - so start at top).
-
000201|    *)
-
000202|   let rec map_bytes_be g f v bits =
-
000203|     (*[6]*)if bits >= 8 then (
-
000204|       (*[4]*)map_bytes_be g f (v >>> 8) (*[4]*)(bits-8);
-
000205|       (*[4]*)let lsb = v land ff in
-
000206|       (*[4]*)f (to_int lsb)
-
000207|     ) else (*[2]*)if bits > 0 then (
-
000208|       (*[0]*)let lsb = v land (mask bits) in
-
000209|       (*[0]*)g (to_int lsb) bits
-
000210|     )
-
000211|  
-
000212|   (* Call function g on the top bits, then f on each full byte
-
000213|    * (little endian - so start at root).
-
000214|    *)
-
000215|   let rec map_bytes_le g f v bits =
-
000216|     (*[0]*)if bits >= 8 then (
-
000217|       (*[0]*)let lsb = v land ff in
-
000218|       (*[0]*)f (*[0]*)(to_int lsb);
-
000219|       (*[0]*)map_bytes_le g f (v >>> 8) (bits-8)
-
000220|     ) else (*[0]*)if bits > 0 then (
-
000221|       (*[0]*)let lsb = v land (mask bits) in
-
000222|       (*[0]*)g (to_int lsb) bits
-
000223|     )
-
000224| end
-
000225|  
-
000226| module I32 = struct
-
000227|   (* Bitwise operations on int32s.  Note we try to keep it as similar
-
000228|    * as possible to the I module above, to make it easier to track
-
000229|    * down bugs.
-
000230|    *)
-
000231|   let (<<<) = (*[28]*)Int32.shift_left
-
000232|   let (>>>) = (*[28]*)Int32.shift_right_logical
-
000233|   let (land) = (*[28]*)Int32.logand
-
000234|   let (lor) = (*[28]*)Int32.logor
-
000235|   let lnot = (*[28]*)Int32.lognot
-
000236|   let pred = (*[28]*)Int32.pred
-
000237|   let max_int = (*[28]*)Int32.max_int
-
000238|   let to_int = (*[28]*)Int32.to_int
-
000239|   let zero = (*[28]*)Int32.zero
-
000240|   let one = (*[28]*)Int32.one
-
000241|   let minus_one = (*[28]*)Int32.minus_one
-
000242|   let ff = (*[28]*)0xff_l
-
000243|  
-
000244|   (* Create a mask so many bits wide. *)
-
000245|   let mask bits =
-
000246|     (*[12]*)if bits < 31 then
-
000247|       (*[12]*)pred (one <<< bits)
-
000248|     else (*[0]*)if bits = 31 then
-
000249|       (*[0]*)max_int
-
000250|     else (*[0]*)if bits = 32 then
-
000251|       (*[0]*)minus_one
-
000252|     else
-
000253|       (*[0]*)invalid_arg "Bitstring.I32.mask"
-
000254|  
-
000255|   (* Byte swap an int of a given size. *)
-
000256|   let byteswap v bits =
-
000257|     (*[12]*)if bits <= 8 then (*[0]*)v
-
000258|     else (*[12]*)if bits <= 16 then (
-
000259|       (*[0]*)let shift = bits-8 in
-
000260|       (*[0]*)let v1 = v >>> shift in
-
000261|       (*[0]*)let v2 = (v land (mask shift)) <<< 8 in
-
000262|       v2 (*[0]*)lor v1
-
000263|     ) else (*[12]*)if bits <= 24 then (
-
000264|       (*[0]*)let shift = bits - 16 in
-
000265|       (*[0]*)let v1 = v >>> (8+shift) in
-
000266|       (*[0]*)let v2 = ((v >>> shift) land ff) <<< 8 in
-
000267|       (*[0]*)let v3 = (v land (mask shift)) <<< 16 in
-
000268|       v3 lor v2 (*[0]*)lor v1
-
000269|     ) else (
-
000270|       (*[12]*)let shift = bits - 24 in
-
000271|       (*[12]*)let v1 = v >>> (16+shift) in
-
000272|       (*[12]*)let v2 = ((v >>> (8+shift)) land ff) <<< 8 in
-
000273|       (*[12]*)let v3 = ((v >>> shift) land ff) <<< 16 in
-
000274|       (*[12]*)let v4 = (v land (mask shift)) <<< 24 in
-
000275|       v4 lor v3 lor v2 (*[12]*)lor v1
-
000276|     )
-
000277|  
-
000278|   (* Check a value is in range 0 .. 2^bits-1. *)
-
000279|   let range_unsigned v bits =
-
000280|     (*[0]*)let mask = lnot (mask bits) in
-
000281|     (v (*[0]*)land mask) = zero
-
000282|  
-
000283|   (* Call function g on the top bits, then f on each full byte
-
000284|    * (big endian - so start at top).
-
000285|    *)
-
000286|   let rec map_bytes_be g f v bits =
-
000287|     (*[0]*)if bits >= 8 then (
-
000288|       (*[0]*)map_bytes_be g f (v >>> 8) (*[0]*)(bits-8);
-
000289|       (*[0]*)let lsb = v land ff in
-
000290|       (*[0]*)f (to_int lsb)
-
000291|     ) else (*[0]*)if bits > 0 then (
-
000292|       (*[0]*)let lsb = v land (mask bits) in
-
000293|       (*[0]*)g (to_int lsb) bits
-
000294|     )
-
000295|  
-
000296|   (* Call function g on the top bits, then f on each full byte
-
000297|    * (little endian - so start at root).
-
000298|    *)
-
000299|   let rec map_bytes_le g f v bits =
-
000300|     (*[0]*)if bits >= 8 then (
-
000301|       (*[0]*)let lsb = v land ff in
-
000302|       (*[0]*)f (*[0]*)(to_int lsb);
-
000303|       (*[0]*)map_bytes_le g f (v >>> 8) (bits-8)
-
000304|     ) else (*[0]*)if bits > 0 then (
-
000305|       (*[0]*)let lsb = v land (mask bits) in
-
000306|       (*[0]*)g (to_int lsb) bits
-
000307|     )
-
000308| end
-
000309|  
-
000310| module I64 = struct
-
000311|   (* Bitwise operations on int64s.  Note we try to keep it as similar
-
000312|    * as possible to the I/I32 modules above, to make it easier to track
-
000313|    * down bugs.
-
000314|    *)
-
000315|   let (<<<) = (*[28]*)Int64.shift_left
-
000316|   let (>>>) = (*[28]*)Int64.shift_right_logical
-
000317|   let (land) = (*[28]*)Int64.logand
-
000318|   let (lor) = (*[28]*)Int64.logor
-
000319|   let lnot = (*[28]*)Int64.lognot
-
000320|   let pred = (*[28]*)Int64.pred
-
000321|   let max_int = (*[28]*)Int64.max_int
-
000322|   let to_int = (*[28]*)Int64.to_int
-
000323|   let zero = (*[28]*)Int64.zero
-
000324|   let one = (*[28]*)Int64.one
-
000325|   let minus_one = (*[28]*)Int64.minus_one
-
000326|   let ff = (*[28]*)0xff_L
-
000327|  
-
000328|   (* Create a mask so many bits wide. *)
-
000329|   let mask bits =
-
000330|     (*[669050]*)if bits < 63 then
-
000331|       (*[664100]*)pred (one <<< bits)
-
000332|     else (*[4950]*)if bits = 63 then
-
000333|       (*[4950]*)max_int
-
000334|     else (*[0]*)if bits = 64 then
-
000335|       (*[0]*)minus_one
-
000336|     else
-
000337|       (*[0]*)invalid_arg "Bitstring.I64.mask"
-
000338|  
-
000339|   (* Byte swap an int of a given size. *)
-
000340|   (* let byteswap v bits = *)
-
000341|  
-
000342|   (* Check a value is in range 0 .. 2^bits-1. *)
-
000343|   let range_unsigned v bits =
-
000344|     (*[351850]*)let mask = lnot (mask bits) in
-
000345|     (v (*[351850]*)land mask) = zero
-
000346|  
-
000347|   (* Call function g on the top bits, then f on each full byte
-
000348|    * (big endian - so start at top).
-
000349|    *)
-
000350|   let rec map_bytes_be g f v bits =
-
000351|     (*[1460650]*)if bits >= 8 then (
-
000352|       (*[1108800]*)map_bytes_be g f (v >>> 8) (*[1108800]*)(bits-8);
-
000353|       (*[1108800]*)let lsb = v land ff in
-
000354|       (*[1108800]*)f (to_int lsb)
-
000355|     ) else (*[34650]*)if bits > 0 then (
-
000356|       (*[317200]*)let lsb = v land (mask bits) in
-
000357|       (*[317200]*)g (to_int lsb) bits
-
000358|     )
-
000359|  
-
000360|   (* Call function g on the top bits, then f on each full byte
-
000361|    * (little endian - so start at root).
-
000362|    *)
-
000363|   let rec map_bytes_le g f v bits =
-
000364|     (*[0]*)if bits >= 8 then (
-
000365|       (*[0]*)let lsb = v land ff in
-
000366|       (*[0]*)f (*[0]*)(to_int lsb);
-
000367|       (*[0]*)map_bytes_le g f (v >>> 8) (bits-8)
-
000368|     ) else (*[0]*)if bits > 0 then (
-
000369|       (*[0]*)let lsb = v land (mask bits) in
-
000370|       (*[0]*)g (to_int lsb) bits
-
000371|     )
-
000372| end
-
000373|  
-
000374| (*----------------------------------------------------------------------*)
-
000375| (* Extraction functions.
-
000376|  *
-
000377|  * NB: internal functions, called from the generated macros, and
-
000378|  * the parameters should have been checked for sanity already).
-
000379|  *)
-
000380|  
-
000381| (* Extract and convert to numeric.  A single bit is returned as
-
000382|  * a boolean.  There are no endianness or signedness considerations.
-
000383|  *)
-
000384| let extract_bit data off len _ =        (* final param is always 1 *)
-
000385|   (*[2515152]*)let byteoff = off lsr 3 in
-
000386|   (*[2515152]*)let bitmask = 1 lsl (7 - (off land 7)) in
-
000387|   (*[2515152]*)let b = Char.code data.[byteoff] land bitmask <> 0 in
-
000388|   (*[2515152]*)b (*, off+1, len-1*)
-
000389|  
-
000390| (* Returns 8 bit unsigned aligned bytes from the string.
-
000391|  * If the string ends then this returns 0's.
-
000392|  *)
-
000393| let _get_byte data byteoff strlen =
-
000394|   (*[9813846]*)if strlen > byteoff then (*[9247619]*)Char.code data.[byteoff] else (*[566227]*)0
-
000395| let _get_byte32 data byteoff strlen =
-
000396|   (*[72]*)if strlen > byteoff then (*[72]*)Int32.of_int (Char.code data.[byteoff]) else (*[0]*)0l
-
000397| let _get_byte64 data byteoff strlen =
-
000398|   (*[1626200]*)if strlen > byteoff then (*[1517793]*)Int64.of_int (Char.code data.[byteoff]) else (*[108407]*)0L
-
000399|  
-
000400| (* Extract [2..8] bits.  Because the result fits into a single
-
000401|  * byte we don't have to worry about endianness, only signedness.
-
000402|  *)
-
000403| let extract_char_unsigned data off len flen =
-
000404|   (*[5009970]*)let byteoff = off lsr 3 in
-
000405|  
-
000406|   (* Optimize the common (byte-aligned) case. *)
-
000407|   (*[5009970]*)if off land 7 = 0 then (
-
000408|     (*[103047]*)let byte = Char.code data.[byteoff] in
-
000409|     byte (*[103047]*)lsr (8 - flen) (*, off+flen, len-flen*)
-
000410|   ) else (
-
000411|     (* Extract the 16 bits at byteoff and byteoff+1 (note that the
-
000412|      * second byte might not exist in the original string).
-
000413|      *)
-
000414|     (*[4906923]*)let strlen = String.length data in
-
000415|  
-
000416|     (*[4906923]*)let word =
-
000417|       (_get_byte data byteoff strlen lsl 8) +
-
000418|         _get_byte data (byteoff+1) strlen in
-
000419|  
-
000420|     (* Mask off the top bits. *)
-
000421|     (*[4906923]*)let bitmask = (1 lsl (16 - (off land 7))) - 1 in
-
000422|     (*[4906923]*)let word = word land bitmask in
-
000423|     (* Shift right to get rid of the bottom bits. *)
-
000424|     (*[4906923]*)let shift = 16 - ((off land 7) + flen) in
-
000425|     (*[4906923]*)let word = word lsr shift in
-
000426|  
-
000427|     (*[4906923]*)word (*, off+flen, len-flen*)
-
000428|   )
-
000429|  
-
000430| (* Extract [9..31] bits.  We have to consider endianness and signedness. *)
-
000431| let extract_int_be_unsigned data off len flen =
-
000432|   (*[0]*)let byteoff = off lsr 3 in
-
000433|  
-
000434|   (*[0]*)let strlen = String.length data in
+
000129| let bitstring_length (_, _, len) = (*[1565296]*)len
+
000130|  
+
000131| let subbitstring (data, off, len) off' len' =
+
000132|   (*[0]*)let off = off + off' in
+
000133|   (*[0]*)if len < off' + len' then (*[0]*)invalid_arg "subbitstring";
+
000134|   ((*[0]*)data, off, len')
+
000135|  
+
000136| let dropbits n (data, off, len) =
+
000137|   (*[336643]*)let off = off + n in
+
000138|   (*[336643]*)let len = len - n in
+
000139|   (*[336643]*)if len < 0 then (*[0]*)invalid_arg "dropbits";
+
000140|   ((*[336643]*)data, off, len)
+
000141|  
+
000142| let takebits n (data, off, len) =
+
000143|   (*[0]*)if len < n then (*[0]*)invalid_arg "takebits";
+
000144|   ((*[0]*)data, off, n)
+
000145|  
+
000146| (*----------------------------------------------------------------------*)
+
000147| (* Bitwise functions.
+
000148|  *
+
000149|  * We try to isolate all bitwise functions within these modules.
+
000150|  *)
+
000151|  
+
000152| module I = struct
+
000153|   (* Bitwise operations on ints.  Note that we assume int <= 31 bits. *)
+
000154|   external (<<<) : int -> int -> int = "%lslint"
+
000155|   external (>>>) : int -> int -> int = "%lsrint"
+
000156|   external to_int : int -> int = "%identity"
+
000157|   let zero = (*[34]*)0
+
000158|   let one = (*[34]*)1
+
000159|   let minus_one = (*[34]*)-1
+
000160|   let ff = (*[34]*)0xff
+
000161|  
+
000162|   (* Create a mask 0-31 bits wide. *)
+
000163|   let mask bits =
+
000164|     (*[2]*)if bits < 30 then
+
000165|       ((*[2]*)one <<< bits) - 1
+
000166|     else (*[0]*)if bits = 30 then
+
000167|       (*[0]*)max_int
+
000168|     else (*[0]*)if bits = 31 then
+
000169|       (*[0]*)minus_one
+
000170|     else
+
000171|       (*[0]*)invalid_arg "Bitstring.I.mask"
+
000172|  
+
000173|   (* Byte swap an int of a given size. *)
+
000174|   let byteswap v bits =
+
000175|     (*[0]*)if bits <= 8 then (*[0]*)v
+
000176|     else (*[0]*)if bits <= 16 then (
+
000177|       (*[0]*)let shift = bits-8 in
+
000178|       (*[0]*)let v1 = v >>> shift in
+
000179|       (*[0]*)let v2 = ((v land (mask shift)) <<< 8) in
+
000180|       v2 (*[0]*)lor v1
+
000181|     ) else (*[0]*)if bits <= 24 then (
+
000182|       (*[0]*)let shift = bits - 16 in
+
000183|       (*[0]*)let v1 = v >>> (8+shift) in
+
000184|       (*[0]*)let v2 = ((v >>> shift) land ff) <<< 8 in
+
000185|       (*[0]*)let v3 = (v land (mask shift)) <<< 16 in
+
000186|       v3 lor v2 (*[0]*)lor v1
+
000187|     ) else (
+
000188|       (*[0]*)let shift = bits - 24 in
+
000189|       (*[0]*)let v1 = v >>> (16+shift) in
+
000190|       (*[0]*)let v2 = ((v >>> (8+shift)) land ff) <<< 8 in
+
000191|       (*[0]*)let v3 = ((v >>> shift) land ff) <<< 16 in
+
000192|       (*[0]*)let v4 = (v land (mask shift)) <<< 24 in
+
000193|       v4 lor v3 lor v2 (*[0]*)lor v1
+
000194|     )
+
000195|  
+
000196|   (* Check a value is in range 0 .. 2^bits-1. *)
+
000197|   let range_unsigned v bits =
+
000198|     (*[2]*)let mask = lnot (mask bits) in
+
000199|     (v (*[2]*)land mask) = zero
+
000200|  
+
000201|   (* Call function g on the top bits, then f on each full byte
+
000202|    * (big endian - so start at top).
+
000203|    *)
+
000204|   let rec map_bytes_be g f v bits =
+
000205|     (*[6]*)if bits >= 8 then (
+
000206|       (*[4]*)map_bytes_be g f (v >>> 8) (*[4]*)(bits-8);
+
000207|       (*[4]*)let lsb = v land ff in
+
000208|       (*[4]*)f (to_int lsb)
+
000209|     ) else (*[2]*)if bits > 0 then (
+
000210|       (*[0]*)let lsb = v land (mask bits) in
+
000211|       (*[0]*)g (to_int lsb) bits
+
000212|     )
+
000213|  
+
000214|   (* Call function g on the top bits, then f on each full byte
+
000215|    * (little endian - so start at root).
+
000216|    *)
+
000217|   let rec map_bytes_le g f v bits =
+
000218|     (*[0]*)if bits >= 8 then (
+
000219|       (*[0]*)let lsb = v land ff in
+
000220|       (*[0]*)f (*[0]*)(to_int lsb);
+
000221|       (*[0]*)map_bytes_le g f (v >>> 8) (bits-8)
+
000222|     ) else (*[0]*)if bits > 0 then (
+
000223|       (*[0]*)let lsb = v land (mask bits) in
+
000224|       (*[0]*)g (to_int lsb) bits
+
000225|     )
+
000226| end
+
000227|  
+
000228| module I32 = struct
+
000229|   (* Bitwise operations on int32s.  Note we try to keep it as similar
+
000230|    * as possible to the I module above, to make it easier to track
+
000231|    * down bugs.
+
000232|    *)
+
000233|   let (<<<) = (*[34]*)Int32.shift_left
+
000234|   let (>>>) = (*[34]*)Int32.shift_right_logical
+
000235|   let (land) = (*[34]*)Int32.logand
+
000236|   let (lor) = (*[34]*)Int32.logor
+
000237|   let lnot = (*[34]*)Int32.lognot
+
000238|   let pred = (*[34]*)Int32.pred
+
000239|   let max_int = (*[34]*)Int32.max_int
+
000240|   let to_int = (*[34]*)Int32.to_int
+
000241|   let zero = (*[34]*)Int32.zero
+
000242|   let one = (*[34]*)Int32.one
+
000243|   let minus_one = (*[34]*)Int32.minus_one
+
000244|   let ff = (*[34]*)0xff_l
+
000245|  
+
000246|   (* Create a mask so many bits wide. *)
+
000247|   let mask bits =
+
000248|     (*[12]*)if bits < 31 then
+
000249|       (*[12]*)pred (one <<< bits)
+
000250|     else (*[0]*)if bits = 31 then
+
000251|       (*[0]*)max_int
+
000252|     else (*[0]*)if bits = 32 then
+
000253|       (*[0]*)minus_one
+
000254|     else
+
000255|       (*[0]*)invalid_arg "Bitstring.I32.mask"
+
000256|  
+
000257|   (* Byte swap an int of a given size. *)
+
000258|   let byteswap v bits =
+
000259|     (*[12]*)if bits <= 8 then (*[0]*)v
+
000260|     else (*[12]*)if bits <= 16 then (
+
000261|       (*[0]*)let shift = bits-8 in
+
000262|       (*[0]*)let v1 = v >>> shift in
+
000263|       (*[0]*)let v2 = (v land (mask shift)) <<< 8 in
+
000264|       v2 (*[0]*)lor v1
+
000265|     ) else (*[12]*)if bits <= 24 then (
+
000266|       (*[0]*)let shift = bits - 16 in
+
000267|       (*[0]*)let v1 = v >>> (8+shift) in
+
000268|       (*[0]*)let v2 = ((v >>> shift) land ff) <<< 8 in
+
000269|       (*[0]*)let v3 = (v land (mask shift)) <<< 16 in
+
000270|       v3 lor v2 (*[0]*)lor v1
+
000271|     ) else (
+
000272|       (*[12]*)let shift = bits - 24 in
+
000273|       (*[12]*)let v1 = v >>> (16+shift) in
+
000274|       (*[12]*)let v2 = ((v >>> (8+shift)) land ff) <<< 8 in
+
000275|       (*[12]*)let v3 = ((v >>> shift) land ff) <<< 16 in
+
000276|       (*[12]*)let v4 = (v land (mask shift)) <<< 24 in
+
000277|       v4 lor v3 lor v2 (*[12]*)lor v1
+
000278|     )
+
000279|  
+
000280|   (* Check a value is in range 0 .. 2^bits-1. *)
+
000281|   let range_unsigned v bits =
+
000282|     (*[0]*)let mask = lnot (mask bits) in
+
000283|     (v (*[0]*)land mask) = zero
+
000284|  
+
000285|   (* Call function g on the top bits, then f on each full byte
+
000286|    * (big endian - so start at top).
+
000287|    *)
+
000288|   let rec map_bytes_be g f v bits =
+
000289|     (*[0]*)if bits >= 8 then (
+
000290|       (*[0]*)map_bytes_be g f (v >>> 8) (*[0]*)(bits-8);
+
000291|       (*[0]*)let lsb = v land ff in
+
000292|       (*[0]*)f (to_int lsb)
+
000293|     ) else (*[0]*)if bits > 0 then (
+
000294|       (*[0]*)let lsb = v land (mask bits) in
+
000295|       (*[0]*)g (to_int lsb) bits
+
000296|     )
+
000297|  
+
000298|   (* Call function g on the top bits, then f on each full byte
+
000299|    * (little endian - so start at root).
+
000300|    *)
+
000301|   let rec map_bytes_le g f v bits =
+
000302|     (*[0]*)if bits >= 8 then (
+
000303|       (*[0]*)let lsb = v land ff in
+
000304|       (*[0]*)f (*[0]*)(to_int lsb);
+
000305|       (*[0]*)map_bytes_le g f (v >>> 8) (bits-8)
+
000306|     ) else (*[0]*)if bits > 0 then (
+
000307|       (*[0]*)let lsb = v land (mask bits) in
+
000308|       (*[0]*)g (to_int lsb) bits
+
000309|     )
+
000310| end
+
000311|  
+
000312| module I64 = struct
+
000313|   (* Bitwise operations on int64s.  Note we try to keep it as similar
+
000314|    * as possible to the I/I32 modules above, to make it easier to track
+
000315|    * down bugs.
+
000316|    *)
+
000317|   let (<<<) = (*[34]*)Int64.shift_left
+
000318|   let (>>>) = (*[34]*)Int64.shift_right_logical
+
000319|   let (land) = (*[34]*)Int64.logand
+
000320|   let (lor) = (*[34]*)Int64.logor
+
000321|   let lnot = (*[34]*)Int64.lognot
+
000322|   let pred = (*[34]*)Int64.pred
+
000323|   let max_int = (*[34]*)Int64.max_int
+
000324|   let to_int = (*[34]*)Int64.to_int
+
000325|   let zero = (*[34]*)Int64.zero
+
000326|   let one = (*[34]*)Int64.one
+
000327|   let minus_one = (*[34]*)Int64.minus_one
+
000328|   let ff = (*[34]*)0xff_L
+
000329|  
+
000330|   (* Create a mask so many bits wide. *)
+
000331|   let mask bits =
+
000332|     (*[669050]*)if bits < 63 then
+
000333|       (*[664100]*)pred (one <<< bits)
+
000334|     else (*[4950]*)if bits = 63 then
+
000335|       (*[4950]*)max_int
+
000336|     else (*[0]*)if bits = 64 then
+
000337|       (*[0]*)minus_one
+
000338|     else
+
000339|       (*[0]*)invalid_arg "Bitstring.I64.mask"
+
000340|  
+
000341|   (* Byte swap an int of a given size. *)
+
000342|   (* let byteswap v bits = *)
+
000343|  
+
000344|   (* Check a value is in range 0 .. 2^bits-1. *)
+
000345|   let range_unsigned v bits =
+
000346|     (*[351850]*)let mask = lnot (mask bits) in
+
000347|     (v (*[351850]*)land mask) = zero
+
000348|  
+
000349|   (* Call function g on the top bits, then f on each full byte
+
000350|    * (big endian - so start at top).
+
000351|    *)
+
000352|   let rec map_bytes_be g f v bits =
+
000353|     (*[1460650]*)if bits >= 8 then (
+
000354|       (*[1108800]*)map_bytes_be g f (v >>> 8) (*[1108800]*)(bits-8);
+
000355|       (*[1108800]*)let lsb = v land ff in
+
000356|       (*[1108800]*)f (to_int lsb)
+
000357|     ) else (*[34650]*)if bits > 0 then (
+
000358|       (*[317200]*)let lsb = v land (mask bits) in
+
000359|       (*[317200]*)g (to_int lsb) bits
+
000360|     )
+
000361|  
+
000362|   (* Call function g on the top bits, then f on each full byte
+
000363|    * (little endian - so start at root).
+
000364|    *)
+
000365|   let rec map_bytes_le g f v bits =
+
000366|     (*[0]*)if bits >= 8 then (
+
000367|       (*[0]*)let lsb = v land ff in
+
000368|       (*[0]*)f (*[0]*)(to_int lsb);
+
000369|       (*[0]*)map_bytes_le g f (v >>> 8) (bits-8)
+
000370|     ) else (*[0]*)if bits > 0 then (
+
000371|       (*[0]*)let lsb = v land (mask bits) in
+
000372|       (*[0]*)g (to_int lsb) bits
+
000373|     )
+
000374| end
+
000375|  
+
000376| (*----------------------------------------------------------------------*)
+
000377| (* Extraction functions.
+
000378|  *
+
000379|  * NB: internal functions, called from the generated macros, and
+
000380|  * the parameters should have been checked for sanity already).
+
000381|  *)
+
000382|  
+
000383| (* Extract and convert to numeric.  A single bit is returned as
+
000384|  * a boolean.  There are no endianness or signedness considerations.
+
000385|  *)
+
000386| let extract_bit data off len _ =        (* final param is always 1 *)
+
000387|   (*[2515152]*)let byteoff = off lsr 3 in
+
000388|   (*[2515152]*)let bitmask = 1 lsl (7 - (off land 7)) in
+
000389|   (*[2515152]*)let b = Char.code data.[byteoff] land bitmask <> 0 in
+
000390|   (*[2515152]*)b (*, off+1, len-1*)
+
000391|  
+
000392| (* Returns 8 bit unsigned aligned bytes from the string.
+
000393|  * If the string ends then this returns 0's.
+
000394|  *)
+
000395| let _get_byte data byteoff strlen =
+
000396|   (*[9818264]*)if strlen > byteoff then (*[9252298]*)Char.code data.[byteoff] else (*[565966]*)0
+
000397| let _get_byte32 data byteoff strlen =
+
000398|   (*[72]*)if strlen > byteoff then (*[72]*)Int32.of_int (Char.code data.[byteoff]) else (*[0]*)0l
+
000399| let _get_byte64 data byteoff strlen =
+
000400|   (*[1626456]*)if strlen > byteoff then (*[1517847]*)Int64.of_int (Char.code data.[byteoff]) else (*[108609]*)0L
+
000401|  
+
000402| (* Extract [2..8] bits.  Because the result fits into a single
+
000403|  * byte we don't have to worry about endianness, only signedness.
+
000404|  *)
+
000405| let extract_char_unsigned data off len flen =
+
000406|   (*[5030404]*)let byteoff = off lsr 3 in
+
000407|  
+
000408|   (* Optimize the common (byte-aligned) case. *)
+
000409|   (*[5030404]*)if off land 7 = 0 then (
+
000410|     (*[121272]*)let byte = Char.code data.[byteoff] in
+
000411|     byte (*[121272]*)lsr (8 - flen) (*, off+flen, len-flen*)
+
000412|   ) else (
+
000413|     (* Extract the 16 bits at byteoff and byteoff+1 (note that the
+
000414|      * second byte might not exist in the original string).
+
000415|      *)
+
000416|     (*[4909132]*)let strlen = String.length data in
+
000417|  
+
000418|     (*[4909132]*)let word =
+
000419|       (_get_byte data byteoff strlen lsl 8) +
+
000420|         _get_byte data (byteoff+1) strlen in
+
000421|  
+
000422|     (* Mask off the top bits. *)
+
000423|     (*[4909132]*)let bitmask = (1 lsl (16 - (off land 7))) - 1 in
+
000424|     (*[4909132]*)let word = word land bitmask in
+
000425|     (* Shift right to get rid of the bottom bits. *)
+
000426|     (*[4909132]*)let shift = 16 - ((off land 7) + flen) in
+
000427|     (*[4909132]*)let word = word lsr shift in
+
000428|  
+
000429|     (*[4909132]*)word (*, off+flen, len-flen*)
+
000430|   )
+
000431|  
+
000432| (* Extract [9..31] bits.  We have to consider endianness and signedness. *)
+
000433| let extract_int_be_unsigned data off len flen =
+
000434|   (*[0]*)let byteoff = off lsr 3 in
000435|  
-
000436|   (*[0]*)let word =
-
000437|     (* Optimize the common (byte-aligned) case. *)
-
000438|     if off land 7 = 0 then (
-
000439|       (*[0]*)let word =
-
000440|         (_get_byte data byteoff strlen lsl 23) +
-
000441|           (_get_byte data (byteoff+1) strlen lsl 15) +
-
000442|           (_get_byte data (byteoff+2) strlen lsl 7) +
-
000443|           (_get_byte data (byteoff+3) strlen lsr 1) in
-
000444|       word (*[0]*)lsr (31 - flen)
-
000445|     ) else (*[0]*)if flen <= 24 then (
-
000446|       (* Extract the 31 bits at byteoff .. byteoff+3. *)
-
000447|       (*[0]*)let word =
-
000448|         (_get_byte data byteoff strlen lsl 23) +
-
000449|           (_get_byte data (byteoff+1) strlen lsl 15) +
-
000450|           (_get_byte data (byteoff+2) strlen lsl 7) +
-
000451|           (_get_byte data (byteoff+3) strlen lsr 1) in
-
000452|       (* Mask off the top bits. *)
-
000453|       (*[0]*)let bitmask = (1 lsl (31 - (off land 7))) - 1 in
-
000454|       (*[0]*)let word = word land bitmask in
-
000455|       (* Shift right to get rid of the bottom bits. *)
-
000456|       (*[0]*)let shift = 31 - ((off land 7) + flen) in
-
000457|       word (*[0]*)lsr shift
-
000458|     ) else (
-
000459|       (* Extract the next 31 bits, slow method. *)
-
000460|       (*[0]*)let word =
-
000461|         let c0 = extract_char_unsigned data off len 8
-
000462|         and off = off + 8 and len = len - 8 in
-
000463|         (*[0]*)let c1 = extract_char_unsigned data off len 8
+
000436|   (*[0]*)let strlen = String.length data in
+
000437|  
+
000438|   (*[0]*)let word =
+
000439|     (* Optimize the common (byte-aligned) case. *)
+
000440|     if off land 7 = 0 then (
+
000441|       (*[0]*)let word =
+
000442|         (_get_byte data byteoff strlen lsl 23) +
+
000443|           (_get_byte data (byteoff+1) strlen lsl 15) +
+
000444|           (_get_byte data (byteoff+2) strlen lsl 7) +
+
000445|           (_get_byte data (byteoff+3) strlen lsr 1) in
+
000446|       word (*[0]*)lsr (31 - flen)
+
000447|     ) else (*[0]*)if flen <= 24 then (
+
000448|       (* Extract the 31 bits at byteoff .. byteoff+3. *)
+
000449|       (*[0]*)let word =
+
000450|         (_get_byte data byteoff strlen lsl 23) +
+
000451|           (_get_byte data (byteoff+1) strlen lsl 15) +
+
000452|           (_get_byte data (byteoff+2) strlen lsl 7) +
+
000453|           (_get_byte data (byteoff+3) strlen lsr 1) in
+
000454|       (* Mask off the top bits. *)
+
000455|       (*[0]*)let bitmask = (1 lsl (31 - (off land 7))) - 1 in
+
000456|       (*[0]*)let word = word land bitmask in
+
000457|       (* Shift right to get rid of the bottom bits. *)
+
000458|       (*[0]*)let shift = 31 - ((off land 7) + flen) in
+
000459|       word (*[0]*)lsr shift
+
000460|     ) else (
+
000461|       (* Extract the next 31 bits, slow method. *)
+
000462|       (*[0]*)let word =
+
000463|         let c0 = extract_char_unsigned data off len 8
000464|         and off = off + 8 and len = len - 8 in
-
000465|         (*[0]*)let c2 = extract_char_unsigned data off len 8
+
000465|         (*[0]*)let c1 = extract_char_unsigned data off len 8
000466|         and off = off + 8 and len = len - 8 in
-
000467|         (*[0]*)let c3 = extract_char_unsigned data off len 7 in
-
000468|         (c0 (*[0]*)lsl 23) + (c1 lsl 15) + (c2 lsl 7) + c3 in
-
000469|       word (*[0]*)lsr (31 - flen)
-
000470|     ) in
-
000471|   (*[0]*)word (*, off+flen, len-flen*)
-
000472|  
-
000473| let extract_int_le_unsigned data off len flen =
-
000474|   (*[0]*)let v = extract_int_be_unsigned data off len flen in
-
000475|   (*[0]*)let v = I.byteswap v flen in
-
000476|   (*[0]*)v
-
000477|  
-
000478| let extract_int_ne_unsigned =
-
000479|   (*[28]*)if nativeendian = BigEndian
-
000480|   then (*[0]*)extract_int_be_unsigned
-
000481|   else (*[28]*)extract_int_le_unsigned
-
000482|  
-
000483| let extract_int_ee_unsigned = function
-
000484|   | BigEndian -> (*[0]*)extract_int_be_unsigned
-
000485|   | LittleEndian -> (*[0]*)extract_int_le_unsigned
-
000486|   | NativeEndian -> (*[0]*)extract_int_ne_unsigned
-
000487|  
-
000488| let _make_int32_be c0 c1 c2 c3 =
-
000489|   (*[18]*)Int32.logor
-
000490|     (Int32.logor
-
000491|        (Int32.logor
-
000492|           (Int32.shift_left c0 24)
-
000493|           (Int32.shift_left c1 16))
-
000494|        (Int32.shift_left c2 8))
-
000495|     c3
-
000496|  
-
000497| let _make_int32_le c0 c1 c2 c3 =
-
000498|   (*[0]*)Int32.logor
-
000499|     (Int32.logor
-
000500|        (Int32.logor
-
000501|           (Int32.shift_left c3 24)
-
000502|           (Int32.shift_left c2 16))
-
000503|        (Int32.shift_left c1 8))
-
000504|     c0
-
000505|  
-
000506| (* Extract exactly 32 bits.  We have to consider endianness and signedness. *)
-
000507| let extract_int32_be_unsigned data off len flen =
-
000508|   (*[18]*)let byteoff = off lsr 3 in
-
000509|  
-
000510|   (*[18]*)let strlen = String.length data in
+
000467|         (*[0]*)let c2 = extract_char_unsigned data off len 8
+
000468|         and off = off + 8 and len = len - 8 in
+
000469|         (*[0]*)let c3 = extract_char_unsigned data off len 7 in
+
000470|         (c0 (*[0]*)lsl 23) + (c1 lsl 15) + (c2 lsl 7) + c3 in
+
000471|       word (*[0]*)lsr (31 - flen)
+
000472|     ) in
+
000473|   (*[0]*)word (*, off+flen, len-flen*)
+
000474|  
+
000475| let extract_int_le_unsigned data off len flen =
+
000476|   (*[0]*)let v = extract_int_be_unsigned data off len flen in
+
000477|   (*[0]*)let v = I.byteswap v flen in
+
000478|   (*[0]*)v
+
000479|  
+
000480| let extract_int_ne_unsigned =
+
000481|   (*[34]*)if nativeendian = BigEndian
+
000482|   then (*[0]*)extract_int_be_unsigned
+
000483|   else (*[34]*)extract_int_le_unsigned
+
000484|  
+
000485| let extract_int_ee_unsigned = function
+
000486|   | BigEndian -> (*[0]*)extract_int_be_unsigned
+
000487|   | LittleEndian -> (*[0]*)extract_int_le_unsigned
+
000488|   | NativeEndian -> (*[0]*)extract_int_ne_unsigned
+
000489|  
+
000490| let _make_int32_be c0 c1 c2 c3 =
+
000491|   (*[18]*)Int32.logor
+
000492|     (Int32.logor
+
000493|        (Int32.logor
+
000494|           (Int32.shift_left c0 24)
+
000495|           (Int32.shift_left c1 16))
+
000496|        (Int32.shift_left c2 8))
+
000497|     c3
+
000498|  
+
000499| let _make_int32_le c0 c1 c2 c3 =
+
000500|   (*[0]*)Int32.logor
+
000501|     (Int32.logor
+
000502|        (Int32.logor
+
000503|           (Int32.shift_left c3 24)
+
000504|           (Int32.shift_left c2 16))
+
000505|        (Int32.shift_left c1 8))
+
000506|     c0
+
000507|  
+
000508| (* Extract exactly 32 bits.  We have to consider endianness and signedness. *)
+
000509| let extract_int32_be_unsigned data off len flen =
+
000510|   (*[18]*)let byteoff = off lsr 3 in
000511|  
-
000512|   (*[18]*)let word =
-
000513|     (* Optimize the common (byte-aligned) case. *)
-
000514|     if off land 7 = 0 then (
-
000515|       (*[18]*)let word =
-
000516|         let c0 = _get_byte32 data byteoff strlen in
-
000517|         (*[18]*)let c1 = _get_byte32 data (byteoff+1) strlen in
-
000518|         (*[18]*)let c2 = _get_byte32 data (byteoff+2) strlen in
-
000519|         (*[18]*)let c3 = _get_byte32 data (byteoff+3) strlen in
-
000520|         (*[18]*)_make_int32_be c0 c1 c2 c3 in
-
000521|       (*[18]*)Int32.shift_right_logical word (32 - flen)
-
000522|     ) else (
-
000523|       (* Extract the next 32 bits, slow method. *)
-
000524|       (*[0]*)let word =
-
000525|         let c0 = extract_char_unsigned data off len 8
-
000526|         and off = off + 8 and len = len - 8 in
-
000527|         (*[0]*)let c1 = extract_char_unsigned data off len 8
+
000512|   (*[18]*)let strlen = String.length data in
+
000513|  
+
000514|   (*[18]*)let word =
+
000515|     (* Optimize the common (byte-aligned) case. *)
+
000516|     if off land 7 = 0 then (
+
000517|       (*[18]*)let word =
+
000518|         let c0 = _get_byte32 data byteoff strlen in
+
000519|         (*[18]*)let c1 = _get_byte32 data (byteoff+1) strlen in
+
000520|         (*[18]*)let c2 = _get_byte32 data (byteoff+2) strlen in
+
000521|         (*[18]*)let c3 = _get_byte32 data (byteoff+3) strlen in
+
000522|         (*[18]*)_make_int32_be c0 c1 c2 c3 in
+
000523|       (*[18]*)Int32.shift_right_logical word (32 - flen)
+
000524|     ) else (
+
000525|       (* Extract the next 32 bits, slow method. *)
+
000526|       (*[0]*)let word =
+
000527|         let c0 = extract_char_unsigned data off len 8
000528|         and off = off + 8 and len = len - 8 in
-
000529|         (*[0]*)let c2 = extract_char_unsigned data off len 8
+
000529|         (*[0]*)let c1 = extract_char_unsigned data off len 8
000530|         and off = off + 8 and len = len - 8 in
-
000531|         (*[0]*)let c3 = extract_char_unsigned data off len 8 in
-
000532|         (*[0]*)let c0 = Int32.of_int c0 in
-
000533|         (*[0]*)let c1 = Int32.of_int c1 in
-
000534|         (*[0]*)let c2 = Int32.of_int c2 in
-
000535|         (*[0]*)let c3 = Int32.of_int c3 in
-
000536|         (*[0]*)_make_int32_be c0 c1 c2 c3 in
-
000537|       (*[0]*)Int32.shift_right_logical word (32 - flen)
-
000538|     ) in
-
000539|   (*[18]*)word (*, off+flen, len-flen*)
-
000540|  
-
000541| let extract_int32_le_unsigned data off len flen =
-
000542|   (*[12]*)let v = extract_int32_be_unsigned data off len flen in
-
000543|   (*[12]*)let v = I32.byteswap v flen in
-
000544|   (*[12]*)v
-
000545|  
-
000546| let extract_int32_ne_unsigned =
-
000547|   (*[28]*)if nativeendian = BigEndian
-
000548|   then (*[0]*)extract_int32_be_unsigned
-
000549|   else (*[28]*)extract_int32_le_unsigned
-
000550|  
-
000551| let extract_int32_ee_unsigned = function
-
000552|   | BigEndian -> (*[6]*)extract_int32_be_unsigned
-
000553|   | LittleEndian -> (*[6]*)extract_int32_le_unsigned
-
000554|   | NativeEndian -> (*[6]*)extract_int32_ne_unsigned
-
000555|  
-
000556| let _make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 =
-
000557|   (*[657463]*)Int64.logor
-
000558|     (Int64.logor
-
000559|        (Int64.logor
-
000560|           (Int64.logor
-
000561|              (Int64.logor
-
000562|                 (Int64.logor
-
000563|                    (Int64.logor
-
000564|                       (Int64.shift_left c0 56)
-
000565|                       (Int64.shift_left c1 48))
-
000566|                    (Int64.shift_left c2 40))
-
000567|                 (Int64.shift_left c3 32))
-
000568|              (Int64.shift_left c4 24))
-
000569|           (Int64.shift_left c5 16))
-
000570|        (Int64.shift_left c6 8))
-
000571|     c7
-
000572|  
-
000573| let _make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 =
-
000574|   (*[0]*)_make_int64_be c7 c6 c5 c4 c3 c2 c1 c0
-
000575|  
-
000576| (* Extract [1..64] bits.  We have to consider endianness and signedness. *)
-
000577| let extract_int64_be_unsigned data off len flen =
-
000578|   (*[657463]*)let byteoff = off lsr 3 in
-
000579|  
-
000580|   (*[657463]*)let strlen = String.length data in
+
000531|         (*[0]*)let c2 = extract_char_unsigned data off len 8
+
000532|         and off = off + 8 and len = len - 8 in
+
000533|         (*[0]*)let c3 = extract_char_unsigned data off len 8 in
+
000534|         (*[0]*)let c0 = Int32.of_int c0 in
+
000535|         (*[0]*)let c1 = Int32.of_int c1 in
+
000536|         (*[0]*)let c2 = Int32.of_int c2 in
+
000537|         (*[0]*)let c3 = Int32.of_int c3 in
+
000538|         (*[0]*)_make_int32_be c0 c1 c2 c3 in
+
000539|       (*[0]*)Int32.shift_right_logical word (32 - flen)
+
000540|     ) in
+
000541|   (*[18]*)word (*, off+flen, len-flen*)
+
000542|  
+
000543| let extract_int32_le_unsigned data off len flen =
+
000544|   (*[12]*)let v = extract_int32_be_unsigned data off len flen in
+
000545|   (*[12]*)let v = I32.byteswap v flen in
+
000546|   (*[12]*)v
+
000547|  
+
000548| let extract_int32_ne_unsigned =
+
000549|   (*[34]*)if nativeendian = BigEndian
+
000550|   then (*[0]*)extract_int32_be_unsigned
+
000551|   else (*[34]*)extract_int32_le_unsigned
+
000552|  
+
000553| let extract_int32_ee_unsigned = function
+
000554|   | BigEndian -> (*[6]*)extract_int32_be_unsigned
+
000555|   | LittleEndian -> (*[6]*)extract_int32_le_unsigned
+
000556|   | NativeEndian -> (*[6]*)extract_int32_ne_unsigned
+
000557|  
+
000558| let _make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 =
+
000559|   (*[657463]*)Int64.logor
+
000560|     (Int64.logor
+
000561|        (Int64.logor
+
000562|           (Int64.logor
+
000563|              (Int64.logor
+
000564|                 (Int64.logor
+
000565|                    (Int64.logor
+
000566|                       (Int64.shift_left c0 56)
+
000567|                       (Int64.shift_left c1 48))
+
000568|                    (Int64.shift_left c2 40))
+
000569|                 (Int64.shift_left c3 32))
+
000570|              (Int64.shift_left c4 24))
+
000571|           (Int64.shift_left c5 16))
+
000572|        (Int64.shift_left c6 8))
+
000573|     c7
+
000574|  
+
000575| let _make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 =
+
000576|   (*[0]*)_make_int64_be c7 c6 c5 c4 c3 c2 c1 c0
+
000577|  
+
000578| (* Extract [1..64] bits.  We have to consider endianness and signedness. *)
+
000579| let extract_int64_be_unsigned data off len flen =
+
000580|   (*[657463]*)let byteoff = off lsr 3 in
000581|  
-
000582|   (*[657463]*)let word =
-
000583|     (* Optimize the common (byte-aligned) case. *)
-
000584|     if off land 7 = 0 then (
-
000585|       (*[203275]*)let word =
-
000586|         let c0 = _get_byte64 data byteoff strlen in
-
000587|         (*[203275]*)let c1 = _get_byte64 data (byteoff+1) strlen in
-
000588|         (*[203275]*)let c2 = _get_byte64 data (byteoff+2) strlen in
-
000589|         (*[203275]*)let c3 = _get_byte64 data (byteoff+3) strlen in
-
000590|         (*[203275]*)let c4 = _get_byte64 data (byteoff+4) strlen in
-
000591|         (*[203275]*)let c5 = _get_byte64 data (byteoff+5) strlen in
-
000592|         (*[203275]*)let c6 = _get_byte64 data (byteoff+6) strlen in
-
000593|         (*[203275]*)let c7 = _get_byte64 data (byteoff+7) strlen in
-
000594|         (*[203275]*)_make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in
-
000595|       (*[203275]*)Int64.shift_right_logical word (64 - flen)
-
000596|     ) else (
-
000597|       (* Extract the next 64 bits, slow method. *)
-
000598|       (*[454188]*)let word =
-
000599|         let c0 = extract_char_unsigned data off len 8
-
000600|         and off = off + 8 and len = len - 8 in
-
000601|         (*[454188]*)let c1 = extract_char_unsigned data off len 8
+
000582|   (*[657463]*)let strlen = String.length data in
+
000583|  
+
000584|   (*[657463]*)let word =
+
000585|     (* Optimize the common (byte-aligned) case. *)
+
000586|     if off land 7 = 0 then (
+
000587|       (*[203307]*)let word =
+
000588|         let c0 = _get_byte64 data byteoff strlen in
+
000589|         (*[203307]*)let c1 = _get_byte64 data (byteoff+1) strlen in
+
000590|         (*[203307]*)let c2 = _get_byte64 data (byteoff+2) strlen in
+
000591|         (*[203307]*)let c3 = _get_byte64 data (byteoff+3) strlen in
+
000592|         (*[203307]*)let c4 = _get_byte64 data (byteoff+4) strlen in
+
000593|         (*[203307]*)let c5 = _get_byte64 data (byteoff+5) strlen in
+
000594|         (*[203307]*)let c6 = _get_byte64 data (byteoff+6) strlen in
+
000595|         (*[203307]*)let c7 = _get_byte64 data (byteoff+7) strlen in
+
000596|         (*[203307]*)_make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in
+
000597|       (*[203307]*)Int64.shift_right_logical word (64 - flen)
+
000598|     ) else (
+
000599|       (* Extract the next 64 bits, slow method. *)
+
000600|       (*[454156]*)let word =
+
000601|         let c0 = extract_char_unsigned data off len 8
000602|         and off = off + 8 and len = len - 8 in
-
000603|         (*[454188]*)let c2 = extract_char_unsigned data off len 8
+
000603|         (*[454156]*)let c1 = extract_char_unsigned data off len 8
000604|         and off = off + 8 and len = len - 8 in
-
000605|         (*[454188]*)let c3 = extract_char_unsigned data off len 8
+
000605|         (*[454156]*)let c2 = extract_char_unsigned data off len 8
000606|         and off = off + 8 and len = len - 8 in
-
000607|         (*[454188]*)let c4 = extract_char_unsigned data off len 8
+
000607|         (*[454156]*)let c3 = extract_char_unsigned data off len 8
000608|         and off = off + 8 and len = len - 8 in
-
000609|         (*[454188]*)let c5 = extract_char_unsigned data off len 8
+
000609|         (*[454156]*)let c4 = extract_char_unsigned data off len 8
000610|         and off = off + 8 and len = len - 8 in
-
000611|         (*[454188]*)let c6 = extract_char_unsigned data off len 8
+
000611|         (*[454156]*)let c5 = extract_char_unsigned data off len 8
000612|         and off = off + 8 and len = len - 8 in
-
000613|         (*[454188]*)let c7 = extract_char_unsigned data off len 8 in
-
000614|         (*[454188]*)let c0 = Int64.of_int c0 in
-
000615|         (*[454188]*)let c1 = Int64.of_int c1 in
-
000616|         (*[454188]*)let c2 = Int64.of_int c2 in
-
000617|         (*[454188]*)let c3 = Int64.of_int c3 in
-
000618|         (*[454188]*)let c4 = Int64.of_int c4 in
-
000619|         (*[454188]*)let c5 = Int64.of_int c5 in
-
000620|         (*[454188]*)let c6 = Int64.of_int c6 in
-
000621|         (*[454188]*)let c7 = Int64.of_int c7 in
-
000622|         (*[454188]*)_make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in
-
000623|       (*[454188]*)Int64.shift_right_logical word (64 - flen)
-
000624|     ) in
-
000625|   (*[657463]*)word (*, off+flen, len-flen*)
-
000626|  
-
000627| let extract_int64_le_unsigned data off len flen =
-
000628|   (*[0]*)let byteoff = off lsr 3 in
-
000629|  
-
000630|   (*[0]*)let strlen = String.length data in
+
000613|         (*[454156]*)let c6 = extract_char_unsigned data off len 8
+
000614|         and off = off + 8 and len = len - 8 in
+
000615|         (*[454156]*)let c7 = extract_char_unsigned data off len 8 in
+
000616|         (*[454156]*)let c0 = Int64.of_int c0 in
+
000617|         (*[454156]*)let c1 = Int64.of_int c1 in
+
000618|         (*[454156]*)let c2 = Int64.of_int c2 in
+
000619|         (*[454156]*)let c3 = Int64.of_int c3 in
+
000620|         (*[454156]*)let c4 = Int64.of_int c4 in
+
000621|         (*[454156]*)let c5 = Int64.of_int c5 in
+
000622|         (*[454156]*)let c6 = Int64.of_int c6 in
+
000623|         (*[454156]*)let c7 = Int64.of_int c7 in
+
000624|         (*[454156]*)_make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in
+
000625|       (*[454156]*)Int64.shift_right_logical word (64 - flen)
+
000626|     ) in
+
000627|   (*[657463]*)word (*, off+flen, len-flen*)
+
000628|  
+
000629| let extract_int64_le_unsigned data off len flen =
+
000630|   (*[0]*)let byteoff = off lsr 3 in
000631|  
-
000632|   (*[0]*)let word =
-
000633|     (* Optimize the common (byte-aligned) case. *)
-
000634|     if off land 7 = 0 then (
-
000635|       (*[0]*)let word =
-
000636|         let c0 = _get_byte64 data byteoff strlen in
-
000637|         (*[0]*)let c1 = _get_byte64 data (byteoff+1) strlen in
-
000638|         (*[0]*)let c2 = _get_byte64 data (byteoff+2) strlen in
-
000639|         (*[0]*)let c3 = _get_byte64 data (byteoff+3) strlen in
-
000640|         (*[0]*)let c4 = _get_byte64 data (byteoff+4) strlen in
-
000641|         (*[0]*)let c5 = _get_byte64 data (byteoff+5) strlen in
-
000642|         (*[0]*)let c6 = _get_byte64 data (byteoff+6) strlen in
-
000643|         (*[0]*)let c7 = _get_byte64 data (byteoff+7) strlen in
-
000644|         (*[0]*)_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
-
000645|       (*[0]*)Int64.logand word (I64.mask flen)
-
000646|     ) else (
-
000647|       (* Extract the next 64 bits, slow method. *)
-
000648|       (*[0]*)let word =
-
000649|         let c0 = extract_char_unsigned data off len 8
-
000650|         and off = off + 8 and len = len - 8 in
-
000651|         (*[0]*)let c1 = extract_char_unsigned data off len 8
+
000632|   (*[0]*)let strlen = String.length data in
+
000633|  
+
000634|   (*[0]*)let word =
+
000635|     (* Optimize the common (byte-aligned) case. *)
+
000636|     if off land 7 = 0 then (
+
000637|       (*[0]*)let word =
+
000638|         let c0 = _get_byte64 data byteoff strlen in
+
000639|         (*[0]*)let c1 = _get_byte64 data (byteoff+1) strlen in
+
000640|         (*[0]*)let c2 = _get_byte64 data (byteoff+2) strlen in
+
000641|         (*[0]*)let c3 = _get_byte64 data (byteoff+3) strlen in
+
000642|         (*[0]*)let c4 = _get_byte64 data (byteoff+4) strlen in
+
000643|         (*[0]*)let c5 = _get_byte64 data (byteoff+5) strlen in
+
000644|         (*[0]*)let c6 = _get_byte64 data (byteoff+6) strlen in
+
000645|         (*[0]*)let c7 = _get_byte64 data (byteoff+7) strlen in
+
000646|         (*[0]*)_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
+
000647|       (*[0]*)Int64.logand word (I64.mask flen)
+
000648|     ) else (
+
000649|       (* Extract the next 64 bits, slow method. *)
+
000650|       (*[0]*)let word =
+
000651|         let c0 = extract_char_unsigned data off len 8
000652|         and off = off + 8 and len = len - 8 in
-
000653|         (*[0]*)let c2 = extract_char_unsigned data off len 8
+
000653|         (*[0]*)let c1 = extract_char_unsigned data off len 8
000654|         and off = off + 8 and len = len - 8 in
-
000655|         (*[0]*)let c3 = extract_char_unsigned data off len 8
+
000655|         (*[0]*)let c2 = extract_char_unsigned data off len 8
000656|         and off = off + 8 and len = len - 8 in
-
000657|         (*[0]*)let c4 = extract_char_unsigned data off len 8
+
000657|         (*[0]*)let c3 = extract_char_unsigned data off len 8
000658|         and off = off + 8 and len = len - 8 in
-
000659|         (*[0]*)let c5 = extract_char_unsigned data off len 8
+
000659|         (*[0]*)let c4 = extract_char_unsigned data off len 8
000660|         and off = off + 8 and len = len - 8 in
-
000661|         (*[0]*)let c6 = extract_char_unsigned data off len 8
+
000661|         (*[0]*)let c5 = extract_char_unsigned data off len 8
000662|         and off = off + 8 and len = len - 8 in
-
000663|         (*[0]*)let c7 = extract_char_unsigned data off len 8 in
-
000664|         (*[0]*)let c0 = Int64.of_int c0 in
-
000665|         (*[0]*)let c1 = Int64.of_int c1 in
-
000666|         (*[0]*)let c2 = Int64.of_int c2 in
-
000667|         (*[0]*)let c3 = Int64.of_int c3 in
-
000668|         (*[0]*)let c4 = Int64.of_int c4 in
-
000669|         (*[0]*)let c5 = Int64.of_int c5 in
-
000670|         (*[0]*)let c6 = Int64.of_int c6 in
-
000671|         (*[0]*)let c7 = Int64.of_int c7 in
-
000672|         (*[0]*)_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
-
000673|       (*[0]*)Int64.logand word (I64.mask flen)
-
000674|     ) in
-
000675|   (*[0]*)word (*, off+flen, len-flen*)
-
000676|  
-
000677| let extract_int64_ne_unsigned =
-
000678|   (*[28]*)if nativeendian = BigEndian
-
000679|   then (*[0]*)extract_int64_be_unsigned
-
000680|   else (*[28]*)extract_int64_le_unsigned
-
000681|  
-
000682| let extract_int64_ee_unsigned = function
-
000683|   | BigEndian -> (*[0]*)extract_int64_be_unsigned
-
000684|   | LittleEndian -> (*[0]*)extract_int64_le_unsigned
-
000685|   | NativeEndian -> (*[0]*)extract_int64_ne_unsigned
-
000686|  
-
000687| external extract_fastpath_int16_be_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_unsigned" "noalloc"
+
000663|         (*[0]*)let c6 = extract_char_unsigned data off len 8
+
000664|         and off = off + 8 and len = len - 8 in
+
000665|         (*[0]*)let c7 = extract_char_unsigned data off len 8 in
+
000666|         (*[0]*)let c0 = Int64.of_int c0 in
+
000667|         (*[0]*)let c1 = Int64.of_int c1 in
+
000668|         (*[0]*)let c2 = Int64.of_int c2 in
+
000669|         (*[0]*)let c3 = Int64.of_int c3 in
+
000670|         (*[0]*)let c4 = Int64.of_int c4 in
+
000671|         (*[0]*)let c5 = Int64.of_int c5 in
+
000672|         (*[0]*)let c6 = Int64.of_int c6 in
+
000673|         (*[0]*)let c7 = Int64.of_int c7 in
+
000674|         (*[0]*)_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
+
000675|       (*[0]*)Int64.logand word (I64.mask flen)
+
000676|     ) in
+
000677|   (*[0]*)word (*, off+flen, len-flen*)
+
000678|  
+
000679| let extract_int64_ne_unsigned =
+
000680|   (*[34]*)if nativeendian = BigEndian
+
000681|   then (*[0]*)extract_int64_be_unsigned
+
000682|   else (*[34]*)extract_int64_le_unsigned
+
000683|  
+
000684| let extract_int64_ee_unsigned = function
+
000685|   | BigEndian -> (*[0]*)extract_int64_be_unsigned
+
000686|   | LittleEndian -> (*[0]*)extract_int64_le_unsigned
+
000687|   | NativeEndian -> (*[0]*)extract_int64_ne_unsigned
000688|  
-
000689| external extract_fastpath_int16_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_unsigned" "noalloc"
+
000689| external extract_fastpath_int16_be_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_unsigned" "noalloc"
000690|  
-
000691| external extract_fastpath_int16_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_unsigned" "noalloc"
+
000691| external extract_fastpath_int16_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_unsigned" "noalloc"
000692|  
-
000693| external extract_fastpath_int16_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_signed" "noalloc"
+
000693| external extract_fastpath_int16_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_unsigned" "noalloc"
000694|  
-
000695| external extract_fastpath_int16_le_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_signed" "noalloc"
+
000695| external extract_fastpath_int16_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_signed" "noalloc"
000696|  
-
000697| external extract_fastpath_int16_ne_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_signed" "noalloc"
+
000697| external extract_fastpath_int16_le_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_signed" "noalloc"
000698|  
-
000699| (*
-
000700| external extract_fastpath_int24_be_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_unsigned" "noalloc"
-
000701|  
-
000702| external extract_fastpath_int24_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_unsigned" "noalloc"
+
000699| external extract_fastpath_int16_ne_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_signed" "noalloc"
+
000700|  
+
000701| (*
+
000702| external extract_fastpath_int24_be_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_unsigned" "noalloc"
000703|  
-
000704| external extract_fastpath_int24_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_unsigned" "noalloc"
+
000704| external extract_fastpath_int24_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_unsigned" "noalloc"
000705|  
-
000706| external extract_fastpath_int24_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_signed" "noalloc"
+
000706| external extract_fastpath_int24_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_unsigned" "noalloc"
000707|  
-
000708| external extract_fastpath_int24_le_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_signed" "noalloc"
+
000708| external extract_fastpath_int24_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_signed" "noalloc"
000709|  
-
000710| external extract_fastpath_int24_ne_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_signed" "noalloc"
-
000711| *)
-
000712|  
-
000713| external extract_fastpath_int32_be_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_unsigned" "noalloc"
+
000710| external extract_fastpath_int24_le_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_signed" "noalloc"
+
000711|  
+
000712| external extract_fastpath_int24_ne_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_signed" "noalloc"
+
000713| *)
000714|  
-
000715| external extract_fastpath_int32_le_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_unsigned" "noalloc"
+
000715| external extract_fastpath_int32_be_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_unsigned" "noalloc"
000716|  
-
000717| external extract_fastpath_int32_ne_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_unsigned" "noalloc"
+
000717| external extract_fastpath_int32_le_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_unsigned" "noalloc"
000718|  
-
000719| external extract_fastpath_int32_be_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_signed" "noalloc"
+
000719| external extract_fastpath_int32_ne_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_unsigned" "noalloc"
000720|  
-
000721| external extract_fastpath_int32_le_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_signed" "noalloc"
+
000721| external extract_fastpath_int32_be_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_signed" "noalloc"
000722|  
-
000723| external extract_fastpath_int32_ne_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_signed" "noalloc"
+
000723| external extract_fastpath_int32_le_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_signed" "noalloc"
000724|  
-
000725| (*
-
000726| external extract_fastpath_int40_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_unsigned" "noalloc"
-
000727|  
-
000728| external extract_fastpath_int40_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_unsigned" "noalloc"
+
000725| external extract_fastpath_int32_ne_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_signed" "noalloc"
+
000726|  
+
000727| (*
+
000728| external extract_fastpath_int40_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_unsigned" "noalloc"
000729|  
-
000730| external extract_fastpath_int40_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_unsigned" "noalloc"
+
000730| external extract_fastpath_int40_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_unsigned" "noalloc"
000731|  
-
000732| external extract_fastpath_int40_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_signed" "noalloc"
+
000732| external extract_fastpath_int40_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_unsigned" "noalloc"
000733|  
-
000734| external extract_fastpath_int40_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_signed" "noalloc"
+
000734| external extract_fastpath_int40_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_signed" "noalloc"
000735|  
-
000736| external extract_fastpath_int40_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_signed" "noalloc"
+
000736| external extract_fastpath_int40_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_signed" "noalloc"
000737|  
-
000738| external extract_fastpath_int48_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_unsigned" "noalloc"
+
000738| external extract_fastpath_int40_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_signed" "noalloc"
000739|  
-
000740| external extract_fastpath_int48_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_unsigned" "noalloc"
+
000740| external extract_fastpath_int48_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_unsigned" "noalloc"
000741|  
-
000742| external extract_fastpath_int48_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_unsigned" "noalloc"
+
000742| external extract_fastpath_int48_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_unsigned" "noalloc"
000743|  
-
000744| external extract_fastpath_int48_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_signed" "noalloc"
+
000744| external extract_fastpath_int48_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_unsigned" "noalloc"
000745|  
-
000746| external extract_fastpath_int48_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_signed" "noalloc"
+
000746| external extract_fastpath_int48_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_signed" "noalloc"
000747|  
-
000748| external extract_fastpath_int48_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_signed" "noalloc"
+
000748| external extract_fastpath_int48_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_signed" "noalloc"
000749|  
-
000750| external extract_fastpath_int56_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_unsigned" "noalloc"
+
000750| external extract_fastpath_int48_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_signed" "noalloc"
000751|  
-
000752| external extract_fastpath_int56_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_unsigned" "noalloc"
+
000752| external extract_fastpath_int56_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_unsigned" "noalloc"
000753|  
-
000754| external extract_fastpath_int56_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_unsigned" "noalloc"
+
000754| external extract_fastpath_int56_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_unsigned" "noalloc"
000755|  
-
000756| external extract_fastpath_int56_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_signed" "noalloc"
+
000756| external extract_fastpath_int56_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_unsigned" "noalloc"
000757|  
-
000758| external extract_fastpath_int56_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_signed" "noalloc"
+
000758| external extract_fastpath_int56_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_signed" "noalloc"
000759|  
-
000760| external extract_fastpath_int56_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_signed" "noalloc"
-
000761| *)
-
000762|  
-
000763| external extract_fastpath_int64_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_unsigned" "noalloc"
+
000760| external extract_fastpath_int56_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_signed" "noalloc"
+
000761|  
+
000762| external extract_fastpath_int56_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_signed" "noalloc"
+
000763| *)
000764|  
-
000765| external extract_fastpath_int64_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_unsigned" "noalloc"
+
000765| external extract_fastpath_int64_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_unsigned" "noalloc"
000766|  
-
000767| external extract_fastpath_int64_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_unsigned" "noalloc"
+
000767| external extract_fastpath_int64_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_unsigned" "noalloc"
000768|  
-
000769| external extract_fastpath_int64_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_signed" "noalloc"
+
000769| external extract_fastpath_int64_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_unsigned" "noalloc"
000770|  
-
000771| external extract_fastpath_int64_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_signed" "noalloc"
+
000771| external extract_fastpath_int64_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_signed" "noalloc"
000772|  
-
000773| external extract_fastpath_int64_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_signed" "noalloc"
+
000773| external extract_fastpath_int64_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_signed" "noalloc"
000774|  
-
000775| (*----------------------------------------------------------------------*)
-
000776| (* Constructor functions. *)
-
000777|  
-
000778| module Buffer = struct
-
000779|   type t = {
-
000780|     buf : Buffer.t;
-
000781|     mutable len : int;                        (* Length in bits. *)
-
000782|     (* Last byte in the buffer (if len is not aligned).  We store
-
000783|      * it outside the buffer because buffers aren't mutable.
-
000784|      *)
-
000785|     mutable last : int;
-
000786|   }
-
000787|  
-
000788|   let create () =
-
000789|     (* XXX We have almost enough information in the generator to
-
000790|      * choose a good initial size.
-
000791|      *)
-
000792|     (*[452559]*){ buf = Buffer.create 128; len = 0; last = 0 }
-
000793|  
-
000794|   let contents { buf = buf; len = len; last = last } =
-
000795|     (*[452559]*)let data =
-
000796|       if len land 7 = 0 then
-
000797|         (*[58202]*)Buffer.contents buf
-
000798|       else
-
000799|         (*[394357]*)Buffer.contents buf ^ (String.make 1 (Char.chr last)) in
-
000800|     (*[452559]*)data, 0, len
-
000801|  
-
000802|   (* Add exactly 8 bits. *)
-
000803|   let add_byte ({ buf = buf; len = len; last = last } as t) byte =
-
000804|     (*[8142106]*)if (*[8142106]*)byte < 0 || (*[8142106]*)byte > 255 then (*[0]*)invalid_arg "Bitstring.Buffer.add_byte";
-
000805|     (*[8142106]*)let shift = len land 7 in
-
000806|     (*[8142106]*)if shift = 0 then
-
000807|       (* Target buffer is byte-aligned. *)
-
000808|       (*[519924]*)Buffer.add_char buf (Char.chr byte)
-
000809|     else (
-
000810|       (* Target buffer is unaligned.  'last' is meaningful. *)
-
000811|       (*[7622182]*)let first = byte lsr shift in
-
000812|       (*[7622182]*)let second = (byte lsl (8 - shift)) land 0xff in
-
000813|       (*[7622182]*)Buffer.add_char buf (*[7622182]*)(Char.chr (last lor first));
-
000814|       (*[7622182]*)t.last <- second
-
000815|     );
-
000816|     (*[8142106]*)t.len <- t.len + 8
-
000817|  
-
000818|   (* Add exactly 1 bit. *)
-
000819|   let add_bit ({ buf = buf; len = len; last = last } as t) bit =
-
000820|     (*[4192108]*)let shift = 7 - (len land 7) in
-
000821|     (*[4192108]*)if shift > 0 then
-
000822|       (* Somewhere in the middle of 'last'. *)
-
000823|       (*[3692102]*)t.last <- last lor ((if bit then (*[2903776]*)1 else (*[788326]*)0) lsl shift)
-
000824|     else (
-
000825|       (* Just a single spare bit in 'last'. *)
-
000826|       (*[500006]*)let last = last lor if bit then (*[391339]*)1 else (*[108667]*)0 in
-
000827|       (*[500006]*)Buffer.add_char buf (*[500006]*)(Char.chr last);
-
000828|       (*[500006]*)t.last <- 0
-
000829|     );
-
000830|     (*[4192108]*)t.len <- len + 1
-
000831|  
-
000832|   (* Add a small number of bits (definitely < 8).  This uses a loop
-
000833|    * to call add_bit so it's slow.
-
000834|    *)
-
000835|   let _add_bits t c slen =
-
000836|     (*[317200]*)if (*[317200]*)slen < 1 || (*[317200]*)slen >= 8 then (*[0]*)invalid_arg "Bitstring.Buffer._add_bits";
-
000837|     (*[317200]*)for i = slen-1 downto 0 do
-
000838|       (*[1268791]*)let bit = c land (1 lsl i) <> 0 in
-
000839|       (*[1268791]*)add_bit t bit
-
000840|     done
-
000841|  
-
000842|   let add_bits ({ buf = buf; len = len } as t) str slen =
-
000843|     (*[23330]*)if slen > 0 then (
-
000844|       (*[1272292]*)if len land 7 = 0 then (
-
000845|         (*[525820]*)if slen land 7 = 0 then
-
000846|           (* Common case - everything is byte-aligned. *)
-
000847|           (*[58261]*)Buffer.add_substring buf str 0 (slen lsr 3)
-
000848|         else (
-
000849|           (* Target buffer is aligned.  Copy whole bytes then leave the
-
000850|            * remaining bits in last.
-
000851|            *)
-
000852|           (*[467559]*)let slenbytes = slen lsr 3 in
-
000853|           (*[335078]*)if slenbytes > 0 then (*[132481]*)Buffer.add_substring buf str 0 slenbytes;
-
000854|           (*[467559]*)let last = Char.code str.[slenbytes] in (* last char *)
-
000855|           (*[467559]*)let mask = 0xff lsl (8 - (slen land 7)) in
-
000856|           (*[467559]*)t.last <- last land mask
-
000857|         );
-
000858|         (*[525820]*)t.len <- len + slen
-
000859|       ) else (
-
000860|         (* Target buffer is unaligned.  Copy whole bytes using
-
000861|          * add_byte which knows how to deal with an unaligned
-
000862|          * target buffer, then call add_bit for the remaining < 8 bits.
-
000863|          *
-
000864|          * XXX This is going to be dog-slow.
-
000865|          *)
-
000866|         (*[746472]*)let slenbytes = slen lsr 3 in
-
000867|         (*[746472]*)for i = 0 to slenbytes-1 do
-
000868|           (*[5829660]*)let byte = Char.code str.[i] in
-
000869|           (*[5829660]*)add_byte t byte
-
000870|         done;
-
000871|         (*[746472]*)let bitsleft = slen - (slenbytes lsl 3) in
-
000872|         (*[136479]*)if bitsleft > 0 then (
-
000873|           (*[609993]*)let c = Char.code str.[slenbytes] in
-
000874|           (*[609993]*)for i = 0 to bitsleft - 1 do
-
000875|             (*[2423817]*)let bit = c land (0x80 lsr i) <> 0 in
-
000876|             (*[2423817]*)add_bit t bit
-
000877|           done
-
000878|         )
-
000879|       );
-
000880|     )
-
000881| end
-
000882|  
-
000883| (* Construct a single bit. *)
-
000884| let construct_bit buf b _ _ =
-
000885|   (*[0]*)Buffer.add_bit buf b
-
000886|  
-
000887| (* Construct a field, flen = [2..8]. *)
-
000888| let construct_char_unsigned buf v flen exn =
-
000889|   (*[1203570]*)let max_val = 1 lsl flen in
-
000890|   (*[1203570]*)if (*[1203570]*)v < 0 || (*[1203570]*)v >= max_val then (*[0]*)raise exn;
-
000891|   (*[1203570]*)if flen = 8 then
-
000892|     (*[1203570]*)Buffer.add_byte buf v
-
000893|   else
-
000894|     (*[0]*)Buffer._add_bits buf v flen
-
000895|  
-
000896| (* Construct a field of up to 31 bits. *)
-
000897| let construct_int_be_unsigned buf v flen exn =
-
000898|   (* Check value is within range. *)
-
000899|   (*[2]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;
-
000900|   (* Add the bytes. *)
-
000901|   (*[2]*)I.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
-
000902|  
-
000903| (* Construct a field of up to 31 bits. *)
-
000904| let construct_int_le_unsigned buf v flen exn =
-
000905|   (* Check value is within range. *)
-
000906|   (*[0]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;
-
000907|   (* Add the bytes. *)
-
000908|   (*[0]*)I.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
-
000909|  
-
000910| let construct_int_ne_unsigned =
-
000911|   (*[28]*)if nativeendian = BigEndian
-
000912|   then (*[0]*)construct_int_be_unsigned
-
000913|   else (*[28]*)construct_int_le_unsigned
-
000914|  
-
000915| let construct_int_ee_unsigned = function
-
000916|   | BigEndian -> (*[0]*)construct_int_be_unsigned
-
000917|   | LittleEndian -> (*[0]*)construct_int_le_unsigned
-
000918|   | NativeEndian -> (*[0]*)construct_int_ne_unsigned
-
000919|  
-
000920| (* Construct a field of exactly 32 bits. *)
-
000921| let construct_int32_be_unsigned buf v flen _ =
-
000922|   (*[6]*)Buffer.add_byte buf
-
000923|     (Int32.to_int (Int32.shift_right_logical v 24));
+
000775| external extract_fastpath_int64_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_signed" "noalloc"
+
000776|  
+
000777| (*----------------------------------------------------------------------*)
+
000778| (* Constructor functions. *)
+
000779|  
+
000780| module Buffer = struct
+
000781|   type t = {
+
000782|     buf : Buffer.t;
+
000783|     mutable len : int;                        (* Length in bits. *)
+
000784|     (* Last byte in the buffer (if len is not aligned).  We store
+
000785|      * it outside the buffer because buffers aren't mutable.
+
000786|      *)
+
000787|     mutable last : int;
+
000788|   }
+
000789|  
+
000790|   let create () =
+
000791|     (* XXX We have almost enough information in the generator to
+
000792|      * choose a good initial size.
+
000793|      *)
+
000794|     (*[493022]*){ buf = Buffer.create 128; len = 0; last = 0 }
+
000795|  
+
000796|   let contents { buf = buf; len = len; last = last } =
+
000797|     (*[493022]*)let data =
+
000798|       if len land 7 = 0 then
+
000799|         (*[63287]*)Buffer.contents buf
+
000800|       else
+
000801|         (*[429735]*)Buffer.contents buf ^ (String.make 1 (Char.chr last)) in
+
000802|     (*[493022]*)data, 0, len
+
000803|  
+
000804|   (* Add exactly 8 bits. *)
+
000805|   let add_byte ({ buf = buf; len = len; last = last } as t) byte =
+
000806|     (*[8255562]*)if (*[8255562]*)byte < 0 || (*[8255562]*)byte > 255 then (*[0]*)invalid_arg "Bitstring.Buffer.add_byte";
+
000807|     (*[8255562]*)let shift = len land 7 in
+
000808|     (*[8255562]*)if shift = 0 then
+
000809|       (* Target buffer is byte-aligned. *)
+
000810|       (*[519924]*)Buffer.add_char buf (Char.chr byte)
+
000811|     else (
+
000812|       (* Target buffer is unaligned.  'last' is meaningful. *)
+
000813|       (*[7735638]*)let first = byte lsr shift in
+
000814|       (*[7735638]*)let second = (byte lsl (8 - shift)) land 0xff in
+
000815|       (*[7735638]*)Buffer.add_char buf (*[7735638]*)(Char.chr (last lor first));
+
000816|       (*[7735638]*)t.last <- second
+
000817|     );
+
000818|     (*[8255562]*)t.len <- t.len + 8
+
000819|  
+
000820|   (* Add exactly 1 bit. *)
+
000821|   let add_bit ({ buf = buf; len = len; last = last } as t) bit =
+
000822|     (*[4421229]*)let shift = 7 - (len land 7) in
+
000823|     (*[4421229]*)if shift > 0 then
+
000824|       (* Somewhere in the middle of 'last'. *)
+
000825|       (*[3888935]*)t.last <- last lor ((if bit then (*[3003091]*)1 else (*[885844]*)0) lsl shift)
+
000826|     else (
+
000827|       (* Just a single spare bit in 'last'. *)
+
000828|       (*[532294]*)let last = last lor if bit then (*[407635]*)1 else (*[124659]*)0 in
+
000829|       (*[532294]*)Buffer.add_char buf (*[532294]*)(Char.chr last);
+
000830|       (*[532294]*)t.last <- 0
+
000831|     );
+
000832|     (*[4421229]*)t.len <- len + 1
+
000833|  
+
000834|   (* Add a small number of bits (definitely < 8).  This uses a loop
+
000835|    * to call add_bit so it's slow.
+
000836|    *)
+
000837|   let _add_bits t c slen =
+
000838|     (*[317200]*)if (*[317200]*)slen < 1 || (*[317200]*)slen >= 8 then (*[0]*)invalid_arg "Bitstring.Buffer._add_bits";
+
000839|     (*[317200]*)for i = slen-1 downto 0 do
+
000840|       (*[1268974]*)let bit = c land (1 lsl i) <> 0 in
+
000841|       (*[1268974]*)add_bit t bit
+
000842|     done
+
000843|  
+
000844|   let add_bits ({ buf = buf; len = len } as t) str slen =
+
000845|     (*[26866]*)if slen > 0 then (
+
000846|       (*[1388985]*)if len land 7 = 0 then (
+
000847|         (*[575655]*)if slen land 7 = 0 then
+
000848|           (* Common case - everything is byte-aligned. *)
+
000849|           (*[64306]*)Buffer.add_substring buf str 0 (slen lsr 3)
+
000850|         else (
+
000851|           (* Target buffer is aligned.  Copy whole bytes then leave the
+
000852|            * remaining bits in last.
+
000853|            *)
+
000854|           (*[511349]*)let slenbytes = slen lsr 3 in
+
000855|           (*[345648]*)if slenbytes > 0 then (*[165701]*)Buffer.add_substring buf str 0 slenbytes;
+
000856|           (*[511349]*)let last = Char.code str.[slenbytes] in (* last char *)
+
000857|           (*[511349]*)let mask = 0xff lsl (8 - (slen land 7)) in
+
000858|           (*[511349]*)t.last <- last land mask
+
000859|         );
+
000860|         (*[575655]*)t.len <- len + slen
+
000861|       ) else (
+
000862|         (* Target buffer is unaligned.  Copy whole bytes using
+
000863|          * add_byte which knows how to deal with an unaligned
+
000864|          * target buffer, then call add_bit for the remaining < 8 bits.
+
000865|          *
+
000866|          * XXX This is going to be dog-slow.
+
000867|          *)
+
000868|         (*[813330]*)let slenbytes = slen lsr 3 in
+
000869|         (*[813330]*)for i = 0 to slenbytes-1 do
+
000870|           (*[5943116]*)let byte = Char.code str.[i] in
+
000871|           (*[5943116]*)add_byte t byte
+
000872|         done;
+
000873|         (*[813330]*)let bitsleft = slen - (slenbytes lsl 3) in
+
000874|         (*[144583]*)if bitsleft > 0 then (
+
000875|           (*[668747]*)let c = Char.code str.[slenbytes] in
+
000876|           (*[668747]*)for i = 0 to bitsleft - 1 do
+
000877|             (*[2652755]*)let bit = c land (0x80 lsr i) <> 0 in
+
000878|             (*[2652755]*)add_bit t bit
+
000879|           done
+
000880|         )
+
000881|       );
+
000882|     )
+
000883| end
+
000884|  
+
000885| (* Construct a single bit. *)
+
000886| let construct_bit buf b _ _ =
+
000887|   (*[0]*)Buffer.add_bit buf b
+
000888|  
+
000889| (* Construct a field, flen = [2..8]. *)
+
000890| let construct_char_unsigned buf v flen exn =
+
000891|   (*[1203570]*)let max_val = 1 lsl flen in
+
000892|   (*[1203570]*)if (*[1203570]*)v < 0 || (*[1203570]*)v >= max_val then (*[0]*)raise exn;
+
000893|   (*[1203570]*)if flen = 8 then
+
000894|     (*[1203570]*)Buffer.add_byte buf v
+
000895|   else
+
000896|     (*[0]*)Buffer._add_bits buf v flen
+
000897|  
+
000898| (* Construct a field of up to 31 bits. *)
+
000899| let construct_int_be_unsigned buf v flen exn =
+
000900|   (* Check value is within range. *)
+
000901|   (*[2]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;
+
000902|   (* Add the bytes. *)
+
000903|   (*[2]*)I.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
+
000904|  
+
000905| (* Construct a field of up to 31 bits. *)
+
000906| let construct_int_le_unsigned buf v flen exn =
+
000907|   (* Check value is within range. *)
+
000908|   (*[0]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;
+
000909|   (* Add the bytes. *)
+
000910|   (*[0]*)I.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
+
000911|  
+
000912| let construct_int_ne_unsigned =
+
000913|   (*[34]*)if nativeendian = BigEndian
+
000914|   then (*[0]*)construct_int_be_unsigned
+
000915|   else (*[34]*)construct_int_le_unsigned
+
000916|  
+
000917| let construct_int_ee_unsigned = function
+
000918|   | BigEndian -> (*[0]*)construct_int_be_unsigned
+
000919|   | LittleEndian -> (*[0]*)construct_int_le_unsigned
+
000920|   | NativeEndian -> (*[0]*)construct_int_ne_unsigned
+
000921|  
+
000922| (* Construct a field of exactly 32 bits. *)
+
000923| let construct_int32_be_unsigned buf v flen _ =
000924|   (*[6]*)Buffer.add_byte buf
-
000925|     (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));
+
000925|     (Int32.to_int (Int32.shift_right_logical v 24));
000926|   (*[6]*)Buffer.add_byte buf
-
000927|     (*[6]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));
+
000927|     (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));
000928|   (*[6]*)Buffer.add_byte buf
-
000929|     (Int32.to_int (Int32.logand v 0xff_l))
-
000930|  
-
000931| let construct_int32_le_unsigned buf v flen _ =
-
000932|   (*[12]*)Buffer.add_byte buf
-
000933|     (Int32.to_int (Int32.logand v 0xff_l));
+
000929|     (*[6]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));
+
000930|   (*[6]*)Buffer.add_byte buf
+
000931|     (Int32.to_int (Int32.logand v 0xff_l))
+
000932|  
+
000933| let construct_int32_le_unsigned buf v flen _ =
000934|   (*[12]*)Buffer.add_byte buf
-
000935|     (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));
+
000935|     (Int32.to_int (Int32.logand v 0xff_l));
000936|   (*[12]*)Buffer.add_byte buf
-
000937|     (*[12]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));
+
000937|     (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));
000938|   (*[12]*)Buffer.add_byte buf
-
000939|     (Int32.to_int (Int32.shift_right_logical v 24))
-
000940|  
-
000941| let construct_int32_ne_unsigned =
-
000942|   (*[28]*)if nativeendian = BigEndian
-
000943|   then (*[0]*)construct_int32_be_unsigned
-
000944|   else (*[28]*)construct_int32_le_unsigned
-
000945|  
-
000946| let construct_int32_ee_unsigned = function
-
000947|   | BigEndian -> (*[6]*)construct_int32_be_unsigned
-
000948|   | LittleEndian -> (*[6]*)construct_int32_le_unsigned
-
000949|   | NativeEndian -> (*[6]*)construct_int32_ne_unsigned
-
000950|  
-
000951| (* Construct a field of up to 64 bits. *)
-
000952| let construct_int64_be_unsigned buf v flen exn =
-
000953|   (* Check value is within range. *)
-
000954|   (*[351850]*)if not (I64.range_unsigned v flen) then (*[0]*)raise exn;
-
000955|   (* Add the bytes. *)
-
000956|   (*[351850]*)I64.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
-
000957|  
-
000958| (* Construct a field of up to 64 bits. *)
-
000959| let construct_int64_le_unsigned buf v flen exn =
-
000960|   (* Check value is within range. *)
-
000961|   (*[0]*)if not (I64.range_unsigned v flen) then (*[0]*)raise exn;
-
000962|   (* Add the bytes. *)
-
000963|   (*[0]*)I64.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
-
000964|  
-
000965| let construct_int64_ne_unsigned =
-
000966|   (*[28]*)if nativeendian = BigEndian
-
000967|   then (*[0]*)construct_int64_be_unsigned
-
000968|   else (*construct_int64_le_unsigned*)
-
000969|     fun _ _ _ _ -> (*[0]*)failwith "construct_int64_le_unsigned"
-
000970|  
-
000971| let construct_int64_ee_unsigned = function
-
000972|   | BigEndian -> (*[0]*)construct_int64_be_unsigned
-
000973|   | LittleEndian -> (*construct_int64_le_unsigned*)
-
000974|       (fun _ _ _ _ -> (*[0]*)failwith "construct_int64_le_unsigned")
-
000975|   | NativeEndian -> (*[0]*)construct_int64_ne_unsigned
-
000976|  
-
000977| (* Construct from a string of bytes, exact multiple of 8 bits
-
000978|  * in length of course.
-
000979|  *)
-
000980| let construct_string buf str =
-
000981|   (*[89505]*)let len = String.length str in
-
000982|   (*[89505]*)Buffer.add_bits buf str (len lsl 3)
-
000983|  
-
000984| (* Construct from a bitstring. *)
-
000985| let construct_bitstring buf (data, off, len) =
-
000986|   (* Add individual bits until we get to the next byte boundary of
-
000987|    * the underlying string.
-
000988|    *)
-
000989|   (*[1197537]*)let blen = 7 - ((off + 7) land 7) in
-
000990|   (*[1197537]*)let blen = min blen len in
-
000991|   (*[1197537]*)let rec loop off len blen =
-
000992|     (*[1197537]*)if blen = 0 then ((*[1197537]*)off, len)
-
000993|     else (
-
000994|       (*[0]*)let b = extract_bit data off len 1
-
000995|       and off = off + 1 and len = len + 1 in
-
000996|       (*[0]*)Buffer.add_bit buf (*[0]*)b;
-
000997|       (*[0]*)loop off len (blen-1)
-
000998|     )
-
000999|   in
-
001000|   (*[1197537]*)let off, len = loop off len blen in
-
001001|   (*[1197537]*)assert ((*[1197537]*)len = 0 || (off (*[1174272]*)land 7) = 0);
-
001002|  
-
001003|   (* Add the remaining 'len' bits. *)
-
001004|   (*[1197537]*)let data =
-
001005|     let off = off lsr 3 in
-
001006|     (* XXX dangerous allocation *)
-
001007|     (*[1197537]*)if off = 0 then (*[1197537]*)data
-
001008|     else (*[0]*)String.sub data off (String.length data - off) in
-
001009|  
-
001010|   (*[1197537]*)Buffer.add_bits buf data len
+
000939|     (*[12]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));
+
000940|   (*[12]*)Buffer.add_byte buf
+
000941|     (Int32.to_int (Int32.shift_right_logical v 24))
+
000942|  
+
000943| let construct_int32_ne_unsigned =
+
000944|   (*[34]*)if nativeendian = BigEndian
+
000945|   then (*[0]*)construct_int32_be_unsigned
+
000946|   else (*[34]*)construct_int32_le_unsigned
+
000947|  
+
000948| let construct_int32_ee_unsigned = function
+
000949|   | BigEndian -> (*[6]*)construct_int32_be_unsigned
+
000950|   | LittleEndian -> (*[6]*)construct_int32_le_unsigned
+
000951|   | NativeEndian -> (*[6]*)construct_int32_ne_unsigned
+
000952|  
+
000953| (* Construct a field of up to 64 bits. *)
+
000954| let construct_int64_be_unsigned buf v flen exn =
+
000955|   (* Check value is within range. *)
+
000956|   (*[351850]*)if not (I64.range_unsigned v flen) then (*[0]*)raise exn;
+
000957|   (* Add the bytes. *)
+
000958|   (*[351850]*)I64.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
+
000959|  
+
000960| (* Construct a field of up to 64 bits. *)
+
000961| let construct_int64_le_unsigned buf v flen exn =
+
000962|   (* Check value is within range. *)
+
000963|   (*[0]*)if not (I64.range_unsigned v flen) then (*[0]*)raise exn;
+
000964|   (* Add the bytes. *)
+
000965|   (*[0]*)I64.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
+
000966|  
+
000967| let construct_int64_ne_unsigned =
+
000968|   (*[34]*)if nativeendian = BigEndian
+
000969|   then (*[0]*)construct_int64_be_unsigned
+
000970|   else (*construct_int64_le_unsigned*)
+
000971|     fun _ _ _ _ -> (*[0]*)failwith "construct_int64_le_unsigned"
+
000972|  
+
000973| let construct_int64_ee_unsigned = function
+
000974|   | BigEndian -> (*[0]*)construct_int64_be_unsigned
+
000975|   | LittleEndian -> (*construct_int64_le_unsigned*)
+
000976|       (fun _ _ _ _ -> (*[0]*)failwith "construct_int64_le_unsigned")
+
000977|   | NativeEndian -> (*[0]*)construct_int64_ne_unsigned
+
000978|  
+
000979| (* Construct from a string of bytes, exact multiple of 8 bits
+
000980|  * in length of course.
+
000981|  *)
+
000982| let construct_string buf str =
+
000983|   (*[89505]*)let len = String.length str in
+
000984|   (*[89505]*)Buffer.add_bits buf str (len lsl 3)
+
000985|  
+
000986| (* Construct from a bitstring. *)
+
000987| let construct_bitstring buf (data, off, len) =
+
000988|   (* Add individual bits until we get to the next byte boundary of
+
000989|    * the underlying string.
+
000990|    *)
+
000991|   (*[1317766]*)let blen = 7 - ((off + 7) land 7) in
+
000992|   (*[1317766]*)let blen = min blen len in
+
000993|   (*[1317766]*)let rec loop off len blen =
+
000994|     (*[1317766]*)if blen = 0 then ((*[1317766]*)off, len)
+
000995|     else (
+
000996|       (*[0]*)let b = extract_bit data off len 1
+
000997|       and off = off + 1 and len = len + 1 in
+
000998|       (*[0]*)Buffer.add_bit buf (*[0]*)b;
+
000999|       (*[0]*)loop off len (blen-1)
+
001000|     )
+
001001|   in
+
001002|   (*[1317766]*)let off, len = loop off len blen in
+
001003|   (*[1317766]*)assert ((*[1317766]*)len = 0 || (off (*[1290965]*)land 7) = 0);
+
001004|  
+
001005|   (* Add the remaining 'len' bits. *)
+
001006|   (*[1317766]*)let data =
+
001007|     let off = off lsr 3 in
+
001008|     (* XXX dangerous allocation *)
+
001009|     (*[1317766]*)if off = 0 then (*[1317766]*)data
+
001010|     else (*[0]*)String.sub data off (String.length data - off) in
001011|  
-
001012| (*----------------------------------------------------------------------*)
-
001013| (* Extract a string from a bitstring. *)
-
001014|  
-
001015| let string_of_bitstring (data, off, len) =
-
001016|   (*[63963]*)if off (*[63963]*)land 7 = 0 && len (*[8535]*)land 7 = 0 then
-
001017|     (* Easy case: everything is byte-aligned. *)
-
001018|     (*[8022]*)String.sub data (off lsr 3) (len lsr 3)
-
001019|   else (
-
001020|     (* Bit-twiddling case. *)
-
001021|     (*[55941]*)let strlen = (len + 7) lsr 3 in
-
001022|     (*[55941]*)let str = String.make strlen '\000' in
-
001023|     (*[55941]*)let rec loop data off len i =
-
001024|       (*[305313]*)if len >= 8 then (
-
001025|         (*[249372]*)let c = extract_char_unsigned data off len 8
-
001026|         and off = off + 8 and len = len - 8 in
-
001027|         (*[249372]*)str.[i] (*[249372]*)<- Char.chr c;
-
001028|         (*[249372]*)loop data off len (i+1)
-
001029|       ) else (*[52179]*)if len > 0 then (
-
001030|         (*[3762]*)let c = extract_char_unsigned data off len len in
-
001031|         (*[3762]*)str.[i] <- Char.chr (c lsl (8-len))
-
001032|       )
-
001033|     in
-
001034|     (*[55941]*)loop data off len (*[55941]*)0;
-
001035|     (*[55941]*)str
-
001036|   )
-
001037|  
-
001038| (* To channel. *)
-
001039|  
-
001040| let bitstring_to_chan ((data, off, len) as bits) chan =
-
001041|   (* Fail if the bitstring length isn't a multiple of 8. *)
-
001042|   (*[0]*)if len land 7 <> 0 then (*[0]*)invalid_arg "bitstring_to_chan";
-
001043|  
-
001044|   (*[0]*)if off land 7 = 0 then
-
001045|     (* Easy case: string is byte-aligned. *)
-
001046|     (*[0]*)output chan data (off lsr 3) (len lsr 3)
-
001047|   else (
-
001048|     (* Bit-twiddling case: reuse string_of_bitstring *)
-
001049|     (*[0]*)let str = string_of_bitstring bits in
-
001050|     (*[0]*)output_string chan str
-
001051|   )
-
001052|  
-
001053| let bitstring_to_file bits filename =
-
001054|   (*[0]*)let chan = open_out_bin filename in
-
001055|   (*[0]*)try
-
001056|     (*[0]*)bitstring_to_chan bits chan;
-
001057|     (*[0]*)close_out chan
-
001058|   with exn ->
-
001059|     (*[0]*)close_out (*[0]*)chan;
-
001060|     (*[0]*)raise exn
-
001061|  
-
001062| (*----------------------------------------------------------------------*)
-
001063| (* Display functions. *)
-
001064|  
-
001065| let isprint c =
-
001066|   (*[0]*)let c = Char.code c in
-
001067|   (*[0]*)c (*[0]*)>= 32 && (*[0]*)c < 127
+
001012|   (*[1317766]*)Buffer.add_bits buf data len
+
001013|  
+
001014| (* Concatenate bitstrings. *)
+
001015| let concat bs =
+
001016|   (*[40461]*)let buf = Buffer.create () in
+
001017|   (*[40461]*)List.iter (construct_bitstring buf) (*[40461]*)bs;
+
001018|   (*[40461]*)Buffer.contents buf
+
001019|  
+
001020| (*----------------------------------------------------------------------*)
+
001021| (* Extract a string from a bitstring. *)
+
001022| let string_of_bitstring (data, off, len) =
+
001023|   (*[73011]*)if off (*[73011]*)land 7 = 0 && len (*[16597]*)land 7 = 0 then
+
001024|     (* Easy case: everything is byte-aligned. *)
+
001025|     (*[9037]*)String.sub data (off lsr 3) (len lsr 3)
+
001026|   else (
+
001027|     (* Bit-twiddling case. *)
+
001028|     (*[63974]*)let strlen = (len + 7) lsr 3 in
+
001029|     (*[63974]*)let str = String.make strlen '\000' in
+
001030|     (*[63974]*)let rec loop data off len i =
+
001031|       (*[326148]*)if len >= 8 then (
+
001032|         (*[262174]*)let c = extract_char_unsigned data off len 8
+
001033|         and off = off + 8 and len = len - 8 in
+
001034|         (*[262174]*)str.[i] (*[262174]*)<- Char.chr c;
+
001035|         (*[262174]*)loop data off len (i+1)
+
001036|       ) else (*[52324]*)if len > 0 then (
+
001037|         (*[11650]*)let c = extract_char_unsigned data off len len in
+
001038|         (*[11650]*)str.[i] <- Char.chr (c lsl (8-len))
+
001039|       )
+
001040|     in
+
001041|     (*[63974]*)loop data off len (*[63974]*)0;
+
001042|     (*[63974]*)str
+
001043|   )
+
001044|  
+
001045| (* To channel. *)
+
001046|  
+
001047| let bitstring_to_chan ((data, off, len) as bits) chan =
+
001048|   (* Fail if the bitstring length isn't a multiple of 8. *)
+
001049|   (*[1]*)if len land 7 <> 0 then (*[0]*)invalid_arg "bitstring_to_chan";
+
001050|  
+
001051|   (*[1]*)if off land 7 = 0 then
+
001052|     (* Easy case: string is byte-aligned. *)
+
001053|     (*[1]*)output chan data (off lsr 3) (len lsr 3)
+
001054|   else (
+
001055|     (* Bit-twiddling case: reuse string_of_bitstring *)
+
001056|     (*[0]*)let str = string_of_bitstring bits in
+
001057|     (*[0]*)output_string chan str
+
001058|   )
+
001059|  
+
001060| let bitstring_to_file bits filename =
+
001061|   (*[0]*)let chan = open_out_bin filename in
+
001062|   (*[0]*)try
+
001063|     (*[0]*)bitstring_to_chan bits chan;
+
001064|     (*[0]*)close_out chan
+
001065|   with exn ->
+
001066|     (*[0]*)close_out (*[0]*)chan;
+
001067|     (*[0]*)raise exn
001068|  
-
001069| let hexdump_bitstring chan (data, off, len) =
-
001070|   (*[0]*)let count = ref 0 in
-
001071|   (*[0]*)let off = ref off in
-
001072|   (*[0]*)let len = ref len in
-
001073|   (*[0]*)let linelen = ref 0 in
-
001074|   (*[0]*)let linechars = String.make 16 ' ' in
-
001075|  
-
001076|   (*[0]*)fprintf chan "00000000  ";
-
001077|  
-
001078|   (*[0]*)while !len > 0 do
-
001079|     (*[0]*)let bits = min !len 8 in
-
001080|     (*[0]*)let byte = extract_char_unsigned data !off !len bits in
-
001081|     (*[0]*)off := !off + bits; (*[0]*)len (*[0]*):= !len - bits;
-
001082|  
-
001083|     (*[0]*)let byte = byte lsl (8-bits) in
-
001084|     (*[0]*)fprintf chan "%02x " byte;
-
001085|  
-
001086|     (*[0]*)incr count;
-
001087|     (*[0]*)linechars.[!linelen] <-
-
001088|       (let c = Char.chr byte in
-
001089|        (*[0]*)if isprint c then (*[0]*)c else (*[0]*)'.');
-
001090|     (*[0]*)incr linelen;
-
001091|     (*[0]*)if !linelen = 8 then (*[0]*)fprintf chan " ";
-
001092|     (*[0]*)if !linelen = 16 then (
-
001093|       (*[0]*)fprintf chan " |%s|\n%08x  " linechars !count;
-
001094|       (*[0]*)linelen (*[0]*):= 0;
-
001095|       (*[0]*)for i = 0 to 15 do (*[0]*)linechars.[i] <- ' ' done
-
001096|     )
-
001097|   done;
-
001098|  
-
001099|   (*[0]*)if !linelen > 0 then (
-
001100|     (*[0]*)let skip = (16 - !linelen) * 3 + if !linelen < 8 then (*[0]*)1 else (*[0]*)0 in
-
001101|     (*[0]*)for i = 0 to skip-1 do (*[0]*)fprintf chan " " done;
-
001102|     (*[0]*)fprintf chan " |%s|\n%!" linechars
-
001103|   ) else
-
001104|     (*[0]*)fprintf chan "\n%!"
+
001069| (*----------------------------------------------------------------------*)
+
001070| (* Comparison. *)
+
001071| let compare ((data1, off1, len1) as bs1) ((data2, off2, len2) as bs2) =
+
001072|   (* In the fully-aligned case, this is reduced to string comparison ... *)
+
001073|   (*[4624]*)if off1 (*[4624]*)land 7 = 0 && len1 (*[4624]*)land 7 (*[4624]*)= 0 && off2 (*[680]*)land 7 (*[680]*)= 0 && len2 (*[535]*)land 7 = 0
+
001074|   then (
+
001075|     (* ... but we have to do that by hand because the bits may
+
001076|      * not extend to the full length of the underlying string.
+
001077|      *)
+
001078|     (*[100]*)let off1 = off1 lsr 3 and off2 = off2 lsr 3
+
001079|     and len1 = len1 lsr 3 and len2 = len2 lsr 3 in
+
001080|     (*[100]*)let rec loop i =
+
001081|       (*[240]*)if (*[240]*)i < len1 && (*[170]*)i < len2 then (
+
001082|         (*[140]*)let c1 = String.unsafe_get data1 (off1 + i)
+
001083|         and c2 = String.unsafe_get data2 (off2 + i) in
+
001084|         (*[140]*)let r = compare c1 c2 in
+
001085|         (*[140]*)if r <> 0 then (*[0]*)r
+
001086|         else (*[140]*)loop (i+1)
+
001087|       )
+
001088|       else (*[100]*)len1 - len2
+
001089|     in
+
001090|     (*[100]*)loop 0
+
001091|   )
+
001092|   else (
+
001093|     (* Slow/unaligned. *)
+
001094|     (*[4524]*)let str1 = string_of_bitstring bs1
+
001095|     and str2 = string_of_bitstring bs2 in
+
001096|     (*[4524]*)let r = String.compare str1 str2 in
+
001097|     (*[4524]*)if r <> 0 then (*[3058]*)r else (*[1466]*)len1 - len2
+
001098|   )
+
001099|  
+
001100| let equals ((_, _, len1) as bs1) ((_, _, len2) as bs2) =
+
001101|   (*[7]*)if len1 <> len2 then (*[0]*)false
+
001102|   else (*[7]*)if bs1 = bs2 then (*[7]*)true
+
001103|   else (*[0]*)0 = compare bs1 bs2
+
001104|  
+
001105| (*----------------------------------------------------------------------*)
+
001106| (* Bit get/set functions. *)
+
001107|  
+
001108| let index_out_of_bounds () = (*[0]*)invalid_arg "index out of bounds"
+
001109|  
+
001110| let put (data, off, len) n v =
+
001111|   (*[0]*)if (*[0]*)n < 0 || (*[0]*)off+n >= len then (*[0]*)index_out_of_bounds ()
+
001112|   else (
+
001113|     (*[0]*)let i = off+n in
+
001114|     (*[0]*)let si = i lsr 3 and mask = 0x80 lsr (i land 7) in
+
001115|     (*[0]*)let c = Char.code data.[si] in
+
001116|     (*[0]*)let c = if v <> 0 then c (*[0]*)lor mask else c (*[0]*)land (lnot mask) in
+
001117|     (*[0]*)data.[si] <- Char.unsafe_chr c
+
001118|   )
+
001119|  
+
001120| let set bits n = (*[0]*)put bits n 1
+
001121|  
+
001122| let clear bits n = (*[0]*)put bits n 0
+
001123|  
+
001124| let get (data, off, len) n =
+
001125|   (*[1945548]*)if (*[1945548]*)n < 0 || (*[1945548]*)off+n >= len then (*[0]*)index_out_of_bounds ()
+
001126|   else (
+
001127|     (*[1945548]*)let i = off+n in
+
001128|     (*[1945548]*)let si = i lsr 3 and mask = 0x80 lsr (i land 7) in
+
001129|     (*[1945548]*)let c = Char.code data.[si] in
+
001130|     c (*[1945548]*)land mask
+
001131|   )
+
001132|  
+
001133| let is_set bits n = (*[1297032]*)get bits n <> 0
+
001134|  
+
001135| let is_clear bits n = (*[648516]*)get bits n = 0
+
001136|  
+
001137| (*----------------------------------------------------------------------*)
+
001138| (* Display functions. *)
+
001139|  
+
001140| let isprint c =
+
001141|   (*[0]*)let c = Char.code c in
+
001142|   (*[0]*)c (*[0]*)>= 32 && (*[0]*)c < 127
+
001143|  
+
001144| let hexdump_bitstring chan (data, off, len) =
+
001145|   (*[0]*)let count = ref 0 in
+
001146|   (*[0]*)let off = ref off in
+
001147|   (*[0]*)let len = ref len in
+
001148|   (*[0]*)let linelen = ref 0 in
+
001149|   (*[0]*)let linechars = String.make 16 ' ' in
+
001150|  
+
001151|   (*[0]*)fprintf chan "00000000  ";
+
001152|  
+
001153|   (*[0]*)while !len > 0 do
+
001154|     (*[0]*)let bits = min !len 8 in
+
001155|     (*[0]*)let byte = extract_char_unsigned data !off !len bits in
+
001156|     (*[0]*)off := !off + bits; (*[0]*)len (*[0]*):= !len - bits;
+
001157|  
+
001158|     (*[0]*)let byte = byte lsl (8-bits) in
+
001159|     (*[0]*)fprintf chan "%02x " byte;
+
001160|  
+
001161|     (*[0]*)incr count;
+
001162|     (*[0]*)linechars.[!linelen] <-
+
001163|       (let c = Char.chr byte in
+
001164|        (*[0]*)if isprint c then (*[0]*)c else (*[0]*)'.');
+
001165|     (*[0]*)incr linelen;
+
001166|     (*[0]*)if !linelen = 8 then (*[0]*)fprintf chan " ";
+
001167|     (*[0]*)if !linelen = 16 then (
+
001168|       (*[0]*)fprintf chan " |%s|\n%08x  " linechars !count;
+
001169|       (*[0]*)linelen (*[0]*):= 0;
+
001170|       (*[0]*)for i = 0 to 15 do (*[0]*)linechars.[i] <- ' ' done
+
001171|     )
+
001172|   done;
+
001173|  
+
001174|   (*[0]*)if !linelen > 0 then (
+
001175|     (*[0]*)let skip = (16 - !linelen) * 3 + if !linelen < 8 then (*[0]*)1 else (*[0]*)0 in
+
001176|     (*[0]*)for i = 0 to skip-1 do (*[0]*)fprintf chan " " done;
+
001177|     (*[0]*)fprintf chan " |%s|\n%!" linechars
+
001178|   ) else
+
001179|     (*[0]*)fprintf chan "\n%!"
-

Generated by Bisect on 2008-08-26 10:36:20

+

Generated by Bisect on 2008-08-26 17:29:02

diff --git a/coverage-report/file0002.html b/coverage-report/file0002.html index 102e516..2ad85f5 100644 --- a/coverage-report/file0002.html +++ b/coverage-report/file0002.html @@ -54,6 +54,6 @@
000027| include Bitstring
-

Generated by Bisect on 2008-08-26 10:36:20

+

Generated by Bisect on 2008-08-26 17:29:02

diff --git a/coverage-report/file0003.html b/coverage-report/file0003.html index 7a90889..76e00df 100644 --- a/coverage-report/file0003.html +++ b/coverage-report/file0003.html @@ -54,6 +54,6 @@
000027|   | NativeEndian -> (*[0]*)"nativeendian"
-

Generated by Bisect on 2008-08-26 10:36:20

+

Generated by Bisect on 2008-08-26 17:29:02

diff --git a/coverage-report/index.html b/coverage-report/index.html index df94381..a697d4b 100644 --- a/coverage-report/index.html +++ b/coverage-report/index.html @@ -10,13 +10,13 @@

Overall statistics

- - + + - - - - + + + + @@ -52,9 +52,9 @@ @@ -92,6 +92,6 @@

-

Generated by Bisect on 2008-08-26 10:36:20

+

Generated by Bisect on 2008-08-26 17:29:02

-- 1.8.3.1
kind coverage
binding 119 / 231 (51 %)
sequence 37 / 93 (39 %)
binding 149 / 245 (60 %)
sequence 60 / 95 (63 %)
for 3 / 5 (60 %)
if/then 72 / 163 (44 %)
try 0 / 2 (0 %)
while 0 / 3 (0 %)
match/function 41 / 77 (53 %)
if/then 100 / 193 (51 %)
try 1 / 2 (50 %)
while 2 / 3 (66 %)
match/function 53 / 88 (60 %)
class expression 0 / 0 (- %)
class initializer 0 / 0 (- %)
class method 0 / 0 (- %)
kind coverage
binding 123 / 235 (52 %)
sequence 37 / 93 (39 %)
binding 153 / 249 (61 %)
sequence 60 / 95 (63 %)
for 3 / 5 (60 %)
if/then 72 / 163 (44 %)
try 0 / 2 (0 %)
while 0 / 3 (0 %)
match/function 41 / 80 (51 %)
if/then 100 / 193 (51 %)
try 1 / 2 (50 %)
while 2 / 3 (66 %)
match/function 53 / 91 (58 %)
class expression 0 / 0 (- %)
class initializer 0 / 0 (- %)
class method 0 / 0 (- %)
- +
- -  47% + +  58%