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;
+}