Add function to check buffer alignment

js/cstruct.js

@@ -64,3 +64,8 @@ function caml_fill_bigstring(buf, buf_off, buf_len, v) {
   }
   return 0;
 }
+
+//Provides: caml_check_alignment_bigstring
+function caml_check_alignment_bigstring(buf, ofs, alignment) {
+  return true; // FIXME: No concept of a fixed buffer address?
+}

lib/cstruct.ml

@@ -95,6 +95,10 @@ let create len =
 let check_bounds t len =
   Bigarray.Array1.dim t.buffer >= len
 
+external check_alignment_bigstring : buffer -> int -> int -> bool = "caml_check_alignment_bigstring"
+
+let check_alignment t alignment = check_alignment_bigstring t.buffer t.off alignment
+
 type byte = char
 
 let byte (i:int) : byte = Char.chr i

lib/cstruct.mli

@@ -213,6 +213,13 @@ val check_bounds : t -> int -> bool
 (** [check_bounds cstr len] is [true] if [cstr.buffer]'s size is
     greater or equal than [len], [false] otherwise. *)
 
+val check_alignment : t -> int -> bool
+(** [check_alignment cstr alignment] is [true] if the first byte stored
+    within [cstr] is at a memory address where [address mod alignment = 0],
+    [false] otherwise.
+    Typical uses are to check a buffer is aligned to a page or disk sector
+    boundary. *)
+
 val get_char: t -> int -> char
 (** [get_char t off] returns the character contained in the cstruct
     at offset [off].

lib/cstruct_stubs.c

@@ -19,6 +19,7 @@
 #include <stdlib.h>
 #include <errno.h>
 #include <string.h>
+#include <stdint.h>
 
 #include <caml/mlvalues.h>
 #include <caml/memory.h>
@@ -69,3 +70,11 @@ caml_fill_bigstring(value val_buf, value val_ofs, value val_len, value val_byte)
          Long_val(val_len));
   return Val_unit;
 }
+
+CAMLprim value
+caml_check_alignment_bigstring(value val_buf, value val_ofs, value val_alignment)
+{
+  uint64_t address = (uint64_t) (Caml_ba_data_val(val_buf) + Long_val(val_ofs));
+  int alignment = Int_val(val_alignment);
+  return Val_bool(address % alignment == 0);
+}

lib_test/tests.ml

@@ -103,6 +103,17 @@ let fillv () =
   test [Cstruct.of_string "abc"; Cstruct.of_string ""; Cstruct.of_string "def"] 6;
   test [Cstruct.of_string "abc"; Cstruct.of_string ""; Cstruct.of_string "def"] 7
 
+let check_alignment alignment () =
+  (* Make the buffer big enough to find 4 aligned offsets within it *)
+  let expected = 4 in
+  let buf = Cstruct.create (expected * alignment) in
+  (* How many aligned offsets are there in this buffer? *)
+  let actual = ref 0 in
+  for i = 0 to Cstruct.len buf - 1 do
+    if Cstruct.(check_alignment (shift buf i) alignment) then incr actual
+  done;
+  assert_equal ~printer:string_of_int expected !actual
+
 let _ =
   let suite =
     "misc tests" >::: [
@@ -118,8 +129,11 @@ let _ =
       ] ;
       "append" >::: [
         "append is concat" >:: append_is_concat ~n:5000
+      ] ;
+      "alignment" >::: [
+        "aligned to 4096" >:: check_alignment 4096
+      ; "aligned to 512"  >:: check_alignment 512
       ]
     ]
   in
   run_test_tt suite
-