unikernel/duniverse/bigstringaf/.github/workflows/test.yml

@@ -0,0 +1,40 @@
+name: build
+
+on:
+  - push
+  - pull_request
+
+jobs:
+  tests:
+    name: Tests
+    strategy:
+      fail-fast: false
+      matrix:
+        os:
+          - ubuntu-latest
+        ocaml-version:
+          - 4.08.1
+          - 4.09.1
+          - 4.11.2
+          - 4.13.1
+          - 4.14.0
+
+    runs-on: ${{ matrix.os }}
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v2
+
+      - name: Use OCaml ${{ matrix.ocaml-version }}
+        uses: ocaml/setup-ocaml@v2
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-version }}
+
+      - name: Deps
+        run: opam install -t --deps-only .
+
+      - name: Build
+        run: opam exec -- dune build
+
+      - name: Test
+        run: opam exec -- dune runtest

unikernel/duniverse/bigstringaf/.gitignore

@@ -0,0 +1,5 @@
+.*.sw[a-z]
+*~
+_build/
+_opam/
+*.install

unikernel/duniverse/bigstringaf/CHANGES.md

@@ -0,0 +1,21 @@
+### 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 release

unikernel/duniverse/bigstringaf/LICENSE

@@ -0,0 +1,30 @@
+Copyright (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.

unikernel/duniverse/bigstringaf/Makefile

@@ -0,0 +1,18 @@
+.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

unikernel/duniverse/bigstringaf/README.md

@@ -0,0 +1,46 @@
+# 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.

unikernel/duniverse/bigstringaf/bigstringaf.opam

@@ -0,0 +1,45 @@
+version: "0.10.0"
+opam-version: "2.0"
+maintainer: "Spiros Eliopoulos <spiros@inhabitedtype.com>"
+authors: [ "Spiros Eliopoulos <spiros@inhabitedtype.com>" ]
+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"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+depends: [
+  "dune" {>= "3.0"}
+  "dune-configurator" {>= "3.0"}
+  "alcotest" {with-test}
+  "ocaml" {>= "4.08.0"}
+]
+conflicts: [
+  "mirage-xen" {< "6.0.0"}
+  "ocaml-freestanding"
+  "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.
+"""

unikernel/duniverse/bigstringaf/dune-project

@@ -0,0 +1,3 @@
+(lang dune 3.0)
+(name bigstringaf)
+(formatting (enabled_for dune))

unikernel/duniverse/bigstringaf/lib/bigstringaf.ml

@@ -0,0 +1,346 @@
+type bigstring =
+  (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+type t = bigstring
+
+let create size = Bigarray.(Array1.create char c_layout size)
+let empty       = create 0
+
+module BA1 = Bigarray.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

unikernel/duniverse/bigstringaf/lib/bigstringaf.mli

@@ -0,0 +1,282 @@
+(** 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.int8_unsigned_elt, Bigarray.c_layout) Bigarray.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

unikernel/duniverse/bigstringaf/lib/bigstringaf_stubs.c

@@ -0,0 +1,107 @@
+/*----------------------------------------------------------------------------
+    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 <string.h>
+#include <caml/mlvalues.h>
+#include <caml/bigarray.h>
+
+CAMLprim value
+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);
+    return Val_unit;
+}
+
+CAMLprim value
+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);
+    return Val_unit;
+}
+
+CAMLprim value
+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);
+    return Val_unit;
+}
+
+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);
+    }
+}

unikernel/duniverse/bigstringaf/lib/config/discover.ml

@@ -0,0 +1,11 @@
+open Configurator.V1
+
+let get_warning_flags t =
+  match ocaml_config_var t "ccomp_type" with
+  | Some "msvc" -> ["/Wall"; "/W3"]
+  | _ -> ["-Wall"; "-Wextra"; "-Wpedantic"]
+
+let () =
+  main ~name:"discover" (fun t ->
+    let wflags = get_warning_flags t in
+    Flags.write_sexp "cflags.sexp" wflags)

unikernel/duniverse/bigstringaf/lib/config/dune

@@ -0,0 +1,3 @@
+(executable
+ (name discover)
+ (libraries dune-configurator))

unikernel/duniverse/bigstringaf/lib/dune

@@ -0,0 +1,16 @@
+(library
+ (name bigstringaf)
+ (public_name bigstringaf)
+ (foreign_stubs
+  (language c)
+  (names bigstringaf_stubs)
+  (flags
+   (:standard
+    (:include cflags.sexp))))
+ (js_of_ocaml
+  (javascript_files runtime.js)))
+
+(rule
+ (targets cflags.sexp)
+ (action
+  (run config/discover.exe)))

unikernel/duniverse/bigstringaf/lib/runtime.js

@@ -0,0 +1,81 @@
+/*----------------------------------------------------------------------------
+    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;
+}

unikernel/duniverse/bigstringaf/lib_test/dune

@@ -0,0 +1,4 @@
+(test
+ (name test_bigstringaf)
+ (libraries alcotest bigstringaf)
+ (modules test_bigstringaf s))

unikernel/duniverse/bigstringaf/lib_test/s.ml

@@ -0,0 +1,42 @@
+module 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

unikernel/duniverse/bigstringaf/lib_test/test_bigstringaf.ml

@@ -0,0 +1,385 @@
+let of_string () =
+  let open Bigstringaf in
+  let exn = Invalid_argument (Printf.sprintf "Bigstringaf.of_string invalid range: { buffer_len: 3, off: %d, len: 2 }" max_int) 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" (Int64.to_int 0x7fffffffffffdeadL) (get_int16_sign_extended_be buffer 0));
+  Alcotest.(check int "get_int16_sign_extended_le" (Int64.to_int 0x7fffffffffffaddeL) (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 ]