This patch adds the framework for including C code in bitstring.

[ocaml-bitstring.git] / bitstring.ml

diff --git a/bitstring.ml b/bitstring.ml
index 38e7032..610c2b5 100644 (file)
--- a/bitstring.ml
+++ b/bitstring.ml
@@ -1,4 +1,4 @@
-(* Bitmatch library.
+(* Bitstring library.
  * Copyright (C) 2008 Red Hat Inc., Richard W.M. Jones
  *
  * This library is free software; you can redistribute it and/or
@@ -21,11 +21,11 @@
 
 open Printf
 
-include Bitmatch_types
-include Bitmatch_config
+include Bitstring_types
+include Bitstring_config
 
 (* Enable runtime debug messages.  Must also have been enabled
- * in pa_bitmatch.ml.
+ * in pa_bitstring.ml.
  *)
 let debug = ref false
 
@@ -157,16 +157,8 @@ module I = struct
   let minus_one = -1
   let ff = 0xff
 
-  (* Create a mask so many bits wide. *)
-  let mask bits =
-    if bits < 30 then
-      pred (one << bits)
-    else if bits = 30 then
-      max_int
-    else if bits = 31 then
-      minus_one
-    else
-      invalid_arg "Bitmatch.I.mask"
+  (* Create a mask 0-31 bits wide. *)
+  external mask : int -> int = "ocaml_bitstring_I_mask" "noalloc"
 
   (* Byte swap an int of a given size. *)
   let byteswap v bits =
@@ -208,6 +200,19 @@ module I = struct
       let lsb = v land (mask bits) in
       g (to_int lsb) bits
     )
+
+  (* Call function g on the top bits, then f on each full byte
+   * (little endian - so start at root).
+   *)
+  let rec map_bytes_le g f v bits =
+    if bits >= 8 then (
+      let lsb = v land ff in
+      f (to_int lsb);
+      map_bytes_le g f (v >> 8) (bits-8)
+    ) else if bits > 0 then (
+      let lsb = v land (mask bits) in
+      g (to_int lsb) bits
+    )
 end
 
 module I32 = struct
@@ -237,7 +242,7 @@ module I32 = struct
     else if bits = 32 then
       minus_one
     else
-      invalid_arg "Bitmatch.I32.mask"
+      invalid_arg "Bitstring.I32.mask"
 
   (* Byte swap an int of a given size. *)
   let byteswap v bits =
@@ -279,6 +284,19 @@ module I32 = struct
       let lsb = v land (mask bits) in
       g (to_int lsb) bits
     )
+
+  (* Call function g on the top bits, then f on each full byte
+   * (little endian - so start at root).
+   *)
+  let rec map_bytes_le g f v bits =
+    if bits >= 8 then (
+      let lsb = v land ff in
+      f (to_int lsb);
+      map_bytes_le g f (v >> 8) (bits-8)
+    ) else if bits > 0 then (
+      let lsb = v land (mask bits) in
+      g (to_int lsb) bits
+    )
 end
 
 module I64 = struct
@@ -308,7 +326,7 @@ module I64 = struct
     else if bits = 64 then
       minus_one
     else
-      invalid_arg "Bitmatch.I64.mask"
+      invalid_arg "Bitstring.I64.mask"
 
   (* Byte swap an int of a given size. *)
   (* let byteswap v bits = *)
@@ -330,6 +348,19 @@ module I64 = struct
       let lsb = v land (mask bits) in
       g (to_int lsb) bits
     )
+
+  (* Call function g on the top bits, then f on each full byte
+   * (little endian - so start at root).
+   *)
+  let rec map_bytes_le g f v bits =
+    if bits >= 8 then (
+      let lsb = v land ff in
+      f (to_int lsb);
+      map_bytes_le g f (v >> 8) (bits-8)
+    ) else if bits > 0 then (
+      let lsb = v land (mask bits) in
+      g (to_int lsb) bits
+    )
 end
 
 (*----------------------------------------------------------------------*)
@@ -661,7 +692,7 @@ module Buffer = struct
 
   (* Add exactly 8 bits. *)
   let add_byte ({ buf = buf; len = len; last = last } as t) byte =
-    if byte < 0 || byte > 255 then invalid_arg "Bitmatch.Buffer.add_byte";
+    if byte < 0 || byte > 255 then invalid_arg "Bitstring.Buffer.add_byte";
     let shift = len land 7 in
     if shift = 0 then
       (* Target buffer is byte-aligned. *)
@@ -693,7 +724,7 @@ module Buffer = struct
    * to call add_bit so it's slow.
    *)
   let _add_bits t c slen =
-    if slen < 1 || slen >= 8 then invalid_arg "Bitmatch.Buffer._add_bits";
+    if slen < 1 || slen >= 8 then invalid_arg "Bitstring.Buffer._add_bits";
     for i = slen-1 downto 0 do
       let bit = c land (1 lsl i) <> 0 in
       add_bit t bit
@@ -760,16 +791,21 @@ let construct_int_be_unsigned buf v flen exn =
   (* Add the bytes. *)
   I.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
 
+(* Construct a field of up to 31 bits. *)
+let construct_int_le_unsigned buf v flen exn =
+  (* Check value is within range. *)
+  if not (I.range_unsigned v flen) then raise exn;
+  (* Add the bytes. *)
+  I.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
+
 let construct_int_ne_unsigned =
   if nativeendian = BigEndian
   then construct_int_be_unsigned
-  else (*construct_int_le_unsigned*)
-    fun _ _ _ _ -> failwith "construct_int_le_unsigned"
+  else construct_int_le_unsigned
 
 let construct_int_ee_unsigned = function
   | BigEndian -> construct_int_be_unsigned
-  | LittleEndian -> (*construct_int_le_unsigned*)
-      (fun _ _ _ _ -> failwith "construct_int_le_unsigned")
+  | LittleEndian -> construct_int_le_unsigned
   | NativeEndian -> construct_int_ne_unsigned
 
 (* Construct a field of exactly 32 bits. *)
@@ -810,6 +846,13 @@ let construct_int64_be_unsigned buf v flen exn =
   (* Add the bytes. *)
   I64.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
 
+(* Construct a field of up to 64 bits. *)
+let construct_int64_le_unsigned buf v flen exn =
+  (* Check value is within range. *)
+  if not (I64.range_unsigned v flen) then raise exn;
+  (* Add the bytes. *)
+  I64.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
+
 let construct_int64_ne_unsigned =
   if nativeendian = BigEndian
   then construct_int64_be_unsigned