X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=coverage-report%2Ffile0001.html;h=3e88fb41070392c21ac39157882f2b1d21521405;hb=52551706a219a684192445205867babf6fe9fa69;hp=2109a226baea5fe5c753db9c785f5ddc9162ee15;hpb=86502a23458f9e93c8241735649ac2edd7fbc68a;p=ocaml-bitstring.git
diff --git a/coverage-report/file0001.html b/coverage-report/file0001.html
index 2109a22..3e88fb4 100644
--- a/coverage-report/file0001.html
+++ b/coverage-report/file0001.html
@@ -9,13 +9,13 @@
kind | | coverage |
- binding | | 149 / 245 (60 %) |
- sequence | | 60 / 95 (63 %) |
- for | | 3 / 5 (60 %) |
- if/then | | 100 / 193 (51 %) |
+ binding | | 226 / 245 (92 %) |
+ sequence | | 83 / 95 (87 %) |
+ for | | 5 / 5 (100 %) |
+ if/then | | 141 / 194 (72 %) |
try | | 1 / 2 (50 %) |
- while | | 2 / 3 (66 %) |
- match/function | | 53 / 88 (60 %) |
+ while | | 3 / 3 (100 %) |
+ match/function | | 64 / 87 (73 %) |
class expression | | 0 / 0 (- %) |
class initializer | | 0 / 0 (- %) |
class method | | 0 / 0 (- %) |
@@ -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 156 2008-08-26 09:42:05Z richard.wm.jones $
+ 000019| * $Id: bitstring.ml 159 2008-08-27 11:26:45Z 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 = (*[34]*)ref false
+ 000030| let debug = (*[43]*)ref false
000031|
000032| (* Exceptions. *)
000033| exception Construct_failure of string * string * int * int
@@ -68,32 +68,32 @@
000041| type t = bitstring
000042|
000043| (* Functions to create and load bitstrings. *)
- 000044| let empty_bitstring = (*[34]*)"", 0, 0
+ 000044| let empty_bitstring = (*[43]*)"", 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
+ 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 = (*[42773]*)make_bitstring len '\000'
+ 000053| let create_bitstring len = (*[42903]*)make_bitstring len '\000'
000054|
- 000055| let zeroes_bitstring = (*[34]*)create_bitstring
+ 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| (*[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;
+ 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| (*[2]*)Buffer.contents buf, 0, Buffer.length buf lsl 3
+ 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
@@ -144,21 +144,21 @@
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
+ 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) = (*[1565296]*)len
+ 000129| let bitstring_length (_, _, len) = (*[1565492]*)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')
+ 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
@@ -167,8 +167,8 @@
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)
+ 000143| (*[100]*)if len < n then (*[0]*)invalid_arg "takebits";
+ 000144| ((*[100]*)data, off, n)
000145|
000146| (*----------------------------------------------------------------------*)
000147| (* Bitwise functions.
@@ -181,74 +181,74 @@
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
+ 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| (*[2]*)if bits < 30 then
- 000165| ((*[2]*)one <<< bits) - 1
- 000166| else (*[0]*)if bits = 30 then
+ 000164| (*[2342]*)if bits < 30 then
+ 000165| ((*[1952]*)one <<< bits) - 1
+ 000166| else (*[390]*)if bits = 30 then
000167| (*[0]*)max_int
- 000168| else (*[0]*)if bits = 31 then
- 000169| (*[0]*)minus_one
+ 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| (*[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
+ 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| (*[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
+ 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| (*[2]*)let mask = lnot (mask bits) in
- 000199| (v (*[2]*)land mask) = zero
+ 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| (*[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
+ 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| (*[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
+ 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|
@@ -257,23 +257,23 @@
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
+ 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| (*[12]*)if bits < 31 then
- 000249| (*[12]*)pred (one <<< 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
@@ -283,25 +283,25 @@
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 (
+ 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 (*[12]*)if bits <= 24 then (
+ 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| (*[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
+ 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. *)
@@ -341,27 +341,27 @@
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
+ 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| (*[669050]*)if bits < 63 then
- 000333| (*[664100]*)pred (one <<< bits)
- 000334| else (*[4950]*)if bits = 63 then
+ 000332| (*[670350]*)if bits < 63 then
+ 000333| (*[664750]*)pred (one <<< bits)
+ 000334| else (*[5600]*)if bits = 63 then
000335| (*[4950]*)max_int
- 000336| else (*[0]*)if bits = 64 then
- 000337| (*[0]*)minus_one
+ 000336| else (*[650]*)if bits = 64 then
+ 000337| (*[650]*)minus_one
000338| else
000339| (*[0]*)invalid_arg "Bitstring.I64.mask"
000340|
@@ -370,18 +370,18 @@
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
+ 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| (*[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 (
+ 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| )
@@ -390,11 +390,11 @@
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 (
+ 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| )
@@ -411,103 +411,103 @@
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*)
+ 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| (*[9818264]*)if strlen > byteoff then (*[9252298]*)Char.code data.[byteoff] else (*[565966]*)0
+ 000396| (*[9840892]*)if strlen > byteoff then (*[9274362]*)Char.code data.[byteoff] else (*[566530]*)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
+ 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| (*[1626456]*)if strlen > byteoff then (*[1517847]*)Int64.of_int (Char.code data.[byteoff]) else (*[108609]*)0L
+ 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| (*[5030404]*)let byteoff = off lsr 3 in
+ 000406| (*[5040562]*)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*)
+ 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| (*[4909132]*)let strlen = String.length data in
+ 000416| (*[4918786]*)let strlen = String.length data in
000417|
- 000418| (*[4909132]*)let word =
+ 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| (*[4909132]*)let bitmask = (1 lsl (16 - (off land 7))) - 1 in
- 000424| (*[4909132]*)let word = word land bitmask in
+ 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| (*[4909132]*)let shift = 16 - ((off land 7) + flen) in
- 000427| (*[4909132]*)let word = word lsr shift in
+ 000426| (*[4918786]*)let shift = 16 - ((off land 7) + flen) in
+ 000427| (*[4918786]*)let word = word lsr shift in
000428|
- 000429| (*[4909132]*)word (*, off+flen, len-flen*)
+ 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| (*[0]*)let byteoff = off lsr 3 in
+ 000434| (*[1170]*)let byteoff = off lsr 3 in
000435|
- 000436| (*[0]*)let strlen = String.length data in
+ 000436| (*[1170]*)let strlen = String.length data in
000437|
- 000438| (*[0]*)let word =
+ 000438| (*[1170]*)let word =
000439| (* Optimize the common (byte-aligned) case. *)
000440| if off land 7 = 0 then (
- 000441| (*[0]*)let word =
+ 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 (*[0]*)lsr (31 - flen)
- 000447| ) else (*[0]*)if flen <= 24 then (
+ 000446| word (*[152]*)lsr (31 - flen)
+ 000447| ) else (*[1018]*)if flen <= 24 then (
000448| (* Extract the 31 bits at byteoff .. byteoff+3. *)
- 000449| (*[0]*)let word =
+ 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| (*[0]*)let bitmask = (1 lsl (31 - (off land 7))) - 1 in
- 000456| (*[0]*)let word = word land bitmask in
+ 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| (*[0]*)let shift = 31 - ((off land 7) + flen) in
- 000459| word (*[0]*)lsr shift
+ 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| (*[0]*)let word =
+ 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| (*[0]*)let c1 = extract_char_unsigned data off len 8
+ 000465| (*[340]*)let c1 = extract_char_unsigned data off len 8
000466| and off = off + 8 and len = len - 8 in
- 000467| (*[0]*)let c2 = extract_char_unsigned data off len 8
+ 000467| (*[340]*)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)
+ 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| (*[0]*)word (*, off+flen, len-flen*)
+ 000473| (*[1170]*)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
+ 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| (*[34]*)if nativeendian = BigEndian
+ 000481| (*[43]*)if nativeendian = BigEndian
000482| then (*[0]*)extract_int_be_unsigned
- 000483| else (*[34]*)extract_int_le_unsigned
+ 000483| else (*[43]*)extract_int_le_unsigned
000484|
000485| let extract_int_ee_unsigned = function
000486| | BigEndian -> (*[0]*)extract_int_be_unsigned
@@ -515,7 +515,7 @@
000488| | NativeEndian -> (*[0]*)extract_int_ne_unsigned
000489|
000490| let _make_int32_be c0 c1 c2 c3 =
- 000491| (*[18]*)Int32.logor
+ 000491| (*[408]*)Int32.logor
000492| (Int32.logor
000493| (Int32.logor
000494| (Int32.shift_left c0 24)
@@ -534,48 +534,48 @@
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
+ 000510| (*[408]*)let byteoff = off lsr 3 in
000511|
- 000512| (*[18]*)let strlen = String.length data in
+ 000512| (*[408]*)let strlen = String.length data in
000513|
- 000514| (*[18]*)let word =
+ 000514| (*[408]*)let word =
000515| (* Optimize the common (byte-aligned) case. *)
000516| if off land 7 = 0 then (
- 000517| (*[18]*)let word =
+ 000517| (*[66]*)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)
+ 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| (*[0]*)let word =
+ 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| (*[0]*)let c1 = extract_char_unsigned data off len 8
+ 000529| (*[342]*)let c1 = extract_char_unsigned data off len 8
000530| and off = off + 8 and len = len - 8 in
- 000531| (*[0]*)let c2 = extract_char_unsigned data off len 8
+ 000531| (*[342]*)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)
+ 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| (*[18]*)word (*, off+flen, len-flen*)
+ 000541| (*[408]*)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
+ 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| (*[34]*)if nativeendian = BigEndian
+ 000549| (*[43]*)if nativeendian = BigEndian
000550| then (*[0]*)extract_int32_be_unsigned
- 000551| else (*[34]*)extract_int32_le_unsigned
+ 000551| else (*[43]*)extract_int32_le_unsigned
000552|
000553| let extract_int32_ee_unsigned = function
000554| | BigEndian -> (*[6]*)extract_int32_be_unsigned
@@ -583,7 +583,7 @@
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
+ 000559| (*[658243]*)Int64.logor
000560| (Int64.logor
000561| (Int64.logor
000562| (Int64.logor
@@ -600,113 +600,113 @@
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
+ 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| (*[657463]*)let byteoff = off lsr 3 in
+ 000580| (*[657723]*)let byteoff = off lsr 3 in
000581|
- 000582| (*[657463]*)let strlen = String.length data in
+ 000582| (*[657723]*)let strlen = String.length data in
000583|
- 000584| (*[657463]*)let word =
+ 000584| (*[657723]*)let word =
000585| (* Optimize the common (byte-aligned) case. *)
000586| if off land 7 = 0 then (
- 000587| (*[203307]*)let word =
+ 000587| (*[203285]*)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)
+ 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| (*[454156]*)let word =
+ 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| (*[454156]*)let c1 = extract_char_unsigned data off len 8
+ 000603| (*[454438]*)let c1 = extract_char_unsigned data off len 8
000604| and off = off + 8 and len = len - 8 in
- 000605| (*[454156]*)let c2 = extract_char_unsigned data off len 8
+ 000605| (*[454438]*)let c2 = extract_char_unsigned data off len 8
000606| and off = off + 8 and len = len - 8 in
- 000607| (*[454156]*)let c3 = extract_char_unsigned data off len 8
+ 000607| (*[454438]*)let c3 = extract_char_unsigned data off len 8
000608| and off = off + 8 and len = len - 8 in
- 000609| (*[454156]*)let c4 = extract_char_unsigned data off len 8
+ 000609| (*[454438]*)let c4 = extract_char_unsigned data off len 8
000610| and off = off + 8 and len = len - 8 in
- 000611| (*[454156]*)let c5 = extract_char_unsigned data off len 8
+ 000611| (*[454438]*)let c5 = extract_char_unsigned data off len 8
000612| and off = off + 8 and len = len - 8 in
- 000613| (*[454156]*)let c6 = extract_char_unsigned data off len 8
+ 000613| (*[454438]*)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)
+ 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| (*[657463]*)word (*, off+flen, len-flen*)
+ 000627| (*[657723]*)word (*, off+flen, len-flen*)
000628|
000629| let extract_int64_le_unsigned data off len flen =
- 000630| (*[0]*)let byteoff = off lsr 3 in
+ 000630| (*[520]*)let byteoff = off lsr 3 in
000631|
- 000632| (*[0]*)let strlen = String.length data in
+ 000632| (*[520]*)let strlen = String.length data in
000633|
- 000634| (*[0]*)let word =
+ 000634| (*[520]*)let word =
000635| (* Optimize the common (byte-aligned) case. *)
000636| if off land 7 = 0 then (
- 000637| (*[0]*)let word =
+ 000637| (*[64]*)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)
+ 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| (*[0]*)let word =
+ 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| (*[0]*)let c1 = extract_char_unsigned data off len 8
+ 000653| (*[456]*)let c1 = extract_char_unsigned data off len 8
000654| and off = off + 8 and len = len - 8 in
- 000655| (*[0]*)let c2 = extract_char_unsigned data off len 8
+ 000655| (*[456]*)let c2 = extract_char_unsigned data off len 8
000656| and off = off + 8 and len = len - 8 in
- 000657| (*[0]*)let c3 = extract_char_unsigned data off len 8
+ 000657| (*[456]*)let c3 = extract_char_unsigned data off len 8
000658| and off = off + 8 and len = len - 8 in
- 000659| (*[0]*)let c4 = extract_char_unsigned data off len 8
+ 000659| (*[456]*)let c4 = extract_char_unsigned data off len 8
000660| and off = off + 8 and len = len - 8 in
- 000661| (*[0]*)let c5 = extract_char_unsigned data off len 8
+ 000661| (*[456]*)let c5 = extract_char_unsigned data off len 8
000662| and off = off + 8 and len = len - 8 in
- 000663| (*[0]*)let c6 = extract_char_unsigned data off len 8
+ 000663| (*[456]*)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)
+ 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| (*[0]*)word (*, off+flen, len-flen*)
+ 000677| (*[520]*)word (*, off+flen, len-flen*)
000678|
000679| let extract_int64_ne_unsigned =
- 000680| (*[34]*)if nativeendian = BigEndian
+ 000680| (*[43]*)if nativeendian = BigEndian
000681| then (*[0]*)extract_int64_be_unsigned
- 000682| else (*[34]*)extract_int64_le_unsigned
+ 000682| else (*[43]*)extract_int64_le_unsigned
000683|
000684| let extract_int64_ee_unsigned = function
000685| | BigEndian -> (*[0]*)extract_int64_be_unsigned
@@ -818,73 +818,73 @@
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 }
+ 000794| (*[493152]*){ buf = Buffer.create 128; len = 0; last = 0 }
000795|
000796| let contents { buf = buf; len = len; last = last } =
- 000797| (*[493022]*)let data =
+ 000797| (*[493152]*)let data =
000798| if len land 7 = 0 then
- 000799| (*[63287]*)Buffer.contents buf
+ 000799| (*[63280]*)Buffer.contents buf
000800| else
- 000801| (*[429735]*)Buffer.contents buf ^ (String.make 1 (Char.chr last)) in
- 000802| (*[493022]*)data, 0, len
+ 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| (*[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
+ 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| (*[519924]*)Buffer.add_char buf (Char.chr byte)
+ 000810| (*[521241]*)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
+ 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| (*[8255562]*)t.len <- t.len + 8
+ 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| (*[4421229]*)let shift = 7 - (len land 7) in
- 000823| (*[4421229]*)if shift > 0 then
+ 000822| (*[4426193]*)let shift = 7 - (len land 7) in
+ 000823| (*[4426193]*)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)
+ 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| (*[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
+ 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| (*[4421229]*)t.len <- len + 1
+ 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| (*[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
+ 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| (*[26866]*)if slen > 0 then (
- 000846| (*[1388985]*)if len land 7 = 0 then (
- 000847| (*[575655]*)if slen land 7 = 0 then
+ 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| (*[64306]*)Buffer.add_substring buf str 0 (slen lsr 3)
+ 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| (*[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
+ 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| (*[575655]*)t.len <- len + slen
+ 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
@@ -911,35 +911,35 @@
000884|
000885| (* Construct a single bit. *)
000886| let construct_bit buf b _ _ =
- 000887| (*[0]*)Buffer.add_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| (*[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
+ 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| (*[0]*)Buffer._add_bits buf v flen
+ 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| (*[2]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;
+ 000901| (*[392]*)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
+ 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| (*[0]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;
+ 000908| (*[780]*)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
+ 000910| (*[780]*)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
+ 000913| (*[43]*)if nativeendian = BigEndian
000914| then (*[0]*)construct_int_be_unsigned
- 000915| else (*[34]*)construct_int_le_unsigned
+ 000915| else (*[43]*)construct_int_le_unsigned
000916|
000917| let construct_int_ee_unsigned = function
000918| | BigEndian -> (*[0]*)construct_int_be_unsigned
@@ -948,29 +948,29 @@
000921|
000922| (* Construct a field of exactly 32 bits. *)
000923| let construct_int32_be_unsigned buf v flen _ =
- 000924| (*[6]*)Buffer.add_byte buf
+ 000924| (*[136]*)Buffer.add_byte buf
000925| (Int32.to_int (Int32.shift_right_logical v 24));
- 000926| (*[6]*)Buffer.add_byte buf
+ 000926| (*[136]*)Buffer.add_byte buf
000927| (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));
- 000928| (*[6]*)Buffer.add_byte buf
- 000929| (*[6]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));
- 000930| (*[6]*)Buffer.add_byte buf
+ 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| (*[12]*)Buffer.add_byte buf
+ 000934| (*[272]*)Buffer.add_byte buf
000935| (Int32.to_int (Int32.logand v 0xff_l));
- 000936| (*[12]*)Buffer.add_byte buf
+ 000936| (*[272]*)Buffer.add_byte buf
000937| (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));
- 000938| (*[12]*)Buffer.add_byte buf
- 000939| (*[12]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));
- 000940| (*[12]*)Buffer.add_byte buf
+ 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| (*[34]*)if nativeendian = BigEndian
+ 000944| (*[43]*)if nativeendian = BigEndian
000945| then (*[0]*)construct_int32_be_unsigned
- 000946| else (*[34]*)construct_int32_le_unsigned
+ 000946| else (*[43]*)construct_int32_le_unsigned
000947|
000948| let construct_int32_ee_unsigned = function
000949| | BigEndian -> (*[6]*)construct_int32_be_unsigned
@@ -980,232 +980,230 @@
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;
+ 000956| (*[352110]*)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
+ 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| (*[0]*)if not (I64.range_unsigned v flen) then (*[0]*)raise exn;
+ 000963| (*[520]*)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
+ 000965| (*[520]*)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
+ 000968| (*[43]*)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
+ 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| (*[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| )
+ 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| (* 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| (*----------------------------------------------------------------------*)
- 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. *)
+ 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 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| )
+ 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 set bits n = (*[0]*)put bits n 1
+ 001120| let clear bits n = (*[0]*)put bits n 0
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| )
+ 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_set bits n = (*[1297032]*)get bits n <> 0
+ 001133| let is_clear bits n = (*[648516]*)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
+ 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| (*[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%!"
+ 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%!"
-
+