New Upstream Release - bin-prot
Ready changes
Summary
Merged new upstream version: 0.16.0 (was: 0.15.0).
Diff
diff --git a/CHANGES.md b/CHANGES.md
index 5bc4f67..0ae9fc1 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,22 @@
+## Release v0.16.0
+
+Insert the changelog here. When making the release, we will keep this
+section and delete the section above.
+
+- In `Bin_prot.Bin_shape`, expose the structure of `Expert.Canonical.t`
+ * The purpose is so that custom bin shape traversals can be built.
+
+- Add a `stable_witness` idiom
+ * This is an idiom of stable types that is checked by the compiler, instead of relying on convention.
+
+- Remove deprecated functions for dealing with float arrays.
+ * Users should now use `ppx_bin_prot` with type `float array` or `floatarray`
+
+- Remove the deprecated `Make_binable*` functor family
+ * Users are advised to use `*_with_uuid` or `*_without_uuid` alternatives
+
+## Old pre-v0.15 changelogs (very likely stale and incomplete)
+
## 113.43.00
- Converted `bin_prot` to use `%expect` tests. No functional changes.
diff --git a/LICENSE.md b/LICENSE.md
index 4e90255..c907fb8 100644
--- a/LICENSE.md
+++ b/LICENSE.md
@@ -1,6 +1,6 @@
The MIT License
-Copyright (c) 2008--2022 Jane Street Group, LLC <opensource@janestreet.com>
+Copyright (c) 2008--2023 Jane Street Group, LLC <opensource-contacts@janestreet.com>
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
diff --git a/README.md b/README.md
index aba24e3..97fc54b 100644
--- a/README.md
+++ b/README.md
@@ -55,27 +55,13 @@ Usage
The API (`.mli`-files) in the `bin_prot` library directory (`lib`)
is fully documented, and HTML-documentation can be built from it on
installation. The documentation for the latest release can also be found
-[online](https://ocaml.janestreet.com/ocaml-core/latest/doc/bin_prot/Bin_prot/index.html).
+[online](https://v3.ocaml.org/p/bin_prot).
Module `Common` defines some globally used types, functions, exceptions,
and values. `Nat0` implements natural numbers including zero.
Modules `Read_ml` and `Write_ml` contain read and write functions respectively
-for all basic types and are implemented in OCaml as far as reasonable.
-Some operations are most easily performed in C. If you only want to read
-or write single, basic, unstructured values, using this module is probably
-the most efficient and convenient way of doing this.
-
-Otherwise you should annotate your type definitions to generate type
-converters automatically (see later sections for details). The preprocessor
-in `syntax/pa_bin_prot.ml` will then generate highly optimized functions for
-converting your OCaml-values to and from the binary representation. This
-automatically generated code will use functions in modules `Unsafe_common`,
-`Unsafe_read_c` and `Unsafe_write_c`, which employ unsafe internal
-representations to achieve optimal performance. The auto-generated code is
-extremely well-tested and should use these unsafe representations correctly.
-Developers who want to make manual use of these unsafe calling conventions
-for efficiency are strongly encouraged to test their code carefully.
+for all basic types.
The module `Size` allows you to compute the size of basic OCaml-values in the
binary representation before writing them to a buffer. The code generator
@@ -92,14 +78,6 @@ the top of files using this library:
Note that you can shadow the definitions in the above module in the unlikely
event that the predefined ways of converting data are unsatisfactory to you.
-The modules `Read_c` and `Write_c` wrap the unsafe low-level converters for
-basic values to ones accessible safely from within OCaml and vice versa. They
-also export functions for wrapping user-defined converters. This should help
-developers make their converters available in the respective other
-representation (low- or high-level). The test applications in the distribution
-use these wrappers to verify the correctness of implementations for low-level
-(C) and high-level (OCaml) representations.
-
The module `Type_class` contains some extra definitions for type classes of
basic values. These definitions can be passed to the function `bin_dump` in
module `Utils` to marshal values into buffers of exact size using the binary
diff --git a/bench/bench.ml b/bench/bench.ml
deleted file mode 100644
index add1ed2..0000000
--- a/bench/bench.ml
+++ /dev/null
@@ -1,100 +0,0 @@
-open Bin_prot
-open Core
-
-[@@@ocaml.alert "-deprecated"]
-
-let%bench_module "float array" =
- (module struct
- let a = Array.create ~len:1000 0.
-
- let buf =
- let buf = Common.create_buf ((1000 * 8) + 8) in
- let _ = Write.bin_write_float_array buf ~pos:0 a in
- buf
- ;;
-
- module Price = struct
- type t = float [@@deriving bin_io]
- end
-
- let price_array : Price.t array = Array.create ~len:1000 0.
- let size_float f = Size.bin_size_float f
-
- let%bench "size non optimal" = Size.bin_size_array size_float a
- let%bench "size float array" = Size.bin_size_float_array a
- let%bench "size Price.t array" = Size.bin_size_array Price.bin_size_t price_array
-
- let write_float buf ~pos f = Write.bin_write_float buf ~pos f
-
- let%bench "write non optimal" =
- let _ = Write.bin_write_array write_float buf ~pos:0 a in
- ()
- ;;
-
- let%bench "write float array" =
- let _ = Write.bin_write_float_array buf ~pos:0 a in
- ()
- ;;
-
- let%bench "write Price.t array" =
- let _ = Write.bin_write_array Price.bin_write_t buf ~pos:0 a in
- ()
- ;;
-
- let read_float buf ~pos_ref = Read.bin_read_float buf ~pos_ref
-
- let%bench "read non optimal" =
- let pos_ref = ref 0 in
- let _ = Read.bin_read_array read_float buf ~pos_ref in
- ()
- ;;
-
- let%bench "read float array" =
- let pos_ref = ref 0 in
- let _ = Read.bin_read_float_array buf ~pos_ref in
- ()
- ;;
-
- let%bench "read Price.t array" =
- let pos_ref = ref 0 in
- let _ = Read.bin_read_array Price.bin_read_t buf ~pos_ref in
- ()
- ;;
-
- let int_array = Array.create ~len:1000 0
-
- let%bench "int array size" = Size.bin_size_array Size.bin_size_int int_array
-
- let%bench "int array write" =
- let _ = Write.bin_write_array Write.bin_write_int buf ~pos:0 int_array in
- ()
- ;;
-
- let%bench "int array read" =
- let pos_ref = ref 0 in
- let _ = Read.bin_read_array Read.bin_read_int buf ~pos_ref in
- ()
- ;;
-
- module Book = struct
- type t = { a : Price.t array } [@@deriving bin_io]
- end
-
- let book = { Book.a = Array.create ~len:1000 0. }
-
- let buf =
- let buf = Common.create_buf (2100 * 8) in
- let _ = Book.bin_write_t buf ~pos:0 book in
- buf
- ;;
-
- let%bench "size field" = Book.bin_size_t book
- let%bench "write field" = Book.bin_write_t buf ~pos:0 book
-
- let%bench "read field" =
- let pos_ref = ref 0 in
- let _ = Book.bin_read_t buf ~pos_ref in
- ()
- ;;
- end)
-;;
diff --git a/bench/bench_numbers.mli b/bench/bench_numbers.mli
new file mode 100644
index 0000000..74bb729
--- /dev/null
+++ b/bench/bench_numbers.mli
@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)
diff --git a/bench/dune b/bench/dune
index 760c8a0..4dba235 100644
--- a/bench/dune
+++ b/bench/dune
@@ -1 +1,4 @@
-(library (name bin_prot_bench) (libraries core) (preprocess (pps ppx_jane)))
\ No newline at end of file
+(library (name bin_prot_bench)
+ (libraries bin_prot ppx_expect.collector ppx_bench.runtime-lib
+ ppx_module_timer.runtime)
+ (preprocess (pps ppx_jane)))
\ No newline at end of file
diff --git a/bin_prot.opam b/bin_prot.opam
index 0243311..1cc4927 100644
--- a/bin_prot.opam
+++ b/bin_prot.opam
@@ -1,5 +1,5 @@
opam-version: "2.0"
-version: "v0.15.0"
+version: "v0.16.0"
maintainer: "Jane Street developers"
authors: ["Jane Street Group, LLC"]
homepage: "https://github.com/janestreet/bin_prot"
@@ -11,19 +11,21 @@ build: [
["dune" "build" "-p" name "-j" jobs]
]
depends: [
- "ocaml" {>= "4.08.0"}
- "base" {>= "v0.15" & < "v0.16"}
- "ppx_compare" {>= "v0.15" & < "v0.16"}
- "ppx_custom_printf" {>= "v0.15" & < "v0.16"}
- "ppx_fields_conv" {>= "v0.15" & < "v0.16"}
- "ppx_optcomp" {>= "v0.15" & < "v0.16"}
- "ppx_sexp_conv" {>= "v0.15" & < "v0.16"}
- "ppx_variants_conv" {>= "v0.15" & < "v0.16"}
- "dune" {>= "2.0.0"}
+ "ocaml" {>= "4.14.0"}
+ "base" {>= "v0.16" & < "v0.17"}
+ "ppx_compare" {>= "v0.16" & < "v0.17"}
+ "ppx_custom_printf" {>= "v0.16" & < "v0.17"}
+ "ppx_fields_conv" {>= "v0.16" & < "v0.17"}
+ "ppx_optcomp" {>= "v0.16" & < "v0.17"}
+ "ppx_sexp_conv" {>= "v0.16" & < "v0.17"}
+ "ppx_stable_witness" {>= "v0.16" & < "v0.17"}
+ "ppx_variants_conv" {>= "v0.16" & < "v0.17"}
+ "dune" {>= "2.0.0"}
]
depopts: [
"mirage-xen-ocaml"
]
+available: arch != "arm32" & arch != "x86_32"
synopsis: "A binary protocol generator"
description: "
Part of Jane Street's Core library
diff --git a/debian/changelog b/debian/changelog
index 44bdc02..00d0e1a 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+bin-prot (1:0.16.0-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- Debian Janitor <janitor@jelmer.uk> Wed, 28 Jun 2023 03:23:48 -0000
+
bin-prot (1:0.15.0-1) unstable; urgency=medium
[ Stéphane Glondu ]
diff --git a/shape/README.md b/shape/README.md
index f09004e..51f8e4e 100644
--- a/shape/README.md
+++ b/shape/README.md
@@ -207,7 +207,7 @@ canonical shapes and hence equivalence at the `Shape.t` level.
```
The intention is that a shape digest can be passed between
-server/client of an RPC protocol to check that the both sides have the
+server/client of an RPC protocol to check that both sides have the
same opinion of the types being passed.
We can convert directly from a base shape to its digest, avoiding
diff --git a/shape/src/bin_shape.ml b/shape/src/bin_shape.ml
index 42f9410..a868415 100644
--- a/shape/src/bin_shape.ml
+++ b/shape/src/bin_shape.ml
@@ -314,13 +314,7 @@ module Canonical_digest : Canonical = struct
end
end
-module Canonical_full : sig
- type t [@@deriving compare, sexp]
-
- include Canonical with type t := t
-
- val to_string_hum : t -> string
-end = struct
+module Canonical_full = struct
module CD = Create_digest
module Exp1 = struct
@@ -393,11 +387,11 @@ end
module Gid : sig
(* unique group-id, used as key for Tenv below *)
- type t [@@deriving compare, sexp_of]
+ type t [@@deriving compare, equal, sexp]
val create : unit -> t
end = struct
- type t = int [@@deriving compare, sexp_of]
+ type t = int [@@deriving compare, equal, sexp]
let r = ref 0
@@ -413,10 +407,10 @@ module Expression = struct
[ `Constr of string * 't option
| `Inherit of Location.t * 't
]
- [@@deriving compare, sexp_of]
+ [@@deriving compare, equal, sexp]
module Group : sig
- type 'a t [@@deriving compare, sexp_of]
+ type 'a t [@@deriving compare, equal, sexp]
val create : Location.t -> (Tid.t * Vid.t list * 'a) list -> 'a t
val id : 'a t -> Gid.t
@@ -427,7 +421,7 @@ module Expression = struct
; loc : Location.t
; members : (Tid.t * (Vid.t list * 'a)) list
}
- [@@deriving compare, sexp_of]
+ [@@deriving compare, equal, sexp]
let create loc trips =
let gid = Gid.create () in
@@ -449,17 +443,23 @@ module Expression = struct
;;
end
- type t =
- | Annotate of Uuid.t * t
- | Base of Uuid.t * t list
- | Record of (string * t) list
- | Variant of (string * t list) list
- | Tuple of t list
- | Poly_variant of (Location.t * t poly_constr list)
- | Var of (Location.t * Vid.t)
- | Rec_app of Tid.t * t list
- | Top_app of t Group.t * Tid.t * t list
- [@@deriving variants, sexp_of]
+ module Stable = struct
+ module V1 = struct
+ type t =
+ | Annotate of Uuid.t * t
+ | Base of Uuid.t * t list
+ | Record of (string * t) list
+ | Variant of (string * t list) list
+ | Tuple of t list
+ | Poly_variant of (Location.t * t poly_constr list)
+ | Var of (Location.t * Vid.t)
+ | Rec_app of Tid.t * t list
+ | Top_app of t Group.t * Tid.t * t list
+ [@@deriving equal, sexp, variants]
+ end
+ end
+
+ include Stable.V1
type group = t Group.t
@@ -766,3 +766,9 @@ module For_typerep = struct
| _ -> raise (Not_a_tuple t)
;;
end
+
+module Expert = struct
+ module Sorted_table = Sorted_table
+ module Canonical_exp_constructor = Canonical_exp_constructor
+ module Canonical = Canonical
+end
diff --git a/shape/src/bin_shape.mli b/shape/src/bin_shape.mli
index fdda0e1..10d73fa 100644
--- a/shape/src/bin_shape.mli
+++ b/shape/src/bin_shape.mli
@@ -39,6 +39,8 @@ module Uuid : sig
use string in `uuid' format: XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX
There is also no attempt to detect & reject duplicates *)
val of_string : string -> t
+
+ val to_string : t -> string
end
(** group of mutually recursive type definitions *)
@@ -72,9 +74,14 @@ val basetype : Uuid.t -> t list -> t
(** [a = annotate s t] creates a shape [a] distinguished, but dependent on shape [t].
Very much as [record [(s,t)]] does.
But with [annotate] the ocaml record type does not exist. *)
-
val annotate : Uuid.t -> t -> t
+module Stable : sig
+ module V1 : sig
+ type nonrec t = t [@@deriving equal, sexp]
+ end
+end
+
(** [Shape.Canonical.t] is the result of [eval]uating a shape to a canonical form, and
represents the shape of Ocaml types w.r.t. bin_io serialization.
@@ -101,8 +108,38 @@ module Digest : sig
val of_md5 : Md5_lib.t -> t
end
+module Expert : sig
+ module Sorted_table : sig
+ type 'a t [@@deriving compare, sexp_of]
+
+ val expose : 'a t -> (string * 'a) list
+ end
+
+ module Canonical_exp_constructor : sig
+ type 'a t =
+ | Annotate of Uuid.t * 'a
+ | Base of Uuid.t * 'a list
+ | Tuple of 'a list
+ | Record of (string * 'a) list
+ | Variant of (string * 'a list) list
+ | Poly_variant of 'a option Sorted_table.t
+ | Application of 'a * 'a list
+ | Rec_app of int * 'a list
+ | Var of int
+ [@@deriving compare, sexp_of]
+ end
+
+ module Canonical : sig
+ module Exp1 : sig
+ type t0 = Exp of t0 Canonical_exp_constructor.t [@@deriving compare, sexp_of]
+ end
+
+ type t = Exp1.t0 [@@deriving compare, sexp_of]
+ end
+end
+
module Canonical : sig
- type t [@@deriving compare, sexp_of]
+ type t = Expert.Canonical.t [@@deriving compare, sexp_of]
val to_string_hum : t -> string
val to_digest : t -> Digest.t
diff --git a/shape/src/dune b/shape/src/dune
index 22034c8..a0a4f53 100644
--- a/shape/src/dune
+++ b/shape/src/dune
@@ -1,5 +1,4 @@
-(library (name bin_shape_lib) (public_name bin_prot.shape)
- (libraries base.md5)
+(library (name bin_shape) (public_name bin_prot.shape) (libraries base.md5)
(preprocess
(pps ppx_compare ppx_sexp_conv ppx_fields_conv ppx_variants_conv
ppx_custom_printf)))
\ No newline at end of file
diff --git a/shape/src/std.ml b/shape/src/std.ml
deleted file mode 100644
index e775552..0000000
--- a/shape/src/std.ml
+++ /dev/null
@@ -1 +0,0 @@
-module Shape = Bin_shape
diff --git a/shape/test/check_no_uuid_duplication.ml b/shape/test/check_no_uuid_duplication.ml
deleted file mode 100644
index 6ceb1a9..0000000
--- a/shape/test/check_no_uuid_duplication.ml
+++ /dev/null
@@ -1,58 +0,0 @@
-open Core
-open Poly
-open Async
-
-type uuid_in_file =
- { fname : string
- ; line : int
- ; uuid : string
- }
-
-let main () =
- let argv = Sys.get_argv () in
- assert (Array.length argv = 2);
- let%bind () = Unix.chdir argv.(1) in
- let%bind files =
- Process.run_lines_exn () ~prog:"hg" ~args:[ "stat"; "-numac" ]
- >>| List.filter ~f:(fun fn ->
- (not (String.is_prefix fn ~prefix:"external/"))
- && (* Filter out symlinks and other things. Use core as it would be too slow with
- async. *)
- (Core_unix.lstat fn).st_kind = S_REG)
- in
- let%bind uuids =
- (* Break the list into chunks of 200 to stay under the command line length
- restrictions *)
- List.chunks_of files ~length:200
- |> Deferred.List.concat_map ~f:(fun files ->
- Process.run_lines_exn
- ()
- ~accept_nonzero_exit:[ 1 ]
- ~prog:"grep"
- ~args:("-HEno" :: "\"[a-f0-9]{8}-([a-f0-9]{4}-){3}[a-f0-9]{12}\"" :: files))
- >>| List.map ~f:(fun line ->
- Scanf.sscanf line {|%[^:]:%u:"%[^"]"|} (fun fname line uuid ->
- { fname; line; uuid }))
- in
- let dups =
- List.map uuids ~f:(fun u -> u.uuid, u)
- |> String.Map.of_alist_multi
- |> Map.filter ~f:(function
- | [] | [ _ ] -> false
- | _ :: _ :: _ -> true)
- |> Map.to_alist
- in
- match dups with
- | [] -> Shutdown.exit 0
- | l ->
- eprintf "Duplicated UUIDS found in the tree!\n";
- List.iter l ~f:(fun (uuid, occurences) ->
- eprintf "UUID %S appears in:\n" uuid;
- List.iter occurences ~f:(fun u -> eprintf "- %s:%u\n" u.fname u.line));
- Shutdown.exit 1
-;;
-
-let (_ : never_returns) =
- don't_wait_for (return () >>= main);
- Scheduler.go ()
-;;
diff --git a/shape/test/dune b/shape/test/dune
deleted file mode 100644
index c045703..0000000
--- a/shape/test/dune
+++ /dev/null
@@ -1,2 +0,0 @@
-(executables (names check_no_uuid_duplication) (libraries core async)
- (preprocess (pps ppx_jane)))
\ No newline at end of file
diff --git a/src/bin_prot.ml b/src/bin_prot.ml
new file mode 100644
index 0000000..262e567
--- /dev/null
+++ b/src/bin_prot.ml
@@ -0,0 +1,12 @@
+module Binable = Binable
+module Blob = Blob
+module Common = Common
+module Md5 = Md5
+module Nat0 = Nat0
+module Read = Read
+module Shape = Shape
+module Size = Size
+module Std = Std
+module Type_class = Type_class
+module Utils = Utils
+module Write = Write
diff --git a/src/blit_stubs.c b/src/blit_stubs.c
index bb77b39..6792401 100644
--- a/src/blit_stubs.c
+++ b/src/blit_stubs.c
@@ -8,99 +8,96 @@
#include <caml/signals.h>
#if defined(__GNUC__) && __GNUC__ >= 3
-# ifndef __likely
-# define likely(x) __builtin_expect (!!(x), 1)
-# endif
-# ifndef __unlikely
-# define unlikely(x) __builtin_expect (!!(x), 0)
-# endif
+#ifndef __likely
+#define likely(x) __builtin_expect(!!(x), 1)
+#endif
+#ifndef __unlikely
+#define unlikely(x) __builtin_expect(!!(x), 0)
+#endif
#else
-# ifndef __likely
-# define likely(x) (x)
-# endif
-# ifndef __unlikely
-# define unlikely(x) (x)
-# endif
+#ifndef __likely
+#define likely(x) (x)
+#endif
+#ifndef __unlikely
+#define unlikely(x) (x)
+#endif
#endif
#ifdef __MINIOS__
-#define unlikely(x) __builtin_expect((x),0)
+#define unlikely(x) __builtin_expect((x), 0)
#endif
-#define get_buf(v_buf, v_pos) (char *) Caml_ba_data_val(v_buf) + Long_val(v_pos)
+#define get_buf(v_buf, v_pos) (char *)Caml_ba_data_val(v_buf) + Long_val(v_pos)
/* Bytes_val is only available from 4.06 */
#ifndef Bytes_val
#define Bytes_val String_val
#endif
-CAMLprim value bin_prot_blit_string_buf_stub(
- value v_src_pos, value v_str, value v_dst_pos, value v_buf, value v_len)
-{
+CAMLprim value bin_prot_blit_string_buf_stub(value v_src_pos, value v_str,
+ value v_dst_pos, value v_buf,
+ value v_len) {
const char *str = String_val(v_str) + Long_val(v_src_pos);
char *buf = get_buf(v_buf, v_dst_pos);
- memcpy(buf, str, (size_t) Long_val(v_len));
+ memcpy(buf, str, (size_t)Long_val(v_len));
return Val_unit;
}
-CAMLprim value bin_prot_blit_bytes_buf_stub(
- value v_src_pos, value v_str, value v_dst_pos, value v_buf, value v_len)
-{
+CAMLprim value bin_prot_blit_bytes_buf_stub(value v_src_pos, value v_str,
+ value v_dst_pos, value v_buf,
+ value v_len) {
unsigned char *str = Bytes_val(v_str) + Long_val(v_src_pos);
char *buf = get_buf(v_buf, v_dst_pos);
- memcpy(buf, str, (size_t) Long_val(v_len));
+ memcpy(buf, str, (size_t)Long_val(v_len));
return Val_unit;
}
-CAMLprim value bin_prot_blit_buf_bytes_stub(
- value v_src_pos, value v_buf, value v_dst_pos, value v_str, value v_len)
-{
+CAMLprim value bin_prot_blit_buf_bytes_stub(value v_src_pos, value v_buf,
+ value v_dst_pos, value v_str,
+ value v_len) {
char *buf = get_buf(v_buf, v_src_pos);
unsigned char *str = Bytes_val(v_str) + Long_val(v_dst_pos);
- memcpy(str, buf, (size_t) Long_val(v_len));
+ memcpy(str, buf, (size_t)Long_val(v_len));
return Val_unit;
}
-CAMLprim value bin_prot_blit_buf_stub(
- value v_src_pos, value v_src, value v_dst_pos, value v_dst, value v_len)
-{
+CAMLprim value bin_prot_blit_buf_stub(value v_src_pos, value v_src,
+ value v_dst_pos, value v_dst,
+ value v_len) {
struct caml_ba_array *ba_src = Caml_ba_array_val(v_src);
struct caml_ba_array *ba_dst = Caml_ba_array_val(v_dst);
- char *src = (char *) ba_src->data + Long_val(v_src_pos);
- char *dst = (char *) ba_dst->data + Long_val(v_dst_pos);
- size_t len = (size_t) Long_val(v_len);
- if
- (
- unlikely(len > 65536)
- || unlikely(((ba_src->flags & CAML_BA_MAPPED_FILE) != 0))
- || unlikely(((ba_dst->flags & CAML_BA_MAPPED_FILE) != 0))
- )
+ char *src = (char *)ba_src->data + Long_val(v_src_pos);
+ char *dst = (char *)ba_dst->data + Long_val(v_dst_pos);
+ size_t len = (size_t)Long_val(v_len);
+ if (unlikely(len > 65536) ||
+ unlikely(((ba_src->flags & CAML_BA_MAPPED_FILE) != 0)) ||
+ unlikely(((ba_dst->flags & CAML_BA_MAPPED_FILE) != 0)))
/* use [memmove] rather than [memcpy] because src and dst may overlap */
{
Begin_roots2(v_src, v_dst);
caml_enter_blocking_section();
- memmove(dst, src, len);
+ memmove(dst, src, len);
caml_leave_blocking_section();
End_roots();
- }
- else memmove(dst, src, len);
+ } else
+ memmove(dst, src, len);
return Val_unit;
}
-CAMLprim value bin_prot_blit_float_array_buf_stub(
- value v_src_pos, value v_arr, value v_dst_pos, value v_buf, value v_len)
-{
- char *arr = (char*)v_arr + Long_val(v_src_pos) * sizeof(double);
+CAMLprim value bin_prot_blit_float_array_buf_stub(value v_src_pos, value v_arr,
+ value v_dst_pos, value v_buf,
+ value v_len) {
+ char *arr = (char *)v_arr + Long_val(v_src_pos) * sizeof(double);
char *buf = get_buf(v_buf, v_dst_pos);
- memcpy(buf, arr, (size_t) (Long_val(v_len) * sizeof(double)));
+ memcpy(buf, arr, (size_t)(Long_val(v_len) * sizeof(double)));
return Val_unit;
}
-CAMLprim value bin_prot_blit_buf_float_array_stub(
- value v_src_pos, value v_buf, value v_dst_pos, value v_arr, value v_len)
-{
+CAMLprim value bin_prot_blit_buf_float_array_stub(value v_src_pos, value v_buf,
+ value v_dst_pos, value v_arr,
+ value v_len) {
char *buf = get_buf(v_buf, v_src_pos);
- char *arr = (char*)v_arr + Long_val(v_dst_pos) * sizeof(double);
- memcpy(arr, buf, (size_t) (Long_val(v_len) * sizeof(double)));
+ char *arr = (char *)v_arr + Long_val(v_dst_pos) * sizeof(double);
+ memcpy(arr, buf, (size_t)(Long_val(v_len) * sizeof(double)));
return Val_unit;
}
diff --git a/src/common.ml b/src/common.ml
index 4cba336..4370bec 100644
--- a/src/common.ml
+++ b/src/common.ml
@@ -237,7 +237,7 @@ let blit_buf_string = blit_buf_bytes
let rec copy_htbl_list htbl = function
| [] -> htbl
| (k, v) :: rest ->
- Caml.Hashtbl.add htbl k v;
+ Stdlib.Hashtbl.add htbl k v;
copy_htbl_list htbl rest
;;
diff --git a/src/dune b/src/dune
index c23459c..2691aec 100644
--- a/src/dune
+++ b/src/dune
@@ -1,5 +1,5 @@
(library (name bin_prot)
- (libraries bigarray bin_shape_lib base.md5 base base.caml)
+ (libraries bin_shape base.md5 base ppx_stable_witness.stable_witness)
(public_name bin_prot) (c_names blit_stubs)
(preprocess (pps ppx_sexp_conv ppx_compare ppx_optcomp))
(js_of_ocaml (javascript_files runtime.js)))
\ No newline at end of file
diff --git a/src/md5.ml b/src/md5.ml
index bf2d892..7bfdd97 100644
--- a/src/md5.ml
+++ b/src/md5.ml
@@ -1,13 +1,24 @@
-include Md5_lib
+module Stable = struct
+ module V1 = struct
+ include Md5_lib
-let bin_shape_t =
- Shape.basetype (Shape.Uuid.of_string "f6bdcdd0-9f75-11e6-9a7e-d3020428efed") []
-;;
+ let bin_shape_t =
+ Shape.basetype (Shape.Uuid.of_string "f6bdcdd0-9f75-11e6-9a7e-d3020428efed") []
+ ;;
-let bin_size_t = Size.bin_size_md5
-let bin_write_t = Write.bin_write_md5
-let bin_read_t = Read.bin_read_md5
+ let bin_size_t = Size.bin_size_md5
+ let bin_write_t = Write.bin_write_md5
+ let bin_read_t = Read.bin_read_md5
-let __bin_read_t__ _buf ~pos_ref _vdigest =
- Common.raise_variant_wrong_type "Shape.Md5.t" !pos_ref
-;;
+ let __bin_read_t__ _buf ~pos_ref _vdigest =
+ Common.raise_variant_wrong_type "Shape.Md5.t" !pos_ref
+ ;;
+
+ let stable_witness : t Stable_witness.t =
+ (* we assume this type to have a stable format *)
+ Stable_witness.assert_stable
+ ;;
+ end
+end
+
+include Stable.V1
diff --git a/src/md5.mli b/src/md5.mli
index 8cd5547..3bebf3e 100644
--- a/src/md5.mli
+++ b/src/md5.mli
@@ -8,3 +8,13 @@ val compare : t -> t -> int
val to_binary : t -> string
val of_binary_exn : string -> t
val unsafe_of_binary : string -> t
+
+module Stable : sig
+ module V1 : sig
+ type nonrec t = t [@@deriving compare]
+
+ val stable_witness : t Stable_witness.t
+
+ include Binable.Minimal.S with type t := t
+ end
+end
diff --git a/src/read.mli b/src/read.mli
index 2e32c8d..2b402c6 100644
--- a/src/read.mli
+++ b/src/read.mli
@@ -39,12 +39,6 @@ val bin_read_float64_mat : mat64 reader
val bin_read_mat : mat reader
val bin_read_bigstring : buf reader
val bin_read_floatarray : floatarray reader
-
-val bin_read_float_array : float array reader
-[@@ocaml.deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] or [floatarray] or the \
- 'floatarray' functions"]
-
val bin_read_variant_int : int reader
val bin_read_int_8bit : int reader
val bin_read_int_16bit : int reader
diff --git a/src/shape.ml b/src/shape.ml
index 7445b8c..834915c 100644
--- a/src/shape.ml
+++ b/src/shape.ml
@@ -1,4 +1,4 @@
-include Bin_shape_lib.Std.Shape
+include Bin_shape
(* new base shapes *)
let bin_shape_unit = basetype (Uuid.of_string "unit") []
@@ -41,13 +41,6 @@ let bin_shape_list x = basetype (Uuid.of_string "list") [ x ]
let bin_shape_array x = basetype (Uuid.of_string "array") [ x ]
let bin_shape_hashtbl x y = basetype (Uuid.of_string "hashtbl") [ x; y ]
-(* shape alias *)
-let bin_shape_float_array = bin_shape_array bin_shape_float
-[@@ocaml.deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] or [floatarray] or the \
- 'floatarray' functions"]
-;;
-
(* shape-constructor aliases *)
let bin_shape_lazy x = x
let bin_shape_pair x y = tuple [ x; y ]
diff --git a/src/shape.mli b/src/shape.mli
new file mode 100644
index 0000000..4ff4942
--- /dev/null
+++ b/src/shape.mli
@@ -0,0 +1,44 @@
+include module type of struct
+ include Bin_shape
+end
+
+val bin_shape_unit : t
+val bin_shape_bool : t
+val bin_shape_string : t
+val bin_shape_bytes : t
+val bin_shape_char : t
+val bin_shape_float : t
+val bin_shape_int : t
+val bin_shape_int32 : t
+val bin_shape_int63 : t
+val bin_shape_int64 : t
+val bin_shape_nativeint : t
+val bin_shape_nat0 : t
+val bin_shape_digest : t
+val bin_shape_float32_vec : t
+val bin_shape_float64_vec : t
+val bin_shape_vec : t
+val bin_shape_float32_mat : t
+val bin_shape_float64_mat : t
+val bin_shape_mat : t
+val bin_shape_bigstring : t
+val bin_shape_floatarray : t
+val bin_shape_variant_int : t
+val bin_shape_int_8bit : t
+val bin_shape_int_16bit : t
+val bin_shape_int_32bit : t
+val bin_shape_int_64bit : t
+val bin_shape_int64_bits : t
+val bin_shape_network16_int : t
+val bin_shape_network32_int : t
+val bin_shape_network32_int32 : t
+val bin_shape_network64_int : t
+val bin_shape_network64_int64 : t
+val bin_shape_ref : t -> t
+val bin_shape_option : t -> t
+val bin_shape_list : t -> t
+val bin_shape_array : t -> t
+val bin_shape_hashtbl : t -> t -> t
+val bin_shape_lazy : t -> t
+val bin_shape_pair : t -> t -> t
+val bin_shape_triple : t -> t -> t -> t
diff --git a/src/size.ml b/src/size.ml
index a5d09d7..08d5661 100644
--- a/src/size.ml
+++ b/src/size.ml
@@ -265,7 +265,3 @@ let bin_size_network32_int _ = 4
let bin_size_network32_int32 _ = 4
let bin_size_network64_int _ = 8
let bin_size_network64_int64 _ = 8
-
-let bin_size_array_no_length bin_size_el ar =
- bin_size_array_loop bin_size_el ar ~total_len:0 ~n:(Array.length ar)
-;;
diff --git a/src/size.mli b/src/size.mli
index c872ea8..d00ca96 100644
--- a/src/size.mli
+++ b/src/size.mli
@@ -36,12 +36,6 @@ val bin_size_float64_mat : mat64 sizer
val bin_size_mat : mat sizer
val bin_size_bigstring : buf sizer
val bin_size_floatarray : floatarray sizer
-
-val bin_size_float_array : float array sizer
-[@@ocaml.deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] or [floatarray] or the \
- 'floatarray' functions"]
-
val bin_size_variant_int : int sizer
val bin_size_int_8bit : int sizer
val bin_size_int_16bit : int sizer
@@ -53,11 +47,6 @@ val bin_size_network32_int : int sizer
val bin_size_network32_int32 : int32 sizer
val bin_size_network64_int : int sizer
val bin_size_network64_int64 : int64 sizer
-
-val bin_size_array_no_length : ('a, 'a array) sizer1
-[@@deprecated
- "[since 2016-03] this function was deprecated as it is misleading and unused"]
-
val bin_size_md5 : Md5_lib.t sizer
(* Provide the maximum sizes for fields which do not depend upon an array/vector/matrix
diff --git a/src/std.ml b/src/std.ml
index d01923d..5c906b7 100644
--- a/src/std.ml
+++ b/src/std.ml
@@ -89,58 +89,6 @@ let __bin_read_floatarray__ _buf ~pos_ref _vint =
Common.raise_variant_wrong_type "floatarray" !pos_ref
;;
-include struct
- type float_array = float array
- [@@deprecated "[since 2021-09] Use [float array] or [floatarray] instead"]
-
- let (bin_shape_float_array [@deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] \
- or [floatarray] or the 'floatarray' functions"])
- =
- Type_class.bin_shape_float_array
- ;;
-
- let (bin_writer_float_array [@deprecated
- "[since 2021-09] use ppx_bin_prot with type [float \
- array] or [floatarray] or the 'floatarray' functions"])
- =
- Type_class.bin_writer_float_array
- ;;
-
- let (bin_write_float_array [@deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] \
- or [floatarray] or the 'floatarray' functions"])
- =
- Write.bin_write_float_array
- ;;
-
- let (bin_reader_float_array [@deprecated
- "[since 2021-09] use ppx_bin_prot with type [float \
- array] or [floatarray] or the 'floatarray' functions \
- directly"])
- =
- Type_class.bin_reader_float_array
- ;;
-
- let (bin_read_float_array [@deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] \
- or [floatarray] or the 'floatarray' functions"])
- =
- Read.bin_read_float_array
- ;;
-
- let __bin_read_float_array__ _buf ~pos_ref _vint =
- Common.raise_variant_wrong_type "float_array" !pos_ref
- ;;
-
- let (__bin_read_float_array__ [@deprecated
- "[since 2021-09] use ppx_bin_prot with type [float \
- array] or [floatarray] or the floatarray functions"])
- =
- __bin_read_float_array__
- ;;
-end [@alert "-deprecated"]
-
let bin_int32 = Type_class.bin_int32
let bin_shape_int32 = Type_class.bin_shape_int32
let bin_writer_int32 = Type_class.bin_writer_int32
diff --git a/src/type_class.ml b/src/type_class.ml
index fe550f2..a322c9a 100644
--- a/src/type_class.ml
+++ b/src/type_class.ml
@@ -491,29 +491,6 @@ let bin_floatarray =
(*$*)
-type float_array = float array
-
-include struct
- (*$ mk_base "float_array" *)
- let bin_writer_float_array =
- { size = Size.bin_size_float_array; write = Write.bin_write_float_array }
- ;;
-
- let bin_reader_float_array =
- { read = Read.bin_read_float_array; vtag_read = variant_wrong_type "float_array" }
- ;;
-
- let bin_shape_float_array = Shape.bin_shape_float_array
-
- let bin_float_array =
- { shape = bin_shape_float_array
- ; writer = bin_writer_float_array
- ; reader = bin_reader_float_array
- }
- ;;
- (*$*)
-end [@alert "-deprecated"]
-
(*$ mk_base "variant_int" *)
let bin_writer_variant_int =
{ size = Size.bin_size_variant_int; write = Write.bin_write_variant_int }
@@ -717,13 +694,6 @@ let bin_network64_int64 =
;;
(*$*)
-let bin_writer_array_no_length bin_writer_el =
- { size = (fun v -> (Size.bin_size_array_no_length [@warning "-3"]) bin_writer_el.size v)
- ; write =
- (fun buf ~pos v ->
- (Write.bin_write_array_no_length [@warning "-3"]) bin_writer_el.write buf ~pos v)
- }
-;;
(* Conversion of binable types *)
diff --git a/src/type_class.mli b/src/type_class.mli
index 62742ac..6a47d06 100644
--- a/src/type_class.mli
+++ b/src/type_class.mli
@@ -201,40 +201,6 @@ val bin_shape_floatarray : Shape.t
val bin_floatarray : floatarray t
(*$*)
-(*$
- mk_base_tp
- ~deprecate:
- "[@@ocaml.deprecated \"[since 2021-09] use ppx_bin_prot with type [float array] or \
- [floatarray] or the 'floatarray' functions\"]"
- "float_array"
- "float array"
-*)
-val bin_writer_float_array : float array writer
-[@@ocaml.deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] or [floatarray] or the \
- 'floatarray' functions"]
-
-val bin_reader_float_array : float array reader
-[@@ocaml.deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] or [floatarray] or the \
- 'floatarray' functions"]
-
-val bin_shape_float_array : Shape.t
-[@@ocaml.deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] or [floatarray] or the \
- 'floatarray' functions"]
-
-val bin_float_array : float array t
-[@@ocaml.deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] or [floatarray] or the \
- 'floatarray' functions"]
-(*$*)
-
-type float_array = float array
-[@@ocaml.deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] or [floatarray] or the \
- 'floatarray' functions"]
-
val bin_writer_variant_int : int writer
val bin_reader_variant_int : int reader
val bin_variant_int : int t
@@ -300,10 +266,6 @@ val bin_shape_network64_int64 : Shape.t
val bin_network64_int64 : int64 t
(*$*)
-val bin_writer_array_no_length : ('a, 'a array) S1.writer
-[@@deprecated
- "[since 2016-03] this writer was deprecated as it is misleading and unused"]
-
(** Conversion of binable types *)
val cnv_writer : ('a -> 'b) -> 'b writer -> 'a writer
diff --git a/src/utils.ml b/src/utils.ml
index 5c79a5f..7e03665 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -308,11 +308,6 @@ module Make_binable3_without_uuid (S : Make_binable3_without_uuid_spec) =
let maybe_caller_identity = None
end)
-module Make_binable = Make_binable_without_uuid
-module Make_binable1 = Make_binable1_without_uuid
-module Make_binable2 = Make_binable2_without_uuid
-module Make_binable3 = Make_binable3_without_uuid
-
let with_module_name f ~module_name function_name =
match module_name with
| None -> f function_name
diff --git a/src/utils_intf.ml b/src/utils_intf.ml
index e984433..cacd6a7 100644
--- a/src/utils_intf.ml
+++ b/src/utils_intf.ml
@@ -1,6 +1,7 @@
open Common
open Type_class
+
module type Make_binable_without_uuid_spec = sig
module Binable : Binable.Minimal.S
@@ -226,30 +227,6 @@ module type Utils = sig
Binable.S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) Bin_spec.t
[@@alert legacy "Use [Make_binable3_with_uuid] if possible."]
- module Make_binable = Make_binable_without_uuid
- [@@alert "-legacy"]
- [@@deprecated
- "[since 2019-11] Use [Make_binable_with_uuid] if possible, or \
- [Make_binable_without_uuid] otherwise."]
-
- module Make_binable1 = Make_binable1_without_uuid
- [@@alert "-legacy"]
- [@@deprecated
- "[since 2019-11] Use [Make_binable1_with_uuid] if possible, or \
- [Make_binable1_without_uuid] otherwise."]
-
- module Make_binable2 = Make_binable2_without_uuid
- [@@alert "-legacy"]
- [@@deprecated
- "[since 2019-11] Use [Make_binable2_with_uuid] if possible, or \
- [Make_binable2_without_uuid] otherwise."]
-
- module Make_binable3 = Make_binable3_without_uuid
- [@@alert "-legacy"]
- [@@deprecated
- "[since 2019-11] Use [Make_binable3_with_uuid] if possible, or \
- [Make_binable3_without_uuid] otherwise."]
-
(** Conversion of iterable types *)
module type Make_iterable_binable_spec = Make_iterable_binable_spec
diff --git a/src/write.ml b/src/write.ml
index 68f4e26..69faef8 100644
--- a/src/write.ml
+++ b/src/write.ml
@@ -23,13 +23,9 @@ external bswap64 : int64 -> int64 = "%bswap_int64"
(*$ open Bin_prot_cinaps $*)
let code_NEG_INT8 = (*$ Code.char NEG_INT8 *) '\xff' (*$*)
-
let code_INT16 = (*$ Code.char INT16 *) '\xfe' (*$*)
-
let code_INT32 = (*$ Code.char INT32 *) '\xfd' (*$*)
-
let code_INT64 = (*$ Code.char INT64 *) '\xfc' (*$*)
-
let arch_sixtyfour = Sys.word_size = 64
let arch_big_endian = Sys.big_endian
@@ -488,10 +484,6 @@ let bin_write_network64_int64 buf ~pos n =
next
;;
-let bin_write_array_no_length bin_write_el buf ~pos ar =
- bin_write_array_loop bin_write_el buf ~els_pos:pos ~n:(Array.length ar) ar
-;;
-
external unsafe_string_get32 : string -> int -> int32 = "%caml_string_get32u"
external unsafe_string_get64 : string -> int -> int64 = "%caml_string_get64u"
diff --git a/src/write.mli b/src/write.mli
index 6194a14..f799a5a 100644
--- a/src/write.mli
+++ b/src/write.mli
@@ -38,12 +38,6 @@ val bin_write_float64_mat : mat64 writer
val bin_write_mat : mat writer
val bin_write_bigstring : buf writer
val bin_write_floatarray : floatarray writer
-
-val bin_write_float_array : float array writer
-[@@ocaml.deprecated
- "[since 2021-09] use ppx_bin_prot with type [float array] or [floatarray] or the \
- 'floatarray' functions"]
-
val bin_write_md5 : Md5_lib.t writer
(** [bin_write_variant_int] writes out the exact little-endian bit
@@ -90,9 +84,3 @@ val bin_write_network64_int : int writer
(** [bin_write_network64_int64] writes out a 64bit integer in 64bit
network byte order (= big-endian). *)
val bin_write_network64_int64 : int64 writer
-
-(** [bin_write_array_no_length] writes out all values in the given array
- without writing out its length. *)
-val bin_write_array_no_length : ('a, 'a array) writer1
-[@@deprecated
- "[since 2016-03] this function was deprecated as it is misleading and unused"]
diff --git a/test/dune b/test/dune
index 2c9eeca..6be85fa 100644
--- a/test/dune
+++ b/test/dune
@@ -1,4 +1,5 @@
-(library (name bin_prot_test) (libraries core bin_prot float_array base.md5)
+(library (name bin_prot_test)
+ (libraries core bin_prot expect_test_patterns float_array base.md5)
(preprocess (pps ppx_jane)))
(alias (name runtest)
diff --git a/test/integers_repr_tests_32bit.mli b/test/integers_repr_tests_32bit.mli
new file mode 100644
index 0000000..74bb729
--- /dev/null
+++ b/test/integers_repr_tests_32bit.mli
@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)
diff --git a/test/integers_repr_tests_64bit.mli b/test/integers_repr_tests_64bit.mli
new file mode 100644
index 0000000..74bb729
--- /dev/null
+++ b/test/integers_repr_tests_64bit.mli
@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)
diff --git a/test/integers_repr_tests_js.mli b/test/integers_repr_tests_js.mli
new file mode 100644
index 0000000..74bb729
--- /dev/null
+++ b/test/integers_repr_tests_js.mli
@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)
diff --git a/test/non_integers_repr.ml b/test/non_integers_repr.ml
index 88136a7..3b86f53 100644
--- a/test/non_integers_repr.ml
+++ b/test/non_integers_repr.ml
@@ -230,17 +230,6 @@ module Tests = struct
}
;;
- let float_array =
- { writer = Write.bin_write_float_array
- ; reader = Read.bin_read_float_array
- ; values = [ [||]; [| 0. |] ]
- ; equal = Array.equal Float.equal
- ; sexp_of = [%sexp_of: float array]
- ; hi_bound = None
- ; lo_bound = Minimum.bin_size_float_array
- } [@ocaml.alert "-deprecated"]
- ;;
-
let ref =
{ writer = Write.bin_write_ref Write.bin_write_int32
; reader = Read.bin_read_ref Read.bin_read_int32
@@ -363,13 +352,14 @@ module Tests = struct
; [ -1l, -1l; Int32.min_value, Int32.min_value ]
]
~f:(fun l ->
- let hashtbl = Caml.Hashtbl.create (List.length l) in
- List.iter l ~f:(fun (key, data) -> Caml.Hashtbl.add hashtbl key data);
+ let hashtbl = Stdlib.Hashtbl.create (List.length l) in
+ List.iter l ~f:(fun (key, data) -> Stdlib.Hashtbl.add hashtbl key data);
hashtbl)
; equal =
(fun t1 t2 ->
let to_list tbl =
- Caml.Hashtbl.fold (fun k v acc -> (k, v) :: acc) tbl [] |> List.sort ~compare
+ Stdlib.Hashtbl.fold (fun k v acc -> (k, v) :: acc) tbl []
+ |> List.sort ~compare
in
to_list t1 = to_list t2)
; sexp_of = [%sexp_of: (int32, int32) Sexplib.Std.Hashtbl.t]
@@ -625,9 +615,11 @@ let%expect_test "Non-integer bin_prot size tests" =
00 00 00 00 00 00 00 00 -> 0
|}];
gen_tests Tests.float_nan;
- [%expect {|
+ Expect_test_patterns.require_match
+ [%here]
+ {|
7f f{8,0} 00 00 00 00 00 01 -> NAN (glob)
- |}];
+ |};
gen_tests Tests.vec;
[%expect
{|
@@ -673,12 +665,6 @@ let%expect_test "Non-integer bin_prot size tests" =
.. .. .. .. .. .. .. .. 00 -> ()
00 00 00 00 00 00 00 00 01 -> (0)
|}];
- gen_tests Tests.float_array;
- [%expect
- {|
- .. .. .. .. .. .. .. .. 00 -> ()
- 00 00 00 00 00 00 00 00 01 -> (0)
- |}];
gen_tests Tests.ref;
[%expect
{|
diff --git a/xen/blit_stubs.c b/xen/blit_stubs.c
index bb77b39..6792401 100644
--- a/xen/blit_stubs.c
+++ b/xen/blit_stubs.c
@@ -8,99 +8,96 @@
#include <caml/signals.h>
#if defined(__GNUC__) && __GNUC__ >= 3
-# ifndef __likely
-# define likely(x) __builtin_expect (!!(x), 1)
-# endif
-# ifndef __unlikely
-# define unlikely(x) __builtin_expect (!!(x), 0)
-# endif
+#ifndef __likely
+#define likely(x) __builtin_expect(!!(x), 1)
+#endif
+#ifndef __unlikely
+#define unlikely(x) __builtin_expect(!!(x), 0)
+#endif
#else
-# ifndef __likely
-# define likely(x) (x)
-# endif
-# ifndef __unlikely
-# define unlikely(x) (x)
-# endif
+#ifndef __likely
+#define likely(x) (x)
+#endif
+#ifndef __unlikely
+#define unlikely(x) (x)
+#endif
#endif
#ifdef __MINIOS__
-#define unlikely(x) __builtin_expect((x),0)
+#define unlikely(x) __builtin_expect((x), 0)
#endif
-#define get_buf(v_buf, v_pos) (char *) Caml_ba_data_val(v_buf) + Long_val(v_pos)
+#define get_buf(v_buf, v_pos) (char *)Caml_ba_data_val(v_buf) + Long_val(v_pos)
/* Bytes_val is only available from 4.06 */
#ifndef Bytes_val
#define Bytes_val String_val
#endif
-CAMLprim value bin_prot_blit_string_buf_stub(
- value v_src_pos, value v_str, value v_dst_pos, value v_buf, value v_len)
-{
+CAMLprim value bin_prot_blit_string_buf_stub(value v_src_pos, value v_str,
+ value v_dst_pos, value v_buf,
+ value v_len) {
const char *str = String_val(v_str) + Long_val(v_src_pos);
char *buf = get_buf(v_buf, v_dst_pos);
- memcpy(buf, str, (size_t) Long_val(v_len));
+ memcpy(buf, str, (size_t)Long_val(v_len));
return Val_unit;
}
-CAMLprim value bin_prot_blit_bytes_buf_stub(
- value v_src_pos, value v_str, value v_dst_pos, value v_buf, value v_len)
-{
+CAMLprim value bin_prot_blit_bytes_buf_stub(value v_src_pos, value v_str,
+ value v_dst_pos, value v_buf,
+ value v_len) {
unsigned char *str = Bytes_val(v_str) + Long_val(v_src_pos);
char *buf = get_buf(v_buf, v_dst_pos);
- memcpy(buf, str, (size_t) Long_val(v_len));
+ memcpy(buf, str, (size_t)Long_val(v_len));
return Val_unit;
}
-CAMLprim value bin_prot_blit_buf_bytes_stub(
- value v_src_pos, value v_buf, value v_dst_pos, value v_str, value v_len)
-{
+CAMLprim value bin_prot_blit_buf_bytes_stub(value v_src_pos, value v_buf,
+ value v_dst_pos, value v_str,
+ value v_len) {
char *buf = get_buf(v_buf, v_src_pos);
unsigned char *str = Bytes_val(v_str) + Long_val(v_dst_pos);
- memcpy(str, buf, (size_t) Long_val(v_len));
+ memcpy(str, buf, (size_t)Long_val(v_len));
return Val_unit;
}
-CAMLprim value bin_prot_blit_buf_stub(
- value v_src_pos, value v_src, value v_dst_pos, value v_dst, value v_len)
-{
+CAMLprim value bin_prot_blit_buf_stub(value v_src_pos, value v_src,
+ value v_dst_pos, value v_dst,
+ value v_len) {
struct caml_ba_array *ba_src = Caml_ba_array_val(v_src);
struct caml_ba_array *ba_dst = Caml_ba_array_val(v_dst);
- char *src = (char *) ba_src->data + Long_val(v_src_pos);
- char *dst = (char *) ba_dst->data + Long_val(v_dst_pos);
- size_t len = (size_t) Long_val(v_len);
- if
- (
- unlikely(len > 65536)
- || unlikely(((ba_src->flags & CAML_BA_MAPPED_FILE) != 0))
- || unlikely(((ba_dst->flags & CAML_BA_MAPPED_FILE) != 0))
- )
+ char *src = (char *)ba_src->data + Long_val(v_src_pos);
+ char *dst = (char *)ba_dst->data + Long_val(v_dst_pos);
+ size_t len = (size_t)Long_val(v_len);
+ if (unlikely(len > 65536) ||
+ unlikely(((ba_src->flags & CAML_BA_MAPPED_FILE) != 0)) ||
+ unlikely(((ba_dst->flags & CAML_BA_MAPPED_FILE) != 0)))
/* use [memmove] rather than [memcpy] because src and dst may overlap */
{
Begin_roots2(v_src, v_dst);
caml_enter_blocking_section();
- memmove(dst, src, len);
+ memmove(dst, src, len);
caml_leave_blocking_section();
End_roots();
- }
- else memmove(dst, src, len);
+ } else
+ memmove(dst, src, len);
return Val_unit;
}
-CAMLprim value bin_prot_blit_float_array_buf_stub(
- value v_src_pos, value v_arr, value v_dst_pos, value v_buf, value v_len)
-{
- char *arr = (char*)v_arr + Long_val(v_src_pos) * sizeof(double);
+CAMLprim value bin_prot_blit_float_array_buf_stub(value v_src_pos, value v_arr,
+ value v_dst_pos, value v_buf,
+ value v_len) {
+ char *arr = (char *)v_arr + Long_val(v_src_pos) * sizeof(double);
char *buf = get_buf(v_buf, v_dst_pos);
- memcpy(buf, arr, (size_t) (Long_val(v_len) * sizeof(double)));
+ memcpy(buf, arr, (size_t)(Long_val(v_len) * sizeof(double)));
return Val_unit;
}
-CAMLprim value bin_prot_blit_buf_float_array_stub(
- value v_src_pos, value v_buf, value v_dst_pos, value v_arr, value v_len)
-{
+CAMLprim value bin_prot_blit_buf_float_array_stub(value v_src_pos, value v_buf,
+ value v_dst_pos, value v_arr,
+ value v_len) {
char *buf = get_buf(v_buf, v_src_pos);
- char *arr = (char*)v_arr + Long_val(v_dst_pos) * sizeof(double);
- memcpy(arr, buf, (size_t) (Long_val(v_len) * sizeof(double)));
+ char *arr = (char *)v_arr + Long_val(v_dst_pos) * sizeof(double);
+ memcpy(arr, buf, (size_t)(Long_val(v_len) * sizeof(double)));
return Val_unit;
}
diff --git a/xen/cflags.sh b/xen/cflags.sh
index 61014fa..13b624d 100755
--- a/xen/cflags.sh
+++ b/xen/cflags.sh
@@ -1,4 +1,4 @@
#!/bin/sh
set -e -o pipefail
-flags="`pkg-config --static mirage-xen --cflags`"
+flags="$(pkg-config --static mirage-xen --cflags)"
echo "($flags)"
More details
Historical runs
- missing-ocaml-package: Missing OCaml package: ppx_stable_witness.stable_witness
- nothing-to-do: Last upstream version 0.15.0 already imported.
- success: Merged new upstream version 0.15.0
- push-failed: Failed to push result branch: Connection closed: Connection closed early The remote server unexpectedly closed the connection.