pax_global_header00006660000000000000000000000064146567355220014531gustar00rootroot0000000000000052 comment=3e14ad7e3e1f44ae7a59636d7e575c9d715efedc ocaml_intrinsics_kernel-0.17.1/000077500000000000000000000000001465673552200165175ustar00rootroot00000000000000ocaml_intrinsics_kernel-0.17.1/.gitignore000066400000000000000000000000411465673552200205020ustar00rootroot00000000000000_build *.install *.merlin _opam ocaml_intrinsics_kernel-0.17.1/.ocamlformat000066400000000000000000000000231465673552200210170ustar00rootroot00000000000000profile=janestreet ocaml_intrinsics_kernel-0.17.1/CONTRIBUTING.md000066400000000000000000000044101465673552200207470ustar00rootroot00000000000000This repository contains open source software that is developed and maintained by [Jane Street][js]. Contributions to this project are welcome and should be submitted via GitHub pull requests. Signing contributions --------------------- We require that you sign your contributions. Your signature certifies that you wrote the patch or otherwise have the right to pass it on as an open-source patch. The rules are pretty simple: if you can certify the below (from [developercertificate.org][dco]): ``` Developer Certificate of Origin Version 1.1 Copyright (C) 2004, 2006 The Linux Foundation and its contributors. 1 Letterman Drive Suite D4700 San Francisco, CA, 94129 Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Developer's Certificate of Origin 1.1 By making a contribution to this project, I certify that: (a) The contribution was created in whole or in part by me and I have the right to submit it under the open source license indicated in the file; or (b) The contribution is based upon previous work that, to the best of my knowledge, is covered under an appropriate open source license and I have the right under that license to submit that work with modifications, whether created in whole or in part by me, under the same open source license (unless I am permitted to submit under a different license), as indicated in the file; or (c) The contribution was provided directly to me by some other person who certified (a), (b) or (c) and I have not modified it. (d) I understand and agree that this project and the contribution are public and that a record of the contribution (including all personal information I submit with it, including my sign-off) is maintained indefinitely and may be redistributed consistent with this project or the open source license(s) involved. ``` Then you just add a line to every git commit message: ``` Signed-off-by: Joe Smith ``` Use your real name (sorry, no pseudonyms or anonymous contributions.) If you set your `user.name` and `user.email` git configs, you can sign your commit automatically with git commit -s. [dco]: http://developercertificate.org/ [js]: https://opensource.janestreet.com/ ocaml_intrinsics_kernel-0.17.1/LICENSE.md000066400000000000000000000021461465673552200201260ustar00rootroot00000000000000The MIT License Copyright (c) 2020--2024 Jane Street Group, LLC Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ocaml_intrinsics_kernel-0.17.1/Makefile000066400000000000000000000004031465673552200201540ustar00rootroot00000000000000INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) default: dune build install: dune install $(INSTALL_ARGS) uninstall: dune uninstall $(INSTALL_ARGS) reinstall: uninstall install clean: dune clean .PHONY: default install uninstall reinstall clean ocaml_intrinsics_kernel-0.17.1/README.md000066400000000000000000000007321465673552200200000ustar00rootroot00000000000000ocaml_intrinsics_kernel - a library of intrinsics for OCaml =========================================================== The ocaml_intrinsics_kernel library provides an OCaml interface to operations that have dedicated hardware instructions on some micro-architectures. Currently, it provides the following operations: * conditional select See ocaml_intrinsics for details. Unlike ocaml_intrinsics, ocaml_intrinsics_kernel can be used by programs compiled to javascript. ocaml_intrinsics_kernel-0.17.1/bench/000077500000000000000000000000001465673552200175765ustar00rootroot00000000000000ocaml_intrinsics_kernel-0.17.1/bench/bench.ml000066400000000000000000000117471465673552200212210ustar00rootroot00000000000000open! Base module I = Ocaml_intrinsics_kernel let%bench_module "Overheads" = (module struct (* Using [%bench_fun] to bind the input outside the benchmarked code actually has less overhead then using [%bench] naively. *) let%bench_fun "int overhead" = let n = Sys.opaque_identity (Random.int Int.max_value) in fun () -> Fn.id n ;; let%bench_fun "int64 overhead" = let n = Sys.opaque_identity (Random.int64 Int64.max_value) in fun () -> Fn.id n ;; let%bench_fun "int32 overhead" = let n = Sys.opaque_identity (Random.int32 Int32.max_value) in fun () -> Fn.id n ;; let%bench_fun "nativeint overhead" = let n = Sys.opaque_identity (Random.nativeint Nativeint.max_value) in fun () -> Fn.id n ;; end) ;; let%bench_module "Clz" = (module struct (* ocaml_intrinsics library *) let%bench_fun "int_clz" = let n = Sys.opaque_identity (Random.int Int.max_value) in fun () -> I.Int.count_leading_zeros n ;; let%bench_fun "int_clz2" = let n = Sys.opaque_identity (Random.int Int.max_value) in fun () -> I.Int.count_leading_zeros2 n ;; let%bench_fun "int64_clz" = let n = Sys.opaque_identity (Random.int64 Int64.max_value) in fun () -> I.Int64.count_leading_zeros n ;; let%bench_fun "nativeint_clz" = let n = Sys.opaque_identity (Random.nativeint Nativeint.max_value) in fun () -> I.Nativeint.count_leading_zeros n ;; let%bench_fun "int32_clz" = let n = Sys.opaque_identity (Random.int32 Int32.max_value) in fun () -> I.Int32.count_leading_zeros n ;; (* Base *) let%bench_fun "base int_clz" = let n = Sys.opaque_identity (Random.int Int.max_value) in fun () -> Base.Int.clz n ;; let%bench_fun "base int64_clz" = let n = Sys.opaque_identity (Random.int64 Int64.max_value) in fun () -> Base.Int64.clz n ;; let%bench_fun "base nativeint_clz" = let n = Sys.opaque_identity (Random.nativeint Nativeint.max_value) in fun () -> Base.Nativeint.clz n ;; let%bench_fun "base int32_clz" = let n = Sys.opaque_identity (Random.int32 Int32.max_value) in fun () -> Base.Int32.clz n ;; end) ;; let%bench_module "Ctz" = (module struct (* ocaml_intrinsics library *) let%bench_fun "int_ctz" = let n = Sys.opaque_identity (Random.int Int.max_value) in fun () -> I.Int.count_trailing_zeros n ;; let%bench_fun "int64_ctz" = let n = Sys.opaque_identity (Random.int64 Int64.max_value) in fun () -> I.Int64.count_trailing_zeros n ;; let%bench_fun "nativeint_ctz" = let n = Sys.opaque_identity (Random.nativeint Nativeint.max_value) in fun () -> I.Nativeint.count_trailing_zeros n ;; let%bench_fun "int32_ctz" = let n = Sys.opaque_identity (Random.int32 Int32.max_value) in fun () -> I.Int32.count_trailing_zeros n ;; (* Base *) let%bench_fun "base int_ctz" = let n = Sys.opaque_identity (Random.int Int.max_value) in fun () -> Base.Int.ctz n ;; let%bench_fun "base int64_ctz" = let n = Sys.opaque_identity (Random.int64 Int64.max_value) in fun () -> Base.Int64.ctz n ;; let%bench_fun "base nativeint_ctz" = let n = Sys.opaque_identity (Random.nativeint Nativeint.max_value) in fun () -> Base.Nativeint.ctz n ;; let%bench_fun "base int32_ctz" = let n = Sys.opaque_identity (Random.int32 Int32.max_value) in fun () -> Base.Int32.ctz n ;; end) ;; let%bench_module "Popcnt" = (module struct (* ocaml_intrinsics library *) let%bench_fun "int_popcount" = let n = Sys.opaque_identity (Random.int Int.max_value) in fun () -> I.Int.count_set_bits n ;; let%bench_fun "int_popcount2" = let n = Sys.opaque_identity (Random.int Int.max_value) in fun () -> I.Int.count_set_bits2 n ;; let%bench_fun "int64_popcount" = let n = Sys.opaque_identity (Random.int64 Int64.max_value) in fun () -> I.Int64.count_set_bits n ;; let%bench_fun "nativeint_popcount" = let n = Sys.opaque_identity (Random.nativeint Nativeint.max_value) in fun () -> I.Nativeint.count_set_bits n ;; let%bench_fun "int32_popcount" = let n = Sys.opaque_identity (Random.int32 Int32.max_value) in fun () -> I.Int32.count_set_bits n ;; (* Base *) let%bench_fun "base int_popcount" = let n = Sys.opaque_identity (Random.int Int.max_value) in fun () -> Base.Int.popcount n ;; let%bench_fun "base int64_popcount" = let n = Sys.opaque_identity (Random.int64 Int64.max_value) in fun () -> Base.Int64.popcount n ;; let%bench_fun "base nativeint_popcount" = let n = Sys.opaque_identity (Random.nativeint Nativeint.max_value) in fun () -> Base.Nativeint.popcount n ;; let%bench_fun "base int32_popcount" = let n = Sys.opaque_identity (Random.int32 Int32.max_value) in fun () -> Base.Int32.popcount n ;; end) ;; ocaml_intrinsics_kernel-0.17.1/bench/bench.mli000066400000000000000000000000551465673552200213600ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ocaml_intrinsics_kernel-0.17.1/bench/dune000066400000000000000000000002711465673552200204540ustar00rootroot00000000000000(library (name ocaml_intrinsics_kernel_bench) (libraries ocaml_intrinsics_kernel ppx_bench.runtime-lib ppx_expect.runtime ppx_module_timer.runtime) (preprocess (pps ppx_jane))) ocaml_intrinsics_kernel-0.17.1/dune-project000066400000000000000000000000211465673552200210320ustar00rootroot00000000000000(lang dune 3.11) ocaml_intrinsics_kernel-0.17.1/ocaml_intrinsics_kernel.opam000066400000000000000000000014761465673552200243050ustar00rootroot00000000000000opam-version: "2.0" version: "v0.17.1" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/ocaml_intrinsics_kernel" bug-reports: "https://github.com/janestreet/ocaml_intrinsics_kernel/issues" dev-repo: "git+https://github.com/janestreet/ocaml_intrinsics_kernel.git" doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ocaml_intrinsics_kernel/index.html" license: "MIT" build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ "ocaml" {>= "5.1.0"} "dune" {>= "3.11.0"} ] available: arch != "arm32" & arch != "x86_32" synopsis: "Intrinsics" description: " Provides functions to invoke amd64 instructions (such as cmov, min/maxsd, popcnt) when available, or compatible software implementation on other targets. See also ocaml_intrinsics library. " ocaml_intrinsics_kernel-0.17.1/src/000077500000000000000000000000001465673552200173065ustar00rootroot00000000000000ocaml_intrinsics_kernel-0.17.1/src/common.ml000066400000000000000000000004361465673552200211330ustar00rootroot00000000000000let available = match Sys.backend_type with | Native -> (* (match Sys.unix with * | false -> false * | true -> * (match Sys.architecture with * | "amd64" | "arm64" -> true * | _ -> false)) *) Sys.unix | Bytecode | Other _ -> false ;; ocaml_intrinsics_kernel-0.17.1/src/common.mli000066400000000000000000000003431465673552200213010ustar00rootroot00000000000000(** Are optimized C stubs available? If not, naive implementation will be used. The value is statically known and depends on the current compiler's configuration (system, target, architecture). *) val available : bool ocaml_intrinsics_kernel-0.17.1/src/conditional.ml000066400000000000000000000024151465673552200221450ustar00rootroot00000000000000(** [select_value c a b] is equivalent to [if c then a else b)] where [a] and [b] are eagerly evaluated, regardless of the value of [c]. Compiles to CMOV instruction on amd64 targets. Can be used to avoid branch misprediction when [c] is data dependent. *) external select_value : bool -> ('a[@local_opt]) -> ('a[@local_opt]) -> ('a[@local_opt]) = "caml_csel_value" [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] external select_int : bool -> (int[@untagged]) -> (int[@untagged]) -> (int[@untagged]) = "caml_csel_value" "caml_csel_int_untagged" [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] external select_int64 : bool -> (int64[@unboxed]) -> (int64[@unboxed]) -> (int64[@unboxed]) = "caml_csel_value" "caml_csel_int64_unboxed" [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] external select_int32 : bool -> (int32[@unboxed]) -> (int32[@unboxed]) -> (int32[@unboxed]) = "caml_csel_value" "caml_csel_int32_unboxed" [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] external select_nativeint : bool -> (nativeint[@unboxed]) -> (nativeint[@unboxed]) -> (nativeint[@unboxed]) = "caml_csel_value" "caml_csel_nativeint_unboxed" [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] ocaml_intrinsics_kernel-0.17.1/src/conditional_stubs.c000066400000000000000000000012151465673552200231740ustar00rootroot00000000000000#include "caml/mlvalues.h" intnat caml_csel_int_untagged(value v_cond, intnat ifso, intnat ifnot) { return (Bool_val(v_cond) ? ifso : ifnot); } uint64_t caml_csel_int64_unboxed(value v_cond, uint64_t ifso, uint64_t ifnot) { return (Bool_val(v_cond) ? ifso : ifnot); } uint32_t caml_csel_int32_unboxed(value v_cond, uint32_t ifso, uint32_t ifnot) { return (Bool_val(v_cond) ? ifso : ifnot); } intnat caml_csel_nativeint_unboxed(value v_cond, intnat ifso, intnat ifnot) { return (Bool_val(v_cond) ? ifso : ifnot); } CAMLprim value caml_csel_value(value v_cond, value v_true, value v_false) { return (Bool_val(v_cond) ? v_true : v_false); } ocaml_intrinsics_kernel-0.17.1/src/dune000066400000000000000000000003761465673552200201720ustar00rootroot00000000000000(library (foreign_stubs (language c) (names conditional_stubs int_stubs float_stubs)) (name ocaml_intrinsics_kernel) (public_name ocaml_intrinsics_kernel) (libraries) (js_of_ocaml (javascript_files runtime.js)) (preprocess no_preprocessing)) ocaml_intrinsics_kernel-0.17.1/src/float.ml000066400000000000000000000006231465673552200207460ustar00rootroot00000000000000external min : (float[@unboxed]) -> (float[@unboxed]) -> (float[@unboxed]) = "caml_sse2_float64_min_bytecode" "caml_sse2_float64_min" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] external max : (float[@unboxed]) -> (float[@unboxed]) -> (float[@unboxed]) = "caml_sse2_float64_max_bytecode" "caml_sse2_float64_max" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] ocaml_intrinsics_kernel-0.17.1/src/float.mli000066400000000000000000000016731465673552200211250ustar00rootroot00000000000000(* X86 docs say: If only one value is a NaN (SNaN or QNaN) for this instruction, the second source operand, either a NaN or a valid floating-point value is written to the result. So we have to be VERY careful how we use these! *) (** Equivalent to [if x < y then x else y]. On an x86-64 machine, this compiles to [minsd xmm0, xmm1]. On ARM, this calls a C implementation. *) external min : (float[@unboxed]) -> (float[@unboxed]) -> (float[@unboxed]) = "caml_sse2_float64_min_bytecode" "caml_sse2_float64_min" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** Equivalent to [if x > y then x else y]. On an x86-64 machine, this compiles to [maxsd xmm0, xmm1]. On ARM, this calls a C implementation. *) external max : (float[@unboxed]) -> (float[@unboxed]) -> (float[@unboxed]) = "caml_sse2_float64_max_bytecode" "caml_sse2_float64_max" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] ocaml_intrinsics_kernel-0.17.1/src/float_stubs.c000066400000000000000000000020571465673552200220030ustar00rootroot00000000000000#include #include #include #include #if defined(__SSE2__) || defined(_MSC_VER) #ifdef _MSC_VER #include #else // _MSC_VER #include #endif // _MSC_VER double caml_sse2_float64_min(double x, double y) { return _mm_cvtsd_f64(_mm_min_sd(_mm_set_sd(x), _mm_set_sd(y))); } double caml_sse2_float64_max(double x, double y) { return _mm_cvtsd_f64(_mm_max_sd(_mm_set_sd(x), _mm_set_sd(y))); } #else // __SSE2__ || _MSC_VER #include #if defined(__GNUC__) __attribute__((optimize("no-math-errno"))) #endif double caml_sse2_float64_min(double x, double y) { return x < y ? x : y; } double caml_sse2_float64_max(double x, double y) { return x > y ? x : y; } #endif // __SSE2__ CAMLprim value caml_sse2_float64_min_bytecode(value x, value y) { return caml_copy_double(caml_sse2_float64_min(Double_val(x), Double_val(y))); } CAMLprim value caml_sse2_float64_max_bytecode(value x, value y) { return caml_copy_double(caml_sse2_float64_max(Double_val(x), Double_val(y))); } ocaml_intrinsics_kernel-0.17.1/src/int.ml000066400000000000000000000054031465673552200204340ustar00rootroot00000000000000(** The are two version of [count_leading_zeros], [count_set_bits] each, which differ in their native code implementation. The first version takes as input a tagged integer and the second version takes as input an untagged integer. Generally, the first version (that operates on a tagged integer) is faster, but if the integer is already untagged, it may be faster to use the second version. *) module Stubs = struct let available = Common.available (** [count_leading_zeros n] returns the number of most-significant zero bits before the most significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 31 or 63, depending on the target. *) external count_leading_zeros : int -> (int[@untagged]) = "caml_int_clz" "caml_int_clz_tagged_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] external count_leading_zeros2 : int -> int = "caml_int_clz" "caml_int_clz_untagged_to_untagged" [@@untagged] [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** [count_set_bits n] returns the number of bits that are 1 in [n]. *) external count_set_bits : int -> (int[@untagged]) = "caml_int_popcnt" "caml_int_popcnt_tagged_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] external count_set_bits2 : int -> int = "caml_int_popcnt" "caml_int_popcnt_untagged_to_untagged" [@@untagged] [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** [count_trailing_zeros n] returns the number of least-significant zero bits before the least significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 31 or 63, depending on the target. *) external count_trailing_zeros : int -> int = "caml_int_ctz" "caml_int_ctz_untagged_to_untagged" [@@untagged] [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] end module Naive = Naive_ints.Make (struct include Stdlib.Int let bitwidth = Sys.int_size end) let[@inline always] count_leading_zeros n = match Stubs.available with | true -> Stubs.count_leading_zeros n | false -> Naive.count_leading_zeros n ;; let[@inline always] count_leading_zeros2 n = match Stubs.available with | true -> Stubs.count_leading_zeros2 n | false -> Naive.count_leading_zeros n ;; let[@inline always] count_set_bits2 n = match Stubs.available with | true -> Stubs.count_set_bits2 n | false -> Naive.count_set_bits n ;; let[@inline always] count_trailing_zeros n = match Stubs.available with | true -> Stubs.count_trailing_zeros n | false -> Naive.count_trailing_zeros n ;; let[@inline always] count_set_bits n = match Stubs.available with | true -> Stubs.count_set_bits n | false -> Naive.count_set_bits n ;; ocaml_intrinsics_kernel-0.17.1/src/int.mli000066400000000000000000000033171465673552200206070ustar00rootroot00000000000000(** The are two versions of [count_leading_zeros] and [count_set_bits]. They have the same types, but their native code implementations differ. The first version inputs a tagged integer and the second version inputs an untagged integer. Generally, the first version (operating on a tagged integer) is faster, but if the untagged integer is already available in the surrounding context, the second version may be faster. *) (** [count_leading_zeros n] returns the number of most-significant zero bits before the most significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 31 or 63, depending on the target. *) val count_leading_zeros : int -> int (** [count_leading_zeros2 n] computes the same result as [count_leading_zeros n]. The functions only differ in optimizations that the compiler may be able to perform around the call. In particular, the implementation of [count_leading_zeros n] may operate directly on tagged n. *) val count_leading_zeros2 : int -> int (** [count_set_bits n] returns the number of bits that are 1 in [n]. *) val count_set_bits : int -> int (** [count_set_bits2 n] computes the same result as [count_set_bits n]. The functions only differs in optimizations that the compiler may be able to perform around the call. In particular, the implementation of [count_set_bits n] may operate directly on tagged n. *) val count_set_bits2 : int -> int (** [count_trailing_zeros n] returns the number of least-significant zero bits before the least significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 31 or 63, depending on the target. *) val count_trailing_zeros : int -> int ocaml_intrinsics_kernel-0.17.1/src/int32.ml000066400000000000000000000053511465673552200206030ustar00rootroot00000000000000module Stubs = struct let available = Common.available (** [count_leading_zeros n] returns the number of most-significant zero bits before the most significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 32. *) external count_leading_zeros : (int32[@unboxed]) -> (int[@untagged]) = "caml_int32_clz" "caml_int32_clz_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** Same as [count_leading_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. *) external count_leading_zeros_nonzero_arg : (int32[@unboxed]) -> (int[@untagged]) = "caml_int32_clz" "caml_int32_clz_nonzero_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** [count_trailing_zeros n] returns the number of least-significant zero bits before the least significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 32. *) external count_trailing_zeros : (int32[@unboxed]) -> (int[@untagged]) = "caml_int32_ctz" "caml_int32_ctz_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** Same as [count_trailing_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. *) external count_trailing_zeros_nonzero_arg : (int32[@unboxed]) -> (int[@untagged]) = "caml_int32_ctz" "caml_int32_ctz_nonzero_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** [count_set_bits n] returns the number of bits that are 1 in [n]. *) external count_set_bits : (int32[@unboxed]) -> (int[@untagged]) = "caml_int32_popcnt" "caml_int32_popcnt_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] end module Naive = Naive_ints.Make (struct include Stdlib.Int32 let bitwidth = 32 end) let[@inline always] count_leading_zeros n = match Stubs.available with | true -> Stubs.count_leading_zeros n | false -> Naive.count_leading_zeros n ;; let[@inline always] count_leading_zeros_nonzero_arg n = match Stubs.available with | true -> Stubs.count_leading_zeros_nonzero_arg n | false -> Naive.count_leading_zeros n ;; let[@inline always] count_trailing_zeros n = match Stubs.available with | true -> Stubs.count_trailing_zeros n | false -> Naive.count_trailing_zeros n ;; let[@inline always] count_trailing_zeros_nonzero_arg n = match Stubs.available with | true -> Stubs.count_trailing_zeros_nonzero_arg n | false -> Naive.count_trailing_zeros n ;; let[@inline always] count_set_bits n = match Stubs.available with | true -> Stubs.count_set_bits n | false -> Naive.count_set_bits n ;; ocaml_intrinsics_kernel-0.17.1/src/int32.mli000066400000000000000000000023351465673552200207530ustar00rootroot00000000000000(** [count_leading_zeros n] returns the number of most-significant zero bits before the most significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 32. *) val count_leading_zeros : int32 -> int (** Same as [count_leading_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. This is no longer needed when using an flambda-backend compiler, which translates [count_leading_zeros] to LZCNT by default (amd64). *) val count_leading_zeros_nonzero_arg : int32 -> int (** [count_trailing_zeros n] returns the number of least-significant zero bits before the least significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 32. *) val count_trailing_zeros : int32 -> int (** Same as [count_trailing_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. This is no longer needed when using an flambda-backend compiler, which translates [count_trailing_zeros] to TZCNT by default (amd64). *) val count_trailing_zeros_nonzero_arg : int32 -> int (** [count_set_bits n] returns the number of bits that are 1 in [n]. *) val count_set_bits : int32 -> int ocaml_intrinsics_kernel-0.17.1/src/int64.ml000066400000000000000000000053511465673552200206100ustar00rootroot00000000000000module Stubs = struct let available = Common.available (** [count_leading_zeros n] returns the number of most-significant zero bits before the most significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 64. *) external count_leading_zeros : (int64[@unboxed]) -> (int[@untagged]) = "caml_int64_clz" "caml_int64_clz_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** Same as [count_leading_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. *) external count_leading_zeros_nonzero_arg : (int64[@unboxed]) -> (int[@untagged]) = "caml_int64_clz" "caml_int64_clz_nonzero_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** [count_trailing_zeros n] returns the number of least-significant zero bits before the least significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 64. *) external count_trailing_zeros : (int64[@unboxed]) -> (int[@untagged]) = "caml_int64_ctz" "caml_int64_ctz_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** Same as [count_trailing_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. *) external count_trailing_zeros_nonzero_arg : (int64[@unboxed]) -> (int[@untagged]) = "caml_int64_ctz" "caml_int64_ctz_nonzero_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** [count_set_bits n] returns the number of bits that are 1 in [n]. *) external count_set_bits : (int64[@unboxed]) -> (int[@untagged]) = "caml_int64_popcnt" "caml_int64_popcnt_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] end module Naive = Naive_ints.Make (struct include Stdlib.Int64 let bitwidth = 64 end) let[@inline always] count_leading_zeros n = match Stubs.available with | true -> Stubs.count_leading_zeros n | false -> Naive.count_leading_zeros n ;; let[@inline always] count_leading_zeros_nonzero_arg n = match Stubs.available with | true -> Stubs.count_leading_zeros_nonzero_arg n | false -> Naive.count_leading_zeros n ;; let[@inline always] count_trailing_zeros n = match Stubs.available with | true -> Stubs.count_trailing_zeros n | false -> Naive.count_trailing_zeros n ;; let[@inline always] count_trailing_zeros_nonzero_arg n = match Stubs.available with | true -> Stubs.count_trailing_zeros_nonzero_arg n | false -> Naive.count_trailing_zeros n ;; let[@inline always] count_set_bits n = match Stubs.available with | true -> Stubs.count_set_bits n | false -> Naive.count_set_bits n ;; ocaml_intrinsics_kernel-0.17.1/src/int64.mli000066400000000000000000000023351465673552200207600ustar00rootroot00000000000000(** [count_leading_zeros n] returns the number of most-significant zero bits before the most significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 64. *) val count_leading_zeros : int64 -> int (** Same as [count_leading_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. This is no longer needed when using an flambda-backend compiler, which translates [count_leading_zeros] to LZCNT by default (amd64). *) val count_leading_zeros_nonzero_arg : int64 -> int (** [count_trailing_zeros n] returns the number of least-significant zero bits before the least significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 64. *) val count_trailing_zeros : int64 -> int (** Same as [count_trailing_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. This is no longer needed when using an flambda-backend compiler, which translates [count_trailing_zeros] to TZCNT by default (amd64). *) val count_trailing_zeros_nonzero_arg : int64 -> int (** [count_set_bits n] returns the number of bits that are 1 in [n]. *) val count_set_bits : int64 -> int ocaml_intrinsics_kernel-0.17.1/src/int_stubs.c000066400000000000000000000214611465673552200214700ustar00rootroot00000000000000#include "caml/config.h" #include "caml/alloc.h" #include "caml/misc.h" #include "caml/mlvalues.h" #if defined(__GNUC__) #if ARCH_INT32_TYPE == long #define int32_clz __builtin_clzl #define int32_ctz __builtin_ctzl #define int32_popcnt __builtin_popcountl #else /* ARCH_INT32_TYPE == long */ #define int32_clz __builtin_clz #define int32_ctz __builtin_ctz #define int32_popcnt __builtin_popcount #endif /* ARCH_INT32_TYPE == long */ #define int64_clz __builtin_clzll #define int64_ctz __builtin_ctzll #define int64_popcnt __builtin_popcountll #else /* defined(__GNUC__) */ #ifdef _MSC_VER #warning "Functionality on Windows has not been tested" #include #pragma intrinsic(_BitScanReverse) intnat naive_int64_clz(uint64_t v) { unsigned long n; #ifdef ARCH_SIXTYFOUR if (_BitScanReverse64(&n, v)) return 63-n; else return 64; #else /* _BitScanReverse64 is not supported */ if ((v >> 32) == 0) { if (_BitScanReverse(&n,v)) return 63-n; else return 64; } else { _BitScanReverse(&n,(v>>32)); return 31-n; } #endif } intnat naive_int32_clz(uint32_t v) { unsigned long n; if (_BitScanReverse(&n, v)) #ifdef ARCH_SIXTYFOUR return 63 - n; #else return 31 - n; #endif else return 32; } #pragma intrinsic(_BitScanForward) intnat naive_int64_ctz(uint64_t v) { unsigned long n; #ifdef ARCH_SIXTYFOUR if (_BitScanForward64(&n, v)) return n; else return 64; #else /* _BitScanForward64 is not supported */ if ((v << 32) == 0) { if (_BitScanForward(&n,(v>>32))) return n+32; else return 64; } else { _BitScanForward(&n,v); return n; } #endif } intnat naive_int32_ctz(uint32_t v) { unsigned long n; if (_BitScanForward(&n, v)) return n else return 32; } /* _MSVC_ intrinsic for popcnt is not supported on all targets. Use naive version of clz and popcnt from Hacker's Delight. */ intnat naive_int64_popcnt (uint64_t x) { int n = 0; while (x != 0) { n = n + 1; x = x & (x - 1); } return n; } intnat naive_int32_popcnt (uint32_t x) { int n = 0; while (x != 0) { n = n + 1; x = x & (x - 1); } return n; } #define int32_clz naive_int32_clz #define int64_clz naive_int64_clz #define int32_ctz naive_int32_ctz #define int64_ctz naive_int64_ctz #define int32_popcnt naive_int32_popcnt #define int64_popcnt naive_int64_popcnt #elseif /* _MSC_VER */ #error "Target not supported" #endif /* _MSC_VER */ #endif /* defined(__GNUC__) */ #ifdef ARCH_SIXTYFOUR static inline intnat int32_clz_for_64bit(uint32_t v) { return int32_clz(v) - 32; } #undef int32_clz #define int32_clz int32_clz_for_64bit #endif intnat int32_clz_check_for_zero_arg(uint32_t x) { /* builtin_clz on input 0 is undefined */ if (x == 0) return 32; return int32_clz(x); } intnat int64_clz_check_for_zero_arg(uint64_t x) { /* builtin_clz on input 0 is undefined */ if (x == 0) return 64; else return int64_clz(x); } intnat int32_ctz_check_for_zero_arg(uint32_t x) { /* builtin_ctz on input 0 is undefined */ if (x == 0) return 32; else return int32_ctz(x); } intnat int64_ctz_check_for_zero_arg(uint64_t x) { /* builtin_clz on input 0 is undefined */ if (x == 0) return 64; else return int64_ctz(x); } /* Untagging of a negative value shifts in an extra bit. The following code clears the shifted sign bit of the argument. This straightline code is faster than conditional code for checking whether the argument is negative. */ #ifdef ARCH_SIXTYFOUR static inline uint64_t clear_sign_bit(intnat v1) { return ((uint64_t) v1) & ~(1ull << 63); } #else static inline uint32_t clear_sign_bit(intnat v1) { return ((uint32_t) v1) & ~(1ul << 31); } #endif /* Takes an untagged input and returns untagged output. */ intnat caml_int_clz_untagged_to_untagged(intnat v1) { #ifdef ARCH_SIXTYFOUR /* -1 because size of int is 63 not 64 (31 not 32, resp.) */ return int64_clz_check_for_zero_arg(clear_sign_bit(v1))-1; #else return int32_clz_check_for_zero_arg(clear_sign_bit(v1))-1; #endif } /* Takes a tagged input and returns untagged output. */ intnat caml_int_clz_tagged_to_untagged(value v1) { /* Do not use Long_val(v1) conversion, instead preserving the tag. It guarantees that the input to builtin_clz is non-zero, to guard against versions of builtin_clz that are undefined for input 0. The tag does not change the number of leading zeros. */ #ifdef ARCH_SIXTYFOUR return int64_clz((uint64_t)v1); #else return int32_clz((uint32_t)v1); #endif } CAMLprim value caml_int_clz(value v1) { return Val_long(caml_int_clz_tagged_to_untagged(v1)); } /* Takes an untagged input and returns untagged output. */ intnat caml_int_ctz_untagged_to_untagged(intnat v1) { /* 1 at the most-significant bit: it does not change the result, because size of OCaml [int] is 63 not 64 (31 not 32, resp.), and guarantees that the input to ctz is not zero. */ #ifdef ARCH_SIXTYFOUR return int64_ctz( ((uint64_t)v1) | (1ull << 63)); #else return int32_ctz(((uint32_t)v1) | (1ul << 31)); #endif } CAMLprim value caml_int_ctz(value v1) { return Val_long(caml_int_ctz_untagged_to_untagged(Long_val(v1))); } /* Takes untagged int and returns untagged int. */ intnat caml_int_popcnt_untagged_to_untagged(intnat v1) { /* Untagging brought in one more '1' for negative numbers. Clear the shifted sign bit. This implementation is expected to be faster than [popcnt(x) - 1] where x is tag(v1). */ #ifdef ARCH_SIXTYFOUR return int64_popcnt(clear_sign_bit(v1)); #else return int32_popcnt(clear_sign_bit(v1)); #endif } /* Takes tagged int and returns untagged int. */ intnat caml_int_popcnt_tagged_to_untagged(value v1) { /* Need -1 to account for the tag. */ #ifdef ARCH_SIXTYFOUR return int64_popcnt((uint64_t)v1) - 1; #else return int32_popcnt((uint32_t)v1) - 1; #endif } CAMLprim value caml_int_popcnt(value v1) { return Val_long(caml_int_popcnt_tagged_to_untagged(v1)); } intnat caml_int32_clz_unboxed_to_untagged(int32_t v) { return int32_clz_check_for_zero_arg((uint32_t) v); } intnat caml_int32_ctz_unboxed_to_untagged(int32_t v) { return int32_ctz_check_for_zero_arg((uint32_t) v); } intnat caml_int32_clz_nonzero_unboxed_to_untagged(int32_t v) { return int32_clz((uint32_t) v); } intnat caml_int32_ctz_nonzero_unboxed_to_untagged(int32_t v) { return int32_ctz((uint32_t) v); } intnat caml_int32_popcnt_unboxed_to_untagged(int32_t v) { return int32_popcnt((uint32_t) v); } CAMLprim value caml_int32_clz(value v1) { return Val_long(caml_int32_clz_unboxed_to_untagged(Int32_val(v1))); } CAMLprim value caml_int32_ctz(value v1) { return Val_long(caml_int32_ctz_unboxed_to_untagged(Int32_val(v1))); } CAMLprim value caml_int32_popcnt(value v1) { return Val_long(caml_int32_popcnt_unboxed_to_untagged(Int32_val(v1))); } intnat caml_int64_clz_unboxed_to_untagged(int64_t v) { return int64_clz_check_for_zero_arg((uint64_t) v); } intnat caml_int64_ctz_unboxed_to_untagged(int64_t v) { return int64_ctz_check_for_zero_arg((uint64_t) v); } intnat caml_int64_clz_nonzero_unboxed_to_untagged(int64_t v) { return int64_clz((uint64_t) v); } intnat caml_int64_ctz_nonzero_unboxed_to_untagged(int64_t v) { return int64_ctz((uint64_t) v); } intnat caml_int64_popcnt_unboxed_to_untagged(int64_t v) { return int64_popcnt((uint64_t) v); } CAMLprim value caml_int64_clz(value v1) { return Val_long(caml_int64_clz_unboxed_to_untagged(Int64_val(v1))); } CAMLprim value caml_int64_ctz(value v1) { return Val_long(caml_int64_ctz_unboxed_to_untagged(Int64_val(v1))); } CAMLprim value caml_int64_popcnt(value v1) { return Val_long(int64_popcnt(Int64_val(v1))); } int caml_nativeint_clz_unboxed_to_untagged(intnat v) { #ifdef ARCH_SIXTYFOUR return int64_clz_check_for_zero_arg((uint64_t) v); #else return int32_clz_check_for_zero_arg((uint32_t) v); #endif } intnat caml_nativeint_ctz_unboxed_to_untagged(intnat v) { #ifdef ARCH_SIXTYFOUR return int64_ctz_check_for_zero_arg((uint64_t) v); #else return int32_ctz_check_for_zero_arg((uint32_t) v); #endif } int caml_nativeint_clz_nonzero_unboxed_to_untagged(intnat v) { #ifdef ARCH_SIXTYFOUR return int64_clz((uint64_t) v); #else return int32_clz((uint32_t) v); #endif } intnat caml_nativeint_ctz_nonzero_unboxed_to_untagged(intnat v) { #ifdef ARCH_SIXTYFOUR return int64_ctz((uint64_t) v); #else return int32_ctz((uint32_t) v); #endif } intnat caml_nativeint_popcnt_unboxed_to_untagged(intnat v) { #ifdef ARCH_SIXTYFOUR return int64_popcnt((uint64_t) v); #else return int32_popcnt((uint32_t) v); #endif } CAMLprim value caml_nativeint_clz(value v1) { return Val_long(caml_nativeint_clz_unboxed_to_untagged(Int64_val(v1))); } CAMLprim value caml_nativeint_ctz(value v1) { return Val_long(caml_nativeint_ctz_unboxed_to_untagged(Int64_val(v1))); } CAMLprim value caml_nativeint_popcnt(value v1) { return Val_long(caml_nativeint_popcnt_unboxed_to_untagged(Int64_val(v1))); } ocaml_intrinsics_kernel-0.17.1/src/naive_ints.ml000066400000000000000000000030571465673552200220040ustar00rootroot00000000000000module type Intlike = sig type t val logand : t -> t -> t val zero : t val one : t val equal : t -> t -> bool val compare : t -> t -> int val shift_right_logical : t -> int -> t val shift_left : t -> int -> t val bitwidth : int end module Make (Int : Intlike) = struct let least_significant_bit n = Int.logand n Int.one let is_least_significant_bit_set n = let lsb = least_significant_bit n in if Int.equal lsb Int.one then true else if Int.equal lsb Int.zero then false else assert false ;; let is_most_significant_bit_set n = if Int.compare n Int.zero < 0 then true else false let count_trailing_zeros n = let rec loop ~acc ~mask = if is_least_significant_bit_set mask then acc else ( let mask = Int.shift_right_logical mask 1 in let acc = acc + 1 in loop ~mask ~acc) in if Int.equal n Int.zero then Int.bitwidth else loop ~acc:0 ~mask:n ;; let count_leading_zeros n = let rec loop ~acc ~mask = if is_most_significant_bit_set mask then acc else ( let mask = Int.shift_left mask 1 in let acc = acc + 1 in loop ~mask ~acc) in if Int.equal n Int.zero then Int.bitwidth else loop ~acc:0 ~mask:n ;; let count_set_bits n = let rec loop ~acc ~mask = if Int.equal mask Int.zero then acc else ( let acc = if is_least_significant_bit_set mask then acc + 1 else acc in let mask = Int.shift_right_logical mask 1 in loop ~mask ~acc) in loop ~acc:0 ~mask:n ;; end ocaml_intrinsics_kernel-0.17.1/src/naive_ints.mli000066400000000000000000000006671465673552200221610ustar00rootroot00000000000000module type Intlike = sig type t val logand : t -> t -> t val zero : t val one : t val equal : t -> t -> bool val compare : t -> t -> int val shift_right_logical : t -> int -> t val shift_left : t -> int -> t val bitwidth : int end module Make (I : Intlike) : sig (** See documentation of [Int]. *) val count_leading_zeros : I.t -> int val count_set_bits : I.t -> int val count_trailing_zeros : I.t -> int end ocaml_intrinsics_kernel-0.17.1/src/nativeint.ml000066400000000000000000000055621465673552200216510ustar00rootroot00000000000000module Stubs = struct let available = Common.available (** [count_leading_zeros n] returns the number of most-significant zero bits before the most significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 32 or 64, depending on the target. *) external count_leading_zeros : (nativeint[@unboxed]) -> (int[@untagged]) = "caml_nativeint_clz" "caml_nativeint_clz_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** Same as [count_leading_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. *) external count_leading_zeros_nonzero_arg : (nativeint[@unboxed]) -> (int[@untagged]) = "caml_nativeint_clz" "caml_nativeint_clz_nonzero_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** [count_trailing_zeros n] returns the number of least-significant zero bits before the least significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 32 or 64, depending on the target. *) external count_trailing_zeros : (nativeint[@unboxed]) -> (int[@untagged]) = "caml_nativeint_ctz" "caml_nativeint_ctz_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** Same as [count_trailing_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. *) external count_trailing_zeros_nonzero_arg : (nativeint[@unboxed]) -> (int[@untagged]) = "caml_nativeint_ctz" "caml_nativeint_ctz_nonzero_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** [count_set_bits n] returns the number of bits that are 1 in [n]. *) external count_set_bits : (nativeint[@unboxed]) -> (int[@untagged]) = "caml_nativeint_popcnt" "caml_nativeint_popcnt_unboxed_to_untagged" [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] end module Naive = Naive_ints.Make (struct include Stdlib.Nativeint let bitwidth = Sys.word_size end) let[@inline always] count_leading_zeros n = match Stubs.available with | true -> Stubs.count_leading_zeros n | false -> Naive.count_leading_zeros n ;; let[@inline always] count_leading_zeros_nonzero_arg n = match Stubs.available with | true -> Stubs.count_leading_zeros_nonzero_arg n | false -> Naive.count_leading_zeros n ;; let[@inline always] count_trailing_zeros n = match Stubs.available with | true -> Stubs.count_trailing_zeros n | false -> Naive.count_trailing_zeros n ;; let[@inline always] count_trailing_zeros_nonzero_arg n = match Stubs.available with | true -> Stubs.count_trailing_zeros_nonzero_arg n | false -> Naive.count_trailing_zeros n ;; let[@inline always] count_set_bits n = match Stubs.available with | true -> Stubs.count_set_bits n | false -> Naive.count_set_bits n ;; ocaml_intrinsics_kernel-0.17.1/src/nativeint.mli000066400000000000000000000024571465673552200220220ustar00rootroot00000000000000(** [count_leading_zeros n] returns the number of most-significant zero bits before the most significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 32 or 64, depending on the target. *) val count_leading_zeros : nativeint -> int (** Same as [count_leading_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. This is no longer needed when using an flambda-backend compiler, which translates [count_leading_zeros] to LZCNT by default (amd64). *) val count_leading_zeros_nonzero_arg : nativeint -> int (** [count_trailing_zeros n] returns the number of least-significant zero bits before the least significant set bit in [n]. If [n] is 0, the result is the number of bits in [n], that is 32 or 64, depending on the target. *) val count_trailing_zeros : nativeint -> int (** Same as [count_trailing_zeros] except if the argument is zero, then the result is undefined. Emits more efficient code. This is no longer needed when using an flambda-backend compiler, which translates [count_trailing_zeros] to TZCNT by default (amd64). *) val count_trailing_zeros_nonzero_arg : nativeint -> int (** [count_set_bits n] returns the number of bits that are 1 in [n]. *) val count_set_bits : nativeint -> int ocaml_intrinsics_kernel-0.17.1/src/runtime.js000066400000000000000000000005721465673552200213330ustar00rootroot00000000000000//Provides: caml_csel_value function caml_csel_value(v_cond, v_true, v_false) { if (v_cond) return v_true; else return v_false; } //Provides: caml_sse2_float64_min_bytecode function caml_sse2_float64_min_bytecode(x, y) { return x < y ? x : y; } //Provides: caml_sse2_float64_max_bytecode function caml_sse2_float64_max_bytecode(x, y) { return x > y ? x : y; } ocaml_intrinsics_kernel-0.17.1/test/000077500000000000000000000000001465673552200174765ustar00rootroot00000000000000ocaml_intrinsics_kernel-0.17.1/test/dune000066400000000000000000000004731465673552200203600ustar00rootroot00000000000000(library (name ocaml_intrinsics_kernel_test) (preprocessor_deps config.h) (libraries ocaml_intrinsics_kernel ppx_bench.runtime-lib ppx_expect.runtime ppx_module_timer.runtime) (preprocess (pps ppx_jane ppx_optcomp))) (rule (targets config.h) (deps) (action (bash "cp %{lib:jst-config:config.h} ."))) ocaml_intrinsics_kernel-0.17.1/test/test_clz.ml000066400000000000000000000072451465673552200216670ustar00rootroot00000000000000[%%import "config.h"] open Base open Stdio module I = Ocaml_intrinsics_kernel let test ~op ~op_name ~to_string x = printf "%s %s = %d\n" op_name (to_string x) (op x) let%expect_test "clz int64" = let open Int64 in let numbers = [ 0L (* Int.num_bits *) ; 1L (* Int.num_bits - 1 *) ; 7L (* Int.num_bits - 3 *) ; max_value ; min_value ; -1L ] in let f = test ~op:I.Int64.count_leading_zeros ~op_name:"clz" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| clz 0x0 = 64 clz 0x1 = 63 clz 0x7 = 61 clz 0x7fff_ffff_ffff_ffff = 1 clz -0x8000_0000_0000_0000 = 0 clz -0x1 = 0 |}] ;; let%expect_test "clz int32" = let open Int32 in let numbers = [ 0l (* Int.num_bits *) ; 1l (* Int.num_bits - 1 *) ; 7l (* Int.num_bits - 3 *) ; max_value ; min_value ; -1l ] in let f = test ~op:I.Int32.count_leading_zeros ~op_name:"clz" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| clz 0x0 = 32 clz 0x1 = 31 clz 0x7 = 29 clz 0x7fff_ffff = 1 clz -0x8000_0000 = 0 clz -0x1 = 0 |}] ;; [%%ifdef JSC_ARCH_SIXTYFOUR] let%expect_test "clz int" = let open Int in let numbers = [ 0 (* Int.num_bits *) ; 1 (* Int.num_bits - 1 *) ; 7 (* Int.num_bits - 3 *) ; max_value ; min_value ; -1 ] in let f = test ~op:I.Int.count_leading_zeros ~op_name:"clz" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| clz 0x0 = 63 clz 0x1 = 62 clz 0x7 = 60 clz 0x3fff_ffff_ffff_ffff = 1 clz -0x4000_0000_0000_0000 = 0 clz -0x1 = 0 |}]; let f = test ~op:I.Int.count_leading_zeros2 ~op_name:"clz2" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| clz2 0x0 = 63 clz2 0x1 = 62 clz2 0x7 = 60 clz2 0x3fff_ffff_ffff_ffff = 1 clz2 -0x4000_0000_0000_0000 = 0 clz2 -0x1 = 0 |}] ;; let%expect_test "clz nativeint" = let open Nativeint in let numbers = [ 0n (* Int.num_bits *) ; 1n (* Int.num_bits - 1 *) ; 7n (* Int.num_bits - 3 *) ; max_value ; min_value ; -1n ] in let f = test ~op:I.Nativeint.count_leading_zeros ~op_name:"clz" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| clz 0x0 = 64 clz 0x1 = 63 clz 0x7 = 61 clz 0x7fff_ffff_ffff_ffff = 1 clz -0x8000_0000_0000_0000 = 0 clz -0x1 = 0 |}] ;; [%%else] let%expect_test "clz int" = let open Int in let numbers = [ 0 (* Int.num_bits *) ; 1 (* Int.num_bits - 1 *) ; 7 (* Int.num_bits - 3 *) ; max_value ; min_value ; -1 ] in let f = test ~op:I.Int.count_leading_zeros ~op_name:"clz" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| clz 0x0 = 31 clz 0x1 = 30 clz 0x7 = 28 clz 0x3fff_ffff = 1 clz -0x4000_0000 = 0 clz -0x1 = 0 |}]; let f = test ~op:I.Int.count_leading_zeros2 ~op_name:"clz2" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| clz2 0x0 = 31 clz2 0x1 = 30 clz2 0x7 = 28 clz2 0x3fff_ffff = 1 clz2 -0x4000_0000 = 0 clz2 -0x1 = 0 |}] ;; let%expect_test "clz nativeint" = let open Nativeint in let numbers = [ 0n (* Int.num_bits *) ; 1n (* Int.num_bits - 1 *) ; 7n (* Int.num_bits - 3 *) ; max_value ; min_value ; -1n ] in let f = test ~op:I.Nativeint.count_leading_zeros ~op_name:"clz" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| clz 0x0 = 32 clz 0x1 = 31 clz 0x7 = 29 clz 0x7fff_ffff = 1 clz -0x8000_0000 = 0 clz -0x1 = 0 |}] ;; [%%endif] ocaml_intrinsics_kernel-0.17.1/test/test_clz.mli000066400000000000000000000000551465673552200220300ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ocaml_intrinsics_kernel-0.17.1/test/test_csel.ml000066400000000000000000000111711465673552200220160ustar00rootroot00000000000000open Base open Stdio module I = Ocaml_intrinsics_kernel.Conditional let%expect_test "csel int" = let inputs = [ 0; 1; 4; 6; 5 ] in List.iter inputs ~f:(fun a -> let expect = if a % 2 = 0 then a else a + 1 in let actual = I.select_value (a % 2 = 0) a (a + 1) in printf "%d %d\n" expect actual); [%expect {| 0 0 2 2 4 4 6 6 6 6 |}] ;; let%expect_test "csel max int value" = let inputs = [ 0, 1; 4, 5 ] in List.iter inputs ~f:(fun (a, b) -> let expect = if a > b then a else b in let actual = I.select_value (a > b) a b in printf "%d %d\n" expect actual); [%expect {| 1 1 5 5 |}] ;; let%expect_test "csel max float value" = let inputs = [ 0.5, Float.neg_infinity; 0.0, 0.1; Float.nan, 5.0 ] in List.iter inputs ~f:(fun (a, b) -> let expect = if Float.(a > b) then a else b in let actual = I.select_value Float.(a > b) a b in printf "%f %f\n" expect actual); [%expect {| 0.500000 0.500000 0.100000 0.100000 5.000000 5.000000 |}] ;; let%expect_test "csel max int untagged" = let inputs = [ 0, 1; 4, 5 ] in List.iter inputs ~f:(fun (a, b) -> let expect = if a > b then a else b in let actual = I.select_int (a > b) a b in printf "%d %d\n" expect actual); [%expect {| 1 1 5 5 |}] ;; let%expect_test "csel max int64 unboxed" = let inputs = [ 0L, 1L; 4L, 5L; Int64.max_value, Int64.min_value ] in List.iter inputs ~f:(fun (a, b) -> let expect = if Int64.(a > b) then a else b in let actual = I.select_int64 Int64.(a > b) a b in printf "%Ld %Ld\n" expect actual); [%expect {| 1 1 5 5 9223372036854775807 9223372036854775807 |}] ;; let%expect_test "csel max int32 unboxed" = let inputs = [ 0l, 1l; 4l, 5l; Int32.max_value, Int32.min_value ] in List.iter inputs ~f:(fun (a, b) -> let expect = if Int32.(a > b) then a else b in let actual = I.select_int32 Int32.(a > b) a b in printf "%ld %ld\n" expect actual); [%expect {| 1 1 5 5 2147483647 2147483647 |}] ;; [%%import "config.h"] [%%ifdef JSC_ARCH_SIXTYFOUR] let%expect_test "csel max nativeint unboxed" = let inputs = [ 0n, 1n; 4n, 5n; Nativeint.max_value, Nativeint.min_value ] in List.iter inputs ~f:(fun (a, b) -> let expect = if Nativeint.(a > b) then a else b in let actual = I.select_nativeint Nativeint.(a > b) a b in printf "%nd %nd\n" expect actual); [%expect {| 1 1 5 5 9223372036854775807 9223372036854775807 |}] ;; [%%else] let%expect_test "csel max nativeint unboxed" = let inputs = [ 0n, 1n; 4n, 5n; Nativeint.max_value, Nativeint.min_value ] in List.iter inputs ~f:(fun (a, b) -> let expect = if Nativeint.(a > b) then a else b in let actual = I.select_nativeint Nativeint.(a > b) a b in printf "%nd %nd\n" expect actual); [%expect {| 1 1 5 5 2147483647 2147483647 |}] ;; [%%endif] let%expect_test "csel sideffects" = let inputs = [ 0, 1; 5, 4 ] in List.iter inputs ~f:(fun (a, b) -> let expect = if a > b then ( printf "hello 0\n"; a) else ( printf "world 0\n"; b) in let actual = I.select_value (a > b) (printf "hello 1\n"; a) (printf "world 1\n"; b) in printf "%d %d\n" expect actual); [%expect {| world 0 world 1 hello 1 1 1 hello 0 world 1 hello 1 5 5 |}] ;; let%expect_test "min extra moves" = (* Currently [min] emits extra moves: * * actual: * * camlT__min_266: * movq %rax, %rdi * movq %rbx, %rax * cmpq %rax, %rdi * cmovl %rdi, %rax * ret * * [min2] is * * camlT__min2_273: * cmpq %rax, %rbx * cmovl %rbx, %rax * ret * ret *) let[@inline never] min (x : int) (y : int) = I.select_value (x < y) x y in let[@inline never] min2 (x : int) (y : int) = I.select_value (y < x) y x in let inputs = [ 0, 1; 5, 4 ] in List.iter inputs ~f:(fun (a, b) -> printf "%d " (min a b); printf "%d\n" (min2 a b)); [%expect {| 0 0 4 4 |}] ;; let%expect_test "float deadcode" = (* Currently [nop_float] emits extra loads, because there is no dead code elimination * after register allocation: * * camlT__nop_float_292: * movsd (%rbx), %xmm0 * movsd (%rax), %xmm1 * ret *) let[@inline never] nop_float (x : float) (y : float) : float = I.select_value Float.(x > y) x x in let inputs = [ 0.5, Float.neg_infinity; 0.0, 0.1; Float.nan, 5.0; Float.infinity, -0.0 ] in List.iter inputs ~f:(fun (a, b) -> printf "%f " (nop_float a b)); [%expect {| 0.500000 0.000000 nan inf |}] ;; ocaml_intrinsics_kernel-0.17.1/test/test_csel.mli000066400000000000000000000000141465673552200221610ustar00rootroot00000000000000(* blank *) ocaml_intrinsics_kernel-0.17.1/test/test_ctz.ml000066400000000000000000000057241465673552200216770ustar00rootroot00000000000000[%%import "config.h"] open Base open Stdio module I = Ocaml_intrinsics_kernel let test ~op ~op_name ~to_string x = printf "%s %s = %d\n" op_name (to_string x) (op x) let numbers = [ 0 (* Int.num_bits *); 1; 7; 2; 4; 12; 18; -1 ] let%expect_test "ctz int64" = let open Int64 in let numbers = List.map numbers ~f:of_int in let f = test ~op:I.Int64.count_trailing_zeros ~op_name:"ctz" ~to_string:Hex.to_string_hum in List.iter ~f (max_value :: min_value :: numbers); [%expect {| ctz 0x7fff_ffff_ffff_ffff = 0 ctz -0x8000_0000_0000_0000 = 63 ctz 0x0 = 64 ctz 0x1 = 0 ctz 0x7 = 0 ctz 0x2 = 1 ctz 0x4 = 2 ctz 0xc = 2 ctz 0x12 = 1 ctz -0x1 = 0 |}] ;; let%expect_test "ctz int32" = let open Int32 in let numbers = List.map numbers ~f:of_int_trunc in let f = test ~op:I.Int32.count_trailing_zeros ~op_name:"ctz" ~to_string:Hex.to_string_hum in List.iter ~f (max_value :: min_value :: numbers); [%expect {| ctz 0x7fff_ffff = 0 ctz -0x8000_0000 = 31 ctz 0x0 = 32 ctz 0x1 = 0 ctz 0x7 = 0 ctz 0x2 = 1 ctz 0x4 = 2 ctz 0xc = 2 ctz 0x12 = 1 ctz -0x1 = 0 |}] ;; [%%ifdef JSC_ARCH_SIXTYFOUR] let%expect_test "ctz int" = let open Int in let f = test ~op:I.Int.count_trailing_zeros ~op_name:"ctz" ~to_string:Hex.to_string_hum in List.iter ~f (max_value :: min_value :: numbers); [%expect {| ctz 0x3fff_ffff_ffff_ffff = 0 ctz -0x4000_0000_0000_0000 = 62 ctz 0x0 = 63 ctz 0x1 = 0 ctz 0x7 = 0 ctz 0x2 = 1 ctz 0x4 = 2 ctz 0xc = 2 ctz 0x12 = 1 ctz -0x1 = 0 |}] ;; let%expect_test "ctz nativeint" = let open Nativeint in let numbers = List.map numbers ~f:of_int in let f = test ~op:I.Nativeint.count_trailing_zeros ~op_name:"ctz" ~to_string:Hex.to_string_hum in List.iter ~f (max_value :: min_value :: numbers); [%expect {| ctz 0x7fff_ffff_ffff_ffff = 0 ctz -0x8000_0000_0000_0000 = 63 ctz 0x0 = 64 ctz 0x1 = 0 ctz 0x7 = 0 ctz 0x2 = 1 ctz 0x4 = 2 ctz 0xc = 2 ctz 0x12 = 1 ctz -0x1 = 0 |}] ;; [%%else] let%expect_test "ctz int" = let open Int in let f = test ~op:I.Int.count_trailing_zeros ~op_name:"ctz" ~to_string:Hex.to_string_hum in List.iter ~f (max_value :: min_value :: numbers); [%expect {| ctz 0x3fff_ffff = 0 ctz -0x4000_0000 = 30 ctz 0x0 = 31 ctz 0x1 = 0 ctz 0x7 = 0 ctz 0x2 = 1 ctz 0x4 = 2 ctz 0xc = 2 ctz 0x12 = 1 ctz -0x1 = 0 |}] ;; let%expect_test "ctz nativeint" = let open Nativeint in let numbers = List.map numbers ~f:of_int in let f = test ~op:I.Nativeint.count_trailing_zeros ~op_name:"ctz" ~to_string:Hex.to_string_hum in List.iter ~f (max_value :: min_value :: numbers); [%expect {| ctz 0x7fff_ffff = 0 ctz -0x8000_0000 = 31 ctz 0x0 = 32 ctz 0x1 = 0 ctz 0x7 = 0 ctz 0x2 = 1 ctz 0x4 = 2 ctz 0xc = 2 ctz 0x12 = 1 ctz -0x1 = 0 |}] ;; [%%endif] ocaml_intrinsics_kernel-0.17.1/test/test_ctz.mli000066400000000000000000000000551465673552200220400ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ocaml_intrinsics_kernel-0.17.1/test/test_float.ml000066400000000000000000000015011465673552200221710ustar00rootroot00000000000000open! Base open! Stdio module I = Ocaml_intrinsics_kernel.Float let%expect_test "min and max" = let args = [ 0., 1. ; 1., 0. ; Float.neg_infinity, Float.infinity ; Float.infinity, Float.neg_infinity ; -0., 0. ; 0., -0. ; Float.nan, 0. ; 0., Float.nan ] in List.iter args ~f:(fun (x, y) -> printf "min %.19g %.19g = %.19g\n" x y (I.min x y)); [%expect {| min 0 1 = 0 min 1 0 = 0 min -inf inf = -inf min inf -inf = -inf min -0 0 = 0 min 0 -0 = -0 min nan 0 = 0 min 0 nan = nan |}]; List.iter args ~f:(fun (x, y) -> printf "max %.19g %.19g = %.19g\n" x y (I.max x y)); [%expect {| max 0 1 = 1 max 1 0 = 1 max -inf inf = inf max inf -inf = inf max -0 0 = 0 max 0 -0 = -0 max nan 0 = 0 max 0 nan = nan |}] ;; ocaml_intrinsics_kernel-0.17.1/test/test_float.mli000066400000000000000000000000551465673552200223450ustar00rootroot00000000000000(*_ This signature is deliberately empty. *) ocaml_intrinsics_kernel-0.17.1/test/test_popcnt.ml000066400000000000000000000065571465673552200224070ustar00rootroot00000000000000[%%import "config.h"] open Base open Stdio module I = Ocaml_intrinsics_kernel let test ~op ~op_name ~to_string x = printf "%s %s = %d\n" op_name (to_string x) (op x) let%expect_test "popcnt int64" = let open Int64 in let numbers = [ 0L; 1L; 7L; max_value; min_value; -1L ] in let f = test ~op:I.Int64.count_set_bits ~op_name:"popcnt" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| popcnt 0x0 = 0 popcnt 0x1 = 1 popcnt 0x7 = 3 popcnt 0x7fff_ffff_ffff_ffff = 63 popcnt -0x8000_0000_0000_0000 = 1 popcnt -0x1 = 64 |}] ;; let%expect_test "popcnt int32" = let open Int32 in let numbers = [ 0l; 1l; 7l; max_value; min_value; -1l ] in let f = test ~op:I.Int32.count_set_bits ~op_name:"popcnt" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| popcnt 0x0 = 0 popcnt 0x1 = 1 popcnt 0x7 = 3 popcnt 0x7fff_ffff = 31 popcnt -0x8000_0000 = 1 popcnt -0x1 = 32 |}] ;; [%%ifdef JSC_ARCH_SIXTYFOUR] let%expect_test "popcnt int" = let open Int in let numbers = [ 0 ; 1 ; 7 ; max_value (* Int.num_bits - 1 *) ; min_value (* 1 *) ; -1 (* Int.num_bits *) ] in let f = test ~op:I.Int.count_set_bits ~op_name:"popcnt" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| popcnt 0x0 = 0 popcnt 0x1 = 1 popcnt 0x7 = 3 popcnt 0x3fff_ffff_ffff_ffff = 62 popcnt -0x4000_0000_0000_0000 = 1 popcnt -0x1 = 63 |}]; let f = test ~op:I.Int.count_set_bits2 ~op_name:"popcnt2" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| popcnt2 0x0 = 0 popcnt2 0x1 = 1 popcnt2 0x7 = 3 popcnt2 0x3fff_ffff_ffff_ffff = 62 popcnt2 -0x4000_0000_0000_0000 = 1 popcnt2 -0x1 = 63 |}] ;; let%expect_test "popcnt nativeint" = let open Nativeint in let numbers = [ 0n; 1n; 7n; max_value; min_value; -1n ] in let f = test ~op:I.Nativeint.count_set_bits ~op_name:"popcnt" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| popcnt 0x0 = 0 popcnt 0x1 = 1 popcnt 0x7 = 3 popcnt 0x7fff_ffff_ffff_ffff = 63 popcnt -0x8000_0000_0000_0000 = 1 popcnt -0x1 = 64 |}] ;; [%%else] let%expect_test "popcnt int" = let open Int in let numbers = [ 0 ; 1 ; 7 ; max_value (* Int.num_bits - 1 *) ; min_value (* 1 *) ; -1 (* Int.num_bits *) ] in let f = test ~op:I.Int.count_set_bits ~op_name:"popcnt" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| popcnt 0x0 = 0 popcnt 0x1 = 1 popcnt 0x7 = 3 popcnt 0x3fff_ffff = 30 popcnt -0x4000_0000 = 1 popcnt -0x1 = 31 |}]; let f = test ~op:I.Int.count_set_bits2 ~op_name:"popcnt2" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| popcnt2 0x0 = 0 popcnt2 0x1 = 1 popcnt2 0x7 = 3 popcnt2 0x3fff_ffff = 30 popcnt2 -0x4000_0000 = 1 popcnt2 -0x1 = 31 |}] ;; let%expect_test "popcnt nativeint" = let open Nativeint in let numbers = [ 0n; 1n; 7n; max_value; min_value; -1n ] in let f = test ~op:I.Nativeint.count_set_bits ~op_name:"popcnt" ~to_string:Hex.to_string_hum in List.iter ~f numbers; [%expect {| popcnt 0x0 = 0 popcnt 0x1 = 1 popcnt 0x7 = 3 popcnt 0x7fff_ffff = 31 popcnt -0x8000_0000 = 1 popcnt -0x1 = 32 |}] ;; [%%endif] ocaml_intrinsics_kernel-0.17.1/test/test_popcnt.mli000066400000000000000000000000551465673552200225430ustar00rootroot00000000000000(*_ This signature is deliberately empty. *)