diff --git a/js/cstruct.js b/js/cstruct.js index f1f7e995..d7f0e415 100644 --- a/js/cstruct.js +++ b/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? +} diff --git a/lib/cstruct.ml b/lib/cstruct.ml index 5b1916b1..f2866e06 100644 --- a/lib/cstruct.ml +++ b/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 diff --git a/lib/cstruct.mli b/lib/cstruct.mli index a0052996..7c884981 100644 --- a/lib/cstruct.mli +++ b/lib/cstruct.mli @@ -222,6 +222,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]. diff --git a/lib/cstruct_stubs.c b/lib/cstruct_stubs.c index 6f82a007..f5b5c5a8 100644 --- a/lib/cstruct_stubs.c +++ b/lib/cstruct_stubs.c @@ -19,6 +19,7 @@ #include #include #include +#include #include #include @@ -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); +} diff --git a/lib_test/tests.ml b/lib_test/tests.ml index 8ccad3ee..9dc19c1d 100644 --- a/lib_test/tests.ml +++ b/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 -