000001| (* Bitstring library.
      000002|  * Copyright (C) 2008 Red Hat Inc., Richard W.M. Jones
      000003|  *
      000004|  * This library is free software; you can redistribute it and/or
      000005|  * modify it under the terms of the GNU Lesser General Public
      000006|  * License as published by the Free Software Foundation; either
      000007|  * version 2 of the License, or (at your option) any later version,
      000008|  * with the OCaml linking exception described in COPYING.LIB.
      000009|  *
      000010|  * This library is distributed in the hope that it will be useful,
      000011|  * but WITHOUT ANY WARRANTY; without even the implied warranty of
      000012|  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
      000013|  * Lesser General Public License for more details.
      000014|  *
      000015|  * You should have received a copy of the GNU Lesser General Public
      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 159 2008-08-27 11:26:45Z richard.wm.jones $
      000020|  *)
      000021|  
      000022| open Printf
      000023|  
      000024| include Bitstring_types
      000025| include Bitstring_config
      000026|  
      000027| (* Enable runtime debug messages.  Must also have been enabled
      000028|  * in pa_bitstring.ml.
      000029|  *)
      000030| let debug = (*[43]*)ref false
      000031|  
      000032| (* Exceptions. *)
      000033| exception Construct_failure of string * string * int * int
      000034|  
      000035| (* A bitstring is simply the data itself (as a string), and the
      000036|  * bitoffset and the bitlength within the string.  Note offset/length
      000037|  * are counted in bits, not bytes.
      000038|  *)
      000039| type bitstring = string * int * int
      000040|  
      000041| type t = bitstring
      000042|  
      000043| (* Functions to create and load bitstrings. *)
      000044| let empty_bitstring = (*[43]*)"", 0, 0
      000045|  
      000046| let make_bitstring len c =
      000047|   (*[1325989]*)if len >= 0 then (*[1325989]*)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 create_bitstring len = (*[42903]*)make_bitstring len '\000'
      000054|  
      000055| let zeroes_bitstring = (*[43]*)create_bitstring
      000056|  
      000057| let ones_bitstring len = (*[1278457]*)make_bitstring len '\xff'
      000058|  
      000059| let bitstring_of_string str = (*[2]*)str, 0, String.length str lsl 3
      000060|  
      000061| let bitstring_of_chan chan =
      000062|   (*[36]*)let tmpsize = 16384 in
      000063|   (*[36]*)let buf = Buffer.create tmpsize in
      000064|   (*[36]*)let tmp = String.create tmpsize in
      000065|   (*[36]*)let n = ref 0 in
      000066|   (*[36]*)while (*[72]*)n := input chan tmp 0 tmpsize; !(*[72]*)n > 0 do
      000067|     (*[36]*)Buffer.add_substring buf tmp 0 !n;
      000068|   done;
      000069|   (*[36]*)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|   (*[35]*)let chan = open_in_bin fname in
      000121|   (*[35]*)try
      000122|     (*[35]*)let bs = bitstring_of_chan chan in
      000123|     (*[35]*)close_in (*[35]*)chan;
      000124|     (*[35]*)bs
      000125|   with exn ->
      000126|     (*[0]*)close_in (*[0]*)chan;
      000127|     (*[0]*)raise exn
      000128|  
      000129| let bitstring_length (_, _, len) = (*[1565492]*)len
      000130|  
      000131| let subbitstring (data, off, len) off' len' =
      000132|   (*[1]*)let off = off + off' in
      000133|   (*[1]*)if len < off' + len' then (*[0]*)invalid_arg "subbitstring";
      000134|   ((*[1]*)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|   (*[100]*)if len < n then (*[0]*)invalid_arg "takebits";
      000144|   ((*[100]*)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 = (*[43]*)0
      000158|   let one = (*[43]*)1
      000159|   let minus_one = (*[43]*)-1
      000160|   let ff = (*[43]*)0xff
      000161|  
      000162|   (* Create a mask 0-31 bits wide. *)
      000163|   let mask bits =
      000164|     (*[2342]*)if bits < 30 then
      000165|       ((*[1952]*)one <<< bits) - 1
      000166|     else (*[390]*)if bits = 30 then
      000167|       (*[0]*)max_int
      000168|     else (*[390]*)if bits = 31 then
      000169|       (*[390]*)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|     (*[780]*)if bits <= 8 then (*[0]*)v
      000176|     else (*[780]*)if bits <= 16 then (
      000177|       (*[260]*)let shift = bits-8 in
      000178|       (*[260]*)let v1 = v >>> shift in
      000179|       (*[260]*)let v2 = ((v land (mask shift)) <<< 8) in
      000180|       v2 (*[260]*)lor v1
      000181|     ) else (*[520]*)if bits <= 24 then (
      000182|       (*[260]*)let shift = bits - 16 in
      000183|       (*[260]*)let v1 = v >>> (8+shift) in
      000184|       (*[260]*)let v2 = ((v >>> shift) land ff) <<< 8 in
      000185|       (*[260]*)let v3 = (v land (mask shift)) <<< 16 in
      000186|       v3 lor v2 (*[260]*)lor v1
      000187|     ) else (
      000188|       (*[260]*)let shift = bits - 24 in
      000189|       (*[260]*)let v1 = v >>> (16+shift) in
      000190|       (*[260]*)let v2 = ((v >>> (8+shift)) land ff) <<< 8 in
      000191|       (*[260]*)let v3 = ((v >>> shift) land ff) <<< 16 in
      000192|       (*[260]*)let v4 = (v land (mask shift)) <<< 24 in
      000193|       v4 lor v3 lor v2 (*[260]*)lor v1
      000194|     )
      000195|  
      000196|   (* Check a value is in range 0 .. 2^bits-1. *)
      000197|   let range_unsigned v bits =
      000198|     (*[1172]*)let mask = lnot (mask bits) in
      000199|     (v (*[1172]*)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|     (*[1436]*)if bits >= 8 then (
      000206|       (*[1044]*)map_bytes_be g f (v >>> 8) (*[1044]*)(bits-8);
      000207|       (*[1044]*)let lsb = v land ff in
      000208|       (*[1044]*)f (to_int lsb)
      000209|     ) else (*[262]*)if bits > 0 then (
      000210|       (*[130]*)let lsb = v land (mask bits) in
      000211|       (*[130]*)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|     (*[2860]*)if bits >= 8 then (
      000219|       (*[2080]*)let lsb = v land ff in
      000220|       (*[2080]*)f (*[2080]*)(to_int lsb);
      000221|       (*[2080]*)map_bytes_le g f (v >>> 8) (bits-8)
      000222|     ) else (*[520]*)if bits > 0 then (
      000223|       (*[260]*)let lsb = v land (mask bits) in
      000224|       (*[260]*)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 (<<<) = (*[43]*)Int32.shift_left
      000234|   let (>>>) = (*[43]*)Int32.shift_right_logical
      000235|   let (land) = (*[43]*)Int32.logand
      000236|   let (lor) = (*[43]*)Int32.logor
      000237|   let lnot = (*[43]*)Int32.lognot
      000238|   let pred = (*[43]*)Int32.pred
      000239|   let max_int = (*[43]*)Int32.max_int
      000240|   let to_int = (*[43]*)Int32.to_int
      000241|   let zero = (*[43]*)Int32.zero
      000242|   let one = (*[43]*)Int32.one
      000243|   let minus_one = (*[43]*)Int32.minus_one
      000244|   let ff = (*[43]*)0xff_l
      000245|  
      000246|   (* Create a mask so many bits wide. *)
      000247|   let mask bits =
      000248|     (*[272]*)if bits < 31 then
      000249|       (*[272]*)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|     (*[272]*)if bits <= 8 then (*[0]*)v
      000260|     else (*[272]*)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 (*[272]*)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|       (*[272]*)let shift = bits - 24 in
      000273|       (*[272]*)let v1 = v >>> (16+shift) in
      000274|       (*[272]*)let v2 = ((v >>> (8+shift)) land ff) <<< 8 in
      000275|       (*[272]*)let v3 = ((v >>> shift) land ff) <<< 16 in
      000276|       (*[272]*)let v4 = (v land (mask shift)) <<< 24 in
      000277|       v4 lor v3 lor v2 (*[272]*)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 (<<<) = (*[43]*)Int64.shift_left
      000318|   let (>>>) = (*[43]*)Int64.shift_right_logical
      000319|   let (land) = (*[43]*)Int64.logand
      000320|   let (lor) = (*[43]*)Int64.logor
      000321|   let lnot = (*[43]*)Int64.lognot
      000322|   let pred = (*[43]*)Int64.pred
      000323|   let max_int = (*[43]*)Int64.max_int
      000324|   let to_int = (*[43]*)Int64.to_int
      000325|   let zero = (*[43]*)Int64.zero
      000326|   let one = (*[43]*)Int64.one
      000327|   let minus_one = (*[43]*)Int64.minus_one
      000328|   let ff = (*[43]*)0xff_L
      000329|  
      000330|   (* Create a mask so many bits wide. *)
      000331|   let mask bits =
      000332|     (*[670350]*)if bits < 63 then
      000333|       (*[664750]*)pred (one <<< bits)
      000334|     else (*[5600]*)if bits = 63 then
      000335|       (*[4950]*)max_int
      000336|     else (*[650]*)if bits = 64 then
      000337|       (*[650]*)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|     (*[352630]*)let mask = lnot (mask bits) in
      000347|     (v (*[352630]*)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|     (*[1462730]*)if bits >= 8 then (
      000354|       (*[1110620]*)map_bytes_be g f (v >>> 8) (*[1110620]*)(bits-8);
      000355|       (*[1110620]*)let lsb = v land ff in
      000356|       (*[1110620]*)f (to_int lsb)
      000357|     ) else (*[34910]*)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|     (*[4160]*)if bits >= 8 then (
      000367|       (*[3640]*)let lsb = v land ff in
      000368|       (*[3640]*)f (*[3640]*)(to_int lsb);
      000369|       (*[3640]*)map_bytes_le g f (v >>> 8) (bits-8)
      000370|     ) else (*[520]*)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|   (*[2515282]*)let byteoff = off lsr 3 in
      000388|   (*[2515282]*)let bitmask = 1 lsl (7 - (off land 7)) in
      000389|   (*[2515282]*)let b = Char.code data.[byteoff] land bitmask <> 0 in
      000390|   (*[2515282]*)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|   (*[9840892]*)if strlen > byteoff then (*[9274362]*)Char.code data.[byteoff] else (*[566530]*)0
      000397| let _get_byte32 data byteoff strlen =
      000398|   (*[264]*)if strlen > byteoff then (*[264]*)Int32.of_int (Char.code data.[byteoff]) else (*[0]*)0l
      000399| let _get_byte64 data byteoff strlen =
      000400|   (*[1626792]*)if strlen > byteoff then (*[1518549]*)Int64.of_int (Char.code data.[byteoff]) else (*[108243]*)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|   (*[5040562]*)let byteoff = off lsr 3 in
      000407|  
      000408|   (* Optimize the common (byte-aligned) case. *)
      000409|   (*[5040562]*)if off land 7 = 0 then (
      000410|     (*[121776]*)let byte = Char.code data.[byteoff] in
      000411|     byte (*[121776]*)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|     (*[4918786]*)let strlen = String.length data in
      000417|  
      000418|     (*[4918786]*)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|     (*[4918786]*)let bitmask = (1 lsl (16 - (off land 7))) - 1 in
      000424|     (*[4918786]*)let word = word land bitmask in
      000425|     (* Shift right to get rid of the bottom bits. *)
      000426|     (*[4918786]*)let shift = 16 - ((off land 7) + flen) in
      000427|     (*[4918786]*)let word = word lsr shift in
      000428|  
      000429|     (*[4918786]*)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|   (*[1170]*)let byteoff = off lsr 3 in
      000435|  
      000436|   (*[1170]*)let strlen = String.length data in
      000437|  
      000438|   (*[1170]*)let word =
      000439|     (* Optimize the common (byte-aligned) case. *)
      000440|     if off land 7 = 0 then (
      000441|       (*[152]*)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 (*[152]*)lsr (31 - flen)
      000447|     ) else (*[1018]*)if flen <= 24 then (
      000448|       (* Extract the 31 bits at byteoff .. byteoff+3. *)
      000449|       (*[678]*)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|       (*[678]*)let bitmask = (1 lsl (31 - (off land 7))) - 1 in
      000456|       (*[678]*)let word = word land bitmask in
      000457|       (* Shift right to get rid of the bottom bits. *)
      000458|       (*[678]*)let shift = 31 - ((off land 7) + flen) in
      000459|       word (*[678]*)lsr shift
      000460|     ) else (
      000461|       (* Extract the next 31 bits, slow method. *)
      000462|       (*[340]*)let word =
      000463|         let c0 = extract_char_unsigned data off len 8
      000464|         and off = off + 8 and len = len - 8 in
      000465|         (*[340]*)let c1 = extract_char_unsigned data off len 8
      000466|         and off = off + 8 and len = len - 8 in
      000467|         (*[340]*)let c2 = extract_char_unsigned data off len 8
      000468|         and off = off + 8 and len = len - 8 in
      000469|         (*[340]*)let c3 = extract_char_unsigned data off len 7 in
      000470|         (c0 (*[340]*)lsl 23) + (c1 lsl 15) + (c2 lsl 7) + c3 in
      000471|       word (*[340]*)lsr (31 - flen)
      000472|     ) in
      000473|   (*[1170]*)word (*, off+flen, len-flen*)
      000474|  
      000475| let extract_int_le_unsigned data off len flen =
      000476|   (*[780]*)let v = extract_int_be_unsigned data off len flen in
      000477|   (*[780]*)let v = I.byteswap v flen in
      000478|   (*[780]*)v
      000479|  
      000480| let extract_int_ne_unsigned =
      000481|   (*[43]*)if nativeendian = BigEndian
      000482|   then (*[0]*)extract_int_be_unsigned
      000483|   else (*[43]*)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|   (*[408]*)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|   (*[408]*)let byteoff = off lsr 3 in
      000511|  
      000512|   (*[408]*)let strlen = String.length data in
      000513|  
      000514|   (*[408]*)let word =
      000515|     (* Optimize the common (byte-aligned) case. *)
      000516|     if off land 7 = 0 then (
      000517|       (*[66]*)let word =
      000518|         let c0 = _get_byte32 data byteoff strlen in
      000519|         (*[66]*)let c1 = _get_byte32 data (byteoff+1) strlen in
      000520|         (*[66]*)let c2 = _get_byte32 data (byteoff+2) strlen in
      000521|         (*[66]*)let c3 = _get_byte32 data (byteoff+3) strlen in
      000522|         (*[66]*)_make_int32_be c0 c1 c2 c3 in
      000523|       (*[66]*)Int32.shift_right_logical word (32 - flen)
      000524|     ) else (
      000525|       (* Extract the next 32 bits, slow method. *)
      000526|       (*[342]*)let word =
      000527|         let c0 = extract_char_unsigned data off len 8
      000528|         and off = off + 8 and len = len - 8 in
      000529|         (*[342]*)let c1 = extract_char_unsigned data off len 8
      000530|         and off = off + 8 and len = len - 8 in
      000531|         (*[342]*)let c2 = extract_char_unsigned data off len 8
      000532|         and off = off + 8 and len = len - 8 in
      000533|         (*[342]*)let c3 = extract_char_unsigned data off len 8 in
      000534|         (*[342]*)let c0 = Int32.of_int c0 in
      000535|         (*[342]*)let c1 = Int32.of_int c1 in
      000536|         (*[342]*)let c2 = Int32.of_int c2 in
      000537|         (*[342]*)let c3 = Int32.of_int c3 in
      000538|         (*[342]*)_make_int32_be c0 c1 c2 c3 in
      000539|       (*[342]*)Int32.shift_right_logical word (32 - flen)
      000540|     ) in
      000541|   (*[408]*)word (*, off+flen, len-flen*)
      000542|  
      000543| let extract_int32_le_unsigned data off len flen =
      000544|   (*[272]*)let v = extract_int32_be_unsigned data off len flen in
      000545|   (*[272]*)let v = I32.byteswap v flen in
      000546|   (*[272]*)v
      000547|  
      000548| let extract_int32_ne_unsigned =
      000549|   (*[43]*)if nativeendian = BigEndian
      000550|   then (*[0]*)extract_int32_be_unsigned
      000551|   else (*[43]*)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|   (*[658243]*)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|   (*[520]*)_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|   (*[657723]*)let byteoff = off lsr 3 in
      000581|  
      000582|   (*[657723]*)let strlen = String.length data in
      000583|  
      000584|   (*[657723]*)let word =
      000585|     (* Optimize the common (byte-aligned) case. *)
      000586|     if off land 7 = 0 then (
      000587|       (*[203285]*)let word =
      000588|         let c0 = _get_byte64 data byteoff strlen in
      000589|         (*[203285]*)let c1 = _get_byte64 data (byteoff+1) strlen in
      000590|         (*[203285]*)let c2 = _get_byte64 data (byteoff+2) strlen in
      000591|         (*[203285]*)let c3 = _get_byte64 data (byteoff+3) strlen in
      000592|         (*[203285]*)let c4 = _get_byte64 data (byteoff+4) strlen in
      000593|         (*[203285]*)let c5 = _get_byte64 data (byteoff+5) strlen in
      000594|         (*[203285]*)let c6 = _get_byte64 data (byteoff+6) strlen in
      000595|         (*[203285]*)let c7 = _get_byte64 data (byteoff+7) strlen in
      000596|         (*[203285]*)_make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in
      000597|       (*[203285]*)Int64.shift_right_logical word (64 - flen)
      000598|     ) else (
      000599|       (* Extract the next 64 bits, slow method. *)
      000600|       (*[454438]*)let word =
      000601|         let c0 = extract_char_unsigned data off len 8
      000602|         and off = off + 8 and len = len - 8 in
      000603|         (*[454438]*)let c1 = extract_char_unsigned data off len 8
      000604|         and off = off + 8 and len = len - 8 in
      000605|         (*[454438]*)let c2 = extract_char_unsigned data off len 8
      000606|         and off = off + 8 and len = len - 8 in
      000607|         (*[454438]*)let c3 = extract_char_unsigned data off len 8
      000608|         and off = off + 8 and len = len - 8 in
      000609|         (*[454438]*)let c4 = extract_char_unsigned data off len 8
      000610|         and off = off + 8 and len = len - 8 in
      000611|         (*[454438]*)let c5 = extract_char_unsigned data off len 8
      000612|         and off = off + 8 and len = len - 8 in
      000613|         (*[454438]*)let c6 = extract_char_unsigned data off len 8
      000614|         and off = off + 8 and len = len - 8 in
      000615|         (*[454438]*)let c7 = extract_char_unsigned data off len 8 in
      000616|         (*[454438]*)let c0 = Int64.of_int c0 in
      000617|         (*[454438]*)let c1 = Int64.of_int c1 in
      000618|         (*[454438]*)let c2 = Int64.of_int c2 in
      000619|         (*[454438]*)let c3 = Int64.of_int c3 in
      000620|         (*[454438]*)let c4 = Int64.of_int c4 in
      000621|         (*[454438]*)let c5 = Int64.of_int c5 in
      000622|         (*[454438]*)let c6 = Int64.of_int c6 in
      000623|         (*[454438]*)let c7 = Int64.of_int c7 in
      000624|         (*[454438]*)_make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in
      000625|       (*[454438]*)Int64.shift_right_logical word (64 - flen)
      000626|     ) in
      000627|   (*[657723]*)word (*, off+flen, len-flen*)
      000628|  
      000629| let extract_int64_le_unsigned data off len flen =
      000630|   (*[520]*)let byteoff = off lsr 3 in
      000631|  
      000632|   (*[520]*)let strlen = String.length data in
      000633|  
      000634|   (*[520]*)let word =
      000635|     (* Optimize the common (byte-aligned) case. *)
      000636|     if off land 7 = 0 then (
      000637|       (*[64]*)let word =
      000638|         let c0 = _get_byte64 data byteoff strlen in
      000639|         (*[64]*)let c1 = _get_byte64 data (byteoff+1) strlen in
      000640|         (*[64]*)let c2 = _get_byte64 data (byteoff+2) strlen in
      000641|         (*[64]*)let c3 = _get_byte64 data (byteoff+3) strlen in
      000642|         (*[64]*)let c4 = _get_byte64 data (byteoff+4) strlen in
      000643|         (*[64]*)let c5 = _get_byte64 data (byteoff+5) strlen in
      000644|         (*[64]*)let c6 = _get_byte64 data (byteoff+6) strlen in
      000645|         (*[64]*)let c7 = _get_byte64 data (byteoff+7) strlen in
      000646|         (*[64]*)_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
      000647|       (*[64]*)Int64.logand word (I64.mask flen)
      000648|     ) else (
      000649|       (* Extract the next 64 bits, slow method. *)
      000650|       (*[456]*)let word =
      000651|         let c0 = extract_char_unsigned data off len 8
      000652|         and off = off + 8 and len = len - 8 in
      000653|         (*[456]*)let c1 = extract_char_unsigned data off len 8
      000654|         and off = off + 8 and len = len - 8 in
      000655|         (*[456]*)let c2 = extract_char_unsigned data off len 8
      000656|         and off = off + 8 and len = len - 8 in
      000657|         (*[456]*)let c3 = extract_char_unsigned data off len 8
      000658|         and off = off + 8 and len = len - 8 in
      000659|         (*[456]*)let c4 = extract_char_unsigned data off len 8
      000660|         and off = off + 8 and len = len - 8 in
      000661|         (*[456]*)let c5 = extract_char_unsigned data off len 8
      000662|         and off = off + 8 and len = len - 8 in
      000663|         (*[456]*)let c6 = extract_char_unsigned data off len 8
      000664|         and off = off + 8 and len = len - 8 in
      000665|         (*[456]*)let c7 = extract_char_unsigned data off len 8 in
      000666|         (*[456]*)let c0 = Int64.of_int c0 in
      000667|         (*[456]*)let c1 = Int64.of_int c1 in
      000668|         (*[456]*)let c2 = Int64.of_int c2 in
      000669|         (*[456]*)let c3 = Int64.of_int c3 in
      000670|         (*[456]*)let c4 = Int64.of_int c4 in
      000671|         (*[456]*)let c5 = Int64.of_int c5 in
      000672|         (*[456]*)let c6 = Int64.of_int c6 in
      000673|         (*[456]*)let c7 = Int64.of_int c7 in
      000674|         (*[456]*)_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
      000675|       (*[456]*)Int64.logand word (I64.mask flen)
      000676|     ) in
      000677|   (*[520]*)word (*, off+flen, len-flen*)
      000678|  
      000679| let extract_int64_ne_unsigned =
      000680|   (*[43]*)if nativeendian = BigEndian
      000681|   then (*[0]*)extract_int64_be_unsigned
      000682|   else (*[43]*)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_be_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_unsigned" "noalloc"
      000690|  
      000691| external extract_fastpath_int16_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_unsigned" "noalloc"
      000692|  
      000693| external extract_fastpath_int16_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_unsigned" "noalloc"
      000694|  
      000695| external extract_fastpath_int16_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_signed" "noalloc"
      000696|  
      000697| external extract_fastpath_int16_le_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_signed" "noalloc"
      000698|  
      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_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_unsigned" "noalloc"
      000705|  
      000706| external extract_fastpath_int24_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_unsigned" "noalloc"
      000707|  
      000708| external extract_fastpath_int24_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_signed" "noalloc"
      000709|  
      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_be_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_unsigned" "noalloc"
      000716|  
      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_ne_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_unsigned" "noalloc"
      000720|  
      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_le_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_signed" "noalloc"
      000724|  
      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_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_unsigned" "noalloc"
      000731|  
      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_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_signed" "noalloc"
      000735|  
      000736| external extract_fastpath_int40_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_signed" "noalloc"
      000737|  
      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_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_unsigned" "noalloc"
      000741|  
      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_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_unsigned" "noalloc"
      000745|  
      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_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_signed" "noalloc"
      000749|  
      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_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_unsigned" "noalloc"
      000753|  
      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_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_unsigned" "noalloc"
      000757|  
      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_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_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_unsigned" "noalloc"
      000766|  
      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_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_unsigned" "noalloc"
      000770|  
      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_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_signed" "noalloc"
      000774|  
      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|     (*[493152]*){ buf = Buffer.create 128; len = 0; last = 0 }
      000795|  
      000796|   let contents { buf = buf; len = len; last = last } =
      000797|     (*[493152]*)let data =
      000798|       if len land 7 = 0 then
      000799|         (*[63280]*)Buffer.contents buf
      000800|       else
      000801|         (*[429872]*)Buffer.contents buf ^ (String.make 1 (Char.chr last)) in
      000802|     (*[493152]*)data, 0, len
      000803|  
      000804|   (* Add exactly 8 bits. *)
      000805|   let add_byte ({ buf = buf; len = len; last = last } as t) byte =
      000806|     (*[8266092]*)if (*[8266092]*)byte < 0 || (*[8266092]*)byte > 255 then (*[0]*)invalid_arg "Bitstring.Buffer.add_byte";
      000807|     (*[8266092]*)let shift = len land 7 in
      000808|     (*[8266092]*)if shift = 0 then
      000809|       (* Target buffer is byte-aligned. *)
      000810|       (*[521241]*)Buffer.add_char buf (Char.chr byte)
      000811|     else (
      000812|       (* Target buffer is unaligned.  'last' is meaningful. *)
      000813|       (*[7744851]*)let first = byte lsr shift in
      000814|       (*[7744851]*)let second = (byte lsl (8 - shift)) land 0xff in
      000815|       (*[7744851]*)Buffer.add_char buf (*[7744851]*)(Char.chr (last lor first));
      000816|       (*[7744851]*)t.last <- second
      000817|     );
      000818|     (*[8266092]*)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|     (*[4426193]*)let shift = 7 - (len land 7) in
      000823|     (*[4426193]*)if shift > 0 then
      000824|       (* Somewhere in the middle of 'last'. *)
      000825|       (*[3893270]*)t.last <- last lor ((if bit then (*[3004643]*)1 else (*[888627]*)0) lsl shift)
      000826|     else (
      000827|       (* Just a single spare bit in 'last'. *)
      000828|       (*[532923]*)let last = last lor if bit then (*[407944]*)1 else (*[124979]*)0 in
      000829|       (*[532923]*)Buffer.add_char buf (*[532923]*)(Char.chr last);
      000830|       (*[532923]*)t.last <- 0
      000831|     );
      000832|     (*[4426193]*)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|     (*[318370]*)if (*[318370]*)slen < 1 || (*[318370]*)slen >= 8 then (*[0]*)invalid_arg "Bitstring.Buffer._add_bits";
      000839|     (*[318370]*)for i = slen-1 downto 0 do
      000840|       (*[1273808]*)let bit = c land (1 lsl i) <> 0 in
      000841|       (*[1273808]*)add_bit t bit
      000842|     done
      000843|  
      000844|   let add_bits ({ buf = buf; len = len } as t) str slen =
      000845|     (*[26867]*)if slen > 0 then (
      000846|       (*[1389114]*)if len land 7 = 0 then (
      000847|         (*[575784]*)if slen land 7 = 0 then
      000848|           (* Common case - everything is byte-aligned. *)
      000849|           (*[64322]*)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|           (*[511462]*)let slenbytes = slen lsr 3 in
      000855|           (*[345655]*)if slenbytes > 0 then (*[165807]*)Buffer.add_substring buf str 0 slenbytes;
      000856|           (*[511462]*)let last = Char.code str.[slenbytes] in (* last char *)
      000857|           (*[511462]*)let mask = 0xff lsl (8 - (slen land 7)) in
      000858|           (*[511462]*)t.last <- last land mask
      000859|         );
      000860|         (*[575784]*)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|   (*[130]*)Buffer.add_bit buf b
      000888|  
      000889| (* Construct a field, flen = [2..8]. *)
      000890| let construct_char_unsigned buf v flen exn =
      000891|   (*[1204740]*)let max_val = 1 lsl flen in
      000892|   (*[1204740]*)if (*[1204740]*)v < 0 || (*[1204740]*)v >= max_val then (*[0]*)raise exn;
      000893|   (*[1204740]*)if flen = 8 then
      000894|     (*[1203960]*)Buffer.add_byte buf v
      000895|   else
      000896|     (*[780]*)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|   (*[392]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;
      000902|   (* Add the bytes. *)
      000903|   (*[392]*)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|   (*[780]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;
      000909|   (* Add the bytes. *)
      000910|   (*[780]*)I.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
      000911|  
      000912| let construct_int_ne_unsigned =
      000913|   (*[43]*)if nativeendian = BigEndian
      000914|   then (*[0]*)construct_int_be_unsigned
      000915|   else (*[43]*)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|   (*[136]*)Buffer.add_byte buf
      000925|     (Int32.to_int (Int32.shift_right_logical v 24));
      000926|   (*[136]*)Buffer.add_byte buf
      000927|     (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));
      000928|   (*[136]*)Buffer.add_byte buf
      000929|     (*[136]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));
      000930|   (*[136]*)Buffer.add_byte buf
      000931|     (Int32.to_int (Int32.logand v 0xff_l))
      000932|  
      000933| let construct_int32_le_unsigned buf v flen _ =
      000934|   (*[272]*)Buffer.add_byte buf
      000935|     (Int32.to_int (Int32.logand v 0xff_l));
      000936|   (*[272]*)Buffer.add_byte buf
      000937|     (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));
      000938|   (*[272]*)Buffer.add_byte buf
      000939|     (*[272]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));
      000940|   (*[272]*)Buffer.add_byte buf
      000941|     (Int32.to_int (Int32.shift_right_logical v 24))
      000942|  
      000943| let construct_int32_ne_unsigned =
      000944|   (*[43]*)if nativeendian = BigEndian
      000945|   then (*[0]*)construct_int32_be_unsigned
      000946|   else (*[43]*)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|   (*[352110]*)if not (I64.range_unsigned v flen) then (*[0]*)raise exn;
      000957|   (* Add the bytes. *)
      000958|   (*[352110]*)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|   (*[520]*)if not (I64.range_unsigned v flen) then (*[0]*)raise exn;
      000964|   (* Add the bytes. *)
      000965|   (*[520]*)I64.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
      000966|  
      000967| let construct_int64_ne_unsigned =
      000968|   (*[43]*)if nativeendian = BigEndian
      000969|   then (*[0]*)construct_int64_be_unsigned
      000970|   else (*[43]*)construct_int64_le_unsigned
      000971|  
      000972| let construct_int64_ee_unsigned = function
      000973|   | BigEndian -> (*[0]*)construct_int64_be_unsigned
      000974|   | LittleEndian -> (*[0]*)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|   (*[1317896]*)let blen = 7 - ((off + 7) land 7) in
      000990|   (*[1317896]*)let blen = min blen len in
      000991|   (*[1317896]*)let rec loop off len blen =
      000992|     (*[1317896]*)if blen = 0 then ((*[1317896]*)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|   (*[1317896]*)let off, len = loop off len blen in
      001001|   (*[1317896]*)assert ((*[1317896]*)len = 0 || (off (*[1291094]*)land 7) = 0);
      001002|  
      001003|   (* Add the remaining 'len' bits. *)
      001004|   (*[1317896]*)let data =
      001005|     let off = off lsr 3 in
      001006|     (* XXX dangerous allocation *)
      001007|     (*[1317896]*)if off = 0 then (*[1317896]*)data
      001008|     else (*[0]*)String.sub data off (String.length data - off) in
      001009|  
      001010|   (*[1317896]*)Buffer.add_bits buf data len
      001011|  
      001012| (* Concatenate bitstrings. *)
      001013| let concat bs =
      001014|   (*[40461]*)let buf = Buffer.create () in
      001015|   (*[40461]*)List.iter (construct_bitstring buf) (*[40461]*)bs;
      001016|   (*[40461]*)Buffer.contents buf
      001017|  
      001018| (*----------------------------------------------------------------------*)
      001019| (* Extract a string from a bitstring. *)
      001020| let string_of_bitstring (data, off, len) =
      001021|   (*[73011]*)if off (*[73011]*)land 7 = 0 && len (*[16597]*)land 7 = 0 then
      001022|     (* Easy case: everything is byte-aligned. *)
      001023|     (*[9037]*)String.sub data (off lsr 3) (len lsr 3)
      001024|   else (
      001025|     (* Bit-twiddling case. *)
      001026|     (*[63974]*)let strlen = (len + 7) lsr 3 in
      001027|     (*[63974]*)let str = String.make strlen '\000' in
      001028|     (*[63974]*)let rec loop data off len i =
      001029|       (*[326148]*)if len >= 8 then (
      001030|         (*[262174]*)let c = extract_char_unsigned data off len 8
      001031|         and off = off + 8 and len = len - 8 in
      001032|         (*[262174]*)str.[i] (*[262174]*)<- Char.chr c;
      001033|         (*[262174]*)loop data off len (i+1)
      001034|       ) else (*[52324]*)if len > 0 then (
      001035|         (*[11650]*)let c = extract_char_unsigned data off len len in
      001036|         (*[11650]*)str.[i] <- Char.chr (c lsl (8-len))
      001037|       )
      001038|     in
      001039|     (*[63974]*)loop data off len (*[63974]*)0;
      001040|     (*[63974]*)str
      001041|   )
      001042|  
      001043| (* To channel. *)
      001044|  
      001045| let bitstring_to_chan ((data, off, len) as bits) chan =
      001046|   (* Fail if the bitstring length isn't a multiple of 8. *)
      001047|   (*[1]*)if len land 7 <> 0 then (*[0]*)invalid_arg "bitstring_to_chan";
      001048|  
      001049|   (*[1]*)if off land 7 = 0 then
      001050|     (* Easy case: string is byte-aligned. *)
      001051|     (*[1]*)output chan data (off lsr 3) (len lsr 3)
      001052|   else (
      001053|     (* Bit-twiddling case: reuse string_of_bitstring *)
      001054|     (*[0]*)let str = string_of_bitstring bits in
      001055|     (*[0]*)output_string chan str
      001056|   )
      001057|  
      001058| let bitstring_to_file bits filename =
      001059|   (*[0]*)let chan = open_out_bin filename in
      001060|   (*[0]*)try
      001061|     (*[0]*)bitstring_to_chan bits chan;
      001062|     (*[0]*)close_out chan
      001063|   with exn ->
      001064|     (*[0]*)close_out (*[0]*)chan;
      001065|     (*[0]*)raise exn
      001066|  
      001067| (*----------------------------------------------------------------------*)
      001068| (* Comparison. *)
      001069| let compare ((data1, off1, len1) as bs1) ((data2, off2, len2) as bs2) =
      001070|   (* In the fully-aligned case, this is reduced to string comparison ... *)
      001071|   (*[4624]*)if off1 (*[4624]*)land 7 = 0 && len1 (*[4624]*)land 7 (*[4624]*)= 0 && off2 (*[680]*)land 7 (*[680]*)= 0 && len2 (*[535]*)land 7 = 0
      001072|   then (
      001073|     (* ... but we have to do that by hand because the bits may
      001074|      * not extend to the full length of the underlying string.
      001075|      *)
      001076|     (*[100]*)let off1 = off1 lsr 3 and off2 = off2 lsr 3
      001077|     and len1 = len1 lsr 3 and len2 = len2 lsr 3 in
      001078|     (*[100]*)let rec loop i =
      001079|       (*[240]*)if (*[240]*)i < len1 && (*[170]*)i < len2 then (
      001080|         (*[140]*)let c1 = String.unsafe_get data1 (off1 + i)
      001081|         and c2 = String.unsafe_get data2 (off2 + i) in
      001082|         (*[140]*)let r = compare c1 c2 in
      001083|         (*[140]*)if r <> 0 then (*[0]*)r
      001084|         else (*[140]*)loop (i+1)
      001085|       )
      001086|       else (*[100]*)len1 - len2
      001087|     in
      001088|     (*[100]*)loop 0
      001089|   )
      001090|   else (
      001091|     (* Slow/unaligned. *)
      001092|     (*[4524]*)let str1 = string_of_bitstring bs1
      001093|     and str2 = string_of_bitstring bs2 in
      001094|     (*[4524]*)let r = String.compare str1 str2 in
      001095|     (*[4524]*)if r <> 0 then (*[3058]*)r else (*[1466]*)len1 - len2
      001096|   )
      001097|  
      001098| let equals ((_, _, len1) as bs1) ((_, _, len2) as bs2) =
      001099|   (*[7]*)if len1 <> len2 then (*[0]*)false
      001100|   else (*[7]*)if bs1 = bs2 then (*[7]*)true
      001101|   else (*[0]*)0 = compare bs1 bs2
      001102|  
      001103| (*----------------------------------------------------------------------*)
      001104| (* Bit get/set functions. *)
      001105|  
      001106| let index_out_of_bounds () = (*[0]*)invalid_arg "index out of bounds"
      001107|  
      001108| let put (data, off, len) n v =
      001109|   (*[0]*)if (*[0]*)n < 0 || (*[0]*)off+n >= len then (*[0]*)index_out_of_bounds ()
      001110|   else (
      001111|     (*[0]*)let i = off+n in
      001112|     (*[0]*)let si = i lsr 3 and mask = 0x80 lsr (i land 7) in
      001113|     (*[0]*)let c = Char.code data.[si] in
      001114|     (*[0]*)let c = if v <> 0 then c (*[0]*)lor mask else c (*[0]*)land (lnot mask) in
      001115|     (*[0]*)data.[si] <- Char.unsafe_chr c
      001116|   )
      001117|  
      001118| let set bits n = (*[0]*)put bits n 1
      001119|  
      001120| let clear bits n = (*[0]*)put bits n 0
      001121|  
      001122| let get (data, off, len) n =
      001123|   (*[1945548]*)if (*[1945548]*)n < 0 || (*[1945548]*)off+n >= len then (*[0]*)index_out_of_bounds ()
      001124|   else (
      001125|     (*[1945548]*)let i = off+n in
      001126|     (*[1945548]*)let si = i lsr 3 and mask = 0x80 lsr (i land 7) in
      001127|     (*[1945548]*)let c = Char.code data.[si] in
      001128|     c (*[1945548]*)land mask
      001129|   )
      001130|  
      001131| let is_set bits n = (*[1297032]*)get bits n <> 0
      001132|  
      001133| let is_clear bits n = (*[648516]*)get bits n = 0
      001134|  
      001135| (*----------------------------------------------------------------------*)
      001136| (* Display functions. *)
      001137|  
      001138| let isprint c =
      001139|   (*[356]*)let c = Char.code c in
      001140|   (*[356]*)c (*[356]*)>= 32 && (*[311]*)c < 127
      001141|  
      001142| let hexdump_bitstring chan (data, off, len) =
      001143|   (*[34]*)let count = ref 0 in
      001144|   (*[34]*)let off = ref off in
      001145|   (*[34]*)let len = ref len in
      001146|   (*[34]*)let linelen = ref 0 in
      001147|   (*[34]*)let linechars = String.make 16 ' ' in
      001148|  
      001149|   (*[34]*)fprintf chan "00000000  ";
      001150|  
      001151|   (*[34]*)while !len > 0 do
      001152|     (*[356]*)let bits = min !len 8 in
      001153|     (*[356]*)let byte = extract_char_unsigned data !off !len bits in
      001154|     (*[356]*)off := !off + bits; (*[356]*)len (*[356]*):= !len - bits;
      001155|  
      001156|     (*[356]*)let byte = byte lsl (8-bits) in
      001157|     (*[356]*)fprintf chan "%02x " byte;
      001158|  
      001159|     (*[356]*)incr count;
      001160|     (*[356]*)linechars.[!linelen] <-
      001161|       (let c = Char.chr byte in
      001162|        (*[356]*)if isprint c then (*[110]*)c else (*[246]*)'.');
      001163|     (*[356]*)incr linelen;
      001164|     (*[335]*)if !linelen = 8 then (*[21]*)fprintf chan " ";
      001165|     (*[343]*)if !linelen = 16 then (
      001166|       (*[13]*)fprintf chan " |%s|\n%08x  " linechars !count;
      001167|       (*[13]*)linelen (*[13]*):= 0;
      001168|       (*[13]*)for i = 0 to 15 do (*[208]*)linechars.[i] <- ' ' done
      001169|     )
      001170|   done;
      001171|  
      001172|   (*[34]*)if !linelen > 0 then (
      001173|     (*[32]*)let skip = (16 - !linelen) * 3 + if !linelen < 8 then (*[24]*)1 else (*[8]*)0 in
      001174|     (*[32]*)for i = 0 to skip-1 do (*[1116]*)fprintf chan " " done;
      001175|     (*[32]*)fprintf chan " |%s|\n%!" linechars
      001176|   ) else
      001177|     (*[2]*)fprintf chan "\n%!"