pax_global_header00006660000000000000000000000064140706674100014517gustar00rootroot0000000000000052 comment=9c1e57375f3da15cf344c228e2cc14a36513923d bigstringaf-0.8.0/000077500000000000000000000000001407066741000140235ustar00rootroot00000000000000bigstringaf-0.8.0/.github/000077500000000000000000000000001407066741000153635ustar00rootroot00000000000000bigstringaf-0.8.0/.github/workflows/000077500000000000000000000000001407066741000174205ustar00rootroot00000000000000bigstringaf-0.8.0/.github/workflows/test.yml000066400000000000000000000014061407066741000211230ustar00rootroot00000000000000name: build on: - push - pull_request jobs: tests: name: Tests strategy: fail-fast: false matrix: os: - ubuntu-latest ocaml-version: - 4.03.0 - 4.05.0 - 4.07.0 - 4.09.0 - 4.11.1 runs-on: ${{ matrix.os }} steps: - name: Checkout code uses: actions/checkout@v2 - name: Use OCaml ${{ matrix.ocaml-version }} uses: avsm/setup-ocaml@v1 with: ocaml-version: ${{ matrix.ocaml-version }} - name: Deps run: | opam pin add -n bigstringaf . opam install -t --deps-only . - name: Build run: opam exec -- dune build - name: Test run: opam exec -- dune runtest bigstringaf-0.8.0/.gitignore000066400000000000000000000001551407066741000160140ustar00rootroot00000000000000.*.sw[a-z] *~ _build/ _tests/ lib_test/tests_ setup.log setup.data *.native *.byte *.docdir *.install .merlinbigstringaf-0.8.0/CHANGES.md000066400000000000000000000012151407066741000154140ustar00rootroot00000000000000### 0.4.0 (2018-10-26) * freestanding: fix dependencies (ocaml-freestanding #22 @hannesm) * xen: unify usage of mirage-xen-posix package (#17 @hannesm) * fix typo in comment (#18 @tiensonqin) * jbuild: do not use bash (#16 #21 @rgrinberg, #22 @hannesm) * opam: add '"-p" name' to subst command (#15 @seliopou) ### 0.3.0 (2018-07-07) * Add linking support for mirage-xen-ocaml and ocaml-freestanding (#12, #13, #14, h/t @samoht, @hannesm, @dinosaure) ### 0.2.0 (2018-06-10) * Add memcmp operations (#2) * Fix bounds checking bugs in constructors (#4, #5, h/t @yallop) * Add safe blit/memcmp operations (#8) ### 0.1.0 (2018-04-01) * initial releasebigstringaf-0.8.0/LICENSE000066400000000000000000000026731407066741000150400ustar00rootroot00000000000000Copyright (c) 2018, Inhabited Type LLC All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. bigstringaf-0.8.0/META.bigstringaf.template000066400000000000000000000001151407066741000206010ustar00rootroot00000000000000# DUNE_GEN freestanding_linkopts = "-l:libbigstringaf_freestanding_stubs.a" bigstringaf-0.8.0/Makefile000066400000000000000000000002601407066741000154610ustar00rootroot00000000000000.PHONY: all build clean test build: dune build @install all: build test: dune runtest install: dune install uninstall: dune uninstall clean: rm -rf _build *.install bigstringaf-0.8.0/README.md000066400000000000000000000022531407066741000153040ustar00rootroot00000000000000# Bigstringaf The OCaml compiler has a bunch of intrinsics for Bigstrings, but they're not widely-known, sometimes misused, and programs that use Bigstrings are slower than they have to be. And even if a library got that part right and exposed the intrinsics properly, the compiler doesn't have any fast blits between Bigstrings and other string-like types. So here they are. Go crazy. [![Build Status](https://github.com/inhabitedtype/bigstringaf/workflows/build/badge.svg)](https://github.com/inhabitedtype/bigstringaf/actions?query=workflow%3A%22build%22) ## Installation Install the library and its dependencies via [OPAM][opam]: [opam]: http://opam.ocaml.org/ ```bash opam install bigstringaf ``` ## Development To install development dependencies, pin the package from the root of the repository: ```bash opam pin add -n bigstringaf . opam install --deps-only bigstringaf ``` After this, you may install a development version of the library using the install command as usual. For building and running the tests during development, you will need to install the `alcotest` package: ```bash opam install alcotest make test ``` ## License BSD3, see LICENSE file for its text. bigstringaf-0.8.0/bigstringaf.opam000066400000000000000000000024151407066741000172020ustar00rootroot00000000000000version: "0.8.0" opam-version: "2.0" maintainer: "Spiros Eliopoulos " authors: [ "Spiros Eliopoulos " ] license: "BSD-3-clause" homepage: "https://github.com/inhabitedtype/bigstringaf" bug-reports: "https://github.com/inhabitedtype/bigstringaf/issues" dev-repo: "git+https://github.com/inhabitedtype/bigstringaf.git" build: [ ["dune" "subst"] {pinned} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name] {with-test} ] depends: [ "dune" {>= "2.6.0"} "alcotest" {with-test} "bigarray-compat" "ocaml" {>= "4.03.0"} "conf-pkg-config" {build} ] depopts: [ "ocaml-freestanding" ] conflicts: [ "mirage-xen" {< "6.0.0"} "ocaml-freestanding" {< "0.4.1"} "js_of_ocaml" {< "3.5.0"} ] synopsis: "Bigstring intrinsics and fast blits based on memcpy/memmove" description: """ Bigstring intrinsics and fast blits based on memcpy/memmove The OCaml compiler has a bunch of intrinsics for Bigstrings, but they're not widely-known, sometimes misused, and so programs that use Bigstrings are slower than they have to be. And even if a library got that part right and exposed the intrinsics properly, the compiler doesn't have any fast blits between Bigstrings and other string-like types. So here they are. Go crazy. """ bigstringaf-0.8.0/dune-project000066400000000000000000000000431407066741000163420ustar00rootroot00000000000000(lang dune 2.6) (name bigstringaf) bigstringaf-0.8.0/lib/000077500000000000000000000000001407066741000145715ustar00rootroot00000000000000bigstringaf-0.8.0/lib/bigstringaf.ml000066400000000000000000000316561407066741000174350ustar00rootroot00000000000000type bigstring = (char, Bigarray_compat.int8_unsigned_elt, Bigarray_compat.c_layout) Bigarray_compat.Array1.t type t = bigstring let create size = Bigarray_compat.(Array1.create char c_layout size) let empty = create 0 module BA1 = Bigarray_compat.Array1 let length t = BA1.dim t external get : t -> int -> char = "%caml_ba_ref_1" external set : t -> int -> char -> unit = "%caml_ba_set_1" external unsafe_get : t -> int -> char = "%caml_ba_unsafe_ref_1" external unsafe_set : t -> int -> char -> unit = "%caml_ba_unsafe_set_1" external unsafe_blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit = "bigstringaf_blit_to_bigstring" [@@noalloc] external unsafe_blit_to_bytes : t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> unit = "bigstringaf_blit_to_bytes" [@@noalloc] external unsafe_blit_from_bytes : Bytes.t -> src_off:int -> t -> dst_off:int -> len:int -> unit = "bigstringaf_blit_from_bytes" [@@noalloc] external unsafe_blit_from_string : string -> src_off:int -> t -> dst_off:int -> len:int -> unit = "bigstringaf_blit_from_bytes" [@@noalloc] external unsafe_memcmp : t -> int -> t -> int -> int -> int = "bigstringaf_memcmp_bigstring" [@@noalloc] external unsafe_memcmp_string : t -> int -> string -> int -> int -> int = "bigstringaf_memcmp_string" [@@noalloc] external unsafe_memchr : t -> int -> char -> int -> int = "bigstringaf_memchr" [@@noalloc] let sub t ~off ~len = BA1.sub t off len let[@inline never] invalid_bounds op buffer_len off len = let message = Printf.sprintf "Bigstringaf.%s invalid range: { buffer_len: %d, off: %d, len: %d }" op buffer_len off len in raise (Invalid_argument message) ;; let[@inline never] invalid_bounds_blit op src_len src_off dst_len dst_off len = let message = Printf.sprintf "Bigstringaf.%s invalid range: { src_len: %d, src_off: %d, dst_len: %d, dst_off: %d, len: %d }" op src_len src_off dst_len dst_off len in raise (Invalid_argument message) ;; let[@inline never] invalid_bounds_memcmp op buf1_len buf1_off buf2_len buf2_off len = let message = Printf.sprintf "Bigstringaf.%s invalid range: { buf1_len: %d, buf1_off: %d, buf2_len: %d, buf2_off: %d, len: %d }" op buf1_len buf1_off buf2_len buf2_off len in raise (Invalid_argument message) ;; (* A note on bounds checking. * * The code should perform the following check to ensure that the blit doesn't * run off the end of the input buffer: * * {[off + len <= buffer_len]} * * However, this may lead to an integer overflow for large values of [off], * e.g., [max_int], which will cause the comparison to return [true] when it * should really return [false]. * * An equivalent comparison that does not run into this integer overflow * problem is: * * {[buffer_len - off => len]} * * This is checking that the input buffer, less the offset, is sufficiently * long to perform the blit. Since the expression is subtracting [off] rather * than adding it, it doesn't suffer from the overflow that the previous * inequality did. As long as there is a check to ensure that [off] is not * negative, it won't underflow either. *) let copy t ~off ~len = let buffer_len = length t in if len < 0 || off < 0 || buffer_len - off < len then invalid_bounds "copy" buffer_len off len; let dst = create len in unsafe_blit t ~src_off:off dst ~dst_off:0 ~len; dst ;; let substring t ~off ~len = let buffer_len = length t in if len < 0 || off < 0 || buffer_len - off < len then invalid_bounds "substring" buffer_len off len; let b = Bytes.create len in unsafe_blit_to_bytes t ~src_off:off b ~dst_off:0 ~len; Bytes.unsafe_to_string b ;; let to_string t = let len = length t in let b = Bytes.create len in unsafe_blit_to_bytes t ~src_off:0 b ~dst_off:0 ~len; Bytes.unsafe_to_string b ;; let of_string ~off ~len s = let buffer_len = String.length s in if len < 0 || off < 0 || buffer_len - off < len then invalid_bounds "of_string" buffer_len off len; let b = create len in unsafe_blit_from_string s ~src_off:off b ~dst_off:0 ~len; b ;; let blit src ~src_off dst ~dst_off ~len = let src_len = length src in let dst_len = length dst in if len < 0 then invalid_bounds_blit "blit" src_len src_off dst_len dst_off len; if src_off < 0 || src_len - src_off < len then invalid_bounds_blit "blit" src_len src_off dst_len dst_off len; if dst_off < 0 || dst_len - dst_off < len then invalid_bounds_blit "blit" src_len src_off dst_len dst_off len; unsafe_blit src ~src_off dst ~dst_off ~len ;; let blit_from_string src ~src_off dst ~dst_off ~len = let src_len = String.length src in let dst_len = length dst in if len < 0 then invalid_bounds_blit "blit_from_string" src_len src_off dst_len dst_off len; if src_off < 0 || src_len - src_off < len then invalid_bounds_blit "blit_from_string" src_len src_off dst_len dst_off len; if dst_off < 0 || dst_len - dst_off < len then invalid_bounds_blit "blit_from_string" src_len src_off dst_len dst_off len; unsafe_blit_from_string src ~src_off dst ~dst_off ~len ;; let blit_from_bytes src ~src_off dst ~dst_off ~len = let src_len = Bytes.length src in let dst_len = length dst in if len < 0 then invalid_bounds_blit "blit_from_bytes" src_len src_off dst_len dst_off len; if src_off < 0 || src_len - src_off < len then invalid_bounds_blit "blit_from_bytes" src_len src_off dst_len dst_off len; if dst_off < 0 || dst_len - dst_off < len then invalid_bounds_blit "blit_from_bytes" src_len src_off dst_len dst_off len; unsafe_blit_from_bytes src ~src_off dst ~dst_off ~len ;; let blit_to_bytes src ~src_off dst ~dst_off ~len = let src_len = length src in let dst_len = Bytes.length dst in if len < 0 then invalid_bounds_blit "blit_to_bytes" src_len src_off dst_len dst_off len; if src_off < 0 || src_len - src_off < len then invalid_bounds_blit "blit_to_bytes" src_len src_off dst_len dst_off len; if dst_off < 0 || dst_len - dst_off < len then invalid_bounds_blit "blit_to_bytes" src_len src_off dst_len dst_off len; unsafe_blit_to_bytes src ~src_off dst ~dst_off ~len ;; let memcmp buf1 buf1_off buf2 buf2_off len = let buf1_len = length buf1 in let buf2_len = length buf2 in if len < 0 then invalid_bounds_memcmp "memcmp" buf1_len buf1_off buf2_len buf2_off len; if buf1_off < 0 || buf1_len - buf1_off < len then invalid_bounds_memcmp "memcmp" buf1_len buf1_off buf2_len buf2_off len; if buf2_off < 0 || buf2_len - buf2_off < len then invalid_bounds_memcmp "memcmp" buf1_len buf1_off buf2_len buf2_off len; unsafe_memcmp buf1 buf1_off buf2 buf2_off len ;; let memcmp_string buf1 buf1_off buf2 buf2_off len = let buf1_len = length buf1 in let buf2_len = String.length buf2 in if len < 0 then invalid_bounds_memcmp "memcmp_string" buf1_len buf1_off buf2_len buf2_off len; if buf1_off < 0 || buf1_len - buf1_off < len then invalid_bounds_memcmp "memcmp_string" buf1_len buf1_off buf2_len buf2_off len; if buf2_off < 0 || buf2_len - buf2_off < len then invalid_bounds_memcmp "memcmp_string" buf1_len buf1_off buf2_len buf2_off len; unsafe_memcmp_string buf1 buf1_off buf2 buf2_off len ;; let memchr buf buf_off chr len = let buf_len = length buf in if len < 0 then invalid_bounds "memchr" buf_len buf_off len; if buf_off < 0 || buf_len - buf_off < len then invalid_bounds "memchr" buf_len buf_off len; unsafe_memchr buf buf_off chr len (* Safe operations *) external caml_bigstring_set_16 : bigstring -> int -> int -> unit = "%caml_bigstring_set16" external caml_bigstring_set_32 : bigstring -> int -> int32 -> unit = "%caml_bigstring_set32" external caml_bigstring_set_64 : bigstring -> int -> int64 -> unit = "%caml_bigstring_set64" external caml_bigstring_get_16 : bigstring -> int -> int = "%caml_bigstring_get16" external caml_bigstring_get_32 : bigstring -> int -> int32 = "%caml_bigstring_get32" external caml_bigstring_get_64 : bigstring -> int -> int64 = "%caml_bigstring_get64" module Swap = struct external bswap16 : int -> int = "%bswap16" external bswap_int32 : int32 -> int32 = "%bswap_int32" external bswap_int64 : int64 -> int64 = "%bswap_int64" let caml_bigstring_set_16 bs off i = caml_bigstring_set_16 bs off (bswap16 i) let caml_bigstring_set_32 bs off i = caml_bigstring_set_32 bs off (bswap_int32 i) let caml_bigstring_set_64 bs off i = caml_bigstring_set_64 bs off (bswap_int64 i) let caml_bigstring_get_16 bs off = bswap16 (caml_bigstring_get_16 bs off) let caml_bigstring_get_32 bs off = bswap_int32 (caml_bigstring_get_32 bs off) let caml_bigstring_get_64 bs off = bswap_int64 (caml_bigstring_get_64 bs off) let get_int16_sign_extended x off = ((caml_bigstring_get_16 x off) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) end let set_int16_le, set_int16_be = if Sys.big_endian then Swap.caml_bigstring_set_16, caml_bigstring_set_16 else caml_bigstring_set_16 , Swap.caml_bigstring_set_16 let set_int32_le, set_int32_be = if Sys.big_endian then Swap.caml_bigstring_set_32, caml_bigstring_set_32 else caml_bigstring_set_32 , Swap.caml_bigstring_set_32 let set_int64_le, set_int64_be = if Sys.big_endian then Swap.caml_bigstring_set_64, caml_bigstring_set_64 else caml_bigstring_set_64 , Swap.caml_bigstring_set_64 let get_int16_le, get_int16_be = if Sys.big_endian then Swap.caml_bigstring_get_16, caml_bigstring_get_16 else caml_bigstring_get_16 , Swap.caml_bigstring_get_16 let get_int16_sign_extended_noswap x off = ((caml_bigstring_get_16 x off) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) let get_int16_sign_extended_le, get_int16_sign_extended_be = if Sys.big_endian then Swap.get_int16_sign_extended , get_int16_sign_extended_noswap else get_int16_sign_extended_noswap, Swap.get_int16_sign_extended let get_int32_le, get_int32_be = if Sys.big_endian then Swap.caml_bigstring_get_32, caml_bigstring_get_32 else caml_bigstring_get_32 , Swap.caml_bigstring_get_32 let get_int64_le, get_int64_be = if Sys.big_endian then Swap.caml_bigstring_get_64, caml_bigstring_get_64 else caml_bigstring_get_64 , Swap.caml_bigstring_get_64 (* Unsafe operations *) external caml_bigstring_unsafe_set_16 : bigstring -> int -> int -> unit = "%caml_bigstring_set16u" external caml_bigstring_unsafe_set_32 : bigstring -> int -> int32 -> unit = "%caml_bigstring_set32u" external caml_bigstring_unsafe_set_64 : bigstring -> int -> int64 -> unit = "%caml_bigstring_set64u" external caml_bigstring_unsafe_get_16 : bigstring -> int -> int = "%caml_bigstring_get16u" external caml_bigstring_unsafe_get_32 : bigstring -> int -> int32 = "%caml_bigstring_get32u" external caml_bigstring_unsafe_get_64 : bigstring -> int -> int64 = "%caml_bigstring_get64u" module USwap = struct external bswap16 : int -> int = "%bswap16" external bswap_int32 : int32 -> int32 = "%bswap_int32" external bswap_int64 : int64 -> int64 = "%bswap_int64" let caml_bigstring_unsafe_set_16 bs off i = caml_bigstring_unsafe_set_16 bs off (bswap16 i) let caml_bigstring_unsafe_set_32 bs off i = caml_bigstring_unsafe_set_32 bs off (bswap_int32 i) let caml_bigstring_unsafe_set_64 bs off i = caml_bigstring_unsafe_set_64 bs off (bswap_int64 i) let caml_bigstring_unsafe_get_16 bs off = bswap16 (caml_bigstring_unsafe_get_16 bs off) let caml_bigstring_unsafe_get_32 bs off = bswap_int32 (caml_bigstring_unsafe_get_32 bs off) let caml_bigstring_unsafe_get_64 bs off = bswap_int64 (caml_bigstring_unsafe_get_64 bs off) end let unsafe_set_int16_le, unsafe_set_int16_be = if Sys.big_endian then USwap.caml_bigstring_unsafe_set_16, caml_bigstring_unsafe_set_16 else caml_bigstring_unsafe_set_16 , USwap.caml_bigstring_unsafe_set_16 let unsafe_set_int32_le, unsafe_set_int32_be = if Sys.big_endian then USwap.caml_bigstring_unsafe_set_32, caml_bigstring_unsafe_set_32 else caml_bigstring_unsafe_set_32 , USwap.caml_bigstring_unsafe_set_32 let unsafe_set_int64_le, unsafe_set_int64_be = if Sys.big_endian then USwap.caml_bigstring_unsafe_set_64, caml_bigstring_unsafe_set_64 else caml_bigstring_unsafe_set_64 , USwap.caml_bigstring_unsafe_set_64 let unsafe_get_int16_le, unsafe_get_int16_be = if Sys.big_endian then USwap.caml_bigstring_unsafe_get_16, caml_bigstring_unsafe_get_16 else caml_bigstring_unsafe_get_16 , USwap.caml_bigstring_unsafe_get_16 let unsafe_get_int16_sign_extended_le x off = ((unsafe_get_int16_le x off) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) let unsafe_get_int16_sign_extended_be x off = ((unsafe_get_int16_be x off ) lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) let unsafe_get_int32_le, unsafe_get_int32_be = if Sys.big_endian then USwap.caml_bigstring_unsafe_get_32, caml_bigstring_unsafe_get_32 else caml_bigstring_unsafe_get_32 , USwap.caml_bigstring_unsafe_get_32 let unsafe_get_int64_le, unsafe_get_int64_be = if Sys.big_endian then USwap.caml_bigstring_unsafe_get_64, caml_bigstring_unsafe_get_64 else caml_bigstring_unsafe_get_64 , USwap.caml_bigstring_unsafe_get_64 bigstringaf-0.8.0/lib/bigstringaf.mli000066400000000000000000000255311407066741000176010ustar00rootroot00000000000000(** Bigstrings, but fast. The OCaml compiler has a bunch of intrinsics for Bigstrings, but they're not widely-known, sometimes misused, and so programs that use Bigstrings are slower than they have to be. And even if a library got that part right and exposed the intrinsics properly, the compiler doesn't have any fast blits between Bigstrings and other string-like types. So here they are. Go crazy. *) type t = (char, Bigarray_compat.int8_unsigned_elt, Bigarray_compat.c_layout) Bigarray_compat.Array1.t (** {2 Constructors} *) val create : int -> t (** [create n] returns a bigstring of length [n] *) val empty : t (** [empty] is the empty bigstring. It has length [0] and you can't really do much with it, but it's a good placeholder that only needs to be allocated once. *) val of_string : off:int -> len:int -> string -> t (** [of_string ~off ~len s] returns a bigstring of length [len] that contains the contents of string from the range [\[off, len)]. *) val copy : t -> off:int -> len:int -> t (** [copy t ~off ~len] allocates a new bigstring of length [len] and copies the bytes from [t] copied into it starting from [off]. *) val sub : t -> off:int -> len:int -> t (** [sub t ~off ~len] does not allocate a bigstring, but instead returns a new view into [t] starting at [off], and with length [len]. {b Note} that this does not allocate a new buffer, but instead shares the buffer of [t] with the newly-returned bigstring. *) (** {2 Memory-safe Operations} *) val length : t -> int (** [length t] is the length of the bigstring, in bytes. *) val substring : t -> off:int -> len:int -> string (** [substring t ~off ~len] returns a string of length [len] containing the bytes of [t] starting at [off]. *) val to_string : t -> string (** [to_string t] is equivalent to [substring t ~off:0 ~len:(length t)] *) external get : t -> int -> char = "%caml_ba_ref_1" (** [get t i] returns the character at offset [i] in [t]. *) external set : t -> int -> char -> unit = "%caml_ba_set_1" (** [set t i c] sets the character at offset [i] in [t] to be [c] *) (** {3 Little-endian Byte Order} The following operations assume a little-endian byte ordering of the bigstring. If the machine-native byte ordering differs, then the get operations will reorder the bytes so that they are in machine-native byte order before returning the result, and the set operations will reorder the bytes so that they are written out in the appropriate order. Most modern processor architectures are little-endian, so more likely than not, these operations will not do any byte reordering. *) val get_int16_le : t -> int -> int (** [get_int16_le t i] returns the two bytes in [t] starting at offset [i], interpreted as an unsigned integer. *) val get_int16_sign_extended_le : t -> int -> int (** [get_int16_sign_extended_le t i] returns the two bytes in [t] starting at offset [i], interpreted as a signed integer and performing sign extension to the native word size before returning the result. *) val set_int16_le : t -> int -> int -> unit (** [set_int16_le t i v] sets the two bytes in [t] starting at offset [i] to the value [v]. *) val get_int32_le : t -> int -> int32 (** [get_int32_le t i] returns the four bytes in [t] starting at offset [i]. *) val set_int32_le : t -> int -> int32 -> unit (** [set_int32_le t i v] sets the four bytes in [t] starting at offset [i] to the value [v]. *) val get_int64_le : t -> int -> int64 (** [get_int64_le t i] returns the eight bytes in [t] starting at offset [i]. *) val set_int64_le : t -> int -> int64 -> unit (** [set_int64_le t i v] sets the eight bytes in [t] starting at offset [i] to the value [v]. *) (** {3 Big-endian Byte Order} The following operations assume a big-endian byte ordering of the bigstring. If the machine-native byte ordering differs, then the get operations will reorder the bytes so that they are in machine-native byte order before returning the result, and the set operations will reorder the bytes so that they are written out in the appropriate order. Network byte order is big-endian, so you may need these operations when dealing with raw frames, for example, in a userland networking stack. *) val get_int16_be : t -> int -> int (** [get_int16_be t i] returns the two bytes in [t] starting at offset [i], interpreted as an unsigned integer. *) val get_int16_sign_extended_be : t -> int -> int (** [get_int16_sign_extended_be t i] returns the two bytes in [t] starting at offset [i], interpreted as a signed integer and performing sign extension to the native word size before returning the result. *) val set_int16_be : t -> int -> int -> unit (** [set_int16_be t i v] sets the two bytes in [t] starting at offset [off] to the value [v]. *) val get_int32_be : t -> int -> int32 (** [get_int32_be t i] returns the four bytes in [t] starting at offset [i]. *) val set_int32_be : t -> int -> int32 -> unit (** [set_int32_be t i v] sets the four bytes in [t] starting at offset [i] to the value [v]. *) val get_int64_be : t -> int -> int64 (** [get_int64_be t i] returns the eight bytes in [t] starting at offset [i]. *) val set_int64_be : t -> int -> int64 -> unit (** [set_int64_be t i v] sets the eight bytes in [t] starting at offset [i] to the value [v]. *) (** {3 Blits} All the following blit operations do the same thing. They copy a given number of bytes from a source starting at some offset to a destination starting at some other offset. Forgetting for a moment that OCaml is a memory-safe language, these are all equivalent to: {[ memcpy(dst + dst_off, src + src_off, len); ]} And in fact, that's how they're implemented. Except that bounds checking is performed before performing the blit. *) val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit val blit_from_string : string -> src_off:int -> t -> dst_off:int -> len:int -> unit val blit_from_bytes : Bytes.t -> src_off:int -> t -> dst_off:int -> len:int -> unit val blit_to_bytes : t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> unit (** {3 [memcmp]} Fast comparisons based on [memcmp]. Similar to the blits, these are implemented as C calls after performing bounds checks. {[ memcmp(buf1 + off1, buf2 + off2, len); ]} *) val memcmp : t -> int -> t -> int -> int -> int val memcmp_string : t -> int -> string -> int -> int -> int (** {3 [memchr]} Search for a byte using [memchr], returning [-1] if the byte is not found. Performing bounds checking before the C call. *) val memchr : t -> int -> char -> int -> int (** {2 Memory-unsafe Operations} The following operations are not memory safe. However, they do compile down to just a couple instructions. Make sure when using them to perform your own bounds checking. Or don't. Just make sure you know what you're doing. You can do it, but only do it if you have to. *) external unsafe_get : t -> int -> char = "%caml_ba_unsafe_ref_1" (** [unsafe_get t i] is like {!get} except no bounds checking is performed. *) external unsafe_set : t -> int -> char -> unit = "%caml_ba_unsafe_set_1" (** [unsafe_set t i c] is like {!set} except no bounds checking is performed. *) val unsafe_get_int16_le : t -> int -> int (** [unsafe_get_int16_le t i] is like {!get_int16_le} except no bounds checking is performed. *) val unsafe_get_int16_be : t -> int -> int (** [unsafe_get_int16_be t i] is like {!get_int16_be} except no bounds checking is performed. *) val unsafe_get_int16_sign_extended_le : t -> int -> int (** [unsafe_get_int16_sign_extended_le t i] is like {!get_int16_sign_extended_le} except no bounds checking is performed. *) val unsafe_get_int16_sign_extended_be : t -> int -> int (** [unsafe_get_int16_sign_extended_be t i] is like {!get_int16_sign_extended_be} except no bounds checking is performed. *) val unsafe_set_int16_le : t -> int -> int -> unit (** [unsafe_set_int16_le t i v] is like {!set_int16_le} except no bounds checking is performed. *) val unsafe_set_int16_be : t -> int -> int -> unit (** [unsafe_set_int16_be t i v] is like {!set_int16_be} except no bounds checking is performed. *) val unsafe_get_int32_le : t -> int -> int32 (** [unsafe_get_int32_le t i] is like {!get_int32_le} except no bounds checking is performed. *) val unsafe_get_int32_be : t -> int -> int32 (** [unsafe_get_int32_be t i] is like {!get_int32_be} except no bounds checking is performed. *) val unsafe_set_int32_le : t -> int -> int32 -> unit (** [unsafe_set_int32_le t i v] is like {!set_int32_le} except no bounds checking is performed. *) val unsafe_set_int32_be : t -> int -> int32 -> unit (** [unsafe_set_int32_be t i v] is like {!set_int32_be} except no bounds checking is performed. *) val unsafe_get_int64_le : t -> int -> int64 (** [unsafe_get_int64_le t i] is like {!get_int64_le} except no bounds checking is performed. *) val unsafe_get_int64_be : t -> int -> int64 (** [unsafe_get_int64_be t i] is like {!get_int64_be} except no bounds checking is performed. *) val unsafe_set_int64_le : t -> int -> int64 -> unit (** [unsafe_set_int64_le t i v] is like {!set_int64_le} except no bounds checking is performed. *) val unsafe_set_int64_be : t -> int -> int64 -> unit (** [unsafe_set_int64_be t i v] is like {!set_int64_be} except no bounds checking is performed. *) (** {3 Blits} All the following blit operations do the same thing. They copy a given number of bytes from a source starting at some offset to a destination starting at some other offset. Forgetting for a moment that OCaml is a memory-safe language, these are all equivalent to: {[ memcpy(dst + dst_off, src + src_off, len); ]} And in fact, that's how they're implemented. Except in the case of [unsafe_blit] which uses a [memmove] so that overlapping blits behave as expected. But in both cases, there's no bounds checking. *) val unsafe_blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit val unsafe_blit_from_string : string -> src_off:int -> t -> dst_off:int -> len:int -> unit val unsafe_blit_from_bytes : Bytes.t -> src_off:int -> t -> dst_off:int -> len:int -> unit val unsafe_blit_to_bytes : t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> unit (** {3 [memcmp]} Fast comparisons based on [memcmp]. Similar to the blits, these are not memory safe and are implemented by the same C call: {[ memcmp(buf1 + off1, buf2 + off2, len); ]} *) val unsafe_memcmp : t -> int -> t -> int -> int -> int val unsafe_memcmp_string : t -> int -> string -> int -> int -> int (** {3 [memchr]} Search for a byte using [memchr], returning [-1] if the byte is not found. It does not check bounds before the C call. *) val unsafe_memchr : t -> int -> char -> int -> int bigstringaf-0.8.0/lib/bigstringaf_stubs.c000066400000000000000000000076351407066741000204670ustar00rootroot00000000000000/*---------------------------------------------------------------------------- Copyright (c) 2017 Inhabited Type LLC. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------*/ #include #include #include void bigstringaf_blit_to_bytes(value vsrc, value vsrc_off, value vdst, value vdst_off, value vlen) { void *src = ((char *)Caml_ba_data_val(vsrc)) + Unsigned_long_val(vsrc_off), *dst = ((char *)String_val(vdst)) + Unsigned_long_val(vdst_off); size_t len = Unsigned_long_val(vlen); memcpy(dst, src, len); } void bigstringaf_blit_to_bigstring(value vsrc, value vsrc_off, value vdst, value vdst_off, value vlen) { void *src = ((char *)Caml_ba_data_val(vsrc)) + Unsigned_long_val(vsrc_off), *dst = ((char *)Caml_ba_data_val(vdst)) + Unsigned_long_val(vdst_off); size_t len = Unsigned_long_val(vlen); memmove(dst, src, len); } void bigstringaf_blit_from_bytes(value vsrc, value vsrc_off, value vdst, value vdst_off, value vlen) { void *src = ((char *)String_val(vsrc)) + Unsigned_long_val(vsrc_off), *dst = ((char *)Caml_ba_data_val(vdst)) + Unsigned_long_val(vdst_off); size_t len = Unsigned_long_val(vlen); memcpy(dst, src, len); } CAMLprim value bigstringaf_memcmp_bigstring(value vba1, value vba1_off, value vba2, value vba2_off, value vlen) { void *ba1 = ((char *)Caml_ba_data_val(vba1)) + Unsigned_long_val(vba1_off), *ba2 = ((char *)Caml_ba_data_val(vba2)) + Unsigned_long_val(vba2_off); size_t len = Unsigned_long_val(vlen); int result = memcmp(ba1, ba2, len); return Val_int(result); } CAMLprim value bigstringaf_memcmp_string(value vba, value vba_off, value vstr, value vstr_off, value vlen) { void *buf1 = ((char *)Caml_ba_data_val(vba)) + Unsigned_long_val(vba_off), *buf2 = ((char *)String_val(vstr)) + Unsigned_long_val(vstr_off); size_t len = Unsigned_long_val(vlen); int result = memcmp(buf1, buf2, len); return Val_int(result); } CAMLprim value bigstringaf_memchr(value vba, value vba_off, value vchr, value vlen) { size_t off = Unsigned_long_val(vba_off); char *buf = ((char *)Caml_ba_data_val(vba)) + off; size_t len = Unsigned_long_val(vlen); int c = Int_val(vchr); char* res = memchr(buf, c, len); if (res == NULL) { return Val_long(-1); } else { return Val_long(off + res - buf); } } bigstringaf-0.8.0/lib/dune000066400000000000000000000004521407066741000154500ustar00rootroot00000000000000(library (name bigstringaf) (public_name bigstringaf) (libraries bigarray-compat) (flags (:standard -safe-string)) (foreign_stubs (language c) (names bigstringaf_stubs) (flags (:standard -Wall -Wextra -Wpedantic))) (js_of_ocaml (javascript_files runtime.js)) ) bigstringaf-0.8.0/lib/freestanding/000077500000000000000000000000001407066741000172425ustar00rootroot00000000000000bigstringaf-0.8.0/lib/freestanding/Makefile000066400000000000000000000011361407066741000207030ustar00rootroot00000000000000PKG_CONFIG_PATH := $(shell opam config var prefix)/lib/pkgconfig EXISTS := $(shell PKG_CONFIG_PATH=$(PKG_CONFIG_PATH) pkg-config --exists ocaml-freestanding; echo $$?) .PHONY: all clean all: libbigstringaf_freestanding_stubs.a ifeq ($(EXISTS), 1) libbigstringaf_freestanding_stubs.a: touch $@ else CC ?= cc FREESTANDING_CFLAGS := $(shell PKG_CONFIG_PATH=$(PKG_CONFIG_PATH) pkg-config --cflags ocaml-freestanding) CFLAGS := -O3 $(FREESTANDING_CFLAGS) OBJS=bigstringaf_stubs.o libbigstringaf_freestanding_stubs.a: $(OBJS) $(AR) r $@ $^ endif clean: $(RM) $(OBJS) libbigstringaf_freestanding_stubs.a bigstringaf-0.8.0/lib/freestanding/dune000066400000000000000000000003741407066741000201240ustar00rootroot00000000000000(copy_files# ../bigstringaf_stubs.c) (rule (deps Makefile bigstringaf_stubs.c) (targets libbigstringaf_freestanding_stubs.a) (action (no-infer (progn (run %{make}))))) (install (section lib) (files libbigstringaf_freestanding_stubs.a)) bigstringaf-0.8.0/lib/runtime.js000066400000000000000000000064241407066741000166200ustar00rootroot00000000000000/*---------------------------------------------------------------------------- Copyright (c) 2017 Inhabited Type LLC. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------*/ //Provides: bigstringaf_blit_to_bytes //Requires: caml_bigstring_blit_ba_to_bytes function bigstringaf_blit_to_bytes(src, src_off, dst, dst_off, len) { return caml_bigstring_blit_ba_to_bytes(src,src_off,dst,dst_off,len); } //Provides: bigstringaf_blit_to_bigstring //Requires: caml_bigstring_blit_ba_to_ba function bigstringaf_blit_to_bigstring(src, src_off, dst, dst_off, len) { return caml_bigstring_blit_ba_to_ba(src, src_off, dst, dst_off, len); } //Provides: bigstringaf_blit_from_bytes //Requires: caml_bigstring_blit_string_to_ba function bigstringaf_blit_from_bytes(src, src_off, dst, dst_off, len) { return caml_bigstring_blit_string_to_ba(src, src_off, dst, dst_off, len); } //Provides: bigstringaf_memcmp_bigstring //Requires: caml_ba_get_1, caml_int_compare function bigstringaf_memcmp_bigstring(ba1, ba1_off, ba2, ba2_off, len) { for (var i = 0; i < len; i++) { var c = caml_int_compare(caml_ba_get_1(ba1, ba1_off + i), caml_ba_get_1(ba2, ba2_off + i)); if (c != 0) return c } return 0; } //Provides: bigstringaf_memcmp_string //Requires: caml_ba_get_1, caml_int_compare, caml_string_unsafe_get function bigstringaf_memcmp_string(ba, ba_off, str, str_off, len) { for (var i = 0; i < len; i++) { var c = caml_int_compare(caml_ba_get_1(ba, ba_off + i), caml_string_unsafe_get(str, str_off + i)); if (c != 0) return c } return 0; } //Provides: bigstringaf_memchr //Requires: caml_ba_get_1 function bigstringaf_memchr(ba, ba_off, chr, len) { for (var i = 0; i < len; i++) { if (caml_ba_get_1(ba, ba_off + i) == chr) { return (ba_off + i); } } return -1; } bigstringaf-0.8.0/lib_test/000077500000000000000000000000001407066741000156305ustar00rootroot00000000000000bigstringaf-0.8.0/lib_test/dune000066400000000000000000000001421407066741000165030ustar00rootroot00000000000000(test (name test_bigstringaf) (libraries alcotest bigstringaf) (modules test_bigstringaf s)) bigstringaf-0.8.0/lib_test/s.ml000066400000000000000000000031231407066741000164230ustar00rootroot00000000000000module type Getters = sig val get : Bigstringaf.t -> int -> char val get_int16_le : Bigstringaf.t -> int -> int val get_int16_sign_extended_le : Bigstringaf.t -> int -> int val get_int32_le : Bigstringaf.t -> int -> int32 val get_int64_le : Bigstringaf.t -> int -> int64 val get_int16_be : Bigstringaf.t -> int -> int val get_int16_sign_extended_be : Bigstringaf.t -> int -> int val get_int32_be : Bigstringaf.t -> int -> int32 val get_int64_be : Bigstringaf.t -> int -> int64 end module type Setters = sig val set : Bigstringaf.t -> int -> char -> unit val set_int16_le : Bigstringaf.t -> int -> int -> unit val set_int32_le : Bigstringaf.t -> int -> int32 -> unit val set_int64_le : Bigstringaf.t -> int -> int64 -> unit val set_int16_be : Bigstringaf.t -> int -> int -> unit val set_int32_be : Bigstringaf.t -> int -> int32 -> unit val set_int64_be : Bigstringaf.t -> int -> int64 -> unit end module type Blit = sig val blit : Bigstringaf.t -> src_off:int -> Bigstringaf.t -> dst_off:int -> len:int -> unit val blit_from_string : String.t -> src_off:int -> Bigstringaf.t -> dst_off:int -> len:int -> unit val blit_from_bytes : Bytes.t -> src_off:int -> Bigstringaf.t -> dst_off:int -> len:int -> unit val blit_to_bytes : Bigstringaf.t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> unit end module type Memcmp = sig val memcmp : Bigstringaf.t -> int -> Bigstringaf.t -> int -> int -> int val memcmp_string : Bigstringaf.t -> int -> String.t -> int -> int -> int end module type Memchr = sig val memchr : Bigstringaf.t -> int -> char -> int -> int end bigstringaf-0.8.0/lib_test/test_bigstringaf.ml000066400000000000000000000375611407066741000215340ustar00rootroot00000000000000let of_string () = let open Bigstringaf in let exn = Invalid_argument "Bigstringaf.of_string invalid range: { buffer_len: 3, off: 4611686018427387903, len: 2 }" in Alcotest.check_raises "safe overflow" exn (fun () -> ignore (of_string ~off:max_int ~len:2 "abc")) ;; let constructors = [ "of_string", `Quick, of_string ] let index_out_of_bounds () = let open Bigstringaf in let exn = Invalid_argument "index out of bounds" in let string = "\xde\xad\xbe\xef" in let buffer = of_string ~off:0 ~len:(String.length string) string in Alcotest.check_raises "get empty 0" exn (fun () -> ignore (get empty 0)); let check_safe_getter name get = Alcotest.check_raises name exn (fun () -> ignore (get buffer (-1))); Alcotest.check_raises name exn (fun () -> ignore (get buffer (length buffer))); in check_safe_getter "get" get; check_safe_getter "get_int16_le" get_int16_le; check_safe_getter "get_int16_be" get_int16_be; check_safe_getter "get_int16_sign_extended_le" get_int16_sign_extended_le; check_safe_getter "get_int16_sign_extended_be" get_int16_sign_extended_be; check_safe_getter "get_int32_le" get_int32_le; check_safe_getter "get_int32_be" get_int32_be; check_safe_getter "get_int64_le" get_int64_le; check_safe_getter "get_int64_be" get_int64_be; ;; let getters m () = let module Getters = (val m : S.Getters) in let open Getters in let string = "\xde\xad\xbe\xef\x8b\xad\xf0\x0d" in let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in Alcotest.(check char "get" '\xde' (get buffer 0)); Alcotest.(check char "get" '\xbe' (get buffer 2)); Alcotest.(check int "get_int16_be" 0xdead (get_int16_be buffer 0)); Alcotest.(check int "get_int16_be" 0xbeef (get_int16_be buffer 2)); Alcotest.(check int "get_int16_le" 0xadde (get_int16_le buffer 0)); Alcotest.(check int "get_int16_le" 0xefbe (get_int16_le buffer 2)); Alcotest.(check int "get_int16_sign_extended_be" 0x7fffffffffffdead (get_int16_sign_extended_be buffer 0)); Alcotest.(check int "get_int16_sign_extended_le" 0x7fffffffffffadde (get_int16_sign_extended_le buffer 0)); Alcotest.(check int "get_int16_sign_extended_le" 0x0df0 (get_int16_sign_extended_le buffer 6)); Alcotest.(check int32 "get_int32_be" 0xdeadbeefl (get_int32_be buffer 0)); Alcotest.(check int32 "get_int32_be" 0xbeef8badl (get_int32_be buffer 2)); Alcotest.(check int32 "get_int32_le" 0xefbeaddel (get_int32_le buffer 0)); Alcotest.(check int32 "get_int32_le" 0xad8befbel (get_int32_le buffer 2)); Alcotest.(check int64 "get_int64_be" 0xdeadbeef8badf00dL (get_int64_be buffer 0)); Alcotest.(check int64 "get_int64_le" 0x0df0ad8befbeaddeL (get_int64_le buffer 0)); ;; let setters m () = let module Setters = (val m : S.Setters) in let open Setters in let string = Bytes.make 16 '_' |> Bytes.unsafe_to_string in let with_buffer ~f = let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in f buffer in let substring ~len buffer = Bigstringaf.substring ~off:0 ~len buffer in with_buffer ~f:(fun buffer -> set buffer 0 '\xde'; Alcotest.(check string "set" "\xde___" (substring ~len:4 buffer))); with_buffer ~f:(fun buffer -> set buffer 2 '\xbe'; Alcotest.(check string "set" "__\xbe_" (substring ~len:4 buffer))); with_buffer ~f:(fun buffer -> set_int16_be buffer 0 0xdead; Alcotest.(check string "set_int16_be" "\xde\xad__" (substring ~len:4 buffer))); with_buffer ~f:(fun buffer -> set_int16_be buffer 2 0xbeef; Alcotest.(check string "set_int16_be" "__\xbe\xef" (substring ~len:4 buffer))); with_buffer ~f:(fun buffer -> set_int16_le buffer 0 0xdead; Alcotest.(check string "set_int16_le" "\xad\xde__" (substring ~len:4 buffer))); with_buffer ~f:(fun buffer -> set_int16_le buffer 2 0xbeef; Alcotest.(check string "set_int16_le" "__\xef\xbe" (substring ~len:4 buffer))); with_buffer ~f:(fun buffer -> set_int32_be buffer 0 0xdeadbeefl; Alcotest.(check string "set_int32_be" "\xde\xad\xbe\xef____" (substring ~len:8 buffer))); with_buffer ~f:(fun buffer -> set_int32_le buffer 0 0xdeadbeefl; Alcotest.(check string "set_int32_le" "\xef\xbe\xad\xde____" (substring ~len:8 buffer))); with_buffer ~f:(fun buffer -> set_int32_be buffer 2 0xbeef8badl; Alcotest.(check string "set_int32_be" "__\xbe\xef\x8b\xad__" (substring ~len:8 buffer))); with_buffer ~f:(fun buffer -> set_int32_le buffer 2 0xbeef8badl; Alcotest.(check string "set_int32_le" "__\xad\x8b\xef\xbe__" (substring ~len:8 buffer))); with_buffer ~f:(fun buffer -> set_int64_be buffer 0 0xdeadbeef8badf00dL; Alcotest.(check string "set_int64_be" "\xde\xad\xbe\xef\x8b\xad\xf0\x0d" (substring ~len:8 buffer))); with_buffer ~f:(fun buffer -> set_int64_le buffer 0 0xdeadbeef8badf00dL; Alcotest.(check string "set_int64_le" "\x0d\xf0\xad\x8b\xef\xbe\xad\xde" (substring ~len:8 buffer))); ;; let string1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" let string2 = "abcdefghijklmnopqrstuvwxyz" let blit m () = let module Blit = (val m : S.Blit) in let open Blit in let with_buffers ~f = let buffer1 = Bigstringaf.of_string string1 ~off:0 ~len:(String.length string1) in let buffer2 = Bigstringaf.of_string string2 ~off:0 ~len:(String.length string2) in f buffer1 buffer2 in with_buffers ~f:(fun buf1 buf2 -> blit buf1 ~src_off:0 buf2 ~dst_off:0 ~len:0; let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in Alcotest.(check string "empty blit" string2 new_string2)); with_buffers ~f:(fun buf1 buf2 -> blit buf1 ~src_off:0 buf2 ~dst_off:0 ~len:(Bigstringaf.length buf2); let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in Alcotest.(check string "full blit to another buffer" string1 new_string2)); with_buffers ~f:(fun buf1 _buf2 -> blit buf1 ~src_off:0 buf1 ~dst_off:0 ~len:(Bigstringaf.length buf1); let new_string1 = Bigstringaf.substring buf1 ~off:0 ~len:(Bigstringaf.length buf1) in Alcotest.(check string "entirely overlapping blit (unchanged)" string1 new_string1)); with_buffers ~f:(fun buf1 buf2 -> blit buf1 ~src_off:0 buf2 ~dst_off:4 ~len:8; let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in Alcotest.(check string "partial blit to another buffer" "abcdABCDEFGHmnopqrstuvwxyz" new_string2)); with_buffers ~f:(fun buf1 _buf2 -> blit buf1 ~src_off:0 buf1 ~dst_off:4 ~len:8; let new_string1 = Bigstringaf.substring buf1 ~off:0 ~len:(Bigstringaf.length buf1) in Alcotest.(check string "partially overlapping" "ABCDABCDEFGHMNOPQRSTUVWXYZ" new_string1)); ;; let blit_to_bytes m () = let module Blit = (val m : S.Blit) in let open Blit in let with_buffers ~f = let buffer1 = string1 in let buffer2 = Bigstringaf.of_string string2 ~off:0 ~len:(String.length string2) in f buffer1 buffer2 in with_buffers ~f:(fun buf1 buf2 -> blit_from_string buf1 ~src_off:0 buf2 ~dst_off:0 ~len:0; let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in Alcotest.(check string "empty blit" string2 new_string2)); with_buffers ~f:(fun buf1 buf2 -> blit_from_string buf1 ~src_off:0 buf2 ~dst_off:0 ~len:(Bigstringaf.length buf2); let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in Alcotest.(check string "full blit to another buffer" string1 new_string2)); with_buffers ~f:(fun buf1 buf2 -> blit_from_string buf1 ~src_off:0 buf2 ~dst_off:4 ~len:8; let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in Alcotest.(check string "partial blit to another buffer" "abcdABCDEFGHmnopqrstuvwxyz" new_string2)); ;; let blit_from_bytes m () = let module Blit = (val m : S.Blit) in let open Blit in let with_buffers ~f = let buffer1 = Bytes.of_string string1 in let buffer2 = Bigstringaf.of_string string2 ~off:0 ~len:(String.length string2) in f buffer1 buffer2 in with_buffers ~f:(fun buf1 buf2 -> blit_from_bytes buf1 ~src_off:0 buf2 ~dst_off:0 ~len:0; let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in Alcotest.(check string "empty blit" string2 new_string2)); with_buffers ~f:(fun buf1 buf2 -> blit_from_bytes buf1 ~src_off:0 buf2 ~dst_off:0 ~len:(Bigstringaf.length buf2); let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in Alcotest.(check string "full blit to another buffer" string1 new_string2)); with_buffers ~f:(fun buf1 buf2 -> blit_from_bytes buf1 ~src_off:0 buf2 ~dst_off:4 ~len:8; let new_string2 = Bigstringaf.substring buf2 ~off:0 ~len:(Bigstringaf.length buf2) in Alcotest.(check string "partial blit to another buffer" "abcdABCDEFGHmnopqrstuvwxyz" new_string2)); ;; let memcmp m () = let module Memcmp = (val m : S.Memcmp) in let open Memcmp in let buffer1 = Bigstringaf.of_string ~off:0 ~len:(String.length string1) string1 in let buffer2 = Bigstringaf.of_string ~off:0 ~len:(String.length string2) string2 in Alcotest.(check bool "identical buffers are equal" true (memcmp buffer1 0 buffer1 0 (Bigstringaf.length buffer1) = 0)); Alcotest.(check bool "prefix of identical buffers are equal" true (memcmp buffer1 0 buffer1 0 (Bigstringaf.length buffer1 - 10 ) = 0)); Alcotest.(check bool "suffix of identical buffers are equal" true (memcmp buffer1 10 buffer1 10 (Bigstringaf.length buffer1 - 10) = 0)); Alcotest.(check bool "uppercase is less than uppercase" true (memcmp buffer1 0 buffer2 0 (Bigstringaf.length buffer1) < 0)); Alcotest.(check bool "lowercase is greater than uppercase" true (memcmp buffer2 0 buffer1 0 (Bigstringaf.length buffer1) > 0)); ;; let memcmp_string m () = let module Memcmp = (val m : S.Memcmp) in let open Memcmp in let buffer1 = Bigstringaf.of_string ~off:0 ~len:(String.length string1) string1 in let buffer2 = Bigstringaf.of_string ~off:0 ~len:(String.length string2) string2 in Alcotest.(check bool "of_string'd and original buffer are equal" true (memcmp_string buffer1 0 string1 0 (Bigstringaf.length buffer1) = 0)); Alcotest.(check bool "prefix of of_string'd and original buffer are equal" true (memcmp_string buffer1 10 string1 10 (Bigstringaf.length buffer1 - 10) = 0)); Alcotest.(check bool "suffix of identical buffers are equal" true (memcmp_string buffer1 10 string1 10 (Bigstringaf.length buffer1 - 10) = 0)); Alcotest.(check bool "uppercase is less than uppercase" true (memcmp_string buffer1 0 string2 0 (Bigstringaf.length buffer1) < 0)); Alcotest.(check bool "lowercase is greater than uppercase" true (memcmp_string buffer2 0 string1 0 (Bigstringaf.length buffer1) > 0)); () ;; let memchr m () = let module Memchr = (val m : S.Memchr) in let open Memchr in let string = "hello world foo bar baz" in let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in let buffer_len = Bigstringaf.length buffer in Alcotest.(check int) "memchr starting at offset 0" (String.index_from string 0 ' ') (memchr buffer 0 ' ' buffer_len); Alcotest.(check int) "memchr with an offset" (String.index_from string 7 ' ') (memchr buffer 7 ' ' (buffer_len - 7)); Alcotest.(check int) "memchr char not found" (-1) (memchr buffer 0 'Z' buffer_len) let negative_bounds_check () = let open Bigstringaf in let buf = Bigstringaf.empty in let exn_str fn = Invalid_argument (Printf.sprintf "Bigstringaf.%s invalid range: { buffer_len: 0, off: 0, len: -8 }" fn) in let exn_ba fn = Invalid_argument (Printf.sprintf "Bigstringaf.%s invalid range: { src_len: 0, src_off: 0, dst_len: 0, dst_off: 4, len: -8 }" fn) in let exn_cmp fn = Invalid_argument (Printf.sprintf "Bigstringaf.%s invalid range: { buf1_len: 0, buf1_off: 0, buf2_len: 0, buf2_off: 0, len: -8 }" fn) in Alcotest.check_raises "copy" (exn_str "copy") (fun () -> ignore (copy buf ~off:0 ~len:(-8))); Alcotest.check_raises "substring" (exn_str "substring") (fun () -> ignore (substring buf ~off:0 ~len:(-8))); Alcotest.check_raises "of_string" (exn_str "of_string") (fun () -> ignore (of_string "" ~off:0 ~len:(-8))); Alcotest.check_raises "blit" (exn_ba "blit") (fun () -> ignore (blit buf ~src_off:0 buf ~dst_off:4 ~len:(-8))); Alcotest.check_raises "blit_from_string" (exn_ba "blit_from_string") (fun () -> ignore (blit_from_string "" ~src_off:0 buf ~dst_off:4 ~len:(-8))); Alcotest.check_raises "blit_from_bytes" (exn_ba "blit_from_bytes") (fun () -> ignore (blit_from_bytes (Bytes.of_string "") ~src_off:0 buf ~dst_off:4 ~len:(-8))); Alcotest.check_raises "blit_to_bytes" (exn_ba "blit_to_bytes") (fun () -> ignore (blit_to_bytes buf ~src_off:0 (Bytes.of_string "") ~dst_off:4 ~len:(-8))); Alcotest.check_raises "memcmp" (exn_cmp "memcmp") (fun () -> ignore (memcmp buf 0 buf 0 (-8))); Alcotest.check_raises "memcmp_string" (exn_cmp "memcmp_string") (fun () -> ignore (memcmp_string buf 0 "" 0 (-8))); ;; let safe_operations = let module Getters : S.Getters = Bigstringaf in let module Setters : S.Setters = Bigstringaf in let module Blit : S.Blit = Bigstringaf in let module Memcmp : S.Memcmp = Bigstringaf in let module Memchr : S.Memchr = Bigstringaf in [ "index out of bounds", `Quick, index_out_of_bounds ; "getters" , `Quick, getters (module Getters) ; "setters" , `Quick, setters (module Setters) ; "blit" , `Quick, blit (module Blit) ; "blit_to_bytes" , `Quick, blit_to_bytes (module Blit) ; "blit_from_bytes" , `Quick, blit_from_bytes (module Blit) ; "memcmp" , `Quick, memcmp (module Memcmp) ; "memcmp_string" , `Quick, memcmp_string (module Memcmp) ; "negative length" , `Quick, negative_bounds_check ; "memchr" , `Quick, memchr (module Memchr) ] let unsafe_operations = let module Getters : S.Getters = struct open Bigstringaf let get = unsafe_get let get_int16_le = unsafe_get_int16_le let get_int16_sign_extended_le = unsafe_get_int16_sign_extended_le let get_int32_le = unsafe_get_int32_le let get_int64_le = unsafe_get_int64_le let get_int16_be = unsafe_get_int16_be let get_int16_sign_extended_be = unsafe_get_int16_sign_extended_be let get_int32_be = unsafe_get_int32_be let get_int64_be = unsafe_get_int64_be end in let module Setters : S.Setters = struct open Bigstringaf let set = unsafe_set let set_int16_le = unsafe_set_int16_le let set_int32_le = unsafe_set_int32_le let set_int64_le = unsafe_set_int64_le let set_int16_be = unsafe_set_int16_be let set_int32_be = unsafe_set_int32_be let set_int64_be = unsafe_set_int64_be end in let module Blit : S.Blit = struct open Bigstringaf let blit = unsafe_blit let blit_from_string = unsafe_blit_from_string let blit_from_bytes = unsafe_blit_from_bytes let blit_to_bytes = unsafe_blit_to_bytes end in let module Memcmp : S.Memcmp = struct open Bigstringaf let memcmp = unsafe_memcmp let memcmp_string = unsafe_memcmp_string end in let module Memchr : S.Memchr = struct open Bigstringaf let memchr = unsafe_memchr end in [ "getters" , `Quick, getters (module Getters) ; "setters" , `Quick, setters (module Setters) ; "blit" , `Quick, blit (module Blit) ; "blit_to_bytes" , `Quick, blit_to_bytes (module Blit) ; "blit_from_bytes", `Quick, blit_from_bytes (module Blit) ; "memcmp" , `Quick, memcmp (module Memcmp) ; "memcmp_string" , `Quick, memcmp_string (module Memcmp) ; "memchr" , `Quick, memchr (module Memchr) ] let () = Alcotest.run "test suite" [ "constructors" , constructors ; "safe operations" , safe_operations ; "unsafe operations", unsafe_operations ]