(* Bitstrings. *)
let extract_bitstring data off len flen =
- (data, off, flen), off+flen, len-flen
+ (data, off, flen) (*, off+flen, len-flen*)
let extract_remainder data off len =
- (data, off, len), off+len, 0
+ (data, off, len) (*, off+len, 0*)
(* Extract and convert to numeric. A single bit is returned as
* a boolean. There are no endianness or signedness considerations.
let byteoff = off lsr 3 in
let bitmask = 1 lsl (7 - (off land 7)) in
let b = Char.code data.[byteoff] land bitmask <> 0 in
- b, off+1, len-1
+ b (*, off+1, len-1*)
(* Returns 8 bit unsigned aligned bytes from the string.
* If the string ends then this returns 0's.
(* Optimize the common (byte-aligned) case. *)
if off land 7 = 0 then (
let byte = Char.code data.[byteoff] in
- byte lsr (8 - flen), off+flen, len-flen
+ byte lsr (8 - flen) (*, off+flen, len-flen*)
) else (
(* Extract the 16 bits at byteoff and byteoff+1 (note that the
* second byte might not exist in the original string).
let shift = 16 - ((off land 7) + flen) in
let word = word lsr shift in
- word, off+flen, len-flen
+ word (*, off+flen, len-flen*)
)
(* Extract [9..31] bits. We have to consider endianness and signedness. *)
) else (
(* Extract the next 31 bits, slow method. *)
let word =
- let c0, off, len = extract_char_unsigned data off len 8 in
- let c1, off, len = extract_char_unsigned data off len 8 in
- let c2, off, len = extract_char_unsigned data off len 8 in
- let c3, off, len = extract_char_unsigned data off len 7 in
+ let c0 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c1 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c2 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c3 = extract_char_unsigned data off len 7 in
(c0 lsl 23) + (c1 lsl 15) + (c2 lsl 7) + c3 in
word lsr (31 - flen)
) in
- word, off+flen, len-flen
+ word (*, off+flen, len-flen*)
let extract_int_le_unsigned data off len flen =
- let v, off, len = extract_int_be_unsigned data off len flen in
+ let v = extract_int_be_unsigned data off len flen in
let v = I.byteswap v flen in
- v, off, len
+ v
let extract_int_ne_unsigned =
if nativeendian = BigEndian
) else (
(* Extract the next 32 bits, slow method. *)
let word =
- let c0, off, len = extract_char_unsigned data off len 8 in
- let c1, off, len = extract_char_unsigned data off len 8 in
- let c2, off, len = extract_char_unsigned data off len 8 in
- let c3, _, _ = extract_char_unsigned data off len 8 in
+ let c0 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c1 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c2 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c3 = extract_char_unsigned data off len 8 in
let c0 = Int32.of_int c0 in
let c1 = Int32.of_int c1 in
let c2 = Int32.of_int c2 in
_make_int32_be c0 c1 c2 c3 in
Int32.shift_right_logical word (32 - flen)
) in
- word, off+flen, len-flen
+ word (*, off+flen, len-flen*)
let extract_int32_le_unsigned data off len flen =
- let v, off, len = extract_int32_be_unsigned data off len flen in
+ let v = extract_int32_be_unsigned data off len flen in
let v = I32.byteswap v flen in
- v, off, len
+ v
let extract_int32_ne_unsigned =
if nativeendian = BigEndian
) else (
(* Extract the next 64 bits, slow method. *)
let word =
- let c0, off, len = extract_char_unsigned data off len 8 in
- let c1, off, len = extract_char_unsigned data off len 8 in
- let c2, off, len = extract_char_unsigned data off len 8 in
- let c3, off, len = extract_char_unsigned data off len 8 in
- let c4, off, len = extract_char_unsigned data off len 8 in
- let c5, off, len = extract_char_unsigned data off len 8 in
- let c6, off, len = extract_char_unsigned data off len 8 in
- let c7, _, _ = extract_char_unsigned data off len 8 in
+ let c0 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c1 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c2 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c3 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c4 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c5 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c6 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c7 = extract_char_unsigned data off len 8 in
let c0 = Int64.of_int c0 in
let c1 = Int64.of_int c1 in
let c2 = Int64.of_int c2 in
_make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in
Int64.shift_right_logical word (64 - flen)
) in
- word, off+flen, len-flen
+ word (*, off+flen, len-flen*)
let extract_int64_le_unsigned data off len flen =
let byteoff = off lsr 3 in
) else (
(* Extract the next 64 bits, slow method. *)
let word =
- let c0, off, len = extract_char_unsigned data off len 8 in
- let c1, off, len = extract_char_unsigned data off len 8 in
- let c2, off, len = extract_char_unsigned data off len 8 in
- let c3, off, len = extract_char_unsigned data off len 8 in
- let c4, off, len = extract_char_unsigned data off len 8 in
- let c5, off, len = extract_char_unsigned data off len 8 in
- let c6, off, len = extract_char_unsigned data off len 8 in
- let c7, _, _ = extract_char_unsigned data off len 8 in
+ let c0 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c1 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c2 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c3 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c4 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c5 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c6 = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
+ let c7 = extract_char_unsigned data off len 8 in
let c0 = Int64.of_int c0 in
let c1 = Int64.of_int c1 in
let c2 = Int64.of_int c2 in
_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
Int64.logand word (I64.mask flen)
) in
- word, off+flen, len-flen
+ word (*, off+flen, len-flen*)
let extract_int64_ne_unsigned =
if nativeendian = BigEndian
let rec loop off len blen =
if blen = 0 then (off, len)
else (
- let b, off, len = extract_bit data off len 1 in
+ 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)
)
let str = String.make strlen '\000' in
let rec loop data off len i =
if len >= 8 then (
- let c, off, len = extract_char_unsigned data off len 8 in
+ let c = extract_char_unsigned data off len 8
+ and off = off + 8 and len = len - 8 in
str.[i] <- Char.chr c;
loop data off len (i+1)
) else if len > 0 then (
- let c, _, _ = extract_char_unsigned data off len len in
+ let c = extract_char_unsigned data off len len in
str.[i] <- Char.chr (c lsl (8-len))
)
in
while !len > 0 do
let bits = min !len 8 in
- let byte, off', len' = extract_char_unsigned data !off !len bits in
- off := off'; len := len';
+ let byte = extract_char_unsigned data !off !len bits in
+ off := !off + bits; len := !len - bits;
let byte = byte lsl (8-bits) in
fprintf chan "%02x " byte;
field
+type functype = ExtractFunc | ConstructFunc
+
(* Choose the right constructor function. *)
-let build_bitstring_call _loc funcname length endian signed =
- match length, endian, signed with
+let build_bitstring_call _loc functype length endian signed =
+ match functype, length, endian, signed with
(* XXX The meaning of signed/unsigned breaks down at
* 31, 32, 63 and 64 bits.
*)
- | (Some 1, _, _) -> <:expr< Bitstring.$lid:funcname ^ "_bit"$ >>
- | (Some (2|3|4|5|6|7|8), _, sign) ->
- let call = Printf.sprintf "%s_char_%s"
- funcname (if sign then "signed" else "unsigned") in
+ | (ExtractFunc, Some 1, _, _) -> <:expr< Bitstring.extract_bit >>
+ | (ConstructFunc, Some 1, _, _) -> <:expr< Bitstring.construct_bit >>
+ | (functype, Some (2|3|4|5|6|7|8), _, signed) ->
+ let funcname = match functype with
+ | ExtractFunc -> "extract"
+ | ConstructFunc -> "construct" in
+ let sign = if signed then "signed" else "unsigned" in
+ let call = sprintf "%s_char_%s" funcname sign in
<:expr< Bitstring.$lid:call$ >>
- | (len, endian, signed) ->
+ | (functype, len, endian, signed) ->
+ let funcname = match functype with
+ | ExtractFunc -> "extract"
+ | ConstructFunc -> "construct" in
let t = match len with
- | Some i when i <= 31 -> "int"
- | Some 32 -> "int32"
- | _ -> "int64" in
+ | Some i when i <= 31 -> "int"
+ | Some 32 -> "int32"
+ | _ -> "int64" in
let sign = if signed then "signed" else "unsigned" in
match endian with
| P.ConstantEndian constant ->
| BigEndian -> "be"
| LittleEndian -> "le"
| NativeEndian -> "ne" in
- let call = Printf.sprintf "%s_%s_%s_%s"
- funcname t endianness sign in
+ let call = sprintf "%s_%s_%s_%s" funcname t endianness sign in
<:expr< Bitstring.$lid:call$ >>
| P.EndianExpr expr ->
- let call = Printf.sprintf "%s_%s_%s_%s"
- funcname t "ee" sign in
+ let call = sprintf "%s_%s_%s_%s" funcname t "ee" sign in
<:expr< Bitstring.$lid:call$ $expr$ >>
(* Generate the code for a constructor, ie. 'BITSTRING ...'. *)
let flen_is_const = expr_is_constant flen in
let int_construct_const (i, endian, signed) =
- build_bitstring_call _loc "construct" (Some i) endian signed in
+ build_bitstring_call _loc ConstructFunc (Some i) endian signed in
let int_construct (endian, signed) =
- build_bitstring_call _loc "construct" None endian signed in
+ build_bitstring_call _loc ConstructFunc None endian signed in
let expr =
match t, flen_is_const with
* current position within the bitstring:
*
* data - original bitstring data (string, never changes)
- *
* off - current offset within data (int, increments as we move through
* the bitstring)
* len - current remaining length within data (int, decrements as
* we move through the bitstring)
*
+ * Also:
+ *
* original_off - saved offset at the start of the match (never changes)
* original_len - saved length at the start of the match (never changes)
+ * off_aligned - true if the original offset is byte-aligned (allows
+ * us to make some common optimizations)
*)
let data = gensym "data"
and off = gensym "off"
and len = gensym "len"
and original_off = gensym "original_off"
and original_len = gensym "original_len"
+ and off_aligned = gensym "off_aligned"
+
(* This is where the result will be stored (a reference). *)
and result = gensym "result" in
| Some check_expr ->
<:expr< if $check_expr$ then $expr$ >> in
- (* Now build the code which matches a field. *)
- let int_extract_const (i, endian, signed) =
- build_bitstring_call _loc "extract" (Some i) endian signed in
- let int_extract (endian, signed) =
- build_bitstring_call _loc "extract" None endian signed in
+ (* Compute the offset of this field within the match, if it
+ * can be known at compile time.
+ *
+ * Actually, we'll compute two things: the 'natural_field_offset'
+ * is the offset assuming this field had no offset() qualifier
+ * (in other words, its position, immediately following the
+ * preceding field). 'field_offset' is the real field offset
+ * taking into account any offset() qualifier.
+ *
+ * This will be [Some i] if our current offset is known
+ * at compile time, or [None] if we can't determine it.
+ *)
+ let natural_field_offset, field_offset =
+ let has_constant_offset field =
+ match P.get_offset field with
+ | None -> false
+ | Some expr ->
+ match expr_is_constant expr with
+ | None -> false
+ | Some i -> true
+ in
+ let get_constant_offset field =
+ match P.get_offset field with
+ | None -> assert false
+ | Some expr ->
+ match expr_is_constant expr with
+ | None -> assert false
+ | Some i -> i
+ in
+
+ let has_constant_len field =
+ match expr_is_constant (P.get_length field) with
+ | None -> false
+ | Some i when i > 0 -> true
+ | Some _ -> false
+ in
+ let get_constant_len field =
+ match expr_is_constant (P.get_length field) with
+ | None -> assert false
+ | Some i when i > 0 -> i
+ | Some _ -> assert false
+ in
+
+ (* NB: We are looping over the PRECEDING fields in reverse order. *)
+ let rec loop = function
+ (* first field has constant offset 0 *)
+ | [] -> Some 0
+ (* preceding field with constant offset & length *)
+ | f :: _
+ when has_constant_offset f && has_constant_len f ->
+ Some (get_constant_offset f + get_constant_len f)
+ (* preceding field with no offset & constant length *)
+ | f :: fs
+ when P.get_offset f = None && has_constant_len f ->
+ (match loop fs with
+ | None -> None
+ | Some offset -> Some (offset + get_constant_len f))
+ (* else, can't work out the offset *)
+ | _ -> None
+ in
+
+ let natural_field_offset = loop fields in
+
+ let field_offset =
+ match P.get_offset field with
+ | None -> natural_field_offset
+ | Some expr -> (* has an offset() clause *)
+ match expr_is_constant expr with
+ | None -> None
+ | i -> i in
+
+ natural_field_offset, field_offset in
+
+ (* Also compute if the field_offset is known to be byte-aligned at
+ * compile time, which is usually both the common and best possible
+ * case for generating optimized code.
+ *
+ * This is None if not aligned / don't know.
+ * Or Some byte_offset if we can work it out.
+ *)
+ let field_offset_aligned =
+ match field_offset with
+ | None -> None (* unknown, assume no *)
+ | Some off when off land 7 = 0 -> Some (off lsr 3)
+ | Some _ -> None in (* definitely no *)
+
+ (* Now build the code which matches a single field. *)
+ let int_extract_const i endian signed =
+ build_bitstring_call _loc ExtractFunc (Some i) endian signed in
+ let int_extract endian signed =
+ build_bitstring_call _loc ExtractFunc None endian signed in
let expr =
- match t, flen_is_const with
+ match t, flen_is_const, field_offset_aligned with
+ (* Very common cases: int field, constant 8/16/32/64 bit length,
+ * aligned to the match at a known offset. We still have to
+ * check if the bitstring is aligned (can only be known at
+ * runtime) but we may be able to directly access the
+ * bytes in the string.
+ *)
+ | P.Int, Some ((8(*|16|32|64*)) as i), Some field_byte_offset ->
+ let extract_fn = int_extract_const i endian signed in
+ let o = gensym "off" and v = gensym "val" in
+
+ (* The fast-path code when everything is aligned. *)
+ let fastpath =
+ <:expr<
+ let $lid:o$ = ($lid:original_off$ lsr 3) +
+ $`int:field_byte_offset$ in
+ Char.code (String.unsafe_get $lid:data$ $lid:o$)
+ >> in
+
+ <:expr<
+ if $lid:len$ >= $`int:i$ then (
+ let $lid:v$ =
+ if $lid:off_aligned$ then
+ $fastpath$
+ else
+ $extract_fn$ $lid:data$ $lid:off$ $lid:len$ $`int:i$ in
+ let $lid:off$ = $lid:off$ + $`int:i$
+ and $lid:len$ = $lid:len$ - $`int:i$ in
+ match $lid:v$ with $fpatt$ when true -> $expr$ | _ -> ()
+ )
+ >>
+
(* Common case: int field, constant flen *)
- | P.Int, Some i when i > 0 && i <= 64 ->
- let extract_fn = int_extract_const (i,endian,signed) in
+ | P.Int, Some i, _ when i > 0 && i <= 64 ->
+ let extract_fn = int_extract_const i endian signed in
let v = gensym "val" in
<:expr<
if $lid:len$ >= $`int:i$ then (
- let $lid:v$, $lid:off$, $lid:len$ =
+ let $lid:v$ =
$extract_fn$ $lid:data$ $lid:off$ $lid:len$ $`int:i$ in
+ let $lid:off$ = $lid:off$ + $`int:i$
+ and $lid:len$ = $lid:len$ - $`int:i$ in
match $lid:v$ with $fpatt$ when true -> $expr$ | _ -> ()
)
>>
- | P.Int, Some _ ->
+ | P.Int, Some _, _ ->
fail "length of int field must be [1..64]"
(* Int field, non-const flen. We have to test the range of
* the field at runtime. If outside the range it's a no-match
* (not an error).
*)
- | P.Int, None ->
- let extract_fn = int_extract (endian,signed) in
+ | P.Int, None, _ ->
+ let extract_fn = int_extract endian signed in
let v = gensym "val" in
<:expr<
if $flen$ >= 1 && $flen$ <= 64 && $flen$ <= $lid:len$ then (
- let $lid:v$, $lid:off$, $lid:len$ =
+ let $lid:v$ =
$extract_fn$ $lid:data$ $lid:off$ $lid:len$ $flen$ in
+ let $lid:off$ = $lid:off$ + $flen$
+ and $lid:len$ = $lid:len$ - $flen$ in
match $lid:v$ with $fpatt$ when true -> $expr$ | _ -> ()
)
>>
(* String, constant flen > 0. *)
- | P.String, Some i when i > 0 && i land 7 = 0 ->
+ | P.String, Some i, _ when i > 0 && i land 7 = 0 ->
let bs = gensym "bs" in
<:expr<
if $lid:len$ >= $`int:i$ then (
- let $lid:bs$, $lid:off$, $lid:len$ =
+ let $lid:bs$ =
Bitstring.extract_bitstring $lid:data$ $lid:off$ $lid:len$
$`int:i$ in
+ let $lid:off$ = $lid:off$ + $`int:i$
+ and $lid:len$ = $lid:len$ - $`int:i$ in
match Bitstring.string_of_bitstring $lid:bs$ with
| $fpatt$ when true -> $expr$
| _ -> ()
(* String, constant flen = -1, means consume all the
* rest of the input.
*)
- | P.String, Some i when i = -1 ->
+ | P.String, Some i, _ when i = -1 ->
let bs = gensym "bs" in
<:expr<
- let $lid:bs$, $lid:off$, $lid:len$ =
+ let $lid:bs$ =
Bitstring.extract_remainder $lid:data$ $lid:off$ $lid:len$ in
+ let $lid:off$ = $lid:off$ + $lid:len$ in
+ let $lid:len$ = 0 in
match Bitstring.string_of_bitstring $lid:bs$ with
| $fpatt$ when true -> $expr$
| _ -> ()
>>
- | P.String, Some _ ->
+ | P.String, Some _, _ ->
fail "length of string must be > 0 and a multiple of 8, or the special value -1"
(* String field, non-const flen. We check the flen is > 0
* and a multiple of 8 (-1 is not allowed here), at runtime.
*)
- | P.String, None ->
+ | P.String, None, _ ->
let bs = gensym "bs" in
<:expr<
if $flen$ >= 0 && $flen$ <= $lid:len$
&& $flen$ land 7 = 0 then (
- let $lid:bs$, $lid:off$, $lid:len$ =
+ let $lid:bs$ =
Bitstring.extract_bitstring
$lid:data$ $lid:off$ $lid:len$ $flen$ in
+ let $lid:off$ = $lid:off$ + $flen$
+ and $lid:len$ = $lid:len$ - $flen$ in
match Bitstring.string_of_bitstring $lid:bs$ with
| $fpatt$ when true -> $expr$
| _ -> ()
* At the moment all we can do is assign the bitstring to an
* identifier.
*)
- | P.Bitstring, Some i when i >= 0 ->
+ | P.Bitstring, Some i, _ when i >= 0 ->
let ident =
match fpatt with
| <:patt< $lid:ident$ >> -> ident
fail "cannot compare a bitstring to a constant" in
<:expr<
if $lid:len$ >= $`int:i$ then (
- let $lid:ident$, $lid:off$, $lid:len$ =
+ let $lid:ident$ =
Bitstring.extract_bitstring $lid:data$ $lid:off$ $lid:len$
$`int:i$ in
+ let $lid:off$ = $lid:off$ + $`int:i$
+ and $lid:len$ = $lid:len$ - $`int:i$ in
$expr$
)
>>
(* Bitstring, constant flen = -1, means consume all the
* rest of the input.
*)
- | P.Bitstring, Some i when i = -1 ->
+ | P.Bitstring, Some i, _ when i = -1 ->
let ident =
match fpatt with
| <:patt< $lid:ident$ >> -> ident
| _ ->
fail "cannot compare a bitstring to a constant" in
<:expr<
- let $lid:ident$, $lid:off$, $lid:len$ =
+ let $lid:ident$ =
Bitstring.extract_remainder $lid:data$ $lid:off$ $lid:len$ in
+ let $lid:off$ = $lid:off$ + $lid:len$ in
+ let $lid:len$ = 0 in
$expr$
>>
- | P.Bitstring, Some _ ->
+ | P.Bitstring, Some _, _ ->
fail "length of bitstring must be >= 0 or the special value -1"
(* Bitstring field, non-const flen. We check the flen is >= 0
* (-1 is not allowed here) at runtime.
*)
- | P.Bitstring, None ->
+ | P.Bitstring, None, _ ->
let ident =
match fpatt with
| <:patt< $lid:ident$ >> -> ident
fail "cannot compare a bitstring to a constant" in
<:expr<
if $flen$ >= 0 && $flen$ <= $lid:len$ then (
- let $lid:ident$, $lid:off$, $lid:len$ =
+ let $lid:ident$ =
Bitstring.extract_bitstring $lid:data$ $lid:off$ $lid:len$
$flen$ in
+ let $lid:off$ = $lid:off$ + $flen$
+ and $lid:len$ = $lid:len$ - $flen$ in
$expr$
)
>>
*)
let requested_offset = expr_is_constant offset_expr in
- (* This will be [Some i] if our current offset is known
- * at compile time, or [None] if we can't determine it.
- *)
- let current_offset =
- let has_constant_offset field =
- match P.get_offset field with
- | None -> false
- | Some expr ->
- match expr_is_constant expr with
- | None -> false
- | Some i -> true
- in
- let get_constant_offset field =
- match P.get_offset field with
- | None -> assert false
- | Some expr ->
- match expr_is_constant expr with
- | None -> assert false
- | Some i -> i
- in
-
- let has_constant_len field =
- match expr_is_constant (P.get_length field) with
- | None -> false
- | Some i when i > 0 -> true
- | Some _ -> false
- in
- let get_constant_len field =
- match expr_is_constant (P.get_length field) with
- | None -> assert false
- | Some i when i > 0 -> i
- | Some _ -> assert false
- in
-
- let rec loop = function
- (* first field has constant offset 0 *)
- | [] -> Some 0
- (* field with constant offset & length *)
- | field :: _
- when has_constant_offset field &&
- has_constant_len field ->
- Some (get_constant_offset field + get_constant_len field)
- (* field with no offset & constant length *)
- | field :: fields
- when P.get_offset field = None &&
- has_constant_len field ->
- (match loop fields with
- | None -> None
- | Some offset -> Some (offset + get_constant_len field))
- (* else, can't work out the offset *)
- | _ -> None
- in
- loop fields in
-
- (* Look at the current offset and requested offset cases and
- * determine what code to generate.
+ (* Look at the field offset (if known) and requested offset
+ * cases and determine what code to generate.
*)
- match current_offset, requested_offset with
- (* This is the good case: both the current offset and
+ match natural_field_offset, requested_offset with
+ (* This is the good case: both the field offset and
* the requested offset are constant, so we can remove
* almost all the runtime checks.
*)
- | Some current_offset, Some requested_offset ->
- let move = requested_offset - current_offset in
+ | Some natural_field_offset, Some requested_offset ->
+ let move = requested_offset - natural_field_offset in
if move < 0 then
- fail (sprintf "requested offset is less than the current offset (%d < %d)" requested_offset current_offset);
+ fail (sprintf "requested offset is less than the field offset (%d < %d)" requested_offset natural_field_offset);
(* Add some code to move the offset and length by a
* constant amount, and a runtime test that len >= 0
* (XXX possibly the runtime test is unnecessary?)
<:expr<
(* Note we save the original offset/length at the start of the match
* in 'original_off'/'original_len' symbols. 'data' never changes.
+ * This code also ensures that if original_off/original_len/off_aligned
+ * aren't actually used, we don't get a warning.
*)
let ($lid:data$, $lid:original_off$, $lid:original_len$) = $bs$ in
let $lid:off$ = $lid:original_off$ and $lid:len$ = $lid:original_len$ in
+ let $lid:off_aligned$ = $lid:off$ land 7 = 0 in
+ ignore $lid:off_aligned$;
let $lid:result$ = ref None in
(try
$cases$
git.annexia.org / ocaml-bitstring.git / commitdiff