Construction wierdness (resulting widths from subbitstrings seems wrong)

[Phil Tomson]

I have this 256-bit bitstring:

# bs_16_512 ;;
- : Bitstring.bitstring =
("\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b
\000\t\000\n\000\011\000\012\000\r\000\014\000\015", 0, 256)

I want to create another bitstring out of it which would look
something like:

# let bso = BITSTRING {
false : 1;
(Bitstring.subbitstring bs_16_512 0 66) : 66 : bitstring } ;

so far so good, the toplevel shows:
val bso : Bitstring.bitstring =
("\000\000\000\000\128\001\000\001\128", 0, 67)

However, when I went to add another field in there:

# let bso = BITSTRING {
false : 1;
(Bitstring.subbitstring bs_16_512 0 66) : 66 : bitstring;
(Bitstring.subbitstring bs_16_512 66 67) : 67 : bitstring } ;;
val bso : Bitstring.bitstring =

("\000\000\000\000\128\001\000\001\128\002\000\002\128\003\000\003\128\004\000",
0, 146)

I'm surprised that the length in this case is 146 instead of 67 + 66 +
1 = 134.

I then tried it separately with the second subbitstring by itself:

# let bso = BITSTRING {
(Bitstring.subbitstring bs_16_512 66 67) : 67 : bitstring } ;;
val bso : Bitstring.bitstring =
("\000\016\000\020\000\024\000\028\000 ", 0, 79)
# Bitstring.bitstring_length bso ;;
- : int = 79


Why is the width in this case 79 instead of 67?

Phil

[Phil Tomson]

Another datapoint: if I do this outside of the BITSTRING { ... }
syntax it seems correct:
# let bso = (Bitstring.subbitstring bs_16_512 66 67) ;;
val bso : Bitstring.bitstring =

("\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b
\000\t\000\n\000\011\000\012\000\r\000\014\000\015",

66, 67)


# Bitstring.bitstring_length bso ;;
- : int = 67

[Phil Tomson]

More data points. I've noticed the same issue with concat:

# Bitstring.concat[(Bitstring.subbitstring bs_16_512 0 66);
(Bitstring.subbitstring bs_16_512 66 67)] ;;

- : Bitstring.bitstring =
("\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b

\000", 0, 145)

...should be 133 wide, not 145.

Now I tried some different widths and found something interesting:

# Bitstring.concat[(Bitstring.subbitstring bs_16_512 0 64);
(Bitstring.subbitstring bs_16_512 64 64)] ;;
- : Bitstring.bitstring =
("\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007",
0, 128)

...64 + 64 = 128, so it works as expected in this case. So what if we
try 65?

# Bitstring.concat[(Bitstring.subbitstring bs_16_512 0 65);
(Bitstring.subbitstring bs_16_512 65 64)] ;;
- : Bitstring.bitstring =
("\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b",
0, 143)

... 65 + 64 != 143

[Phil Tomson]

> More data points.  I've noticed the same issue with concat:
>
> # Bitstring.concat[(Bitstring.subbitstring bs_16_512 0 66);
> (Bitstring.subbitstring bs_16_512 66 67)] ;;
> - : Bitstring.bitstring =
> ("\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b
> \000", 0, 145)
>
> ...should be 133 wide, not 145.
>
> Now I tried some different widths and found something interesting:
>
> # Bitstring.concat[(Bitstring.subbitstring bs_16_512 0 64);
> (Bitstring.subbitstring bs_16_512 64 64)] ;;
> - : Bitstring.bitstring =
> ("\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007",
> 0, 128)
>
> ...64 + 64 = 128, so it works as expected in this case.  So what if we
> try 65?
>
> # Bitstring.concat[(Bitstring.subbitstring bs_16_512 0 65);
> (Bitstring.subbitstring bs_16_512 65 64)] ;;
> - : Bitstring.bitstring =
> ("\000\000\000\001\000\002\000\003\000\004\000\005\000\006\000\007\000\b",
> 0, 143)
>
> ... 65 + 64 != 143

Finally after a lot of debugging and scratching my head I came up with
a fix. I changed the following in bitstring.ml:

let add_bits ({ buf = buf; len = len } as t) str slen =
if slen > 0 then (
if len land 7 = 0 then (
if slen land 7 = 0 then
(* Common case - everything is byte-aligned. *)
Buffer.add_substring buf str 0 (slen lsr 3)
else (
(* Target buffer is aligned. Copy whole bytes then leave the
* remaining bits in last.
*)
let slenbytes = slen lsr 3 in
if slenbytes > 0 then Buffer.add_substring buf str 0 slenbytes;
(* PT: added lastidx to prevent illegal index *)
let lastidx = min slenbytes ((String.length str) -1) in
<== added
(*was: let last = Char.code str.[slenbytes] in *)(* last char *)
let last = Char.code str.[lastidx] in (* last char *) <==
changed


But the primary problem seemed to be in construct_bitstring:


let construct_bitstring buf (data, off, len) =
(* Add individual bits until we get to the next byte boundary of
* the underlying string.
*)
let blen = 7 - ((off + 7) land 7) in
let blen = min blen (len) in
let rec loop off len blen =
if blen = 0 then (off, len)
else (
let b = extract_bit data off len 1
(*was:and off = off + 1 and len = len + 1 in *)
and off = off + 1 and len = len - 1 in <== changed to
Buffer.add_bit buf b;
loop off len (blen-1)
)
in
let off, len = loop off len blen in
assert (len = 0 || (off land 7) = 0);
(* Add the remaining 'len' bits. *)
let data =
let off = off lsr 3 in
(* XXX dangerous allocation *)
if off = 0 then data
else (
let sl = String.length data - off in
if sl = 0 then data
else String.sub data off (sl)
) in

Buffer.add_bits buf data len


I haven't exhaustively tested this, but it's giving me the right
answers now.
(actually, I just realized that the first change may not be needed
given the second change - I'll have to test out that hypothesis)

Phil

[Richard W.M. Jones]

Thanks for debugging this in more detail.

I'll take a look later unless you come up with a final patch
in the meantime.

Rich.

--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
virt-p2v converts physical machines to virtual machines. Boot with a
live CD or over the network (PXE) and turn machines into Xen guests.
http://et.redhat.com/~rjones/virt-p2v

[Phil Tomson]

Rich,

Here's the patch for bitstring.ml:

*** bitstring.ml.orig 2011-10-22 11:50:23.058536172 -0700
--- bitstring.ml 2011-10-22 11:56:53.483188450 -0700
***************
*** 853,859 ****

*)
let slenbytes = slen lsr 3 in
if slenbytes > 0 then Buffer.add_substring buf str 0 slenbytes;

! let last = Char.code str.[slenbytes] in (* last char *)
let mask = 0xff lsl (8 - (slen land 7)) in
t.last <- last land mask
);
--- 853,860 ----

*)
let slenbytes = slen lsr 3 in
if slenbytes > 0 then Buffer.add_substring buf str 0 slenbytes;

! let lastidx = min slenbytes ((String.length str) -1) in
! let last = Char.code str.[lastidx] in (* last char *)
let mask = 0xff lsl (8 - (slen land 7)) in
t.last <- last land mask
);
***************
*** 992,998 ****

if blen = 0 then (off, len)
else (
let b = extract_bit data off len 1

! and off = off + 1 and len = len + 1 in

Buffer.add_bit buf b;
loop off len (blen-1)
)

--- 993,999 ----

if blen = 0 then (off, len)
else (
let b = extract_bit data off len 1

! and off = off + 1 and len = len - 1 in

[Richard W.M. Jones]

Thanks -- I have applied your fix:

https://code.google.com/p/bitstring/source/detail?r=190

Rich.

--
Richard Jones
Red Hat