├── .gitignore ├── .travis.yml ├── CHANGES.md ├── LICENSE ├── Makefile ├── README.md ├── dune-project ├── gen └── gen.ml ├── lib ├── bytes_conv.ml ├── bytes_conv.mli ├── dune ├── float_conv.c ├── infix.ml ├── infix.mli ├── int128.h ├── int128_conv.c ├── int128_stubs.c ├── int16.h ├── int16_conv.c ├── int24.h ├── int24_conv.c ├── int32_conv.c ├── int40.h ├── int40_conv.c ├── int40_stubs.c ├── int48.h ├── int48_conv.c ├── int48_stubs.c ├── int56.h ├── int56_conv.c ├── int56_stubs.c ├── int64_conv.c ├── int8.h ├── int8_conv.c ├── int_conv.c ├── int_wrapper.ml ├── int_wrapper.mli ├── nativeint_conv.c ├── stdint.ml ├── stdint.mli ├── str_conv.ml ├── str_conv.mli ├── uint128.h ├── uint128_conv.c ├── uint128_stubs.c ├── uint16.h ├── uint16_conv.c ├── uint24.h ├── uint24_conv.c ├── uint32.h ├── uint32_conv.c ├── uint32_stubs.c ├── uint40.h ├── uint40_conv.c ├── uint40_stubs.c ├── uint48.h ├── uint48_conv.c ├── uint48_stubs.c ├── uint56.h ├── uint56_conv.c ├── uint56_stubs.c ├── uint64.h ├── uint64_conv.c ├── uint64_stubs.c ├── uint8.h └── uint8_conv.c ├── spec ├── common.ml ├── int128.ml ├── int32.ml ├── uint128.ml ├── uint32.ml └── uint64.ml ├── stdint.opam ├── stdint.opam.template └── tests ├── .gitignore ├── dune └── stdint_test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | .merlin 3 | *.install 4 | *.sw* 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh 3 | script: bash -ex .travis-docker.sh 4 | services: 5 | - docker 6 | env: 7 | global: 8 | - PINS="stdint:." 9 | - DISTRO="ubuntu-16.04" 10 | matrix: 11 | - PACKAGE="stdint" OCAML_VERSION="4.03" 12 | - PACKAGE="stdint" OCAML_VERSION="4.04" 13 | - PACKAGE="stdint" OCAML_VERSION="4.06" 14 | - PACKAGE="stdint" OCAML_VERSION="4.07" 15 | - PACKAGE="stdint" OCAML_VERSION="4.09" 16 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # 0.7.2 (18/10/2022) 2 | 3 | - Fix compatibility with OCaml 5.0 on 32-bits systems (#69, @MisterDA) 4 | - Fix build system, opam file, and documentation (#69, @MisterDA) 5 | 6 | # 0.7.1 (14/10/2022) 7 | 8 | ## Fixes: 9 | 10 | * Fix undefined reference to `get_uint128` (#62) 11 | * Add `[@@noalloc]` where possible (#64) 12 | * Fix compatibility with OCaml 5.0 (#68) 13 | 14 | # 0.7.0 (28/10/2020) 15 | 16 | ## Fixes: 17 | 18 | * Correct conversion from uint24 to other ints (#39, @rixed) 19 | * Fix conversion from all ints to uint24 and int24 (#41, @rixed) 20 | * Fix int24 failing to recover from casts (#43, @rixed) 21 | * Fix sign extensions (#49, @rixed) 22 | * `Long_val` returns `intnat`, previously `long` was used (#53, @dra27) 23 | * Reduce size of marshalled custom values on 4.08+ (#54, @dra27) 24 | * Store 128-bit ints as structs to prevent unaligned access (#55, @dra27) 25 | 26 | ## New features: 27 | 28 | * Add `of_substring` (#49, @darlentar) 29 | 30 | # 0.6.0 (12/3/2019) 31 | 32 | * Speed up generic comparison of int backed types (#34, @rixed) 33 | * Port to dune (#35, @tuncer) 34 | * Move to stdlib from pervasives (#36, @tuncer) 35 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010 Andre Nathan 2 | Jeff Shaw 3 | Copyright (c) 2015 Markus W. Weissmann 4 | Florian Pichlmeier 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in 14 | all copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 22 | THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all build check 2 | 3 | all: build 4 | 5 | build: 6 | dune build 7 | 8 | check: 9 | dune runtest 10 | 11 | opam-release: 12 | dune-release distrib --skip-build --skip-lint --skip-tests 13 | # See https://github.com/ocamllabs/dune-release/issues/206 14 | DUNE_RELEASE_DELEGATE=github-dune-release-delegate dune-release publish distrib --verbose 15 | dune-release opam pkg 16 | dune-release opam submit 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ocaml-stdint 2 | This OCaml library provides integer types having specified widths. 3 | 4 | It provides the following unsigned integer types: 5 | * uint8 6 | * uint16 7 | * uint24 8 | * uint32 9 | * uint40 10 | * uint48 11 | * uint56 12 | * uint64 13 | * uint128 14 | 15 | and the following list of signed integer types: 16 | * int8 17 | * int16 18 | * int24 19 | * int32 (identical to int32 from the base library) 20 | * int40 21 | * int48 22 | * int56 23 | * int64 (identical to int64 from the base library) 24 | * int128 25 | 26 | There is a module for every integer type that implements the Int interface. 27 | This interface is similar to Int32 and Int64 from the base library but provides more functions and constants like 28 | * arithmetic and bit-wise operations 29 | * constants like maximum and minimum value 30 | * infix operators 31 | * conversion to and from every other integer type (including int, float and nativeint) 32 | * parsing from and conversion to readable strings (binary, octal, decimal, hexademical) 33 | * conversion to and from buffers in both big endian and little endian byte order 34 | 35 | The library also comes with C header files that allow easy access to the integer values in C bindings. 36 | The functions are modeled on base of the int32 and int64 access functions provided by the base library. 37 | The semantics of all operations is identical to the Int32, Int64 modules, C, C++, Java etc.: Conversion will silently truncate larger values as will other operations leading to overflowing integer values. 38 | 39 | The [API of stdint](http://stdint.forge.ocamlcore.org/doc/) can be found online at the [OCaml forge](https://forge.ocamlcore.org/). 40 | 41 | To use the integer types, we recommend to ```open Stdint``` but not the individual modules: 42 | ```ocaml 43 | open Stdint 44 | 45 | let _ = 46 | let a = Uint8.of_int 21 in 47 | let x = Uint8.(a * (one + one)) in 48 | print_endline (Uint8.to_string x) 49 | ``` 50 | 51 | The 128 bit integer types are currently only available on 64 bit platforms; the compatibility layer for 32 bit platforms is not yet fully implemented and will raise `Failure` for several functions. 52 | 53 | ## Implementation 54 | 55 | The representation of integers depends on their size: 56 | * Signed integers smaller than the standard integer type are stored in a standard ```int```. They are left-aligned so that most arithmetic operations are just the same as the ones on normal integers. The standard OCaml integer type is 31 bit on 32 bit machines and 63 bit on 64 bit machines. Operations like addition and division require an extra shift; others like xor require an additional mask to keep the unused bits (at the right) at ```0```. 57 | * Unsigned integers smaller than the standard integer types are stored in the standard ```int```, too. They are right-aligned making most arithmetic operations compatible to standard integer operations. Operations like addition require an additional mask operation to keep the unused bits (at the left) at ```0```. 58 | * ```uint32``` and ```uint64``` have their custom in-memory representation implemented in C 59 | * Signed integers larger than the standard integer but smaller than ```int64``` are stored in the latter. The requirements are otherwise identical to small signed integers store in the standard integer. 60 | * Unsigned integers larger than the standard integer but smaller then ```uint64``` are stored in the latter. The requirements are otherwise identical to small unsigned integers store in the standard integer. 61 | * 128 Bit integers have a custom in-memory representation implemented in C. On 64 Bit platforms they use the specialized arithmetic operations provided by the C compiler that are much faster than manual operations, to which a fallback solution exists on 32 Bit platforms. 62 | 63 | ## Copyright 64 | 65 | The stdint library is written by Andre Nathan, Jeff Shaw, [Markus Weissmann](http://www.mweissmann.de) and Florian Pichlmeier. 66 | It is based on the [ocaml-uint](https://github.com/andrenth/ocaml-uint/) library. 67 | 68 | The source-code of stdint is available under the MIT license. 69 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | (name stdint) 3 | 4 | (formatting disabled) 5 | (generate_opam_files true) 6 | 7 | (license MIT) 8 | (maintainers "Markus W. Weissmann ") 9 | (authors 10 | "Andre Nathan " 11 | "Jeff Shaw " 12 | "Markus W. Weissmann " 13 | "Florian Pichlmeier ") 14 | (source (github andrenth/ocaml-stdint)) 15 | (documentation "https://andrenth.github.io/ocaml-stdint/") 16 | 17 | (package 18 | (name stdint) 19 | (synopsis "Signed and unsigned integer types having specified widths") 20 | (description "\ 21 | The stdint library provides signed and unsigned integer types of various fixed 22 | widths: 8, 16, 24, 32, 40, 48, 56, 64 and 128 bit. 23 | 24 | This interface is similar to Int32 and Int64 from the base library but provides 25 | more functions and constants like arithmetic and bit-wise operations, constants 26 | like maximum and minimum values, infix operators conversion to and from every 27 | other integer type (including int, float and nativeint), parsing from and 28 | conversion to readable strings (binary, octal, decimal, hexademical), conversion 29 | to and from buffers in both big endian and little endian byte order.") 30 | (depends 31 | (ocaml (>= 4.03)) 32 | (qcheck :with-test))) 33 | -------------------------------------------------------------------------------- /gen/gen.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | type i = 3 | | N 4 | | I 5 | | F 6 | | I8 7 | | I16 8 | | I24 9 | | I32 10 | | I40 11 | | I48 12 | | I56 13 | | I64 14 | | I128 15 | | U8 16 | | U16 17 | | U24 18 | | U32 19 | | U40 20 | | U48 21 | | U56 22 | | U64 23 | | U128 24 | 25 | let name = function 26 | | N -> "nativeint" 27 | | I -> "int" 28 | | F -> "float" 29 | | I8 -> "int8" 30 | | I16 -> "int16" 31 | | I24 -> "int24" 32 | | I32 -> "int32" 33 | | I40 -> "int40" 34 | | I48 -> "int48" 35 | | I56 -> "int56" 36 | | I64 -> "int64" 37 | | I128 -> "int128" 38 | | U8 -> "uint8" 39 | | U16 -> "uint16" 40 | | U24 -> "uint24" 41 | | U32 -> "uint32" 42 | | U40 -> "uint40" 43 | | U48 -> "uint48" 44 | | U56 -> "uint56" 45 | | U64 -> "uint64" 46 | | U128 -> "uint128" 47 | 48 | let ctype = function 49 | | N -> "int" 50 | | I -> "int" 51 | | F -> "double" 52 | | I8 -> "int8_t" 53 | | I16 -> "int16_t" 54 | | I24 -> "int32_t" 55 | | I32 -> "int32_t" 56 | | I40 -> "int64_t" 57 | | I48 -> "int64_t" 58 | | I56 -> "int64_t" 59 | | I64 -> "int64_t" 60 | | I128 -> "__int128_t" 61 | | U8 -> "uint8_t" 62 | | U16 -> "uint16_t" 63 | | U24 -> "uint32_t" 64 | | U32 -> "uint32_t" 65 | | U40 -> "uint64_t" 66 | | U48 -> "uint64_t" 67 | | U56 -> "uint64_t" 68 | | U64 -> "uint64_t" 69 | | U128 -> "__uint128_t" 70 | 71 | let valf x = let r = match x with 72 | | I -> "Int" 73 | | N -> "Nativeint" 74 | | F -> "Double" 75 | | I8 -> "Int8" 76 | | I16 -> "Int16" 77 | | I24 -> "Int24" 78 | | I32 -> "Int32" 79 | | I40 -> "Int40" 80 | | I48 -> "Int48" 81 | | I56 -> "Int56" 82 | | I64 -> "Int64" 83 | | I128 -> "Int128" 84 | | U8 -> "Uint8" 85 | | U16 -> "Uint16" 86 | | U24 -> "Uint24" 87 | | U32 -> "Uint32" 88 | | U40 -> "Uint40" 89 | | U48 -> "Uint48" 90 | | U56 -> "Uint56" 91 | | U64 -> "Uint64" 92 | | U128 -> "Uint128" 93 | in r ^ "_val" 94 | 95 | let copyf : i -> (('a -> 'b, unit, string) format) = function 96 | | N -> "caml_copy_nativeint(%s)" 97 | | I -> "Val_int(%s)" 98 | | F -> "caml_copy_double(%s)" 99 | | I8 -> "copy_int8(%s)" 100 | | I16 -> "copy_int16(%s)" 101 | | I24 -> "caml_copy_int32((%s) << 8)" 102 | | I32 -> "caml_copy_int32(%s)" 103 | | I40 -> "caml_copy_int64((%s) << 24)" 104 | | I48 -> "caml_copy_int64((%s) << 16)" 105 | | I56 -> "caml_copy_int64((%s) << 8)" 106 | | I64 -> "caml_copy_int64(%s)" 107 | | I128 -> "copy_int128(%s)" 108 | | U8 -> "copy_uint8(%s)" 109 | | U16 -> "copy_uint16(%s)" 110 | | U24 -> "copy_uint32((%s) << 8)" 111 | | U32 -> "copy_uint32(%s)" 112 | | U40 -> "copy_uint64((%s) << 24)" 113 | | U48 -> "copy_uint64((%s) << 16)" 114 | | U56 -> "copy_uint64((%s) << 8)" 115 | | U64 -> "copy_uint64(%s)" 116 | | U128 -> "copy_uint128(%s)" 117 | 118 | let is_base = function 119 | | N | I | F -> true 120 | | _ -> false 121 | 122 | let in_mltypes = function 123 | | N | I | F | I32 | I64 -> true 124 | | _ -> false 125 | 126 | let all_types = [I; N; F; I8; I16; I24; I32; I40; I48; I56; I64; I128; U8; U16; U24; U32; U40; U48; U56; U64; U128] 127 | 128 | let prefix = 129 | let includes1 = 130 | ["assert"; "stdint"; "string"; "inttypes"; "caml/alloc"; "caml/custom"; "caml/fail"; "caml/intext"; "caml/memory"; "caml/mlvalues"] |> 131 | List.fold_left (fun str elt -> Printf.sprintf "%s#include <%s.h>\n" str elt) "" 132 | in 133 | let includes2 = 134 | List.filter (fun x -> not (in_mltypes x)) all_types |> 135 | List.fold_left (fun str elt -> Printf.sprintf "%s#include \"%s.h\"\n" str (name elt)) "" 136 | in 137 | includes1 ^ "\n" ^ includes2 138 | 139 | let f dst src = 140 | if dst = src then "" else 141 | if (is_base dst) && (is_base src) then "" else 142 | let arg = Printf.sprintf "(%s)%s(v)" (ctype dst) (valf src) in 143 | let body = Printf.sprintf (copyf dst) arg in 144 | "CAMLprim value\n" ^ 145 | (Printf.sprintf "%s_of_%s(value v)\n{\n" (name dst) (name src)) ^ 146 | " CAMLparam1(v);\n" ^ 147 | (Printf.sprintf " CAMLreturn (%s);\n}\n\n" body) 148 | 149 | let convc btype = 150 | let filename = (name btype) ^ "_conv.c" in 151 | let oc = open_out filename in 152 | let () = Printf.fprintf oc "%s\n" prefix in 153 | let () = List.iter (fun x -> Printf.fprintf oc "%s" (f btype x)) all_types in 154 | close_out oc 155 | 156 | let conv_of base other : string = 157 | let ofname = if base = other then "%identity" else Printf.sprintf "%s_of_%s" (name base) (name other) in 158 | Printf.sprintf " external of_%-9s : %9s -> %9s = \"%s\"\n" (name other) (name other) (name base) ofname 159 | 160 | let conv_to base other : string = 161 | let ofname = if base = other then "%identity" else Printf.sprintf "%s_of_%s" (name other) (name base) in 162 | Printf.sprintf " external to_%-9s : %9s -> %9s = \"%s\"\n" (name other) (name base) (name other) ofname 163 | 164 | let extml btype = 165 | if is_base btype then () 166 | else 167 | let filename = (name btype) ^ "_conv_ext.ml" in 168 | let oc = open_out filename in 169 | let () = List.iter (fun x -> Printf.fprintf oc "%s" (conv_of btype x)) all_types in 170 | let () = Printf.fprintf oc "\n" in 171 | let () = List.iter (fun x -> Printf.fprintf oc "%s" (conv_to btype x)) all_types in 172 | close_out oc 173 | 174 | let _ = 175 | let () = List.iter extml all_types in 176 | let () = List.iter convc all_types in 177 | () 178 | 179 | -------------------------------------------------------------------------------- /lib/bytes_conv.ml: -------------------------------------------------------------------------------- 1 | module type IntSig = sig 2 | type t 3 | val zero : t 4 | val bits : int 5 | val of_int : int -> t 6 | val to_int : t -> int 7 | val logand : t -> t -> t 8 | val logor : t -> t -> t 9 | val shift_left : t -> int -> t 10 | val shift_right_logical : t -> int -> t 11 | end 12 | 13 | module type S = sig 14 | type t 15 | val of_bytes_big_endian : Bytes.t -> int -> t 16 | val of_bytes_little_endian : Bytes.t -> int -> t 17 | val to_bytes_big_endian : t -> Bytes.t -> int -> unit 18 | val to_bytes_little_endian : t -> Bytes.t -> int -> unit 19 | end 20 | 21 | let int_of_pos buffer offset = Char.code (Bytes.get buffer offset) 22 | 23 | module Make (I : IntSig) = struct 24 | type t = I.t 25 | 26 | let of_bytes_big_endian buffer offset = 27 | let rec loop buffer i n = 28 | if i = (I.bits / 8) then n 29 | else 30 | let b = I.of_int (int_of_pos buffer (offset + i)) in 31 | let n' = I.logor (I.shift_left n 8) b in 32 | loop buffer (i + 1) n' 33 | in 34 | loop buffer 0 I.zero 35 | 36 | let of_bytes_little_endian buffer offset = 37 | let rec loop buffer i n = 38 | if i = 0 then n 39 | else 40 | let b = I.of_int (int_of_pos buffer (offset + i - 1)) in 41 | let n' = I.logor (I.shift_left n 8) b in 42 | loop buffer (i - 1) n' 43 | in 44 | loop buffer (I.bits / 8) I.zero 45 | 46 | let to_bytes_big_endian v buffer offset = 47 | let rec loop buffer i n = 48 | if i = 0 then () 49 | else 50 | let b = Char.unsafe_chr (I.to_int (I.logand (I.of_int 0xFF) n)) in 51 | let () = Bytes.set buffer (offset + i - 1) b in 52 | let n' = I.shift_right_logical n 8 in 53 | loop buffer (i - 1) n' 54 | in 55 | loop buffer (I.bits / 8) v 56 | 57 | let to_bytes_little_endian v buffer offset = 58 | let rec loop buffer i n = 59 | if i = (I.bits / 8) then () 60 | else 61 | let b = Char.unsafe_chr (I.to_int (I.logand (I.of_int 0xFF) n)) in 62 | let () = Bytes.set buffer (offset + i) b in 63 | let n' = I.shift_right_logical n 8 in 64 | loop buffer (i + 1) n' 65 | in 66 | loop buffer 0 v 67 | end 68 | 69 | -------------------------------------------------------------------------------- /lib/bytes_conv.mli: -------------------------------------------------------------------------------- 1 | module type IntSig = sig 2 | type t 3 | val zero : t 4 | val bits : int 5 | val of_int : int -> t 6 | val to_int : t -> int 7 | val logand : t -> t -> t 8 | val logor : t -> t -> t 9 | val shift_left : t -> int -> t 10 | val shift_right_logical : t -> int -> t 11 | end 12 | 13 | module type S = sig 14 | type t 15 | val of_bytes_big_endian : Bytes.t -> int -> t 16 | val of_bytes_little_endian : Bytes.t -> int -> t 17 | val to_bytes_big_endian : t -> Bytes.t -> int -> unit 18 | val to_bytes_little_endian : t -> Bytes.t -> int -> unit 19 | end 20 | 21 | module Make (I : IntSig) : S with type t = I.t 22 | 23 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name stdint) 3 | (public_name stdint) 4 | (synopsis "Standard integer types for OCaml") 5 | (flags (:standard -w -32)) 6 | (install_c_headers 7 | int8 int16 int24 int40 int48 int56 int128 8 | uint8 uint16 uint24 uint32 uint40 uint48 uint56 uint64 uint128) 9 | (foreign_stubs 10 | (language c) 11 | (names 12 | float_conv 13 | int128_conv 14 | int128_stubs 15 | int16_conv 16 | int24_conv 17 | int32_conv 18 | int40_conv 19 | int40_stubs 20 | int48_conv 21 | int48_stubs 22 | int56_conv 23 | int56_stubs 24 | int64_conv 25 | int8_conv 26 | int_conv 27 | nativeint_conv 28 | uint128_conv 29 | uint128_stubs 30 | uint16_conv 31 | uint24_conv 32 | uint32_conv 33 | uint32_stubs 34 | uint40_conv 35 | uint40_stubs 36 | uint48_conv 37 | uint48_stubs 38 | uint56_conv 39 | uint56_stubs 40 | uint64_conv 41 | uint64_stubs 42 | uint8_conv))) 43 | 44 | (rule 45 | (targets Stdint_stdlib_.ml) 46 | (enabled_if (< %{ocaml_version} 4.07)) 47 | (action (with-stdout-to %{targets} (echo "include Pervasives")))) 48 | 49 | (rule 50 | (targets Stdint_stdlib_.ml) 51 | (enabled_if (>= %{ocaml_version} 4.07)) 52 | (action (with-stdout-to %{targets} (echo "include Stdlib")))) 53 | -------------------------------------------------------------------------------- /lib/float_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | float_of_int8(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (caml_copy_double((double)Int8_val(v))); 34 | } 35 | 36 | CAMLprim value 37 | float_of_int16(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (caml_copy_double((double)Int16_val(v))); 41 | } 42 | 43 | CAMLprim value 44 | float_of_int24(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (caml_copy_double((double)Int24_val(v))); 48 | } 49 | 50 | CAMLprim value 51 | float_of_int32(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (caml_copy_double((double)Int32_val(v))); 55 | } 56 | 57 | CAMLprim value 58 | float_of_int40(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (caml_copy_double((double)Int40_val(v))); 62 | } 63 | 64 | CAMLprim value 65 | float_of_int48(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (caml_copy_double((double)Int48_val(v))); 69 | } 70 | 71 | CAMLprim value 72 | float_of_int56(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (caml_copy_double((double)Int56_val(v))); 76 | } 77 | 78 | CAMLprim value 79 | float_of_int64(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (caml_copy_double((double)Int64_val(v))); 83 | } 84 | 85 | CAMLprim value 86 | float_of_int128(value v) 87 | { 88 | CAMLparam1(v); 89 | #ifdef HAVE_INT128 90 | CAMLreturn (caml_copy_double((double)Int128_val(v))); 91 | #else 92 | caml_failwith(__func__); 93 | CAMLreturn(Val_unit); 94 | #endif 95 | } 96 | 97 | CAMLprim value 98 | float_of_uint8(value v) 99 | { 100 | CAMLparam1(v); 101 | CAMLreturn (caml_copy_double((double)Uint8_val(v))); 102 | } 103 | 104 | CAMLprim value 105 | float_of_uint16(value v) 106 | { 107 | CAMLparam1(v); 108 | CAMLreturn (caml_copy_double((double)Uint16_val(v))); 109 | } 110 | 111 | CAMLprim value 112 | float_of_uint24(value v) 113 | { 114 | CAMLparam1(v); 115 | CAMLreturn (caml_copy_double((double)Uint24_val(v))); 116 | } 117 | 118 | CAMLprim value 119 | float_of_uint32(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (caml_copy_double((double)Uint32_val(v))); 123 | } 124 | 125 | CAMLprim value 126 | float_of_uint40(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (caml_copy_double((double)Uint40_val(v))); 130 | } 131 | 132 | CAMLprim value 133 | float_of_uint48(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (caml_copy_double((double)Uint48_val(v))); 137 | } 138 | 139 | CAMLprim value 140 | float_of_uint56(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (caml_copy_double((double)Uint56_val(v))); 144 | } 145 | 146 | CAMLprim value 147 | float_of_uint64(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (caml_copy_double((double)Uint64_val(v))); 151 | } 152 | 153 | CAMLprim value 154 | float_of_uint128(value v) 155 | { 156 | CAMLparam1(v); 157 | #ifdef HAVE_INT128 158 | CAMLreturn (caml_copy_double((double)Uint128_val(v))); 159 | #else 160 | caml_failwith(__func__); 161 | CAMLreturn(Val_unit); 162 | #endif 163 | } 164 | 165 | -------------------------------------------------------------------------------- /lib/infix.ml: -------------------------------------------------------------------------------- 1 | module type IntSig = sig 2 | type t 3 | val add : t -> t -> t 4 | val sub : t -> t -> t 5 | val mul : t -> t -> t 6 | val div : t -> t -> t 7 | end 8 | 9 | module type S = sig 10 | type t 11 | val ( + ) : t -> t -> t 12 | val ( - ) : t -> t -> t 13 | val ( * ) : t -> t -> t 14 | val ( / ) : t -> t -> t 15 | end 16 | 17 | module Make (I : IntSig) = struct 18 | type t = I.t 19 | 20 | let ( + ) = I.add 21 | let ( - ) = I.sub 22 | let ( * ) = I.mul 23 | let ( / ) = I.div 24 | end 25 | 26 | -------------------------------------------------------------------------------- /lib/infix.mli: -------------------------------------------------------------------------------- 1 | module type IntSig = sig 2 | type t 3 | val add : t -> t -> t 4 | val sub : t -> t -> t 5 | val mul : t -> t -> t 6 | val div : t -> t -> t 7 | end 8 | 9 | module type S = sig 10 | type t 11 | val ( + ) : t -> t -> t 12 | val ( - ) : t -> t -> t 13 | val ( * ) : t -> t -> t 14 | val ( / ) : t -> t -> t 15 | end 16 | 17 | module Make (I : IntSig) : S with type t = I.t 18 | 19 | -------------------------------------------------------------------------------- /lib/int128.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_INT128_H 2 | #define OCAML_INT128_H 3 | 4 | #if defined(__SIZEOF_INT128__) 5 | 6 | #define HAVE_INT128 7 | typedef __int128_t int128; 8 | typedef struct { uint64_t low; int64_t high; } int128_ocaml; 9 | 10 | inline __int128_t get_int128(value v) 11 | { 12 | int128_ocaml *i = (int128_ocaml *)Data_custom_val(v); 13 | return ((__int128_t)i->high << 64 | i->low); 14 | } 15 | 16 | #define Int128_val(v) get_int128(v) 17 | 18 | #else 19 | 20 | typedef struct { int64_t high; uint64_t low; } int128; 21 | 22 | #define Int128_val(v) (*((int128 *)Data_custom_val(v))) 23 | 24 | #endif 25 | 26 | CAMLextern value copy_int128(int128 i); 27 | 28 | #endif 29 | -------------------------------------------------------------------------------- /lib/int128_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | int128_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | #ifdef HAVE_INT128 34 | CAMLreturn (copy_int128((__int128_t)Long_val(v))); 35 | #else 36 | int128 x = { .high = 0, .low = Long_val(v) }; 37 | CAMLreturn(copy_int128(x)); 38 | #endif 39 | } 40 | 41 | CAMLprim value 42 | int128_of_nativeint(value v) 43 | { 44 | CAMLparam1(v); 45 | #ifdef HAVE_INT128 46 | CAMLreturn (copy_int128((__int128_t)Nativeint_val(v))); 47 | #else 48 | int128 x = { .high = 0, .low = Nativeint_val(v) }; 49 | CAMLreturn(copy_int128(x)); 50 | #endif 51 | } 52 | 53 | CAMLprim value 54 | int128_of_float(value v) 55 | { 56 | CAMLparam1(v); 57 | #ifdef HAVE_INT128 58 | CAMLreturn (copy_int128((__int128_t)Double_val(v))); 59 | #else 60 | caml_failwith(__func__); 61 | CAMLreturn(Val_unit); 62 | #endif 63 | } 64 | 65 | CAMLprim value 66 | int128_of_int8(value v) 67 | { 68 | CAMLparam1(v); 69 | #ifdef HAVE_INT128 70 | CAMLreturn (copy_int128((__int128_t)Int8_val(v))); 71 | #else 72 | int128 x = { .high = 0, .low = Int8_val(v) }; 73 | CAMLreturn(copy_int128(x)); 74 | #endif 75 | } 76 | 77 | CAMLprim value 78 | int128_of_int16(value v) 79 | { 80 | CAMLparam1(v); 81 | #ifdef HAVE_INT128 82 | CAMLreturn (copy_int128((__int128_t)Int16_val(v))); 83 | #else 84 | int128 x = { .high = 0, .low = Int16_val(v) }; 85 | CAMLreturn(copy_int128(x)); 86 | #endif 87 | } 88 | 89 | CAMLprim value 90 | int128_of_int24(value v) 91 | { 92 | CAMLparam1(v); 93 | #ifdef HAVE_INT128 94 | CAMLreturn (copy_int128((__int128_t)Int24_val(v))); 95 | #else 96 | int128 x = { .high = 0, .low = Int24_val(v) }; 97 | CAMLreturn(copy_int128(x)); 98 | #endif 99 | } 100 | 101 | CAMLprim value 102 | int128_of_int32(value v) 103 | { 104 | CAMLparam1(v); 105 | #ifdef HAVE_INT128 106 | CAMLreturn (copy_int128((__int128_t)Int32_val(v))); 107 | #else 108 | int128 x = { .high = 0, .low = Int32_val(v) }; 109 | CAMLreturn(copy_int128(x)); 110 | #endif 111 | } 112 | 113 | CAMLprim value 114 | int128_of_int40(value v) 115 | { 116 | CAMLparam1(v); 117 | #ifdef HAVE_INT128 118 | CAMLreturn (copy_int128((__int128_t)Int40_val(v))); 119 | #else 120 | int128 x = { .high = 0, .low = Int40_val(v) }; 121 | CAMLreturn(copy_int128(x)); 122 | #endif 123 | } 124 | 125 | CAMLprim value 126 | int128_of_int48(value v) 127 | { 128 | CAMLparam1(v); 129 | #ifdef HAVE_INT128 130 | CAMLreturn (copy_int128((__int128_t)Int48_val(v))); 131 | #else 132 | int128 x = { .high = 0, .low = Int48_val(v) }; 133 | CAMLreturn(copy_int128(x)); 134 | #endif 135 | } 136 | 137 | CAMLprim value 138 | int128_of_int56(value v) 139 | { 140 | CAMLparam1(v); 141 | #ifdef HAVE_INT128 142 | CAMLreturn (copy_int128((__int128_t)Int56_val(v))); 143 | #else 144 | int128 x = { .high = 0, .low = Int56_val(v) }; 145 | CAMLreturn(copy_int128(x)); 146 | #endif 147 | } 148 | 149 | CAMLprim value 150 | int128_of_int64(value v) 151 | { 152 | CAMLparam1(v); 153 | #ifdef HAVE_INT128 154 | CAMLreturn (copy_int128((__int128_t)Int64_val(v))); 155 | #else 156 | int128 x = { .high = 0, .low = Int64_val(v) }; 157 | CAMLreturn(copy_int128(x)); 158 | #endif 159 | } 160 | 161 | CAMLprim value 162 | int128_of_uint8(value v) 163 | { 164 | CAMLparam1(v); 165 | #ifdef HAVE_INT128 166 | CAMLreturn (copy_int128((__int128_t)Uint8_val(v))); 167 | #else 168 | int128 x = { .high = 0, .low = Uint8_val(v) }; 169 | CAMLreturn(copy_int128(x)); 170 | #endif 171 | } 172 | 173 | CAMLprim value 174 | int128_of_uint16(value v) 175 | { 176 | CAMLparam1(v); 177 | #ifdef HAVE_INT128 178 | CAMLreturn (copy_int128((__int128_t)Uint16_val(v))); 179 | #else 180 | int128 x = { .high = 0, .low = Uint16_val(v) }; 181 | CAMLreturn(copy_int128(x)); 182 | #endif 183 | } 184 | 185 | CAMLprim value 186 | int128_of_uint24(value v) 187 | { 188 | CAMLparam1(v); 189 | #ifdef HAVE_INT128 190 | CAMLreturn (copy_int128((__int128_t)Uint24_val(v))); 191 | #else 192 | int128 x = { .high = 0, .low = Uint24_val(v) }; 193 | CAMLreturn(copy_int128(x)); 194 | #endif 195 | } 196 | 197 | CAMLprim value 198 | int128_of_uint32(value v) 199 | { 200 | CAMLparam1(v); 201 | #ifdef HAVE_INT128 202 | CAMLreturn (copy_int128((__int128_t)Uint32_val(v))); 203 | #else 204 | int128 x = { .high = 0, .low = Uint32_val(v) }; 205 | CAMLreturn(copy_int128(x)); 206 | #endif 207 | } 208 | 209 | CAMLprim value 210 | int128_of_uint40(value v) 211 | { 212 | CAMLparam1(v); 213 | #ifdef HAVE_INT128 214 | CAMLreturn (copy_int128((__int128_t)Uint40_val(v))); 215 | #else 216 | int128 x = { .high = 0, .low = Uint40_val(v) }; 217 | CAMLreturn(copy_int128(x)); 218 | #endif 219 | } 220 | 221 | CAMLprim value 222 | int128_of_uint48(value v) 223 | { 224 | CAMLparam1(v); 225 | #ifdef HAVE_INT128 226 | CAMLreturn (copy_int128((__int128_t)Uint48_val(v))); 227 | #else 228 | int128 x = { .high = 0, .low = Uint48_val(v) }; 229 | CAMLreturn(copy_int128(x)); 230 | #endif 231 | } 232 | 233 | CAMLprim value 234 | int128_of_uint56(value v) 235 | { 236 | CAMLparam1(v); 237 | #ifdef HAVE_INT128 238 | CAMLreturn (copy_int128((__int128_t)Uint56_val(v))); 239 | #else 240 | int128 x = { .high = 0, .low = Uint56_val(v) }; 241 | CAMLreturn(copy_int128(x)); 242 | #endif 243 | } 244 | 245 | CAMLprim value 246 | int128_of_uint64(value v) 247 | { 248 | CAMLparam1(v); 249 | #ifdef HAVE_INT128 250 | CAMLreturn (copy_int128((__int128_t)Uint64_val(v))); 251 | #else 252 | int128 x = { .high = 0, .low = Uint64_val(v) }; 253 | CAMLreturn(copy_int128(x)); 254 | #endif 255 | } 256 | 257 | CAMLprim value 258 | int128_of_uint128(value v) 259 | { 260 | CAMLparam1(v); 261 | #if defined(HAVE_INT128) && defined(HAVE_UINT128) 262 | CAMLreturn (copy_int128((__int128_t)Uint128_val(v))); 263 | #else 264 | uint128 x = Uint128_val(v); 265 | int128 y = { .high = x.high, .low = x.low }; 266 | CAMLreturn(copy_int128(y)); 267 | #endif 268 | } 269 | 270 | -------------------------------------------------------------------------------- /lib/int128_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | 15 | #include "uint128.h" 16 | #include "int128.h" 17 | 18 | #ifdef HAVE_INT128 19 | extern inline __int128_t get_int128(value); 20 | #else 21 | 22 | void divmod128(int128 *d, int128 *modulus, int128 *quotient, int128 *rem); 23 | 24 | static inline int32_t compare(int128 *x, int128 *y) { 25 | uint64_t z = x->high - y->high; 26 | if (0 != z) { 27 | return z >> 32; 28 | } 29 | return (x->low - y->low) >> 32; 30 | } 31 | 32 | static inline void neg(int128 *x) { 33 | uint64_t n; 34 | x->high ^= UINT64_MAX; 35 | x->low ^= UINT64_MAX; 36 | n = x->low; 37 | x->low += 1; 38 | if (x->low < n) { 39 | x->high++; 40 | } 41 | } 42 | 43 | static inline void divmod(int128 *x, int128 *divisor, int128 *res, int128 *remainder) { 44 | assert(0 != divisor->high); 45 | assert(0 != divisor->low); 46 | 47 | if (x->high < 0) { 48 | neg(x); 49 | if (divisor->high < 0) { 50 | neg(divisor); 51 | divmod128(x, divisor, res, remainder); 52 | } else { 53 | divmod128(x, divisor, res, remainder); 54 | neg(res); 55 | } 56 | } else { 57 | if (divisor->high < 0) { 58 | neg(divisor); 59 | divmod128(x, divisor, res, remainder); 60 | neg(res); 61 | } else { 62 | divmod128(x, divisor, res, remainder); 63 | } 64 | } 65 | } 66 | #endif 67 | 68 | static int 69 | int128_cmp(value v1, value v2) 70 | { 71 | #ifdef HAVE_INT128 72 | __int128_t i1 = Int128_val(v1); 73 | __int128_t i2 = Int128_val(v2); 74 | return (i1 > i2) - (i1 < i2); 75 | #else 76 | int128 x = Int128_val(v1); 77 | int128 y = Int128_val(v2); 78 | 79 | return compare(&x, &y); 80 | #endif 81 | } 82 | 83 | static intnat 84 | int128_hash(value v) 85 | { 86 | #ifdef HAVE_INT128 87 | __int128_t x = Int128_val(v); 88 | uint32_t b0 = (uint32_t) x, 89 | b1 = (uint32_t) (x >> 32U), 90 | b2 = (uint32_t) (x >> 64U), 91 | b3 = (uint32_t) (x >> 96U); 92 | #else 93 | int128 x = Int128_val(v); 94 | uint32_t b0 = (uint32_t) x.low, 95 | b1 = (uint32_t) (x.low >> 32U), 96 | b2 = (uint32_t) x.high, 97 | b3 = (uint32_t) (x.high >> 32U); 98 | #endif 99 | return b0 ^ b1 ^ b2 ^ b3; 100 | } 101 | 102 | static void 103 | int128_serialize(value v, uintnat *wsize_32, uintnat *wsize_64) 104 | { 105 | #ifdef HAVE_INT128 106 | __int128_t i = Int128_val(v); 107 | int64_t hi = i >> 64; 108 | int64_t lo = i; 109 | #else 110 | int128 i = Int128_val(v); 111 | int64_t hi = i.high; 112 | int64_t lo = i.low; 113 | #endif 114 | /* Serializing in big-endian order as other integer values */ 115 | caml_serialize_int_8(hi); 116 | caml_serialize_int_8(lo); 117 | *wsize_32 = *wsize_64 = 16; 118 | } 119 | 120 | static uintnat 121 | int128_deserialize(void *dst) 122 | { 123 | int64_t hi = caml_deserialize_sint_8(); 124 | uint64_t lo = caml_deserialize_uint_8(); 125 | #ifdef HAVE_INT128 126 | __int128_t v = ((__int128_t)hi << 64) | lo; 127 | #else 128 | int128 v; 129 | v.high = hi; 130 | v.low = lo; 131 | #endif 132 | memcpy(dst, &v, sizeof(v)); 133 | return 16; 134 | } 135 | 136 | #if OCAML_VERSION_MAJOR > 4 || OCAML_VERSION_MAJOR == 4 && OCAML_VERSION_MINOR >= 8 137 | static const struct custom_fixed_length int128_length = { 16, 16 }; 138 | #endif 139 | 140 | struct custom_operations int128_ops = { 141 | "stdint.int128", 142 | custom_finalize_default, 143 | int128_cmp, 144 | int128_hash, 145 | int128_serialize, 146 | int128_deserialize, 147 | custom_compare_ext_default 148 | #if OCAML_VERSION_MAJOR > 4 || OCAML_VERSION_MAJOR == 4 && OCAML_VERSION_MINOR >= 8 149 | , &int128_length 150 | #endif 151 | }; 152 | 153 | #ifdef HAVE_INT128 154 | CAMLprim value 155 | copy_int128(__int128_t i) 156 | { 157 | CAMLparam0(); 158 | value res = caml_alloc_custom(&int128_ops, 16, 0, 1); 159 | int128_ocaml *v = (int128_ocaml *)Data_custom_val(res); 160 | v->high = (int64_t)(i >> 64); 161 | v->low = (uint64_t)i; 162 | CAMLreturn (res); 163 | } 164 | #else 165 | CAMLprim value 166 | copy_int128(int128 i) 167 | { 168 | CAMLparam0(); 169 | value res = caml_alloc_custom(&int128_ops, 16, 0, 1); 170 | Int128_val(res) = i; 171 | CAMLreturn (res); 172 | } 173 | #endif 174 | 175 | CAMLprim value 176 | int128_add(value v1, value v2) 177 | { 178 | return suint128_add(v1, v2, (CAMLprim value (*)(uint128))copy_int128); 179 | } 180 | 181 | CAMLprim value 182 | int128_sub(value v1, value v2) 183 | { 184 | return suint128_sub(v1, v2, (CAMLprim value (*)(uint128))copy_int128); 185 | } 186 | 187 | CAMLprim value 188 | int128_mul(value v1, value v2) 189 | { 190 | return suint128_mul(v1, v2, (CAMLprim value (*)(uint128))copy_int128); 191 | } 192 | 193 | CAMLprim value 194 | int128_div(value v1, value v2) 195 | { 196 | CAMLparam2(v1, v2); 197 | #ifdef HAVE_INT128 198 | __int128_t divisor = Int128_val(v2); 199 | 200 | if (divisor == 0) 201 | caml_raise_zero_divide(); 202 | CAMLreturn (copy_int128(Int128_val(v1) / divisor)); 203 | #else 204 | int128 x, divisor, res, remainder; 205 | 206 | x = Int128_val(v1); 207 | divisor = Int128_val(v2); 208 | 209 | if ((0 == divisor.high) && (0 == divisor.low)) 210 | caml_raise_zero_divide(); 211 | 212 | divmod(&x, &divisor, &res, &remainder); 213 | 214 | CAMLreturn(copy_int128(res)); 215 | #endif 216 | } 217 | 218 | CAMLprim value 219 | int128_mod(value v1, value v2) 220 | { 221 | CAMLparam2(v1, v2); 222 | #ifdef HAVE_INT128 223 | __int128_t divisor = Int128_val(v2); 224 | if (divisor == 0) 225 | caml_raise_zero_divide(); 226 | CAMLreturn (copy_int128(Int128_val(v1) % divisor)); 227 | #else 228 | int128 x, divisor, res, remainder; 229 | 230 | x = Int128_val(v1); 231 | divisor = Int128_val(v2); 232 | 233 | if ((0 == divisor.high) && (0 == divisor.low)) 234 | caml_raise_zero_divide(); 235 | 236 | divmod(&x, &divisor, &res, &remainder); 237 | 238 | CAMLreturn(copy_int128(remainder)); 239 | #endif 240 | } 241 | 242 | CAMLprim value 243 | int128_and(value v1, value v2) 244 | { 245 | return suint128_and(v1, v2, (CAMLprim value (*)(uint128))copy_int128); 246 | } 247 | 248 | CAMLprim value 249 | int128_or(value v1, value v2) 250 | { 251 | return suint128_or(v1, v2, (CAMLprim value (*)(uint128))copy_int128); 252 | } 253 | 254 | CAMLprim value 255 | int128_xor(value v1, value v2) 256 | { 257 | return suint128_xor(v1, v2, (CAMLprim value (*)(uint128))copy_int128); 258 | } 259 | 260 | CAMLprim value 261 | int128_shift_left(value v1, value v2) 262 | { 263 | return suint128_shift_left(v1, v2, (CAMLprim value (*)(uint128))copy_int128); 264 | } 265 | 266 | CAMLprim value 267 | int128_shift_right(value v1, value v2) 268 | { 269 | CAMLparam2(v1, v2); 270 | #ifdef HAVE_INT128 271 | CAMLreturn (copy_int128(Int128_val(v1) >> Long_val(v2))); 272 | #else 273 | int128 x = Int128_val(v1); 274 | intnat s = Long_val(v2); 275 | 276 | if (0 == s) { 277 | // nothing 278 | } else if (s < 64) { 279 | x.low = (x.high << (64 - s)) | (x.low >> s); 280 | x.high = x.high >> s; 281 | } else { 282 | x.low = x.high >> (s - 64); 283 | if (x.high < 0) { 284 | x.high = UINT64_MAX; 285 | } else { 286 | x.high = 0; 287 | } 288 | } 289 | 290 | CAMLreturn(copy_int128(x)); 291 | #endif 292 | } 293 | 294 | CAMLprim value 295 | int128_bits_of_float(value v) 296 | { 297 | CAMLparam1(v); 298 | #ifdef HAVE_INT128 299 | union { float d; __int128_t i; } u; 300 | u.d = Double_val(v); 301 | CAMLreturn (copy_int128(u.i)); 302 | #else 303 | caml_failwith(__func__); 304 | CAMLreturn(Val_unit); 305 | #endif 306 | } 307 | 308 | CAMLprim value 309 | int128_float_of_bits(value v) 310 | { 311 | CAMLparam1(v); 312 | #ifdef HAVE_INT128 313 | union { float d; __int128_t i; } u; 314 | u.i = Int128_val(v); 315 | CAMLreturn(caml_copy_double(u.d)); 316 | #else 317 | caml_failwith(__func__); 318 | CAMLreturn(Val_unit); 319 | #endif 320 | } 321 | 322 | #ifdef HAVE_INT128 323 | static const __uint128_t int128_max = (((__uint128_t) INT64_MAX) << 64) | ((__uint128_t) UINT64_MAX); 324 | static const __uint128_t int128_min = ((__uint128_t) 1) << 127; 325 | #else 326 | static const int128 int128_max = { .high = INT64_MAX, .low = UINT64_MAX }; 327 | static const int128 int128_min = { .high = INT64_MIN, .low = 0 }; 328 | #endif 329 | 330 | CAMLprim value 331 | int128_max_int(void) 332 | { 333 | CAMLparam0(); 334 | CAMLreturn(copy_int128(int128_max)); 335 | } 336 | 337 | CAMLprim value 338 | int128_min_int(void) 339 | { 340 | CAMLparam0(); 341 | CAMLreturn(copy_int128(int128_min)); 342 | } 343 | 344 | CAMLprim value 345 | int128_neg(value v) 346 | { 347 | CAMLparam1(v); 348 | #ifdef HAVE_INT128 349 | __int128_t x = -1 * Int128_val(v); 350 | CAMLreturn(copy_int128(x)); 351 | #else 352 | int128 x = Int128_val(v); 353 | neg(&x); 354 | CAMLreturn(copy_int128(x)); 355 | #endif 356 | } 357 | 358 | CAMLprim value 359 | int128_abs(value v) 360 | { 361 | CAMLparam1(v); 362 | #ifdef HAVE_INT128 363 | __int128_t x = Int128_val(v); 364 | x = x < 0 ? (-x) : x; 365 | CAMLreturn(copy_int128(x)); 366 | #else 367 | int128 x = Int128_val(v); 368 | 369 | if (x.high < 0) 370 | neg(&x); 371 | 372 | CAMLreturn(copy_int128(x)); 373 | #endif 374 | } 375 | 376 | CAMLprim value 377 | int128_init_custom_ops(void) 378 | { 379 | CAMLparam0(); 380 | caml_register_custom_operations(&int128_ops); 381 | CAMLreturn (Val_unit); 382 | } 383 | 384 | -------------------------------------------------------------------------------- /lib/int16.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_INT16_H 2 | #define OCAML_INT16_H 3 | 4 | #ifdef ARCH_SIXTYFOUR 5 | 6 | #define Int16_val(x) ((int16_t)(((intnat)(x)) >> 48)) 7 | #define Val_int16(x) (((intnat)(x) << 48) + 1) 8 | 9 | #else 10 | 11 | #define Int16_val(x) ((int16_t)(((intnat)(x)) >> 16)) 12 | #define Val_int16(x) (((intnat)(x) << 16) + 1) 13 | 14 | #endif 15 | 16 | #endif 17 | -------------------------------------------------------------------------------- /lib/int16_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | int16_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (Val_int16((int16_t)Long_val(v))); 34 | } 35 | 36 | CAMLprim value 37 | int16_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (Val_int16((int16_t)Nativeint_val(v))); 41 | } 42 | 43 | CAMLprim value 44 | int16_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (Val_int16((int16_t)Double_val(v))); 48 | } 49 | 50 | CAMLprim value 51 | int16_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (Val_int16((int16_t)Int8_val(v))); 55 | } 56 | 57 | CAMLprim value 58 | int16_of_int24(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (Val_int16((int16_t)Int24_val(v))); 62 | } 63 | 64 | CAMLprim value 65 | int16_of_int32(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (Val_int16((int16_t)Int32_val(v))); 69 | } 70 | 71 | CAMLprim value 72 | int16_of_int40(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (Val_int16((int16_t)Int40_val(v))); 76 | } 77 | 78 | CAMLprim value 79 | int16_of_int48(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (Val_int16((int16_t)Int48_val(v))); 83 | } 84 | 85 | CAMLprim value 86 | int16_of_int56(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (Val_int16((int16_t)Int56_val(v))); 90 | } 91 | 92 | CAMLprim value 93 | int16_of_int64(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (Val_int16((int16_t)Int64_val(v))); 97 | } 98 | 99 | CAMLprim value 100 | int16_of_int128(value v) 101 | { 102 | CAMLparam1(v); 103 | #ifdef HAVE_INT128 104 | CAMLreturn (Val_int16((int16_t)Int128_val(v))); 105 | #else 106 | caml_failwith(__func__); 107 | CAMLreturn(Val_unit); 108 | #endif 109 | } 110 | 111 | CAMLprim value 112 | int16_of_uint8(value v) 113 | { 114 | CAMLparam1(v); 115 | CAMLreturn (Val_int16((int16_t)Uint8_val(v))); 116 | } 117 | 118 | CAMLprim value 119 | int16_of_uint16(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (Val_int16((int16_t)Uint16_val(v))); 123 | } 124 | 125 | CAMLprim value 126 | int16_of_uint24(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (Val_int16((int16_t)Uint24_val(v))); 130 | } 131 | 132 | CAMLprim value 133 | int16_of_uint32(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (Val_int16((int16_t)Uint32_val(v))); 137 | } 138 | 139 | CAMLprim value 140 | int16_of_uint40(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (Val_int16((int16_t)Uint40_val(v))); 144 | } 145 | 146 | CAMLprim value 147 | int16_of_uint48(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (Val_int16((int16_t)Uint48_val(v))); 151 | } 152 | 153 | CAMLprim value 154 | int16_of_uint56(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (Val_int16((int16_t)Uint56_val(v))); 158 | } 159 | 160 | CAMLprim value 161 | int16_of_uint64(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (Val_int16((int16_t)Uint64_val(v))); 165 | } 166 | 167 | CAMLprim value 168 | int16_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (Val_int16((int16_t)Uint128_val(v))); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | CAMLprim value int16_bits_of_float(value v) { 180 | CAMLparam1(v); 181 | union { float d; int16_t i; } u; 182 | u.d = Double_val(v); 183 | CAMLreturn (Val_int16(u.i)); 184 | } 185 | 186 | CAMLprim value int16_float_of_bits(value v) { 187 | CAMLparam1(v); 188 | union { float d; int16_t i; } u; 189 | u.i = Int16_val(v); 190 | CAMLreturn (caml_copy_double(u.d)); 191 | } 192 | 193 | -------------------------------------------------------------------------------- /lib/int24.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_INT24_H 2 | #define OCAML_INT24_H 3 | 4 | #ifdef ARCH_SIXTYFOUR 5 | 6 | #define Int24_val(x) ((int32_t)(((intnat)(x)) >> 40)) 7 | #define Val_int24(x) (((intnat)(x) << 40) + 1) 8 | 9 | #else 10 | 11 | #define Int24_val(x) ((int32_t)(((intnat)(x)) >> 8)) 12 | #define Val_int24(x) (((intnat)(x) << 8) + 1) 13 | 14 | #endif 15 | 16 | #endif 17 | 18 | -------------------------------------------------------------------------------- /lib/int24_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | int24_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (Val_int24((int32_t)Long_val(v))); 34 | } 35 | 36 | CAMLprim value 37 | int24_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (Val_int24((int32_t)Nativeint_val(v))); 41 | } 42 | 43 | CAMLprim value 44 | int24_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (Val_int24((int32_t)Double_val(v))); 48 | } 49 | 50 | CAMLprim value 51 | int24_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (Val_int24((int32_t)Int8_val(v))); 55 | } 56 | 57 | CAMLprim value 58 | int24_of_int16(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (Val_int24((int32_t)Int16_val(v))); 62 | } 63 | 64 | CAMLprim value 65 | int24_of_int32(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (Val_int24((int32_t)Int32_val(v))); 69 | } 70 | 71 | CAMLprim value 72 | int24_of_int40(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (Val_int24((int32_t)Int40_val(v))); 76 | } 77 | 78 | CAMLprim value 79 | int24_of_int48(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (Val_int24((int32_t)Int48_val(v))); 83 | } 84 | 85 | CAMLprim value 86 | int24_of_int56(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (Val_int24((int32_t)Int56_val(v))); 90 | } 91 | 92 | CAMLprim value 93 | int24_of_int64(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (Val_int24((int32_t)Int64_val(v))); 97 | } 98 | 99 | CAMLprim value 100 | int24_of_int128(value v) 101 | { 102 | CAMLparam1(v); 103 | #ifdef HAVE_INT128 104 | CAMLreturn (Val_int24((int32_t)Int128_val(v))); 105 | #else 106 | caml_failwith(__func__); 107 | CAMLreturn(Val_unit); 108 | #endif 109 | } 110 | 111 | CAMLprim value 112 | int24_of_uint8(value v) 113 | { 114 | CAMLparam1(v); 115 | CAMLreturn (Val_int24((int32_t)Uint8_val(v))); 116 | } 117 | 118 | CAMLprim value 119 | int24_of_uint16(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (Val_int24((int32_t)Uint16_val(v))); 123 | } 124 | 125 | CAMLprim value 126 | int24_of_uint24(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (Val_int24((int32_t)Uint24_val(v))); 130 | } 131 | 132 | CAMLprim value 133 | int24_of_uint32(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (Val_int24((int32_t)Uint32_val(v))); 137 | } 138 | 139 | CAMLprim value 140 | int24_of_uint40(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (Val_int24((int32_t)Uint40_val(v))); 144 | } 145 | 146 | CAMLprim value 147 | int24_of_uint48(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (Val_int24((int32_t)Uint48_val(v))); 151 | } 152 | 153 | CAMLprim value 154 | int24_of_uint56(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (Val_int24((int32_t)Uint56_val(v))); 158 | } 159 | 160 | CAMLprim value 161 | int24_of_uint64(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (Val_int24((int32_t)Uint64_val(v))); 165 | } 166 | 167 | CAMLprim value 168 | int24_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (Val_int24((int32_t)Uint128_val(v))); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | -------------------------------------------------------------------------------- /lib/int32_conv.c: -------------------------------------------------------------------------------- 1 | #define CAML_NAME_SPACE 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | 14 | #include "int8.h" 15 | #include "int16.h" 16 | #include "int24.h" 17 | #include "int40.h" 18 | #include "int48.h" 19 | #include "int56.h" 20 | #include "int128.h" 21 | #include "uint8.h" 22 | #include "uint16.h" 23 | #include "uint24.h" 24 | #include "uint32.h" 25 | #include "uint40.h" 26 | #include "uint48.h" 27 | #include "uint56.h" 28 | #include "uint64.h" 29 | #include "uint128.h" 30 | 31 | CAMLprim value 32 | int32_of_int(value v) 33 | { 34 | CAMLparam1(v); 35 | CAMLreturn (caml_copy_int32((int32_t)Long_val(v))); 36 | } 37 | 38 | CAMLprim value 39 | int32_of_nativeint(value v) 40 | { 41 | CAMLparam1(v); 42 | CAMLreturn (caml_copy_int32((int32_t)Nativeint_val(v))); 43 | } 44 | 45 | CAMLprim value 46 | int32_of_float(value v) 47 | { 48 | CAMLparam1(v); 49 | CAMLreturn (caml_copy_int32((int32_t)Double_val(v))); 50 | } 51 | 52 | CAMLprim value 53 | int32_of_int8(value v) 54 | { 55 | CAMLparam1(v); 56 | CAMLreturn (caml_copy_int32((int32_t)Int8_val(v))); 57 | } 58 | 59 | CAMLprim value 60 | int32_of_int16(value v) 61 | { 62 | CAMLparam1(v); 63 | CAMLreturn (caml_copy_int32((int32_t)Int16_val(v))); 64 | } 65 | 66 | CAMLprim value 67 | int32_of_int24(value v) 68 | { 69 | CAMLparam1(v); 70 | CAMLreturn (caml_copy_int32((int32_t)Int24_val(v))); 71 | } 72 | 73 | CAMLprim value 74 | int32_of_int40(value v) 75 | { 76 | CAMLparam1(v); 77 | CAMLreturn (caml_copy_int32((int32_t)Int40_val(v))); 78 | } 79 | 80 | CAMLprim value 81 | int32_of_int48(value v) 82 | { 83 | CAMLparam1(v); 84 | CAMLreturn (caml_copy_int32((int32_t)Int48_val(v))); 85 | } 86 | 87 | CAMLprim value 88 | int32_of_int56(value v) 89 | { 90 | CAMLparam1(v); 91 | CAMLreturn (caml_copy_int32((int32_t)Int56_val(v))); 92 | } 93 | 94 | CAMLprim value 95 | int32_of_int64(value v) 96 | { 97 | CAMLparam1(v); 98 | CAMLreturn (caml_copy_int32((int32_t)Int64_val(v))); 99 | } 100 | 101 | CAMLprim value 102 | int32_of_int128(value v) 103 | { 104 | CAMLparam1(v); 105 | #ifdef HAVE_INT128 106 | CAMLreturn (caml_copy_int32((int32_t)Int128_val(v))); 107 | #else 108 | caml_failwith(__func__); 109 | CAMLreturn(Val_unit); 110 | #endif 111 | } 112 | 113 | CAMLprim value 114 | int32_of_uint8(value v) 115 | { 116 | CAMLparam1(v); 117 | CAMLreturn (caml_copy_int32((int32_t)Uint8_val(v))); 118 | } 119 | 120 | CAMLprim value 121 | int32_of_uint16(value v) 122 | { 123 | CAMLparam1(v); 124 | CAMLreturn (caml_copy_int32((int32_t)Uint16_val(v))); 125 | } 126 | 127 | CAMLprim value 128 | int32_of_uint24(value v) 129 | { 130 | CAMLparam1(v); 131 | CAMLreturn (caml_copy_int32((int32_t)Uint24_val(v))); 132 | } 133 | 134 | CAMLprim value 135 | int32_of_uint32(value v) 136 | { 137 | CAMLparam1(v); 138 | CAMLreturn (caml_copy_int32((int32_t)Uint32_val(v))); 139 | } 140 | 141 | CAMLprim value 142 | int32_of_uint40(value v) 143 | { 144 | CAMLparam1(v); 145 | CAMLreturn (caml_copy_int32((int32_t)Uint40_val(v))); 146 | } 147 | 148 | CAMLprim value 149 | int32_of_uint48(value v) 150 | { 151 | CAMLparam1(v); 152 | CAMLreturn (caml_copy_int32((int32_t)Uint48_val(v))); 153 | } 154 | 155 | CAMLprim value 156 | int32_of_uint56(value v) 157 | { 158 | CAMLparam1(v); 159 | CAMLreturn (caml_copy_int32((int32_t)Uint56_val(v))); 160 | } 161 | 162 | CAMLprim value 163 | int32_of_uint64(value v) 164 | { 165 | CAMLparam1(v); 166 | CAMLreturn (caml_copy_int32((int32_t)Uint64_val(v))); 167 | } 168 | 169 | CAMLprim value 170 | int32_of_uint128(value v) 171 | { 172 | CAMLparam1(v); 173 | #ifdef HAVE_UINT128 174 | CAMLreturn (caml_copy_int32((int32_t)Uint128_val(v))); 175 | #else 176 | caml_failwith(__func__); 177 | CAMLreturn(Val_unit); 178 | #endif 179 | } 180 | 181 | -------------------------------------------------------------------------------- /lib/int40.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_INT40_H 2 | #define OCAML_INT40_H 3 | 4 | #define Int40_val(v) ((*((int64_t *)Data_custom_val(v))) >> 24) 5 | 6 | #define copy_int40(v) caml_copy_int64(v) 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /lib/int40_conv.c: -------------------------------------------------------------------------------- 1 | #define CAML_NAME_SPACE 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | 14 | #include "int8.h" 15 | #include "int16.h" 16 | #include "int24.h" 17 | #include "int40.h" 18 | #include "int48.h" 19 | #include "int56.h" 20 | #include "int128.h" 21 | #include "uint8.h" 22 | #include "uint16.h" 23 | #include "uint24.h" 24 | #include "uint32.h" 25 | #include "uint40.h" 26 | #include "uint48.h" 27 | #include "uint56.h" 28 | #include "uint64.h" 29 | #include "uint128.h" 30 | 31 | CAMLprim value 32 | int40_of_int(value v) 33 | { 34 | CAMLparam1(v); 35 | CAMLreturn (caml_copy_int64(((int64_t)Long_val(v)) << 24)); 36 | } 37 | 38 | CAMLprim value 39 | int40_of_nativeint(value v) 40 | { 41 | CAMLparam1(v); 42 | CAMLreturn (caml_copy_int64(((int64_t)Nativeint_val(v)) << 24)); 43 | } 44 | 45 | CAMLprim value 46 | int40_of_float(value v) 47 | { 48 | CAMLparam1(v); 49 | CAMLreturn (caml_copy_int64(((int64_t)Double_val(v)) << 24)); 50 | } 51 | 52 | CAMLprim value 53 | int40_of_int8(value v) 54 | { 55 | CAMLparam1(v); 56 | CAMLreturn (caml_copy_int64(((int64_t)Int8_val(v)) << 24)); 57 | } 58 | 59 | CAMLprim value 60 | int40_of_int16(value v) 61 | { 62 | CAMLparam1(v); 63 | CAMLreturn (caml_copy_int64(((int64_t)Int16_val(v)) << 24)); 64 | } 65 | 66 | CAMLprim value 67 | int40_of_int24(value v) 68 | { 69 | CAMLparam1(v); 70 | CAMLreturn (caml_copy_int64(((int64_t)Int24_val(v)) << 24)); 71 | } 72 | 73 | CAMLprim value 74 | int40_of_int32(value v) 75 | { 76 | CAMLparam1(v); 77 | CAMLreturn (caml_copy_int64(((int64_t)Int32_val(v)) << 24)); 78 | } 79 | 80 | CAMLprim value 81 | int40_of_int48(value v) 82 | { 83 | CAMLparam1(v); 84 | CAMLreturn (caml_copy_int64(((int64_t)Int48_val(v)) << 24)); 85 | } 86 | 87 | CAMLprim value 88 | int40_of_int56(value v) 89 | { 90 | CAMLparam1(v); 91 | CAMLreturn (caml_copy_int64(((int64_t)Int56_val(v)) << 24)); 92 | } 93 | 94 | CAMLprim value 95 | int40_of_int64(value v) 96 | { 97 | CAMLparam1(v); 98 | CAMLreturn (caml_copy_int64(((int64_t)Int64_val(v)) << 24)); 99 | } 100 | 101 | CAMLprim value 102 | int40_of_int128(value v) 103 | { 104 | CAMLparam1(v); 105 | #ifdef HAVE_INT128 106 | CAMLreturn (caml_copy_int64(((int64_t)Int128_val(v)) << 24)); 107 | #else 108 | caml_failwith(__func__); 109 | CAMLreturn(Val_unit); 110 | #endif 111 | } 112 | 113 | CAMLprim value 114 | int40_of_uint8(value v) 115 | { 116 | CAMLparam1(v); 117 | CAMLreturn (caml_copy_int64(((int64_t)Uint8_val(v)) << 24)); 118 | } 119 | 120 | CAMLprim value 121 | int40_of_uint16(value v) 122 | { 123 | CAMLparam1(v); 124 | CAMLreturn (caml_copy_int64(((int64_t)Uint16_val(v)) << 24)); 125 | } 126 | 127 | CAMLprim value 128 | int40_of_uint24(value v) 129 | { 130 | CAMLparam1(v); 131 | CAMLreturn (caml_copy_int64(((int64_t)Uint24_val(v)) << 24)); 132 | } 133 | 134 | CAMLprim value 135 | int40_of_uint32(value v) 136 | { 137 | CAMLparam1(v); 138 | CAMLreturn (caml_copy_int64(((int64_t)Uint32_val(v)) << 24)); 139 | } 140 | 141 | CAMLprim value 142 | int40_of_uint40(value v) 143 | { 144 | CAMLparam1(v); 145 | CAMLreturn (caml_copy_int64(((int64_t)Uint40_val(v)) << 24)); 146 | } 147 | 148 | CAMLprim value 149 | int40_of_uint48(value v) 150 | { 151 | CAMLparam1(v); 152 | CAMLreturn (caml_copy_int64(((int64_t)Uint48_val(v)) << 24)); 153 | } 154 | 155 | CAMLprim value 156 | int40_of_uint56(value v) 157 | { 158 | CAMLparam1(v); 159 | CAMLreturn (caml_copy_int64(((int64_t)Uint56_val(v)) << 24)); 160 | } 161 | 162 | CAMLprim value 163 | int40_of_uint64(value v) 164 | { 165 | CAMLparam1(v); 166 | CAMLreturn (caml_copy_int64(((int64_t)Uint64_val(v)) << 24)); 167 | } 168 | 169 | CAMLprim value 170 | int40_of_uint128(value v) 171 | { 172 | CAMLparam1(v); 173 | #ifdef HAVE_UINT128 174 | CAMLreturn (caml_copy_int64(((int64_t)Uint128_val(v)) << 24)); 175 | #else 176 | caml_failwith(__func__); 177 | CAMLreturn(Val_unit); 178 | #endif 179 | } 180 | 181 | -------------------------------------------------------------------------------- /lib/int40_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | #include "int40.h" 12 | 13 | static const int64_t mask = 0xFFFFFFFFFF000000LL; 14 | 15 | CAMLprim value 16 | int40_mul(value v1, value v2) 17 | { 18 | CAMLparam2(v1, v2); 19 | CAMLreturn (copy_int40(Int40_val(v1) * Int64_val(v2))); 20 | } 21 | 22 | CAMLprim value 23 | int40_div(value v1, value v2) 24 | { 25 | CAMLparam2(v1, v2); 26 | int64_t divisor = Int64_val(v2); 27 | if (divisor == 0) 28 | caml_raise_zero_divide(); 29 | CAMLreturn (copy_int40((Int64_val(v1) / divisor) << 24)); 30 | } 31 | 32 | CAMLprim value 33 | int40_xor(value v1, value v2) 34 | { 35 | CAMLparam2(v1, v2); 36 | CAMLreturn (copy_int40((Int64_val(v1) ^ Int64_val(v2)) & mask)); 37 | } 38 | 39 | CAMLprim value 40 | int40_shift_right(value v1, value v2) 41 | { 42 | CAMLparam2(v1, v2); 43 | CAMLreturn (copy_int40((Int64_val(v1) >> Long_val(v2)) & mask)); 44 | } 45 | 46 | CAMLprim value 47 | int40_max_int(void) 48 | { 49 | CAMLparam0(); 50 | CAMLreturn (copy_int40(INT64_MAX & mask)); 51 | } 52 | 53 | CAMLprim value 54 | int40_min_int(void) 55 | { 56 | CAMLparam0(); 57 | CAMLreturn (copy_int40(INT64_MIN & mask)); 58 | } 59 | 60 | -------------------------------------------------------------------------------- /lib/int48.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_INT48_H 2 | #define OCAML_INT48_H 3 | 4 | #define Int48_val(v) ((*((int64_t *)Data_custom_val(v))) >> 16) 5 | 6 | #define copy_int48(v) caml_copy_int64(v) 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /lib/int48_conv.c: -------------------------------------------------------------------------------- 1 | #define CAML_NAME_SPACE 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | 14 | #include "int8.h" 15 | #include "int16.h" 16 | #include "int24.h" 17 | #include "int40.h" 18 | #include "int48.h" 19 | #include "int56.h" 20 | #include "int128.h" 21 | #include "uint8.h" 22 | #include "uint16.h" 23 | #include "uint24.h" 24 | #include "uint32.h" 25 | #include "uint40.h" 26 | #include "uint48.h" 27 | #include "uint56.h" 28 | #include "uint64.h" 29 | #include "uint128.h" 30 | 31 | CAMLprim value 32 | int48_of_int(value v) 33 | { 34 | CAMLparam1(v); 35 | CAMLreturn (caml_copy_int64(((int64_t)Long_val(v)) << 16)); 36 | } 37 | 38 | CAMLprim value 39 | int48_of_nativeint(value v) 40 | { 41 | CAMLparam1(v); 42 | CAMLreturn (caml_copy_int64(((int64_t)Nativeint_val(v)) << 16)); 43 | } 44 | 45 | CAMLprim value 46 | int48_of_float(value v) 47 | { 48 | CAMLparam1(v); 49 | CAMLreturn (caml_copy_int64(((int64_t)Double_val(v)) << 16)); 50 | } 51 | 52 | CAMLprim value 53 | int48_of_int8(value v) 54 | { 55 | CAMLparam1(v); 56 | CAMLreturn (caml_copy_int64(((int64_t)Int8_val(v)) << 16)); 57 | } 58 | 59 | CAMLprim value 60 | int48_of_int16(value v) 61 | { 62 | CAMLparam1(v); 63 | CAMLreturn (caml_copy_int64(((int64_t)Int16_val(v)) << 16)); 64 | } 65 | 66 | CAMLprim value 67 | int48_of_int24(value v) 68 | { 69 | CAMLparam1(v); 70 | CAMLreturn (caml_copy_int64(((int64_t)Int24_val(v)) << 16)); 71 | } 72 | 73 | CAMLprim value 74 | int48_of_int32(value v) 75 | { 76 | CAMLparam1(v); 77 | CAMLreturn (caml_copy_int64(((int64_t)Int32_val(v)) << 16)); 78 | } 79 | 80 | CAMLprim value 81 | int48_of_int40(value v) 82 | { 83 | CAMLparam1(v); 84 | CAMLreturn (caml_copy_int64(((int64_t)Int40_val(v)) << 16)); 85 | } 86 | 87 | CAMLprim value 88 | int48_of_int56(value v) 89 | { 90 | CAMLparam1(v); 91 | CAMLreturn (caml_copy_int64(((int64_t)Int56_val(v)) << 16)); 92 | } 93 | 94 | CAMLprim value 95 | int48_of_int64(value v) 96 | { 97 | CAMLparam1(v); 98 | CAMLreturn (caml_copy_int64(((int64_t)Int64_val(v)) << 16)); 99 | } 100 | 101 | CAMLprim value 102 | int48_of_int128(value v) 103 | { 104 | CAMLparam1(v); 105 | #ifdef HAVE_INT128 106 | CAMLreturn (caml_copy_int64(((int64_t)Int128_val(v)) << 16)); 107 | #else 108 | caml_failwith(__func__); 109 | CAMLreturn(Val_unit); 110 | #endif 111 | } 112 | 113 | CAMLprim value 114 | int48_of_uint8(value v) 115 | { 116 | CAMLparam1(v); 117 | CAMLreturn (caml_copy_int64(((int64_t)Uint8_val(v)) << 16)); 118 | } 119 | 120 | CAMLprim value 121 | int48_of_uint16(value v) 122 | { 123 | CAMLparam1(v); 124 | CAMLreturn (caml_copy_int64(((int64_t)Uint16_val(v)) << 16)); 125 | } 126 | 127 | CAMLprim value 128 | int48_of_uint24(value v) 129 | { 130 | CAMLparam1(v); 131 | CAMLreturn (caml_copy_int64(((int64_t)Uint24_val(v)) << 16)); 132 | } 133 | 134 | CAMLprim value 135 | int48_of_uint32(value v) 136 | { 137 | CAMLparam1(v); 138 | CAMLreturn (caml_copy_int64(((int64_t)Uint32_val(v)) << 16)); 139 | } 140 | 141 | CAMLprim value 142 | int48_of_uint40(value v) 143 | { 144 | CAMLparam1(v); 145 | CAMLreturn (caml_copy_int64(((int64_t)Uint40_val(v)) << 16)); 146 | } 147 | 148 | CAMLprim value 149 | int48_of_uint48(value v) 150 | { 151 | CAMLparam1(v); 152 | CAMLreturn (caml_copy_int64(((int64_t)Uint48_val(v)) << 16)); 153 | } 154 | 155 | CAMLprim value 156 | int48_of_uint56(value v) 157 | { 158 | CAMLparam1(v); 159 | CAMLreturn (caml_copy_int64(((int64_t)Uint56_val(v)) << 16)); 160 | } 161 | 162 | CAMLprim value 163 | int48_of_uint64(value v) 164 | { 165 | CAMLparam1(v); 166 | CAMLreturn (caml_copy_int64(((int64_t)Uint64_val(v)) << 16)); 167 | } 168 | 169 | CAMLprim value 170 | int48_of_uint128(value v) 171 | { 172 | CAMLparam1(v); 173 | #ifdef HAVE_UINT128 174 | CAMLreturn (caml_copy_int64(((int64_t)Uint128_val(v)) << 16)); 175 | #else 176 | caml_failwith(__func__); 177 | CAMLreturn(Val_unit); 178 | #endif 179 | } 180 | 181 | -------------------------------------------------------------------------------- /lib/int48_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | #include "int48.h" 12 | 13 | static const int64_t mask = 0xFFFFFFFFFFFF0000LL; 14 | 15 | CAMLprim value 16 | int48_mul(value v1, value v2) 17 | { 18 | CAMLparam2(v1, v2); 19 | CAMLreturn (copy_int48(Int48_val(v1) * Int64_val(v2))); 20 | } 21 | 22 | CAMLprim value 23 | int48_div(value v1, value v2) 24 | { 25 | CAMLparam2(v1, v2); 26 | int64_t divisor = Int64_val(v2); 27 | if (divisor == 0) 28 | caml_raise_zero_divide(); 29 | CAMLreturn (copy_int48((Int64_val(v1) / divisor) << 16)); 30 | } 31 | 32 | CAMLprim value 33 | int48_xor(value v1, value v2) 34 | { 35 | CAMLparam2(v1, v2); 36 | CAMLreturn (copy_int48((Int64_val(v1) ^ Int64_val(v2)) & mask)); 37 | } 38 | 39 | CAMLprim value 40 | int48_shift_right(value v1, value v2) 41 | { 42 | CAMLparam2(v1, v2); 43 | CAMLreturn (copy_int48((Int64_val(v1) >> Long_val(v2)) & mask)); 44 | } 45 | 46 | CAMLprim value 47 | int48_max_int(void) 48 | { 49 | CAMLparam0(); 50 | CAMLreturn (copy_int48(INT64_MAX & mask)); 51 | } 52 | 53 | CAMLprim value 54 | int48_min_int(void) 55 | { 56 | CAMLparam0(); 57 | CAMLreturn (copy_int48(INT64_MIN & mask)); 58 | } 59 | 60 | -------------------------------------------------------------------------------- /lib/int56.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_INT56_H 2 | #define OCAML_INT56_H 3 | 4 | #define Int56_val(v) ((*((int64_t *)Data_custom_val(v))) >> 8) 5 | 6 | #define copy_int56(v) caml_copy_int64(v) 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /lib/int56_conv.c: -------------------------------------------------------------------------------- 1 | #define CAML_NAME_SPACE 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | 14 | #include "int8.h" 15 | #include "int16.h" 16 | #include "int24.h" 17 | #include "int40.h" 18 | #include "int48.h" 19 | #include "int56.h" 20 | #include "int128.h" 21 | #include "uint8.h" 22 | #include "uint16.h" 23 | #include "uint24.h" 24 | #include "uint32.h" 25 | #include "uint40.h" 26 | #include "uint48.h" 27 | #include "uint56.h" 28 | #include "uint64.h" 29 | #include "uint128.h" 30 | 31 | CAMLprim value 32 | int56_of_int(value v) 33 | { 34 | CAMLparam1(v); 35 | CAMLreturn (caml_copy_int64(((int64_t)Long_val(v)) << 8)); 36 | } 37 | 38 | CAMLprim value 39 | int56_of_nativeint(value v) 40 | { 41 | CAMLparam1(v); 42 | CAMLreturn (caml_copy_int64(((int64_t)Nativeint_val(v)) << 8)); 43 | } 44 | 45 | CAMLprim value 46 | int56_of_float(value v) 47 | { 48 | CAMLparam1(v); 49 | CAMLreturn (caml_copy_int64(((int64_t)Double_val(v)) << 8)); 50 | } 51 | 52 | CAMLprim value 53 | int56_of_int8(value v) 54 | { 55 | CAMLparam1(v); 56 | CAMLreturn (caml_copy_int64(((int64_t)Int8_val(v)) << 8)); 57 | } 58 | 59 | CAMLprim value 60 | int56_of_int16(value v) 61 | { 62 | CAMLparam1(v); 63 | CAMLreturn (caml_copy_int64(((int64_t)Int16_val(v)) << 8)); 64 | } 65 | 66 | CAMLprim value 67 | int56_of_int24(value v) 68 | { 69 | CAMLparam1(v); 70 | CAMLreturn (caml_copy_int64(((int64_t)Int24_val(v)) << 8)); 71 | } 72 | 73 | CAMLprim value 74 | int56_of_int32(value v) 75 | { 76 | CAMLparam1(v); 77 | CAMLreturn (caml_copy_int64(((int64_t)Int32_val(v)) << 8)); 78 | } 79 | 80 | CAMLprim value 81 | int56_of_int40(value v) 82 | { 83 | CAMLparam1(v); 84 | CAMLreturn (caml_copy_int64(((int64_t)Int40_val(v)) << 8)); 85 | } 86 | 87 | CAMLprim value 88 | int56_of_int48(value v) 89 | { 90 | CAMLparam1(v); 91 | CAMLreturn (caml_copy_int64(((int64_t)Int48_val(v)) << 8)); 92 | } 93 | 94 | CAMLprim value 95 | int56_of_int64(value v) 96 | { 97 | CAMLparam1(v); 98 | CAMLreturn (caml_copy_int64(((int64_t)Int64_val(v)) << 8)); 99 | } 100 | 101 | CAMLprim value 102 | int56_of_int128(value v) 103 | { 104 | CAMLparam1(v); 105 | #ifdef HAVE_INT128 106 | CAMLreturn (caml_copy_int64(((int64_t)Int128_val(v)) << 8)); 107 | #else 108 | caml_failwith(__func__); 109 | CAMLreturn(Val_unit); 110 | #endif 111 | } 112 | 113 | CAMLprim value 114 | int56_of_uint8(value v) 115 | { 116 | CAMLparam1(v); 117 | CAMLreturn (caml_copy_int64(((int64_t)Uint8_val(v)) << 8)); 118 | } 119 | 120 | CAMLprim value 121 | int56_of_uint16(value v) 122 | { 123 | CAMLparam1(v); 124 | CAMLreturn (caml_copy_int64(((int64_t)Uint16_val(v)) << 8)); 125 | } 126 | 127 | CAMLprim value 128 | int56_of_uint24(value v) 129 | { 130 | CAMLparam1(v); 131 | CAMLreturn (caml_copy_int64(((int64_t)Uint24_val(v)) << 8)); 132 | } 133 | 134 | CAMLprim value 135 | int56_of_uint32(value v) 136 | { 137 | CAMLparam1(v); 138 | CAMLreturn (caml_copy_int64(((int64_t)Uint32_val(v)) << 8)); 139 | } 140 | 141 | CAMLprim value 142 | int56_of_uint40(value v) 143 | { 144 | CAMLparam1(v); 145 | CAMLreturn (caml_copy_int64(((int64_t)Uint40_val(v)) << 8)); 146 | } 147 | 148 | CAMLprim value 149 | int56_of_uint48(value v) 150 | { 151 | CAMLparam1(v); 152 | CAMLreturn (caml_copy_int64(((int64_t)Uint48_val(v)) << 8)); 153 | } 154 | 155 | CAMLprim value 156 | int56_of_uint56(value v) 157 | { 158 | CAMLparam1(v); 159 | CAMLreturn (caml_copy_int64(((int64_t)Uint56_val(v)) << 8)); 160 | } 161 | 162 | CAMLprim value 163 | int56_of_uint64(value v) 164 | { 165 | CAMLparam1(v); 166 | CAMLreturn (caml_copy_int64(((int64_t)Uint64_val(v)) << 8)); 167 | } 168 | 169 | CAMLprim value 170 | int56_of_uint128(value v) 171 | { 172 | CAMLparam1(v); 173 | #ifdef HAVE_UINT128 174 | CAMLreturn (caml_copy_int64(((int64_t)Uint128_val(v)) << 8)); 175 | #else 176 | caml_failwith(__func__); 177 | CAMLreturn(Val_unit); 178 | #endif 179 | } 180 | 181 | -------------------------------------------------------------------------------- /lib/int56_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | #include "int56.h" 12 | 13 | static const int64_t mask = 0xFFFFFFFFFFFFFF00LL; 14 | 15 | CAMLprim value 16 | int56_mul(value v1, value v2) 17 | { 18 | CAMLparam2(v1, v2); 19 | CAMLreturn (copy_int56(Int56_val(v1) * Int64_val(v2))); 20 | } 21 | 22 | CAMLprim value 23 | int56_div(value v1, value v2) 24 | { 25 | CAMLparam2(v1, v2); 26 | int64_t divisor = Int64_val(v2); 27 | if (divisor == 0) 28 | caml_raise_zero_divide(); 29 | CAMLreturn (copy_int56((Int64_val(v1) / divisor) << 8)); 30 | } 31 | 32 | CAMLprim value 33 | int56_xor(value v1, value v2) 34 | { 35 | CAMLparam2(v1, v2); 36 | CAMLreturn (copy_int56((Int64_val(v1) ^ Int64_val(v2)) & mask)); 37 | } 38 | 39 | CAMLprim value 40 | int56_shift_right(value v1, value v2) 41 | { 42 | CAMLparam2(v1, v2); 43 | CAMLreturn (copy_int56((Int64_val(v1) >> Long_val(v2)) & mask)); 44 | } 45 | 46 | CAMLprim value 47 | int56_max_int(void) 48 | { 49 | CAMLparam0(); 50 | CAMLreturn (copy_int56(INT64_MAX & mask)); 51 | } 52 | 53 | CAMLprim value 54 | int56_min_int(void) 55 | { 56 | CAMLparam0(); 57 | CAMLreturn (copy_int56(INT64_MIN & mask)); 58 | } 59 | 60 | -------------------------------------------------------------------------------- /lib/int64_conv.c: -------------------------------------------------------------------------------- 1 | #define CAML_NAME_SPACE 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | 14 | #include "int8.h" 15 | #include "int16.h" 16 | #include "int24.h" 17 | #include "int40.h" 18 | #include "int48.h" 19 | #include "int56.h" 20 | #include "int128.h" 21 | #include "uint8.h" 22 | #include "uint16.h" 23 | #include "uint24.h" 24 | #include "uint32.h" 25 | #include "uint40.h" 26 | #include "uint48.h" 27 | #include "uint56.h" 28 | #include "uint64.h" 29 | #include "uint128.h" 30 | 31 | CAMLprim value 32 | int64_of_int(value v) 33 | { 34 | CAMLparam1(v); 35 | CAMLreturn (caml_copy_int64((int64_t)Long_val(v))); 36 | } 37 | 38 | CAMLprim value 39 | int64_of_nativeint(value v) 40 | { 41 | CAMLparam1(v); 42 | CAMLreturn (caml_copy_int64((int64_t)Nativeint_val(v))); 43 | } 44 | 45 | CAMLprim value 46 | int64_of_float(value v) 47 | { 48 | CAMLparam1(v); 49 | CAMLreturn (caml_copy_int64((int64_t)Double_val(v))); 50 | } 51 | 52 | CAMLprim value 53 | int64_of_int8(value v) 54 | { 55 | CAMLparam1(v); 56 | CAMLreturn (caml_copy_int64((int64_t)Int8_val(v))); 57 | } 58 | 59 | CAMLprim value 60 | int64_of_int16(value v) 61 | { 62 | CAMLparam1(v); 63 | CAMLreturn (caml_copy_int64((int64_t)Int16_val(v))); 64 | } 65 | 66 | CAMLprim value 67 | int64_of_int24(value v) 68 | { 69 | CAMLparam1(v); 70 | CAMLreturn (caml_copy_int64((int64_t)Int24_val(v))); 71 | } 72 | 73 | CAMLprim value 74 | int64_of_int32(value v) 75 | { 76 | CAMLparam1(v); 77 | CAMLreturn (caml_copy_int64((int64_t)Int32_val(v))); 78 | } 79 | 80 | CAMLprim value 81 | int64_of_int40(value v) 82 | { 83 | CAMLparam1(v); 84 | CAMLreturn (caml_copy_int64((int64_t)Int40_val(v))); 85 | } 86 | 87 | CAMLprim value 88 | int64_of_int48(value v) 89 | { 90 | CAMLparam1(v); 91 | CAMLreturn (caml_copy_int64((int64_t)Int48_val(v))); 92 | } 93 | 94 | CAMLprim value 95 | int64_of_int56(value v) 96 | { 97 | CAMLparam1(v); 98 | CAMLreturn (caml_copy_int64((int64_t)Int56_val(v))); 99 | } 100 | 101 | CAMLprim value 102 | int64_of_int128(value v) 103 | { 104 | CAMLparam1(v); 105 | #ifdef HAVE_INT128 106 | CAMLreturn (caml_copy_int64((int64_t)Int128_val(v))); 107 | #else 108 | caml_failwith(__func__); 109 | CAMLreturn(Val_unit); 110 | #endif 111 | } 112 | 113 | CAMLprim value 114 | int64_of_uint8(value v) 115 | { 116 | CAMLparam1(v); 117 | CAMLreturn (caml_copy_int64((int64_t)Uint8_val(v))); 118 | } 119 | 120 | CAMLprim value 121 | int64_of_uint16(value v) 122 | { 123 | CAMLparam1(v); 124 | CAMLreturn (caml_copy_int64((int64_t)Uint16_val(v))); 125 | } 126 | 127 | CAMLprim value 128 | int64_of_uint24(value v) 129 | { 130 | CAMLparam1(v); 131 | CAMLreturn (caml_copy_int64((int64_t)Uint24_val(v))); 132 | } 133 | 134 | CAMLprim value 135 | int64_of_uint32(value v) 136 | { 137 | CAMLparam1(v); 138 | CAMLreturn (caml_copy_int64((int64_t)Uint32_val(v))); 139 | } 140 | 141 | CAMLprim value 142 | int64_of_uint40(value v) 143 | { 144 | CAMLparam1(v); 145 | CAMLreturn (caml_copy_int64((int64_t)Uint40_val(v))); 146 | } 147 | 148 | CAMLprim value 149 | int64_of_uint48(value v) 150 | { 151 | CAMLparam1(v); 152 | CAMLreturn (caml_copy_int64((int64_t)Uint48_val(v))); 153 | } 154 | 155 | CAMLprim value 156 | int64_of_uint56(value v) 157 | { 158 | CAMLparam1(v); 159 | CAMLreturn (caml_copy_int64((int64_t)Uint56_val(v))); 160 | } 161 | 162 | CAMLprim value 163 | int64_of_uint64(value v) 164 | { 165 | CAMLparam1(v); 166 | CAMLreturn (caml_copy_int64((int64_t)Uint64_val(v))); 167 | } 168 | 169 | CAMLprim value 170 | int64_of_uint128(value v) 171 | { 172 | CAMLparam1(v); 173 | #ifdef HAVE_UINT128 174 | CAMLreturn (caml_copy_int64((int64_t)Uint128_val(v))); 175 | #else 176 | caml_failwith(__func__); 177 | CAMLreturn(Val_unit); 178 | #endif 179 | } 180 | 181 | -------------------------------------------------------------------------------- /lib/int8.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_INT8_H 2 | #define OCAML_INT8_H 3 | 4 | #ifdef ARCH_SIXTYFOUR 5 | 6 | #define Int8_val(x) ((int8_t)(((intnat)(x)) >> 56)) 7 | #define Val_int8(x) (((intnat)(x) << 56) + 1) 8 | 9 | #else 10 | 11 | #define Int8_val(x) ((int8_t)(((intnat)(x)) >> 24)) 12 | #define Val_int8(x) (((intnat)(x) << 24) + 1) 13 | 14 | #endif 15 | 16 | #endif 17 | -------------------------------------------------------------------------------- /lib/int8_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | #include 30 | 31 | CAMLprim value 32 | int8_of_int(value v) 33 | { 34 | CAMLparam1(v); 35 | CAMLreturn (Val_int8((int8_t)Long_val(v))); 36 | } 37 | 38 | CAMLprim value 39 | int8_of_nativeint(value v) 40 | { 41 | CAMLparam1(v); 42 | CAMLreturn (Val_int8((int8_t)Nativeint_val(v))); 43 | } 44 | 45 | CAMLprim value 46 | int8_of_float(value v) 47 | { 48 | CAMLparam1(v); 49 | CAMLreturn (Val_int8((int8_t)Double_val(v))); 50 | } 51 | 52 | CAMLprim value 53 | int8_of_int16(value v) 54 | { 55 | CAMLparam1(v); 56 | CAMLreturn (Val_int8((int8_t)Int16_val(v))); 57 | } 58 | 59 | CAMLprim value 60 | int8_of_int24(value v) 61 | { 62 | CAMLparam1(v); 63 | CAMLreturn (Val_int8((int8_t)Int24_val(v))); 64 | } 65 | 66 | CAMLprim value 67 | int8_of_int32(value v) 68 | { 69 | CAMLparam1(v); 70 | CAMLreturn (Val_int8((int8_t)Int32_val(v))); 71 | } 72 | 73 | CAMLprim value 74 | int8_of_int40(value v) 75 | { 76 | CAMLparam1(v); 77 | CAMLreturn (Val_int8((int8_t)Int40_val(v))); 78 | } 79 | 80 | CAMLprim value 81 | int8_of_int48(value v) 82 | { 83 | CAMLparam1(v); 84 | CAMLreturn (Val_int8((int8_t)Int48_val(v))); 85 | } 86 | 87 | CAMLprim value 88 | int8_of_int56(value v) 89 | { 90 | CAMLparam1(v); 91 | CAMLreturn (Val_int8((int8_t)Int56_val(v))); 92 | } 93 | 94 | CAMLprim value 95 | int8_of_int64(value v) 96 | { 97 | CAMLparam1(v); 98 | CAMLreturn (Val_int8((int8_t)Int64_val(v))); 99 | } 100 | 101 | CAMLprim value 102 | int8_of_int128(value v) 103 | { 104 | CAMLparam1(v); 105 | #ifdef HAVE_INT128 106 | CAMLreturn (Val_int8((int8_t)Int128_val(v))); 107 | #else 108 | caml_failwith(__func__); 109 | CAMLreturn(Val_unit); 110 | #endif 111 | } 112 | 113 | CAMLprim value 114 | int8_of_uint8(value v) 115 | { 116 | CAMLparam1(v); 117 | CAMLreturn (Val_int8((int8_t)Uint8_val(v))); 118 | } 119 | 120 | CAMLprim value 121 | int8_of_uint16(value v) 122 | { 123 | CAMLparam1(v); 124 | CAMLreturn (Val_int8((int8_t)Uint16_val(v))); 125 | } 126 | 127 | CAMLprim value 128 | int8_of_uint24(value v) 129 | { 130 | CAMLparam1(v); 131 | CAMLreturn (Val_int8((int8_t)Uint24_val(v))); 132 | } 133 | 134 | CAMLprim value 135 | int8_of_uint32(value v) 136 | { 137 | CAMLparam1(v); 138 | CAMLreturn (Val_int8((int8_t)Uint32_val(v))); 139 | } 140 | 141 | CAMLprim value 142 | int8_of_uint40(value v) 143 | { 144 | CAMLparam1(v); 145 | CAMLreturn (Val_int8((int8_t)Uint40_val(v))); 146 | } 147 | 148 | CAMLprim value 149 | int8_of_uint48(value v) 150 | { 151 | CAMLparam1(v); 152 | CAMLreturn (Val_int8((int8_t)Uint48_val(v))); 153 | } 154 | 155 | CAMLprim value 156 | int8_of_uint56(value v) 157 | { 158 | CAMLparam1(v); 159 | CAMLreturn (Val_int8((int8_t)Uint56_val(v))); 160 | } 161 | 162 | CAMLprim value 163 | int8_of_uint64(value v) 164 | { 165 | CAMLparam1(v); 166 | CAMLreturn (Val_int8((int8_t)Uint64_val(v))); 167 | } 168 | 169 | CAMLprim value 170 | int8_of_uint128(value v) 171 | { 172 | CAMLparam1(v); 173 | #ifdef HAVE_UINT128 174 | CAMLreturn (Val_int8((int8_t)Uint128_val(v))); 175 | #else 176 | caml_failwith(__func__); 177 | CAMLreturn(Val_unit); 178 | #endif 179 | } 180 | 181 | CAMLprim value int8_bits_of_float(value v) { 182 | CAMLparam1(v); 183 | union { float d; int8_t i; } u; 184 | u.d = Double_val(v); 185 | CAMLreturn (Val_int8(u.i)); 186 | } 187 | 188 | CAMLprim value int8_float_of_bits(value v) { 189 | CAMLparam1(v); 190 | union { float d; int8_t i; } u; 191 | u.i = Int8_val(v); 192 | CAMLreturn (caml_copy_double(u.d)); 193 | } 194 | 195 | -------------------------------------------------------------------------------- /lib/int_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | int_of_int8(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (Val_long((intnat)Int8_val(v))); 34 | } 35 | 36 | CAMLprim value 37 | int_of_int16(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (Val_long((intnat)Int16_val(v))); 41 | } 42 | 43 | CAMLprim value 44 | int_of_int24(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (Val_long((intnat)Int24_val(v))); 48 | } 49 | 50 | CAMLprim value 51 | int_of_int32(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (Val_long((intnat)Int32_val(v))); 55 | } 56 | 57 | CAMLprim value 58 | int_of_int40(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (Val_long((intnat)Int40_val(v))); 62 | } 63 | 64 | CAMLprim value 65 | int_of_int48(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (Val_long((intnat)Int48_val(v))); 69 | } 70 | 71 | CAMLprim value 72 | int_of_int56(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (Val_long((intnat)Int56_val(v))); 76 | } 77 | 78 | CAMLprim value 79 | int_of_int64(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (Val_long((intnat)Int64_val(v))); 83 | } 84 | 85 | CAMLprim value 86 | int_of_int128(value v) 87 | { 88 | CAMLparam1(v); 89 | #ifdef HAVE_INT128 90 | CAMLreturn (Val_long((intnat)Int128_val(v))); 91 | #else 92 | caml_failwith(__func__); 93 | CAMLreturn(Val_unit); 94 | #endif 95 | } 96 | 97 | CAMLprim value 98 | int_of_uint8(value v) 99 | { 100 | CAMLparam1(v); 101 | CAMLreturn (Val_long((intnat)Uint8_val(v))); 102 | } 103 | 104 | CAMLprim value 105 | int_of_uint16(value v) 106 | { 107 | CAMLparam1(v); 108 | CAMLreturn (Val_long((intnat)Uint16_val(v))); 109 | } 110 | 111 | CAMLprim value 112 | int_of_uint24(value v) 113 | { 114 | CAMLparam1(v); 115 | CAMLreturn (Val_long((intnat)Uint24_val(v))); 116 | } 117 | 118 | CAMLprim value 119 | int_of_uint32(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (Val_long((intnat)Uint32_val(v))); 123 | } 124 | 125 | CAMLprim value 126 | int_of_uint40(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (Val_long((intnat)Uint40_val(v))); 130 | } 131 | 132 | CAMLprim value 133 | int_of_uint48(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (Val_long((intnat)Uint48_val(v))); 137 | } 138 | 139 | CAMLprim value 140 | int_of_uint56(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (Val_long((intnat)Uint56_val(v))); 144 | } 145 | 146 | CAMLprim value 147 | int_of_uint64(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (Val_long((intnat)Uint64_val(v))); 151 | } 152 | 153 | CAMLprim value 154 | int_of_uint128(value v) 155 | { 156 | CAMLparam1(v); 157 | #ifdef HAVE_UINT128 158 | CAMLreturn (Val_long((intnat)Uint128_val(v))); 159 | #else 160 | caml_failwith(__func__); 161 | CAMLreturn(Val_unit); 162 | #endif 163 | } 164 | 165 | -------------------------------------------------------------------------------- /lib/int_wrapper.ml: -------------------------------------------------------------------------------- 1 | module type Size = sig 2 | val bits : int 3 | end 4 | 5 | module type S = sig 6 | type t = int 7 | val bits : int 8 | val add : t -> t -> t 9 | val sub : t -> t -> t 10 | val mul : t -> t -> t 11 | val div : t -> t -> t 12 | val rem : t -> t -> t 13 | val logand : t -> t -> t 14 | val logor : t -> t -> t 15 | val logxor : t -> t -> t 16 | val shift_left : t -> t -> t 17 | val shift_right : t -> t -> t 18 | val shift_right_logical : t -> t -> t 19 | val abs : t -> t 20 | val neg : t -> t 21 | val of_int : int -> t 22 | val to_int : t -> int 23 | val zero : t 24 | val one : t 25 | val succ : t -> t 26 | val pred : t -> t 27 | val max_int : t 28 | val min_int : t 29 | val lognot : t -> t 30 | val compare : t -> t -> int 31 | val divmod : t -> t -> (t * t) 32 | end 33 | 34 | module Make_signed (I : Size) = struct 35 | type t = int 36 | 37 | let bits = I.bits 38 | 39 | let of_int x = x lsl (Sys.word_size - I.bits - 1) 40 | let to_int x = x asr (Sys.word_size - I.bits - 1) 41 | let mask = (1 lsl I.bits) - 1 42 | 43 | let add = (+) 44 | let sub = (-) 45 | let mul a b = (to_int a) * b 46 | let div a b = of_int (a / b) 47 | let rem = (mod) 48 | let logand = (land) 49 | let logor = (lor) 50 | let logxor a b = (a lxor b) land (of_int mask) 51 | let shift_left a b = a lsl b 52 | let shift_right a b = (a asr b) land (of_int mask) 53 | let shift_right_logical a b = (a lsr b) land (of_int mask) 54 | let abs = abs 55 | let neg x = (-1) * x 56 | 57 | let zero = 0 58 | let one = of_int 1 59 | let minus_one = of_int (-1) 60 | let succ = add one 61 | let pred x = sub x one 62 | 63 | let max_int = of_int (1 lsl (I.bits - 1)) - 1 64 | let min_int = of_int ((-1) * (1 lsl (I.bits - 1))) 65 | 66 | let lognot = logxor minus_one 67 | let compare = Stdint_stdlib_.compare 68 | let divmod = (fun x y -> div x y, rem x y) 69 | end 70 | 71 | module Make_unsigned (I : Size) = struct 72 | type t = int 73 | 74 | let bits = I.bits 75 | 76 | let mask = (1 lsl I.bits) - 1 77 | let of_int = (land) mask 78 | external to_int : t -> int = "%identity" 79 | 80 | let add a b = of_int (a + b) 81 | let sub a b = of_int (a - b) 82 | let mul a b = of_int (a * b) 83 | let div = (/) 84 | let rem = (mod) 85 | let logand = (land) 86 | let logor = (lor) 87 | let logxor a b = of_int (a lxor b) 88 | let shift_left a b = of_int (a lsl b) 89 | let shift_right = (lsr) 90 | let shift_right_logical = shift_right 91 | external abs : t -> t = "%identity" 92 | let neg x = of_int ((-1) * x) 93 | 94 | let zero = of_int 0 95 | let one = of_int 1 96 | let succ = add one 97 | let pred x = sub x one 98 | let max_int = of_int ((1 lsl I.bits) - 1) 99 | let min_int = zero 100 | let lognot = logxor max_int 101 | let compare = Stdint_stdlib_.compare 102 | let divmod = (fun x y -> div x y, rem x y) 103 | end 104 | 105 | -------------------------------------------------------------------------------- /lib/int_wrapper.mli: -------------------------------------------------------------------------------- 1 | module type Size = sig 2 | val bits : int 3 | end 4 | 5 | module type S = sig 6 | type t = int 7 | val bits : int 8 | val add : t -> t -> t 9 | val sub : t -> t -> t 10 | val mul : t -> t -> t 11 | val div : t -> t -> t 12 | val rem : t -> t -> t 13 | val logand : t -> t -> t 14 | val logor : t -> t -> t 15 | val logxor : t -> t -> t 16 | val shift_left : t -> t -> t 17 | val shift_right : t -> t -> t 18 | val shift_right_logical : t -> t -> t 19 | val abs : t -> t 20 | val neg : t -> t 21 | val of_int : int -> t 22 | val to_int : t -> int 23 | val zero : t 24 | val one : t 25 | val succ : t -> t 26 | val pred : t -> t 27 | val max_int : t 28 | val min_int : t 29 | val lognot : t -> t 30 | val compare : t -> t -> int 31 | val divmod : t -> t -> (t * t) 32 | end 33 | 34 | module Make_signed (D : Size) : S 35 | 36 | module Make_unsigned (D : Size) : S 37 | 38 | -------------------------------------------------------------------------------- /lib/nativeint_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | nativeint_of_int8(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (caml_copy_nativeint((intnat)Int8_val(v))); 34 | } 35 | 36 | CAMLprim value 37 | nativeint_of_int16(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (caml_copy_nativeint((intnat)Int16_val(v))); 41 | } 42 | 43 | CAMLprim value 44 | nativeint_of_int24(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (caml_copy_nativeint((intnat)Int24_val(v))); 48 | } 49 | 50 | CAMLprim value 51 | nativeint_of_int32(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (caml_copy_nativeint((intnat)Int32_val(v))); 55 | } 56 | 57 | CAMLprim value 58 | nativeint_of_int40(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (caml_copy_nativeint((intnat)Int40_val(v))); 62 | } 63 | 64 | CAMLprim value 65 | nativeint_of_int48(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (caml_copy_nativeint((intnat)Int48_val(v))); 69 | } 70 | 71 | CAMLprim value 72 | nativeint_of_int56(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (caml_copy_nativeint((intnat)Int56_val(v))); 76 | } 77 | 78 | CAMLprim value 79 | nativeint_of_int64(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (caml_copy_nativeint((intnat)Int64_val(v))); 83 | } 84 | 85 | CAMLprim value 86 | nativeint_of_int128(value v) 87 | { 88 | CAMLparam1(v); 89 | #ifdef HAVE_INT128 90 | CAMLreturn (caml_copy_nativeint((intnat)Int128_val(v))); 91 | #else 92 | caml_failwith(__func__); 93 | CAMLreturn(Val_unit); 94 | #endif 95 | } 96 | 97 | CAMLprim value 98 | nativeint_of_uint8(value v) 99 | { 100 | CAMLparam1(v); 101 | CAMLreturn (caml_copy_nativeint((intnat)Uint8_val(v))); 102 | } 103 | 104 | CAMLprim value 105 | nativeint_of_uint16(value v) 106 | { 107 | CAMLparam1(v); 108 | CAMLreturn (caml_copy_nativeint((intnat)Uint16_val(v))); 109 | } 110 | 111 | CAMLprim value 112 | nativeint_of_uint24(value v) 113 | { 114 | CAMLparam1(v); 115 | CAMLreturn (caml_copy_nativeint((intnat)Uint24_val(v))); 116 | } 117 | 118 | CAMLprim value 119 | nativeint_of_uint32(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (caml_copy_nativeint((intnat)Uint32_val(v))); 123 | } 124 | 125 | CAMLprim value 126 | nativeint_of_uint40(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (caml_copy_nativeint((intnat)Uint40_val(v))); 130 | } 131 | 132 | CAMLprim value 133 | nativeint_of_uint48(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (caml_copy_nativeint((intnat)Uint48_val(v))); 137 | } 138 | 139 | CAMLprim value 140 | nativeint_of_uint56(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (caml_copy_nativeint((intnat)Uint56_val(v))); 144 | } 145 | 146 | CAMLprim value 147 | nativeint_of_uint64(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (caml_copy_nativeint((intnat)Uint64_val(v))); 151 | } 152 | 153 | CAMLprim value 154 | nativeint_of_uint128(value v) 155 | { 156 | CAMLparam1(v); 157 | #ifdef HAVE_UINT128 158 | CAMLreturn (caml_copy_nativeint((intnat)Uint128_val(v))); 159 | #else 160 | caml_failwith(__func__); 161 | CAMLreturn(Val_unit); 162 | #endif 163 | } 164 | 165 | -------------------------------------------------------------------------------- /lib/stdint.mli: -------------------------------------------------------------------------------- 1 | (** Standard integer types *) 2 | 3 | type int8 = private int 4 | (** Signed 8-bit integer *) 5 | 6 | type int16 = private int 7 | (** Signed 16-bit integer *) 8 | 9 | type int24 = private int 10 | (** Signed 24-bit integer *) 11 | 12 | type int32 = Int32.t 13 | (** Signed 32-bit integer *) 14 | 15 | type int40 16 | (** Signed 40-bit integer *) 17 | 18 | type int48 19 | (** Signed 48-bit integer *) 20 | 21 | type int56 22 | (** Signed 56-bit integer *) 23 | 24 | type int64 = Int64.t 25 | (** Signed 64-bit integer *) 26 | 27 | type int128 28 | (** Signed 128-bit integer *) 29 | 30 | type uint8 = private int 31 | (** Unsigned 8-bit integer *) 32 | 33 | type uint16 = private int 34 | (** Unsigned 16-bit integer *) 35 | 36 | type uint24 = private int 37 | (** Unsigned 24-bit integer *) 38 | 39 | type uint32 40 | (** Unsigned 32-bit integer *) 41 | 42 | type uint40 43 | (** Unsigned 40-bit integer *) 44 | 45 | type uint48 46 | (** Unsigned 48-bit integer *) 47 | 48 | type uint56 49 | (** Unsigned 56-bit integer *) 50 | 51 | type uint64 52 | (** Unsigned 64-bit integer *) 53 | 54 | type uint128 55 | (** Unsigned 128-bit integer *) 56 | 57 | (** The generic integer interface *) 58 | module type Int = sig 59 | 60 | type t 61 | (** The specific integer type *) 62 | 63 | (** {5 Constants} *) 64 | 65 | val zero : t 66 | (** The value [0] *) 67 | 68 | val one : t 69 | (** The value [1] *) 70 | 71 | val max_int : t 72 | (** The greatest representable integer *) 73 | 74 | val min_int : t 75 | (** The smallest representable integer; for unsigned integers this is [zero]. *) 76 | 77 | val bits : int 78 | (** The number of bits used by this integer *) 79 | 80 | (** {5 Infix operations } *) 81 | 82 | val ( + ): t -> t -> t 83 | (** Addition *) 84 | 85 | val ( - ): t -> t -> t 86 | (** Subtraction *) 87 | 88 | val ( * ) : t -> t -> t 89 | (** Multiplication *) 90 | 91 | val ( / ) : t -> t -> t 92 | (** Integer division. Raise [Division_by_zero] if the second argument is zero. 93 | This division rounds the real quotient of its arguments towards zero, as specified for [(/)]. *) 94 | 95 | (** {5 Arithmetic operations } *) 96 | 97 | val add : t -> t -> t 98 | (** Addition *) 99 | 100 | val sub : t -> t -> t 101 | (** Subtraction *) 102 | 103 | val mul : t -> t -> t 104 | (** Multiplication *) 105 | 106 | val div : t -> t -> t 107 | (** Integer division. Raise [Division_by_zero] if the second argument is zero. 108 | This division rounds the real quotient of its arguments towards zero, as specified for [(/)]. *) 109 | 110 | val rem : t -> t -> t 111 | (** Integer remainder. If [y] is not [zero], the result of [rem x y] satisfies the following property: 112 | [x = add (mul (div x y) y) (rem x y)]. If [y = 0], [rem x y] raises [Division_by_zero]. *) 113 | 114 | val succ : t -> t 115 | (** Successor. [succ x] is [add x one]. *) 116 | 117 | val pred : t -> t 118 | (** Predecessor. [pred x] is [sub x one]. *) 119 | 120 | val abs : t -> t 121 | (** Return the absolute value of its argument. *) 122 | 123 | val neg : t -> t 124 | (* Unary negation. Negation satisfies the property that [0 = x + (neg x)] for signed and unsigned types. *) 125 | 126 | (** {5 Bitiwse operations } *) 127 | 128 | val logand : t -> t -> t 129 | (** Bitwise logical and. *) 130 | 131 | val logor : t -> t -> t 132 | (** Bitwise logical or. *) 133 | 134 | val logxor : t -> t -> t 135 | (** Bitwise logical exclusive or. *) 136 | 137 | val lognot : t -> t 138 | (** Bitwise logical negation. *) 139 | 140 | val shift_left : t -> int -> t 141 | (** [shift_left x y] shifts [x] to the left by [y] bits. 142 | The result is unspecified if [y < 0] or [y >= bits]. *) 143 | 144 | val shift_right : t -> int -> t 145 | (** [shift_right x y] shifts [x] to the right by [y] bits. 146 | If this is a signed integer, this is an arithmetic shift: 147 | the sign bit of [x] is replicated and inserted in the vacated bits. 148 | The result is unspecified if [y < 0] or [y >= bits]. 149 | For an unsigned integer, this is identical to [shift_right_logical]. *) 150 | 151 | val shift_right_logical : t -> int -> t 152 | (** [shift_right_logical x y] shifts [x] to the right by [y] bits. 153 | This is a logical shift: zeroes are inserted in the vacated bits regardless 154 | if [x] is a signed or unsiged integer. 155 | The result is unspecified if [y < 0] or [y >= bits]. *) 156 | 157 | (** {5 Numeric conversion functions} *) 158 | 159 | val of_int : int -> t 160 | (** Convert the given integer (type [int]) to this integer type. *) 161 | 162 | val to_int : t -> int 163 | (** Convert the given integer (type [t]) to an integer of type [int]. *) 164 | 165 | val of_float : float -> t 166 | (** Convert the given floating-point number to an integer of type [t]. *) 167 | 168 | val to_float : t -> float 169 | (** Convert the given integer to a floating-point number. *) 170 | 171 | val of_nativeint : nativeint -> t 172 | (** Convert the given integer (type [t]) to a native integer. *) 173 | 174 | val to_nativeint : t -> nativeint 175 | (** Convert the given native integer (type [nativeint]) to an integer (type [t]. *) 176 | 177 | val of_int8 : int8 -> t 178 | (** Convert an integer of type [int8] to an integer of type [t]. *) 179 | 180 | val to_int8 : t -> int8 181 | (** Convert an integer of type [t] to an integer of type [int8]. *) 182 | 183 | val of_int16 : int16 -> t 184 | (** Convert an integer of type [int16] to an integer of type [t]. *) 185 | 186 | val to_int16 : t -> int16 187 | (** Convert an integer of type [t] to an integer of type [int16]. *) 188 | 189 | val of_int24 : int24 -> t 190 | (** Convert an integer of type [int24] to an integer of type [t]. *) 191 | 192 | val to_int24 : t -> int24 193 | (** Convert an integer of type [t] to an integer of type [int24]. *) 194 | 195 | val of_int32 : int32 -> t 196 | (** Convert an integer of type [int32] to an integer of type [t]. *) 197 | 198 | val to_int32 : t -> int32 199 | (** Convert an integer of type [t] to an integer of type [int32]. *) 200 | 201 | val of_int40 : int40 -> t 202 | (** Convert an integer of type [int40] to an integer of type [t]. *) 203 | 204 | val to_int40 : t -> int40 205 | (** Convert an integer of type [t] to an integer of type [int40]. *) 206 | 207 | val of_int48 : int48 -> t 208 | (** Convert an integer of type [int48] to an integer of type [t]. *) 209 | 210 | val to_int48 : t -> int48 211 | (** Convert an integer of type [t] to an integer of type [int48]. *) 212 | 213 | val of_int56 : int56 -> t 214 | (** Convert an integer of type [int56] to an integer of type [t]. *) 215 | 216 | val to_int56 : t -> int56 217 | (** Convert an integer of type [t] to an integer of type [int56]. *) 218 | 219 | val of_int64 : int64 -> t 220 | (** Convert an integer of type [int64] to an integer of type [t]. *) 221 | 222 | val to_int64 : t -> int64 223 | (** Convert an integer of type [t] to an integer of type [int64]. *) 224 | 225 | val of_int128 : int128 -> t 226 | (** Convert an integer of type [int128] to an integer of type [t]. *) 227 | 228 | val to_int128 : t -> int128 229 | (** Convert an integer of type [t] to an integer of type [int128]. *) 230 | 231 | val of_uint8 : uint8 -> t 232 | (** Convert an integer of type [uint8] to an integer of type [t]. *) 233 | 234 | val to_uint8 : t -> uint8 235 | (** Convert an integer of type [t] to an integer of type [uint8]. *) 236 | 237 | val of_uint16 : uint16 -> t 238 | (** Convert an integer of type [uint16] to an integer of type [t]. *) 239 | 240 | val to_uint16 : t -> uint16 241 | (** Convert an integer of type [t] to an integer of type [uint16]. *) 242 | 243 | val of_uint24 : uint24 -> t 244 | (** Convert an integer of type [uint24] to an integer of type [t]. *) 245 | 246 | val to_uint24 : t -> uint24 247 | (** Convert an integer of type [t] to an integer of type [uint24]. *) 248 | 249 | val of_uint32 : uint32 -> t 250 | (** Convert an integer of type [uint32] to an integer of type [t]. *) 251 | 252 | val to_uint32 : t -> uint32 253 | (** Convert an integer of type [t] to an integer of type [uint32]. *) 254 | 255 | val of_uint40 : uint40 -> t 256 | (** Convert an integer of type [uint40] to an integer of type [t]. *) 257 | 258 | val to_uint40 : t -> uint40 259 | (** Convert an integer of type [t] to an integer of type [uint40]. *) 260 | 261 | val of_uint48 : uint48 -> t 262 | (** Convert an integer of type [uint48] to an integer of type [t]. *) 263 | 264 | val to_uint48 : t -> uint48 265 | (** Convert an integer of type [t] to an integer of type [uint48]. *) 266 | 267 | val of_uint56 : uint56 -> t 268 | (** Convert an integer of type [uint56] to an integer of type [t]. *) 269 | 270 | val to_uint56 : t -> uint56 271 | (** Convert an integer of type [t] to an integer of type [uint56]. *) 272 | 273 | val of_uint64 : uint64 -> t 274 | (** Convert an integer of type [uint64] to an integer of type [t]. *) 275 | 276 | val to_uint64 : t -> uint64 277 | (** Convert an integer of type [t] to an integer of type [uint64]. *) 278 | 279 | val of_uint128 : uint128 -> t 280 | (** Convert an integer of type [uint128] to an integer of type [t]. *) 281 | 282 | val to_uint128 : t -> uint128 283 | (** Convert an integer of type [t] to an integer of type [uint128]. *) 284 | 285 | (** {5 String conversion functions} *) 286 | 287 | val of_substring : string -> pos:int -> (t * int) 288 | (** Convert the given substring starting at the given offset [pos] 289 | to an integer of type [t] and return the offset. 290 | The string is read in decimal (by default) or in hexadecimal, octal 291 | or binary if the string begins with [0x], [0o] or [0b] respectively. 292 | Raise [Failure "*_of_substring"] if the given string is not a valid 293 | representation of an integer, or if the integer represented exceeds 294 | the range of integers representable in type [t]. *) 295 | 296 | val of_string : string -> t 297 | (** Convert the given string to an integer of type [t]. 298 | The string is read in decimal (by default) or in hexadecimal, octal 299 | or binary if the string begins with [0x], [0o] or [0b] respectively. 300 | Raise [Failure "*_of_string"] if the given string is not a valid 301 | representation of an integer, or if the integer represented exceeds 302 | the range of integers representable in type [t]. *) 303 | 304 | val to_string : t -> string 305 | (** Return the string representation of its argument, in decimal. *) 306 | 307 | val to_string_bin : t -> string 308 | (** Return the string representation of its argument, in binary (beginning with [0b]) *) 309 | 310 | val to_string_oct : t -> string 311 | (** Return the string representation of its argument, in octal (beginning with [0o]) *) 312 | 313 | val to_string_hex : t -> string 314 | (** Return the string representation of its argument, in hex (beginning with [0x]) *) 315 | 316 | val printer : Format.formatter -> t -> unit 317 | val printer_bin : Format.formatter -> t -> unit 318 | val printer_oct : Format.formatter -> t -> unit 319 | val printer_hex : Format.formatter -> t -> unit 320 | 321 | (** {5 Raw bytes conversion functions} *) 322 | 323 | val of_bytes_big_endian : Bytes.t -> int -> t 324 | (** [of_bytes_big_endian buffer offset] creates an integer value of type [t] from the 325 | buffer [buffer] starting at offset [offset]. The byte order is interpreted to be 326 | big endian. If the buffer does not hold enough bytes for this integer, i.e. if 327 | [(Bytes.length buffer) < (offset + (bits / 8))], the function will raise 328 | [Invalid_argument "index out of bounds"]. *) 329 | 330 | val of_bytes_little_endian : Bytes.t -> int -> t 331 | (** [of_bytes_big_endian buffer offset] creates an integer value of type [t] from the 332 | buffer [buffer] starting at offset [offset]. The byte order is interpreted to be 333 | little endian. If the buffer does not hold enough bytes for this integer, i.e. if 334 | [(Bytes.length buffer) < (offset + (bits / 8))], the function will raise 335 | [Invalid_argument "index out of bounds"]. *) 336 | 337 | val to_bytes_big_endian : t -> Bytes.t -> int -> unit 338 | (** [to_bytes_big_endian i buffer offset] writes the integer [i] to the buffer [buffer] 339 | starting at offset [offset]. The byte order used is big endian. If the buffer does 340 | not hold enough bytes, i.e. if [(Bytes.length buffer) < (offset + (bits / 8))], the 341 | function will raise [Invalid_argument "index out of bounds"]. *) 342 | 343 | val to_bytes_little_endian : t -> Bytes.t -> int -> unit 344 | (** [to_bytes_little_endian i buffer offset] writes the integer [i] to the buffer [buffer] 345 | starting at offset [offset]. The byte order used is little endian. If the buffer does 346 | not hold enough bytes, i.e. if [(Bytes.length buffer) < (offset + (bits / 8))], the 347 | function will raise [Invalid_argument "index out of bounds"]. *) 348 | 349 | (** {5 Comparison function} *) 350 | 351 | val compare : t -> t -> int 352 | (** The comparison function for integers of type [t], with the same specification as compare. 353 | Along with the type [t], this function compare allows this module to be 354 | passed as argument to the functors Set.Make and Map.Make. *) 355 | end 356 | 357 | module Int8 : Int with type t = int8 358 | module Int16 : Int with type t = int16 359 | module Int24 : Int with type t = int24 360 | module Int32 : Int with type t = int32 361 | module Int40 : Int with type t = int40 362 | module Int48 : Int with type t = int48 363 | module Int56 : Int with type t = int56 364 | module Int64 : Int with type t = int64 365 | module Int128 : Int with type t = int128 366 | module Uint8 : Int with type t = uint8 367 | module Uint16 : Int with type t = uint16 368 | module Uint24 : Int with type t = uint24 369 | module Uint32 : Int with type t = uint32 370 | module Uint40 : Int with type t = uint40 371 | module Uint48 : Int with type t = uint48 372 | module Uint56 : Int with type t = uint56 373 | module Uint64 : Int with type t = uint64 374 | module Uint128 : Int with type t = uint128 375 | -------------------------------------------------------------------------------- /lib/str_conv.ml: -------------------------------------------------------------------------------- 1 | module type IntSig = sig 2 | type t 3 | val name : string 4 | val fmt : string 5 | val zero : t 6 | val max_int : t 7 | val min_int : t 8 | val bits : int 9 | val of_int : int -> t 10 | val to_int : t -> int 11 | val add : t -> t -> t 12 | val sub : t -> t -> t 13 | val mul : t -> t -> t 14 | val divmod : t -> t -> t * t 15 | end 16 | 17 | module type S = sig 18 | type t 19 | val of_substring : string -> pos:int -> (t * int) 20 | val of_string : string -> t 21 | val to_string : t -> string 22 | val to_string_bin : t -> string 23 | val to_string_oct : t -> string 24 | val to_string_hex : t -> string 25 | val printer : Format.formatter -> t -> unit 26 | val printer_bin : Format.formatter -> t -> unit 27 | val printer_oct : Format.formatter -> t -> unit 28 | val printer_hex : Format.formatter -> t -> unit 29 | end 30 | 31 | module Make (I : IntSig) : S with type t = I.t = struct 32 | type t = I.t 33 | 34 | exception EndOfNumber of I.t * int 35 | 36 | (** Base function for *of_string* and *of_substring* 37 | * functions *) 38 | let _of_substring start_off s func_name = 39 | let fail () = invalid_arg (I.name ^ func_name) in 40 | if start_off >= String.length s then fail (); 41 | (* is this supposed to be a negative number? *) 42 | let negative, off = 43 | if s.[start_off] = '-' then 44 | true, 1+start_off 45 | else if s.[start_off] = '+' then 46 | false, 1+start_off 47 | else 48 | false, start_off in 49 | let len = String.length s in 50 | if len <= off then fail (); 51 | (* does the string have a base-prefix and what base is it? *) 52 | let base, off = 53 | let is_digit ~base c = 54 | if base <= 10 then ( 55 | Char.(code c - code '0') < base 56 | ) else ( 57 | (c >= '0' && c <= '9') || 58 | (10 + Char.(code (lowercase_ascii c) - code 'a') < base) 59 | ) in 60 | if len - off < 3 then (* no space for a prefix in there *) 61 | 10, off 62 | else if s.[off] = '0' then 63 | match Char.lowercase_ascii s.[off + 1] with 64 | | 'b' when is_digit ~base:2 s.[off+2] -> 2, off + 2 65 | | 'o' when is_digit ~base:8 s.[off+2] -> 8, off + 2 66 | | 'x' when is_digit ~base:16 s.[off+2] -> 16, off + 2 67 | | _ -> 10, off 68 | else 10, off in 69 | let base = I.of_int base in 70 | (* operators that are different for parsing negative and positive numbers *) 71 | let (thresh, rem), join, cmp_safe = 72 | if negative then 73 | (I.divmod I.min_int base, I.sub, 1) 74 | else 75 | (I.divmod I.max_int base, I.add, -1) in 76 | let rec loop off (n : I.t) = 77 | if off = len then 78 | n, off 79 | else begin 80 | let c = s.[off] in 81 | if c <> '_' then begin 82 | let disp = 83 | if c >= '0' && c <= '9' then 48 84 | else if c >= 'A' && c <= 'F' then 55 85 | else if c >= 'a' && c <= 'f' then 87 86 | else raise (EndOfNumber (n, off)) in 87 | let disp = int_of_char c - disp in 88 | let d = I.of_int disp in 89 | (* do not accept digit larger than the base *) 90 | if d >= base then raise (EndOfNumber (n, off)); 91 | (* will we overflow? *) 92 | (match compare n thresh with 93 | | 0 -> 94 | let r = compare d rem in 95 | if r <> cmp_safe && r <> 0 then raise (EndOfNumber (n, off)); 96 | | r -> 97 | if r <> cmp_safe then raise (EndOfNumber (n, off))); 98 | (* shift the existing number, join the new digit *) 99 | let res = join (I.mul n base) d in 100 | loop (off + 1) res 101 | end else 102 | loop (off + 1) n 103 | end 104 | in 105 | loop off I.zero 106 | 107 | let of_substring s ~pos = 108 | try 109 | _of_substring pos s ".of_substring" 110 | with 111 | | EndOfNumber (n, off) -> n, off 112 | 113 | let of_string s = 114 | try 115 | let n, _ = _of_substring 0 s ".of_string" in n 116 | with 117 | | EndOfNumber _ -> invalid_arg (I.name ^ ".of_string") 118 | 119 | let to_string_base base prefix x = 120 | let prefixlen = String.length prefix in 121 | let base = I.of_int base in 122 | let conv = "0123456789abcdef" in 123 | if x = I.zero then 124 | prefix ^ "0" 125 | else begin 126 | (* worst-case: 1 (signed) + length prefix + 1 char-per-bit *) 127 | let maxlen = 1 + prefixlen + I.bits in 128 | let buffer = Bytes.create maxlen in 129 | (* create the number starting at the end of the buffer, working towards 130 | * its start. *) 131 | let off = ref (maxlen - 1) in 132 | let rec loop n = 133 | if n <> I.zero then begin 134 | let n', digit = I.divmod n base in 135 | let digit = (I.to_int digit) in 136 | Bytes.set buffer !off conv.[abs digit]; 137 | decr off; 138 | loop n' 139 | end in 140 | loop x; 141 | (* add prefix -- in reverse order *) 142 | for i = prefixlen - 1 downto 0 do 143 | Bytes.set buffer !off (String.get prefix i); 144 | decr off 145 | done; 146 | if x < I.zero then begin 147 | Bytes.set buffer !off '-'; 148 | decr off 149 | end; 150 | Bytes.sub_string buffer (!off + 1) (maxlen - !off - 1) 151 | end 152 | 153 | let to_string = to_string_base 10 "" 154 | let to_string_bin = to_string_base 2 "0b" 155 | let to_string_oct = to_string_base 8 "0o" 156 | let to_string_hex = to_string_base 16 "0x" 157 | 158 | let print_with f fmt x = 159 | Format.fprintf fmt "@[%s@]" (f x ^ I.fmt) 160 | 161 | let printer = print_with to_string 162 | let printer_bin = print_with to_string_bin 163 | let printer_oct = print_with to_string_oct 164 | let printer_hex = print_with to_string_hex 165 | end 166 | -------------------------------------------------------------------------------- /lib/str_conv.mli: -------------------------------------------------------------------------------- 1 | module type IntSig = sig 2 | type t 3 | val name : string 4 | val fmt : string 5 | val zero : t 6 | val max_int : t 7 | val min_int : t 8 | val bits : int 9 | val of_int : int -> t 10 | val to_int : t -> int 11 | val add : t -> t -> t 12 | val sub : t -> t -> t 13 | val mul : t -> t -> t 14 | val divmod : t -> t -> t * t 15 | end 16 | 17 | module type S = sig 18 | type t 19 | val of_substring : string -> pos:int -> (t * int) 20 | val of_string : string -> t 21 | val to_string : t -> string 22 | val to_string_bin : t -> string 23 | val to_string_oct : t -> string 24 | val to_string_hex : t -> string 25 | val printer : Format.formatter -> t -> unit 26 | val printer_bin : Format.formatter -> t -> unit 27 | val printer_oct : Format.formatter -> t -> unit 28 | val printer_hex : Format.formatter -> t -> unit 29 | end 30 | 31 | module Make (I : IntSig) : S with type t = I.t 32 | 33 | -------------------------------------------------------------------------------- /lib/uint128.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_UINT128_H 2 | #define OCAML_UINT128_H 3 | 4 | #if defined(__SIZEOF_INT128__) 5 | 6 | #define HAVE_UINT128 7 | typedef __uint128_t uint128; 8 | typedef struct { uint64_t low; uint64_t high; } uint128_ocaml; 9 | 10 | inline __uint128_t get_uint128(value v) 11 | { 12 | uint128_ocaml *i = (uint128_ocaml *)Data_custom_val(v); 13 | return ((__uint128_t)i->high << 64 | i->low); 14 | } 15 | 16 | #define Uint128_val(v) get_uint128(v) 17 | 18 | #else 19 | 20 | typedef struct { uint64_t high; uint64_t low; } uint128; 21 | 22 | #define Uint128_val(v) (*((uint128 *)Data_custom_val(v))) 23 | 24 | #endif 25 | 26 | CAMLextern value copy_uint128(uint128 i); 27 | CAMLextern value suint128_add(value v1, value v2, CAMLprim value (*)(uint128)); 28 | CAMLextern value suint128_sub(value v1, value v2, CAMLprim value (*)(uint128)); 29 | CAMLextern value suint128_mul(value v1, value v2, CAMLprim value (*)(uint128)); 30 | CAMLextern value suint128_and(value v1, value v2, CAMLprim value (*)(uint128)); 31 | CAMLextern value suint128_or(value v1, value v2, CAMLprim value (*)(uint128)); 32 | CAMLextern value suint128_xor(value v1, value v2, CAMLprim value (*)(uint128)); 33 | CAMLextern value suint128_shift_left(value v1, value v2, CAMLprim value (*)(uint128)); 34 | 35 | #endif 36 | -------------------------------------------------------------------------------- /lib/uint128_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | uint128_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | #ifdef HAVE_INT128 34 | CAMLreturn(copy_uint128((__uint128_t)Long_val(v))); 35 | #else 36 | uint128 x = { .high = 0, .low = Long_val(v) }; 37 | CAMLreturn(copy_uint128(x)); 38 | #endif 39 | } 40 | 41 | CAMLprim value 42 | uint128_of_nativeint(value v) 43 | { 44 | CAMLparam1(v); 45 | #ifdef HAVE_UINT128 46 | CAMLreturn (copy_uint128((__uint128_t)Nativeint_val(v))); 47 | #else 48 | uint128 x = { .high = 0, .low = Nativeint_val(v) }; 49 | CAMLreturn(copy_uint128(x)); 50 | #endif 51 | } 52 | 53 | CAMLprim value 54 | uint128_of_float(value v) 55 | { 56 | CAMLparam1(v); 57 | #ifdef HAVE_UINT128 58 | CAMLreturn (copy_uint128((__uint128_t)Double_val(v))); 59 | #else 60 | caml_failwith(__func__); 61 | CAMLreturn(Val_unit); 62 | #endif 63 | } 64 | 65 | CAMLprim value 66 | uint128_of_int8(value v) 67 | { 68 | CAMLparam1(v); 69 | #ifdef HAVE_UINT128 70 | CAMLreturn (copy_uint128((__uint128_t)Int8_val(v))); 71 | #else 72 | uint128 x = { .high = 0, .low = Int8_val(v) }; 73 | CAMLreturn(copy_uint128(x)); 74 | #endif 75 | } 76 | 77 | CAMLprim value 78 | uint128_of_int16(value v) 79 | { 80 | CAMLparam1(v); 81 | #ifdef HAVE_UINT128 82 | CAMLreturn (copy_uint128((__uint128_t)Int16_val(v))); 83 | #else 84 | uint128 x = { .high = 0, .low = Int16_val(v) }; 85 | CAMLreturn(copy_uint128(x)); 86 | #endif 87 | } 88 | 89 | CAMLprim value 90 | uint128_of_int24(value v) 91 | { 92 | CAMLparam1(v); 93 | #ifdef HAVE_UINT128 94 | CAMLreturn (copy_uint128((__uint128_t)Int24_val(v))); 95 | #else 96 | uint128 x = { .high = 0, .low = Int24_val(v) }; 97 | CAMLreturn(copy_uint128(x)); 98 | #endif 99 | } 100 | 101 | CAMLprim value 102 | uint128_of_int32(value v) 103 | { 104 | CAMLparam1(v); 105 | #ifdef HAVE_UINT128 106 | CAMLreturn (copy_uint128((__uint128_t)Int32_val(v))); 107 | #else 108 | uint128 x = { .high = 0, .low = Int32_val(v) }; 109 | CAMLreturn(copy_uint128(x)); 110 | #endif 111 | } 112 | 113 | CAMLprim value 114 | uint128_of_int40(value v) 115 | { 116 | CAMLparam1(v); 117 | #ifdef HAVE_UINT128 118 | CAMLreturn (copy_uint128((__uint128_t)Int40_val(v))); 119 | #else 120 | uint128 x = { .high = 0, .low = Int40_val(v) }; 121 | CAMLreturn(copy_uint128(x)); 122 | #endif 123 | } 124 | 125 | CAMLprim value 126 | uint128_of_int48(value v) 127 | { 128 | CAMLparam1(v); 129 | #ifdef HAVE_UINT128 130 | CAMLreturn (copy_uint128((__uint128_t)Int48_val(v))); 131 | #else 132 | uint128 x = { .high = 0, .low = Int48_val(v) }; 133 | CAMLreturn(copy_uint128(x)); 134 | #endif 135 | } 136 | 137 | CAMLprim value 138 | uint128_of_int56(value v) 139 | { 140 | CAMLparam1(v); 141 | #ifdef HAVE_UINT128 142 | CAMLreturn (copy_uint128((__uint128_t)Int56_val(v))); 143 | #else 144 | uint128 x = { .high = 0, .low = Int56_val(v) }; 145 | CAMLreturn(copy_uint128(x)); 146 | #endif 147 | } 148 | 149 | CAMLprim value 150 | uint128_of_int64(value v) 151 | { 152 | CAMLparam1(v); 153 | #ifdef HAVE_UINT128 154 | CAMLreturn (copy_uint128((__uint128_t)Int64_val(v))); 155 | #else 156 | uint128 x = { .high = 0, .low = Int64_val(v) }; 157 | CAMLreturn(copy_uint128(x)); 158 | #endif 159 | } 160 | 161 | CAMLprim value 162 | uint128_of_int128(value v) 163 | { 164 | CAMLparam1(v); 165 | #ifdef HAVE_UINT128 166 | CAMLreturn (copy_uint128((__uint128_t)Int128_val(v))); 167 | #else 168 | int128 x = Int128_val(v); 169 | uint128 y = { .high = x.high, .low = x.low }; 170 | CAMLreturn(copy_uint128(y)); 171 | #endif 172 | } 173 | 174 | CAMLprim value 175 | uint128_of_uint8(value v) 176 | { 177 | CAMLparam1(v); 178 | #ifdef HAVE_UINT128 179 | CAMLreturn (copy_uint128((__uint128_t)Uint8_val(v))); 180 | #else 181 | caml_failwith(__func__); 182 | CAMLreturn(Val_unit); 183 | #endif 184 | } 185 | 186 | CAMLprim value 187 | uint128_of_uint16(value v) 188 | { 189 | CAMLparam1(v); 190 | #ifdef HAVE_UINT128 191 | CAMLreturn (copy_uint128((__uint128_t)Uint16_val(v))); 192 | #else 193 | uint128 x = { .high = 0, .low = Uint16_val(v) }; 194 | CAMLreturn(copy_uint128(x)); 195 | #endif 196 | } 197 | 198 | CAMLprim value 199 | uint128_of_uint24(value v) 200 | { 201 | CAMLparam1(v); 202 | #ifdef HAVE_UINT128 203 | CAMLreturn (copy_uint128((__uint128_t)Uint24_val(v))); 204 | #else 205 | uint128 x = { .high = 0, .low = Uint24_val(v) }; 206 | CAMLreturn(copy_uint128(x)); 207 | #endif 208 | } 209 | 210 | CAMLprim value 211 | uint128_of_uint32(value v) 212 | { 213 | CAMLparam1(v); 214 | #ifdef HAVE_UINT128 215 | CAMLreturn (copy_uint128((__uint128_t)Uint32_val(v))); 216 | #else 217 | uint128 x = { .high = 0, .low = Uint32_val(v) }; 218 | CAMLreturn(copy_uint128(x)); 219 | #endif 220 | } 221 | 222 | CAMLprim value 223 | uint128_of_uint40(value v) 224 | { 225 | CAMLparam1(v); 226 | #ifdef HAVE_UINT128 227 | CAMLreturn (copy_uint128((__uint128_t)Uint40_val(v))); 228 | #else 229 | uint128 x = { .high = 0, .low = Uint40_val(v) }; 230 | CAMLreturn(copy_uint128(x)); 231 | #endif 232 | } 233 | 234 | CAMLprim value 235 | uint128_of_uint48(value v) 236 | { 237 | CAMLparam1(v); 238 | #ifdef HAVE_UINT128 239 | CAMLreturn (copy_uint128((__uint128_t)Uint48_val(v))); 240 | #else 241 | uint128 x = { .high = 0, .low = Uint48_val(v) }; 242 | CAMLreturn(copy_uint128(x)); 243 | #endif 244 | } 245 | 246 | CAMLprim value 247 | uint128_of_uint56(value v) 248 | { 249 | CAMLparam1(v); 250 | #ifdef HAVE_UINT128 251 | CAMLreturn (copy_uint128((__uint128_t)Uint56_val(v))); 252 | #else 253 | uint128 x = { .high = 0, .low = Uint56_val(v) }; 254 | CAMLreturn(copy_uint128(x)); 255 | #endif 256 | } 257 | 258 | CAMLprim value 259 | uint128_of_uint64(value v) 260 | { 261 | CAMLparam1(v); 262 | #ifdef HAVE_UINT128 263 | CAMLreturn (copy_uint128((__uint128_t)Uint64_val(v))); 264 | #else 265 | uint128 x = { .high = 0, .low = Uint64_val(v) }; 266 | CAMLreturn(copy_uint128(x)); 267 | #endif 268 | } 269 | 270 | -------------------------------------------------------------------------------- /lib/uint128_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | 15 | #include "int8.h" 16 | #include "int16.h" 17 | #include "int128.h" 18 | #include "uint8.h" 19 | #include "uint16.h" 20 | #include "uint32.h" 21 | #include "uint64.h" 22 | #include "uint128.h" 23 | 24 | #ifdef HAVE_UINT128 25 | extern inline __uint128_t get_uint128(value); 26 | #else 27 | 28 | static inline int compare(uint128 *x, uint128 *y) { 29 | assert(x); 30 | assert(y); 31 | x->high -= y->high; 32 | if (0 != x->high) { 33 | return x->high; 34 | } 35 | return x->low - y->low; 36 | } 37 | 38 | static inline void shift_left(uint128 *x, int s) { 39 | assert(x); 40 | if (0 == s) { 41 | // nothing 42 | } else if (s < 64) { 43 | x->high = (x->high << s) | (x->low >> (64 - s)); 44 | x->low = x->low << s; 45 | } else { 46 | x->high = x->low << (s - 64); 47 | x->low = 0; 48 | } 49 | } 50 | 51 | static inline void shift_right(uint128 *x, int s) { 52 | assert(x); 53 | if (0 == s) { 54 | // nothing 55 | } else if (s < 64) { 56 | x->low = (x->high << (64 - s)) | (x->low >> s); 57 | x->high = x->high >> s; 58 | } else { 59 | x->low = x->high >> (s - 64); 60 | x->high = 0; 61 | } 62 | } 63 | 64 | static inline void sub(uint128 *x, uint128 *y) { 65 | assert(x); 66 | assert(y); 67 | if (x->low < y->low) { 68 | x->high--; 69 | } 70 | x->low -= y->low; 71 | x->high -= y->high; 72 | } 73 | 74 | void divmod128(uint128 *d, uint128 *modulus, uint128 *quotient, uint128 *rem) { 75 | uint128 mask; 76 | int cmp; 77 | 78 | mask = (uint128){.high = 0, .low = 1}; 79 | 80 | while (d->high >= 0) { 81 | cmp = compare(d, modulus); 82 | shift_left(d, 1); 83 | shift_left(&mask, 1); 84 | if (cmp >= 0) { 85 | break; 86 | } 87 | } 88 | rem = modulus; 89 | quotient = 0; 90 | 91 | while ((mask.low | mask.high) != 0) { 92 | if (compare(rem, d) >= 0) { 93 | *quotient = (uint128){.high = quotient->high | mask.high, .low = quotient->low | mask.low}; 94 | sub(rem, d); 95 | } 96 | shift_right(&mask, 1); 97 | shift_right(d, 1); 98 | } 99 | } 100 | 101 | void add(uint128 *x, uint128 *y) { 102 | x->low += y->low; 103 | x->high += y->high; 104 | if (x->low < y->low) { 105 | x->high++; 106 | } 107 | } 108 | #endif 109 | 110 | static int 111 | uint128_cmp(value v1, value v2) 112 | { 113 | #ifdef HAVE_UINT128 114 | __uint128_t i1 = Uint128_val(v1); 115 | __uint128_t i2 = Uint128_val(v2); 116 | return (i1 > i2) - (i1 < i2); 117 | #else 118 | uint128 x = Uint128_val(v1); 119 | uint128 y = Uint128_val(v2); 120 | 121 | return compare(&x, &y); 122 | #endif 123 | } 124 | 125 | static intnat 126 | uint128_hash(value v) 127 | { 128 | #ifdef HAVE_UINT128 129 | __uint128_t x = Uint128_val(v); 130 | uint32_t b0 = (uint32_t) x, 131 | b1 = (uint32_t) (x >> 32U), 132 | b2 = (uint32_t) (x >> 64U), 133 | b3 = (uint32_t) (x >> 96U); 134 | #else 135 | uint128 x = Uint128_val(v); 136 | uint32_t b0 = (uint32_t) x.low, 137 | b1 = (uint32_t) (x.low >> 32U), 138 | b2 = (uint32_t) x.high, 139 | b3 = (uint32_t) (x.high >> 32U); 140 | #endif 141 | return b0 ^ b1 ^ b2 ^ b3; 142 | } 143 | 144 | static void 145 | uint128_serialize(value v, uintnat *wsize_32, uintnat *wsize_64) 146 | { 147 | #ifdef HAVE_INT128 148 | __uint128_t i = Uint128_val(v); 149 | uint64_t hi = i >> 64U; 150 | uint64_t lo = i; 151 | #else 152 | uint128 i = Uint128_val(v); 153 | uint64_t hi = i.high; 154 | uint64_t lo = i.low; 155 | #endif 156 | /* Serializing in big-endian order as other integer values */ 157 | caml_serialize_int_8(hi); 158 | caml_serialize_int_8(lo); 159 | *wsize_32 = *wsize_64 = 16; 160 | } 161 | 162 | static uintnat 163 | uint128_deserialize(void *dst) 164 | { 165 | uint64_t hi = caml_deserialize_uint_8(); 166 | uint64_t lo = caml_deserialize_uint_8(); 167 | #ifdef HAVE_INT128 168 | __uint128_t v = ((__uint128_t)hi << 64U) | lo; 169 | #else 170 | uint128 v; 171 | v.high = hi; 172 | v.low = lo; 173 | #endif 174 | memcpy(dst, &v, sizeof(v)); 175 | return 16; 176 | } 177 | 178 | #if OCAML_VERSION_MAJOR > 4 || OCAML_VERSION_MAJOR == 4 && OCAML_VERSION_MINOR >= 8 179 | static const struct custom_fixed_length uint128_length = { 16, 16 }; 180 | #endif 181 | 182 | struct custom_operations uint128_ops = { 183 | "stdint.uint128", 184 | custom_finalize_default, 185 | uint128_cmp, 186 | uint128_hash, 187 | uint128_serialize, 188 | uint128_deserialize, 189 | custom_compare_ext_default 190 | #if OCAML_VERSION_MAJOR > 4 || OCAML_VERSION_MAJOR == 4 && OCAML_VERSION_MINOR >= 8 191 | , &uint128_length 192 | #endif 193 | }; 194 | 195 | #ifdef HAVE_UINT128 196 | CAMLprim value 197 | copy_uint128(__uint128_t i) 198 | { 199 | CAMLparam0(); 200 | value res = caml_alloc_custom(&uint128_ops, 16, 0, 1); 201 | uint128_ocaml *v = (uint128_ocaml *)Data_custom_val(res); 202 | v->high = (uint64_t)(i >> 64); 203 | v->low = (uint64_t)i; 204 | CAMLreturn (res); 205 | } 206 | #else 207 | CAMLprim value 208 | copy_uint128(uint128 i) 209 | { 210 | CAMLparam0(); 211 | value res = caml_alloc_custom(&uint128_ops, 16, 0, 1); 212 | Uint128_val(res) = i; 213 | CAMLreturn (res); 214 | } 215 | #endif 216 | 217 | CAMLprim value 218 | suint128_add(value v1, value v2, CAMLprim value (*copy)(uint128)) 219 | { 220 | CAMLparam2(v1, v2); 221 | #ifdef HAVE_UINT128 222 | CAMLreturn(copy(Uint128_val(v1) + Uint128_val(v2))); 223 | #else 224 | uint128 x, y; 225 | 226 | x = Uint128_val(v1); 227 | y = Uint128_val(v2); 228 | 229 | add(&x, &y); 230 | 231 | CAMLreturn(copy(x)); 232 | #endif 233 | } 234 | 235 | CAMLprim value 236 | uint128_add(value v1, value v2) 237 | { 238 | return suint128_add(v1, v2, copy_uint128); 239 | } 240 | 241 | CAMLprim value 242 | suint128_sub(value v1, value v2, CAMLprim value (*copy)(uint128)) 243 | { 244 | CAMLparam2(v1, v2); 245 | #ifdef HAVE_UINT128 246 | CAMLreturn (copy(Uint128_val(v1) - Uint128_val(v2))); 247 | #else 248 | uint128 x, y; 249 | 250 | x = Uint128_val(v1); 251 | y = Uint128_val(v2); 252 | 253 | sub(&x, &y); 254 | 255 | CAMLreturn (copy(x)); 256 | #endif 257 | } 258 | 259 | CAMLprim value 260 | uint128_sub(value v1, value v2) 261 | { 262 | return suint128_sub(v1, v2, copy_uint128); 263 | } 264 | 265 | CAMLprim value 266 | suint128_mul(value v1, value v2, CAMLprim value (*copy)(uint128)) 267 | { 268 | CAMLparam2(v1, v2); 269 | #ifdef HAVE_UINT128 270 | CAMLreturn (copy(Uint128_val(v1) * Uint128_val(v2))); 271 | #else 272 | uint128 x, y, z; 273 | uint64_t p0, p1, p2, p3; 274 | 275 | x = Uint128_val(v1); 276 | y = Uint128_val(v2); 277 | 278 | p0 = (x.low & UINT32_MAX) * (y.low & UINT32_MAX); 279 | p1 = (x.low & UINT32_MAX) * (y.low >> 32); 280 | p2 = (x.low >> 32) * (y.low & UINT32_MAX); 281 | p3 = (x.low >> 32) * (y.low >> 32); 282 | z.low = p0; 283 | z.high = p3 + (p1 >> 32) + (p2 >> 32); 284 | p1 <<= 32; 285 | z.low += p1; 286 | if (z.low < p1) { 287 | z.high++; 288 | } 289 | p2 <<= 32; 290 | z.low += p2; 291 | if (z.low < p2) { 292 | z.high++; 293 | } 294 | z.high += x.low * y.high + x.high * y.low; 295 | 296 | CAMLreturn(copy(z)); 297 | #endif 298 | } 299 | 300 | CAMLprim value 301 | uint128_mul(value v1, value v2) 302 | { 303 | return suint128_mul(v1, v2, copy_uint128); 304 | } 305 | 306 | CAMLprim value 307 | uint128_div(value v1, value v2) 308 | { 309 | CAMLparam2(v1, v2); 310 | #ifdef HAVE_UINT128 311 | __uint128_t divisor = Uint128_val(v2); 312 | 313 | if (divisor == 0) 314 | caml_raise_zero_divide(); 315 | CAMLreturn (copy_uint128(Uint128_val(v1) / divisor)); 316 | #else 317 | uint128 d, modulus, rem, quotient; 318 | 319 | d = Uint128_val(v1); 320 | modulus = Uint128_val(v2); 321 | 322 | divmod128(&d, &modulus, "ient, &rem); 323 | 324 | CAMLreturn(copy_uint128(quotient)); 325 | #endif 326 | } 327 | 328 | CAMLprim value 329 | uint128_mod(value v1, value v2) 330 | { 331 | CAMLparam2(v1, v2); 332 | #ifdef HAVE_UINT128 333 | __uint128_t divisor = Uint128_val(v2); 334 | if (divisor == 0) 335 | caml_raise_zero_divide(); 336 | CAMLreturn (copy_uint128(Uint128_val(v1) % divisor)); 337 | #else 338 | uint128 d, modulus, rem, quotient; 339 | 340 | d = Uint128_val(v1); 341 | modulus = Uint128_val(v2); 342 | 343 | divmod128(&d, &modulus, "ient, &rem); 344 | 345 | CAMLreturn(copy_uint128(rem)); 346 | #endif 347 | } 348 | 349 | CAMLprim value 350 | suint128_and(value v1, value v2, CAMLprim value (*copy)(uint128)) 351 | { 352 | CAMLparam2(v1, v2); 353 | #ifdef HAVE_UINT128 354 | CAMLreturn (copy(Uint128_val(v1) & Uint128_val(v2))); 355 | #else 356 | uint128 x, y; 357 | 358 | x = Uint128_val(v1); 359 | y = Uint128_val(v2); 360 | x.high &= y.high; 361 | x.low &= y.low; 362 | CAMLreturn (copy(x)); 363 | #endif 364 | } 365 | 366 | CAMLprim value 367 | uint128_and(value v1, value v2) 368 | { 369 | return suint128_and(v1, v2, copy_uint128); 370 | } 371 | 372 | CAMLprim value 373 | suint128_or(value v1, value v2, CAMLprim value (*copy)(uint128)) 374 | { 375 | CAMLparam2(v1, v2); 376 | #ifdef HAVE_UINT128 377 | CAMLreturn (copy(Uint128_val(v1) | Uint128_val(v2))); 378 | #else 379 | uint128 x, y; 380 | 381 | x = Uint128_val(v1); 382 | y = Uint128_val(v2); 383 | x.high |= y.high; 384 | x.low |= y.low; 385 | CAMLreturn (copy(x)); 386 | #endif 387 | } 388 | 389 | CAMLprim value 390 | uint128_or(value v1, value v2) 391 | { 392 | return suint128_or(v1, v2, copy_uint128); 393 | } 394 | 395 | CAMLprim value 396 | suint128_xor(value v1, value v2, CAMLprim value (*copy)(uint128)) 397 | { 398 | CAMLparam2(v1, v2); 399 | #ifdef HAVE_UINT128 400 | CAMLreturn (copy(Uint128_val(v1) ^ Uint128_val(v2))); 401 | #else 402 | uint128 x, y; 403 | 404 | x = Uint128_val(v1); 405 | y = Uint128_val(v2); 406 | x.high ^= y.high; 407 | x.low ^= y.low; 408 | CAMLreturn (copy(x)); 409 | #endif 410 | } 411 | 412 | CAMLprim value 413 | uint128_xor(value v1, value v2) 414 | { 415 | return suint128_xor(v1, v2, copy_uint128); 416 | } 417 | 418 | CAMLprim value 419 | suint128_shift_left(value v1, value v2, CAMLprim value (*copy)(uint128)) 420 | { 421 | CAMLparam2(v1, v2); 422 | #ifdef HAVE_UINT128 423 | CAMLreturn (copy(Uint128_val(v1) << Long_val(v2))); 424 | #else 425 | uint128 x; 426 | intnat s; 427 | 428 | x = Uint128_val(v1); 429 | s = Long_val(v2); 430 | 431 | shift_left(&x, s); 432 | 433 | CAMLreturn (copy(x)); 434 | #endif 435 | } 436 | 437 | CAMLprim value 438 | uint128_shift_left(value v1, value v2) 439 | { 440 | return suint128_shift_left(v1, v2, copy_uint128); 441 | } 442 | 443 | CAMLprim value 444 | uint128_shift_right(value v1, value v2) 445 | { 446 | CAMLparam2(v1, v2); 447 | #ifdef HAVE_UINT128 448 | CAMLreturn (copy_uint128(Uint128_val(v1) >> Long_val(v2))); 449 | #else 450 | uint128 x; 451 | intnat s; 452 | 453 | x = Uint128_val(v1); 454 | s = Long_val(v2); 455 | 456 | if (0 == s) { 457 | // nothing 458 | } else if (s < 64) { 459 | x.low = (x.high << (64 - s)) | (x.low >> s); 460 | x.high = x.high >> s; 461 | } else { 462 | x.low = x.high >> (s - 64); 463 | x.high = 0; 464 | } 465 | CAMLreturn (copy_uint128(x)); 466 | #endif 467 | } 468 | 469 | CAMLprim value 470 | uint128_bits_of_float(value v) 471 | { 472 | CAMLparam1(v); 473 | #ifdef HAVE_UINT128 474 | union { float d; __uint128_t i; } u; 475 | u.d = Double_val(v); 476 | CAMLreturn (copy_uint128(u.i)); 477 | #else 478 | caml_failwith(__func__); 479 | CAMLreturn(Val_unit); 480 | #endif 481 | } 482 | 483 | CAMLprim value 484 | uint128_float_of_bits(value v) 485 | { 486 | CAMLparam1(v); 487 | #ifdef HAVE_UINT128 488 | union { float d; __uint128_t i; } u; 489 | u.i = Uint128_val(v); 490 | CAMLreturn (caml_copy_double(u.d)); 491 | #else 492 | caml_failwith(__func__); 493 | CAMLreturn(Val_unit); 494 | #endif 495 | } 496 | 497 | #ifdef HAVE_UINT128 498 | static const uint128 uint128_max = (((__uint128_t) UINT64_MAX) << 64) | ((__uint128_t) UINT64_MAX); 499 | #else 500 | static const uint128 uint128_max = { .high = UINT64_MAX, .low = UINT64_MAX }; 501 | #endif 502 | 503 | CAMLprim value 504 | uint128_max_int(void) 505 | { 506 | CAMLparam0(); 507 | CAMLreturn (copy_uint128(uint128_max)); 508 | } 509 | 510 | CAMLprim value 511 | uint128_init_custom_ops(void) 512 | { 513 | CAMLparam0(); 514 | caml_register_custom_operations(&uint128_ops); 515 | CAMLreturn (Val_unit); 516 | } 517 | 518 | -------------------------------------------------------------------------------- /lib/uint16.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_UINT16_H 2 | #define OCAML_UINT16_H 3 | 4 | #define Uint16_val(x) ((uint16_t)(Unsigned_long_val(x))) 5 | #define Val_uint16(x) (Val_long((x) & 0xFFFF)) 6 | 7 | #endif 8 | 9 | -------------------------------------------------------------------------------- /lib/uint16_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | uint16_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (Val_uint16((uint16_t)Long_val(v))); 34 | } 35 | 36 | CAMLprim value 37 | uint16_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (Val_uint16((uint16_t)Nativeint_val(v))); 41 | } 42 | 43 | CAMLprim value 44 | uint16_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (Val_uint16((uint16_t)Double_val(v))); 48 | } 49 | 50 | CAMLprim value 51 | uint16_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (Val_uint16((uint16_t)Int8_val(v))); 55 | } 56 | 57 | CAMLprim value 58 | uint16_of_int16(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (Val_uint16((uint16_t)Int16_val(v))); 62 | } 63 | 64 | CAMLprim value 65 | uint16_of_int24(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (Val_uint16((uint16_t)Int24_val(v))); 69 | } 70 | 71 | CAMLprim value 72 | uint16_of_int32(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (Val_uint16((uint16_t)Int32_val(v))); 76 | } 77 | 78 | CAMLprim value 79 | uint16_of_int40(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (Val_uint16((uint16_t)Int40_val(v))); 83 | } 84 | 85 | CAMLprim value 86 | uint16_of_int48(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (Val_uint16((uint16_t)Int48_val(v))); 90 | } 91 | 92 | CAMLprim value 93 | uint16_of_int56(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (Val_uint16((uint16_t)Int56_val(v))); 97 | } 98 | 99 | CAMLprim value 100 | uint16_of_int64(value v) 101 | { 102 | CAMLparam1(v); 103 | CAMLreturn (Val_uint16((uint16_t)Int64_val(v))); 104 | } 105 | 106 | CAMLprim value 107 | uint16_of_int128(value v) 108 | { 109 | CAMLparam1(v); 110 | #ifdef HAVE_INT128 111 | CAMLreturn (Val_uint16((uint16_t)Int128_val(v))); 112 | #else 113 | caml_failwith(__func__); 114 | CAMLreturn(Val_unit); 115 | #endif 116 | } 117 | 118 | CAMLprim value 119 | uint16_of_uint8(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (Val_uint16((uint16_t)Uint8_val(v))); 123 | } 124 | 125 | CAMLprim value 126 | uint16_of_uint24(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (Val_uint16((uint16_t)Uint24_val(v))); 130 | } 131 | 132 | CAMLprim value 133 | uint16_of_uint32(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (Val_uint16((uint16_t)Uint32_val(v))); 137 | } 138 | 139 | CAMLprim value 140 | uint16_of_uint40(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (Val_uint16((uint16_t)Uint40_val(v))); 144 | } 145 | 146 | CAMLprim value 147 | uint16_of_uint48(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (Val_uint16((uint16_t)Uint48_val(v))); 151 | } 152 | 153 | CAMLprim value 154 | uint16_of_uint56(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (Val_uint16((uint16_t)Uint56_val(v))); 158 | } 159 | 160 | CAMLprim value 161 | uint16_of_uint64(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (Val_uint16((uint16_t)Uint64_val(v))); 165 | } 166 | 167 | CAMLprim value 168 | uint16_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (Val_uint16((uint16_t)Uint128_val(v))); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | -------------------------------------------------------------------------------- /lib/uint24.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_UINT24_H 2 | #define OCAML_UINT24_H 3 | 4 | #define Uint24_val(x) ((uint32_t)(Unsigned_long_val(x))) 5 | #define Val_uint24(x) (Val_long((x) & 0xFFFFFF)) 6 | 7 | #endif 8 | 9 | -------------------------------------------------------------------------------- /lib/uint24_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | uint24_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (Val_uint24(((uint32_t)Long_val(v)))); 34 | } 35 | 36 | CAMLprim value 37 | uint24_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (Val_uint24(((uint32_t)Nativeint_val(v)))); 41 | } 42 | 43 | CAMLprim value 44 | uint24_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (Val_uint24(((uint32_t)Double_val(v)))); 48 | } 49 | 50 | CAMLprim value 51 | uint24_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (Val_uint24(((uint32_t)Int8_val(v)))); 55 | } 56 | 57 | CAMLprim value 58 | uint24_of_int16(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (Val_uint24(((uint32_t)Int16_val(v)))); 62 | } 63 | 64 | CAMLprim value 65 | uint24_of_int24(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (Val_uint24(((uint32_t)Int24_val(v)))); 69 | } 70 | 71 | CAMLprim value 72 | uint24_of_int32(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (Val_uint24(((uint32_t)Int32_val(v)))); 76 | } 77 | 78 | CAMLprim value 79 | uint24_of_int40(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (Val_uint24(((uint32_t)Int40_val(v)))); 83 | } 84 | 85 | CAMLprim value 86 | uint24_of_int48(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (Val_uint24(((uint32_t)Int48_val(v)))); 90 | } 91 | 92 | CAMLprim value 93 | uint24_of_int56(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (Val_uint24(((uint32_t)Int56_val(v)))); 97 | } 98 | 99 | CAMLprim value 100 | uint24_of_int64(value v) 101 | { 102 | CAMLparam1(v); 103 | CAMLreturn (Val_uint24(((uint32_t)Int64_val(v)))); 104 | } 105 | 106 | CAMLprim value 107 | uint24_of_int128(value v) 108 | { 109 | CAMLparam1(v); 110 | #ifdef HAVE_INT128 111 | CAMLreturn (Val_uint24(((uint32_t)Int128_val(v)))); 112 | #else 113 | caml_failwith(__func__); 114 | CAMLreturn(Val_unit); 115 | #endif 116 | } 117 | 118 | CAMLprim value 119 | uint24_of_uint8(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (Val_uint24(((uint32_t)Uint8_val(v)))); 123 | } 124 | 125 | CAMLprim value 126 | uint24_of_uint16(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (Val_uint24(((uint32_t)Uint16_val(v)))); 130 | } 131 | 132 | CAMLprim value 133 | uint24_of_uint32(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (Val_uint24(((uint32_t)Uint32_val(v)))); 137 | } 138 | 139 | CAMLprim value 140 | uint24_of_uint40(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (Val_uint24(((uint32_t)Uint40_val(v)))); 144 | } 145 | 146 | CAMLprim value 147 | uint24_of_uint48(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (Val_uint24(((uint32_t)Uint48_val(v)))); 151 | } 152 | 153 | CAMLprim value 154 | uint24_of_uint56(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (Val_uint24(((uint32_t)Uint56_val(v)))); 158 | } 159 | 160 | CAMLprim value 161 | uint24_of_uint64(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (Val_uint24(((uint32_t)Uint64_val(v)))); 165 | } 166 | 167 | CAMLprim value 168 | uint24_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (Val_uint24(((uint32_t)Uint128_val(v)))); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | -------------------------------------------------------------------------------- /lib/uint32.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_UINT32_H 2 | #define OCAML_UINT32_H 3 | 4 | #define Uint32_val(v) (*((uint32_t *)Data_custom_val(v))) 5 | 6 | CAMLextern value copy_uint32(uint32_t i); 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /lib/uint32_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | uint32_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (copy_uint32((uint32_t)Long_val(v))); 34 | } 35 | 36 | CAMLprim value 37 | uint32_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (copy_uint32((uint32_t)Nativeint_val(v))); 41 | } 42 | 43 | CAMLprim value 44 | uint32_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (copy_uint32((uint32_t)Double_val(v))); 48 | } 49 | 50 | CAMLprim value 51 | uint32_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (copy_uint32((uint32_t)Int8_val(v))); 55 | } 56 | 57 | CAMLprim value 58 | uint32_of_int16(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (copy_uint32((uint32_t)Int16_val(v))); 62 | } 63 | 64 | CAMLprim value 65 | uint32_of_int24(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (copy_uint32((uint32_t)Int24_val(v))); 69 | } 70 | 71 | CAMLprim value 72 | uint32_of_int32(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (copy_uint32((uint32_t)Int32_val(v))); 76 | } 77 | 78 | CAMLprim value 79 | uint32_of_int40(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (copy_uint32((uint32_t)Int40_val(v))); 83 | } 84 | 85 | CAMLprim value 86 | uint32_of_int48(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (copy_uint32((uint32_t)Int48_val(v))); 90 | } 91 | 92 | CAMLprim value 93 | uint32_of_int56(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (copy_uint32((uint32_t)Int56_val(v))); 97 | } 98 | 99 | CAMLprim value 100 | uint32_of_int64(value v) 101 | { 102 | CAMLparam1(v); 103 | CAMLreturn (copy_uint32((uint32_t)Int64_val(v))); 104 | } 105 | 106 | CAMLprim value 107 | uint32_of_int128(value v) 108 | { 109 | CAMLparam1(v); 110 | #ifdef HAVE_UINT128 111 | CAMLreturn (copy_uint32((uint32_t)Int128_val(v))); 112 | #else 113 | caml_failwith(__func__); 114 | CAMLreturn(Val_unit); 115 | #endif 116 | } 117 | 118 | CAMLprim value 119 | uint32_of_uint8(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (copy_uint32((uint32_t)Uint8_val(v))); 123 | } 124 | 125 | CAMLprim value 126 | uint32_of_uint16(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (copy_uint32((uint32_t)Uint16_val(v))); 130 | } 131 | 132 | CAMLprim value 133 | uint32_of_uint24(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (copy_uint32((uint32_t)Uint24_val(v))); 137 | } 138 | 139 | CAMLprim value 140 | uint32_of_uint40(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (copy_uint32((uint32_t)Uint40_val(v))); 144 | } 145 | 146 | CAMLprim value 147 | uint32_of_uint48(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (copy_uint32((uint32_t)Uint48_val(v))); 151 | } 152 | 153 | CAMLprim value 154 | uint32_of_uint56(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (copy_uint32((uint32_t)Uint56_val(v))); 158 | } 159 | 160 | CAMLprim value 161 | uint32_of_uint64(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (copy_uint32((uint32_t)Uint64_val(v))); 165 | } 166 | 167 | CAMLprim value 168 | uint32_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (copy_uint32((uint32_t)Uint128_val(v))); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | -------------------------------------------------------------------------------- /lib/uint32_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | 13 | #include "uint32.h" 14 | 15 | static int 16 | uint32_cmp(value v1, value v2) 17 | { 18 | uint32_t i1 = Uint32_val(v1); 19 | uint32_t i2 = Uint32_val(v2); 20 | return (i1 > i2) - (i1 < i2); 21 | } 22 | 23 | static intnat 24 | uint32_hash(value v) 25 | { 26 | return Uint32_val(v); 27 | } 28 | 29 | static void 30 | uint32_serialize(value v, uintnat *wsize_32, uintnat *wsize_64) 31 | { 32 | caml_serialize_int_4(Uint32_val(v)); 33 | *wsize_32 = *wsize_64 = 4; 34 | } 35 | 36 | static uintnat 37 | uint32_deserialize(void *dst) 38 | { 39 | *((uint32_t *) dst) = caml_deserialize_uint_4(); 40 | return 4; 41 | } 42 | 43 | #if OCAML_VERSION_MAJOR > 4 || OCAML_VERSION_MAJOR == 4 && OCAML_VERSION_MINOR >= 8 44 | static const struct custom_fixed_length uint32_length = { 4, 4 }; 45 | #endif 46 | 47 | struct custom_operations uint32_ops = { 48 | "uint.uint32", 49 | custom_finalize_default, 50 | uint32_cmp, 51 | uint32_hash, 52 | uint32_serialize, 53 | uint32_deserialize, 54 | custom_compare_ext_default 55 | #if OCAML_VERSION_MAJOR > 4 || OCAML_VERSION_MAJOR == 4 && OCAML_VERSION_MINOR >= 8 56 | , &uint32_length 57 | #endif 58 | }; 59 | 60 | CAMLprim value 61 | copy_uint32(uint32_t i) 62 | { 63 | CAMLparam0(); 64 | value res = caml_alloc_custom(&uint32_ops, 4, 0, 1); 65 | Uint32_val(res) = i; 66 | CAMLreturn (res); 67 | } 68 | 69 | CAMLprim value 70 | uint32_add(value v1, value v2) 71 | { 72 | CAMLparam2(v1, v2); 73 | CAMLreturn (copy_uint32(Uint32_val(v1) + Uint32_val(v2))); 74 | } 75 | 76 | CAMLprim value 77 | uint32_sub(value v1, value v2) 78 | { 79 | CAMLparam2(v1, v2); 80 | CAMLreturn (copy_uint32(Uint32_val(v1) - Uint32_val(v2))); 81 | } 82 | 83 | CAMLprim value 84 | uint32_mul(value v1, value v2) 85 | { 86 | CAMLparam2(v1, v2); 87 | CAMLreturn (copy_uint32(Uint32_val(v1) * Uint32_val(v2))); 88 | } 89 | 90 | CAMLprim value 91 | uint32_div(value v1, value v2) 92 | { 93 | CAMLparam2(v1, v2); 94 | uint32_t divisor = Uint32_val(v2); 95 | if (divisor == 0) 96 | caml_raise_zero_divide(); 97 | CAMLreturn (copy_uint32(Uint32_val(v1) / divisor)); 98 | } 99 | 100 | CAMLprim value 101 | uint32_mod(value v1, value v2) 102 | { 103 | CAMLparam2(v1, v2); 104 | uint32_t divisor = Uint32_val(v2); 105 | if (divisor == 0) 106 | caml_raise_zero_divide(); 107 | CAMLreturn (copy_uint32(Uint32_val(v1) % divisor)); 108 | } 109 | 110 | CAMLprim value 111 | uint32_and(value v1, value v2) 112 | { 113 | CAMLparam2(v1, v2); 114 | CAMLreturn (copy_uint32(Uint32_val(v1) & Uint32_val(v2))); 115 | } 116 | 117 | CAMLprim value 118 | uint32_or(value v1, value v2) 119 | { 120 | CAMLparam2(v1, v2); 121 | CAMLreturn (copy_uint32(Uint32_val(v1) | Uint32_val(v2))); 122 | } 123 | 124 | CAMLprim value 125 | uint32_xor(value v1, value v2) 126 | { 127 | CAMLparam2(v1, v2); 128 | CAMLreturn (copy_uint32(Uint32_val(v1) ^ Uint32_val(v2))); 129 | } 130 | 131 | CAMLprim value 132 | uint32_shift_left(value v1, value v2) 133 | { 134 | CAMLparam2(v1, v2); 135 | CAMLreturn (copy_uint32(Uint32_val(v1) << Long_val(v2))); 136 | } 137 | 138 | CAMLprim value 139 | uint32_shift_right(value v1, value v2) 140 | { 141 | CAMLparam2(v1, v2); 142 | CAMLreturn (copy_uint32(Uint32_val(v1) >> Long_val(v2))); 143 | } 144 | 145 | CAMLprim value 146 | uint32_bits_of_float(value v) 147 | { 148 | CAMLparam1(v); 149 | union { float d; uint32_t i; } u; 150 | u.d = Double_val(v); 151 | CAMLreturn (copy_uint32(u.i)); 152 | } 153 | 154 | CAMLprim value 155 | uint32_float_of_bits(value v) 156 | { 157 | CAMLparam1(v); 158 | union { float d; uint32_t i; } u; 159 | u.i = Uint32_val(v); 160 | CAMLreturn (caml_copy_double(u.d)); 161 | } 162 | 163 | CAMLprim value 164 | uint32_neg(value v) 165 | { 166 | CAMLparam1(v); 167 | CAMLreturn (copy_uint32(UINT32_MAX - Uint32_val(v) + 1)); 168 | } 169 | 170 | CAMLprim value 171 | uint32_max_int(void) 172 | { 173 | CAMLparam0(); 174 | CAMLreturn (copy_uint32(UINT32_MAX)); 175 | } 176 | 177 | CAMLprim value 178 | uint32_init_custom_ops(void) 179 | { 180 | CAMLparam0(); 181 | caml_register_custom_operations(&uint32_ops); 182 | CAMLreturn (Val_unit); 183 | } 184 | -------------------------------------------------------------------------------- /lib/uint40.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_UINT40_H 2 | #define OCAML_UINT40_H 3 | 4 | #include "uint64.h" 5 | 6 | #define Uint40_val(v) ((*((uint64_t *)Data_custom_val(v))) >> 24) 7 | 8 | #define copy_uint40(v) copy_uint64(v) 9 | 10 | #endif 11 | -------------------------------------------------------------------------------- /lib/uint40_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | uint40_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (copy_uint64(((uint64_t)Long_val(v)) << 24)); 34 | } 35 | 36 | CAMLprim value 37 | uint40_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (copy_uint64(((uint64_t)Nativeint_val(v)) << 24)); 41 | } 42 | 43 | CAMLprim value 44 | uint40_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (copy_uint64(((uint64_t)Double_val(v)) << 24)); 48 | } 49 | 50 | CAMLprim value 51 | uint40_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (copy_uint64(((uint64_t)Int8_val(v)) << 24)); 55 | } 56 | 57 | CAMLprim value 58 | uint40_of_int16(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (copy_uint64(((uint64_t)Int16_val(v)) << 24)); 62 | } 63 | 64 | CAMLprim value 65 | uint40_of_int24(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (copy_uint64(((uint64_t)Int24_val(v)) << 24)); 69 | } 70 | 71 | CAMLprim value 72 | uint40_of_int32(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (copy_uint64(((uint64_t)Int32_val(v)) << 24)); 76 | } 77 | 78 | CAMLprim value 79 | uint40_of_int40(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (copy_uint64(((uint64_t)Int40_val(v)) << 24)); 83 | } 84 | 85 | CAMLprim value 86 | uint40_of_int48(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (copy_uint64(((uint64_t)Int48_val(v)) << 24)); 90 | } 91 | 92 | CAMLprim value 93 | uint40_of_int56(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (copy_uint64(((uint64_t)Int56_val(v)) << 24)); 97 | } 98 | 99 | CAMLprim value 100 | uint40_of_int64(value v) 101 | { 102 | CAMLparam1(v); 103 | CAMLreturn (copy_uint64(((uint64_t)Int64_val(v)) << 24)); 104 | } 105 | 106 | CAMLprim value 107 | uint40_of_int128(value v) 108 | { 109 | CAMLparam1(v); 110 | #ifdef HAVE_INT128 111 | CAMLreturn (copy_uint64(((uint64_t)Int128_val(v)) << 24)); 112 | #else 113 | caml_failwith(__func__); 114 | CAMLreturn(Val_unit); 115 | #endif 116 | } 117 | 118 | CAMLprim value 119 | uint40_of_uint8(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (copy_uint64(((uint64_t)Uint8_val(v)) << 24)); 123 | } 124 | 125 | CAMLprim value 126 | uint40_of_uint16(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (copy_uint64(((uint64_t)Uint16_val(v)) << 24)); 130 | } 131 | 132 | CAMLprim value 133 | uint40_of_uint24(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (copy_uint64(((uint64_t)Uint24_val(v)) << 24)); 137 | } 138 | 139 | CAMLprim value 140 | uint40_of_uint32(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (copy_uint64(((uint64_t)Uint32_val(v)) << 24)); 144 | } 145 | 146 | CAMLprim value 147 | uint40_of_uint48(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (copy_uint64(((uint64_t)Uint48_val(v)) << 24)); 151 | } 152 | 153 | CAMLprim value 154 | uint40_of_uint56(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (copy_uint64(((uint64_t)Uint56_val(v)) << 24)); 158 | } 159 | 160 | CAMLprim value 161 | uint40_of_uint64(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (copy_uint64(((uint64_t)Uint64_val(v)) << 24)); 165 | } 166 | 167 | CAMLprim value 168 | uint40_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (copy_uint64(((uint64_t)Uint128_val(v)) << 24)); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | -------------------------------------------------------------------------------- /lib/uint40_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | #include "uint40.h" 12 | 13 | static const uint64_t mask = 0xFFFFFFFFFF000000ULL; 14 | 15 | CAMLprim value 16 | uint40_mul(value v1, value v2) 17 | { 18 | CAMLparam2(v1, v2); 19 | CAMLreturn (copy_uint40(Uint40_val(v1) * Uint64_val(v2))); 20 | } 21 | 22 | CAMLprim value 23 | uint40_div(value v1, value v2) 24 | { 25 | CAMLparam2(v1, v2); 26 | uint64_t divisor = Uint64_val(v2); 27 | if (divisor == 0) 28 | caml_raise_zero_divide(); 29 | CAMLreturn (copy_uint40((Uint64_val(v1) / divisor) << 24)); 30 | } 31 | 32 | CAMLprim value 33 | uint40_xor(value v1, value v2) 34 | { 35 | CAMLparam2(v1, v2); 36 | CAMLreturn (copy_uint40((Uint64_val(v1) ^ Uint64_val(v2)) & mask)); 37 | } 38 | 39 | CAMLprim value 40 | uint40_shift_right(value v1, value v2) 41 | { 42 | CAMLparam2(v1, v2); 43 | CAMLreturn (copy_uint40((Uint64_val(v1) >> Long_val(v2)) & mask)); 44 | } 45 | 46 | static const uint64_t uint40_max = 0xFFFFFFFFFF000000ULL; 47 | static const uint64_t uint40_one = (1 << 24); 48 | 49 | CAMLprim value 50 | uint40_max_int(void) 51 | { 52 | CAMLparam0(); 53 | CAMLreturn (copy_uint40(uint40_max)); 54 | } 55 | 56 | CAMLprim value 57 | uint40_neg(value v) 58 | { 59 | CAMLparam1(v); 60 | CAMLreturn (copy_uint64(uint40_max - Uint64_val(v) + uint40_one)); 61 | } 62 | 63 | -------------------------------------------------------------------------------- /lib/uint48.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_UINT48_H 2 | #define OCAML_UINT48_H 3 | 4 | #include "uint64.h" 5 | 6 | #define Uint48_val(v) ((*((uint64_t *)Data_custom_val(v))) >> 16) 7 | 8 | #define copy_uint48(v) copy_uint64(v) 9 | 10 | #endif 11 | -------------------------------------------------------------------------------- /lib/uint48_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | uint48_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (copy_uint64(((uint64_t)Long_val(v)) << 16)); 34 | } 35 | 36 | CAMLprim value 37 | uint48_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (copy_uint64(((uint64_t)Nativeint_val(v)) << 16)); 41 | } 42 | 43 | CAMLprim value 44 | uint48_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (copy_uint64(((uint64_t)Double_val(v)) << 16)); 48 | } 49 | 50 | CAMLprim value 51 | uint48_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (copy_uint64(((uint64_t)Int8_val(v)) << 16)); 55 | } 56 | 57 | CAMLprim value 58 | uint48_of_int16(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (copy_uint64(((uint64_t)Int16_val(v)) << 16)); 62 | } 63 | 64 | CAMLprim value 65 | uint48_of_int24(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (copy_uint64(((uint64_t)Int24_val(v)) << 16)); 69 | } 70 | 71 | CAMLprim value 72 | uint48_of_int32(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (copy_uint64(((uint64_t)Int32_val(v)) << 16)); 76 | } 77 | 78 | CAMLprim value 79 | uint48_of_int40(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (copy_uint64(((uint64_t)Int40_val(v)) << 16)); 83 | } 84 | 85 | CAMLprim value 86 | uint48_of_int48(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (copy_uint64(((uint64_t)Int48_val(v)) << 16)); 90 | } 91 | 92 | CAMLprim value 93 | uint48_of_int56(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (copy_uint64(((uint64_t)Int56_val(v)) << 16)); 97 | } 98 | 99 | CAMLprim value 100 | uint48_of_int64(value v) 101 | { 102 | CAMLparam1(v); 103 | CAMLreturn (copy_uint64(((uint64_t)Int64_val(v)) << 16)); 104 | } 105 | 106 | CAMLprim value 107 | uint48_of_int128(value v) 108 | { 109 | CAMLparam1(v); 110 | #ifdef HAVE_INT128 111 | CAMLreturn (copy_uint64(((uint64_t)Int128_val(v)) << 16)); 112 | #else 113 | caml_failwith(__func__); 114 | CAMLreturn(Val_unit); 115 | #endif 116 | } 117 | 118 | CAMLprim value 119 | uint48_of_uint8(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (copy_uint64(((uint64_t)Uint8_val(v)) << 16)); 123 | } 124 | 125 | CAMLprim value 126 | uint48_of_uint16(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (copy_uint64(((uint64_t)Uint16_val(v)) << 16)); 130 | } 131 | 132 | CAMLprim value 133 | uint48_of_uint24(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (copy_uint64(((uint64_t)Uint24_val(v)) << 16)); 137 | } 138 | 139 | CAMLprim value 140 | uint48_of_uint32(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (copy_uint64(((uint64_t)Uint32_val(v)) << 16)); 144 | } 145 | 146 | CAMLprim value 147 | uint48_of_uint40(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (copy_uint64(((uint64_t)Uint40_val(v)) << 16)); 151 | } 152 | 153 | CAMLprim value 154 | uint48_of_uint56(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (copy_uint64(((uint64_t)Uint56_val(v)) << 16)); 158 | } 159 | 160 | CAMLprim value 161 | uint48_of_uint64(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (copy_uint64(((uint64_t)Uint64_val(v)) << 16)); 165 | } 166 | 167 | CAMLprim value 168 | uint48_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (copy_uint64(((uint64_t)Uint128_val(v)) << 16)); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | -------------------------------------------------------------------------------- /lib/uint48_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | #include "uint48.h" 12 | 13 | static const uint64_t mask = 0xFFFFFFFFFFFF0000ULL; 14 | 15 | CAMLprim value 16 | uint48_mul(value v1, value v2) 17 | { 18 | CAMLparam2(v1, v2); 19 | CAMLreturn (copy_uint48(Uint48_val(v1) * Uint64_val(v2))); 20 | } 21 | 22 | CAMLprim value 23 | uint48_div(value v1, value v2) 24 | { 25 | CAMLparam2(v1, v2); 26 | uint64_t divisor = Uint64_val(v2); 27 | if (divisor == 0) 28 | caml_raise_zero_divide(); 29 | CAMLreturn (copy_uint48((Uint64_val(v1) / divisor) << 16)); 30 | } 31 | 32 | CAMLprim value 33 | uint48_xor(value v1, value v2) 34 | { 35 | CAMLparam2(v1, v2); 36 | CAMLreturn (copy_uint48((Uint64_val(v1) ^ Uint64_val(v2)) & mask)); 37 | } 38 | 39 | CAMLprim value 40 | uint48_shift_right(value v1, value v2) 41 | { 42 | CAMLparam2(v1, v2); 43 | CAMLreturn (copy_uint48((Uint64_val(v1) >> Long_val(v2)) & mask)); 44 | } 45 | 46 | static const uint64_t uint48_max = 0xFFFFFFFFFFFF0000ULL; 47 | static const uint64_t uint48_one = (1 << 16); 48 | 49 | CAMLprim value 50 | uint48_max_int(void) 51 | { 52 | CAMLparam0(); 53 | CAMLreturn (copy_uint48(uint48_max)); 54 | } 55 | 56 | CAMLprim value 57 | uint48_neg(value v) 58 | { 59 | CAMLparam1(v); 60 | CAMLreturn (copy_uint64(uint48_max - Uint64_val(v) + uint48_one)); 61 | } 62 | 63 | -------------------------------------------------------------------------------- /lib/uint56.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_UINT56_H 2 | #define OCAML_UINT56_H 3 | 4 | #include "uint64.h" 5 | 6 | #define Uint56_val(v) ((*((uint64_t *)Data_custom_val(v))) >> 8) 7 | 8 | #define copy_uint56(v) copy_uint64(v) 9 | 10 | #endif 11 | -------------------------------------------------------------------------------- /lib/uint56_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | uint56_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (copy_uint64(((uint64_t)Long_val(v)) << 8)); 34 | } 35 | 36 | CAMLprim value 37 | uint56_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (copy_uint64(((uint64_t)Nativeint_val(v)) << 8)); 41 | } 42 | 43 | CAMLprim value 44 | uint56_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (copy_uint64(((uint64_t)Double_val(v)) << 8)); 48 | } 49 | 50 | CAMLprim value 51 | uint56_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (copy_uint64(((uint64_t)Int8_val(v)) << 8)); 55 | } 56 | 57 | CAMLprim value 58 | uint56_of_int16(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (copy_uint64(((uint64_t)Int16_val(v)) << 8)); 62 | } 63 | 64 | CAMLprim value 65 | uint56_of_int24(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (copy_uint64(((uint64_t)Int24_val(v)) << 8)); 69 | } 70 | 71 | CAMLprim value 72 | uint56_of_int32(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (copy_uint64(((uint64_t)Int32_val(v)) << 8)); 76 | } 77 | 78 | CAMLprim value 79 | uint56_of_int40(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (copy_uint64(((uint64_t)Int40_val(v)) << 8)); 83 | } 84 | 85 | CAMLprim value 86 | uint56_of_int48(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (copy_uint64(((uint64_t)Int48_val(v)) << 8)); 90 | } 91 | 92 | CAMLprim value 93 | uint56_of_int56(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (copy_uint64(((uint64_t)Int56_val(v)) << 8)); 97 | } 98 | 99 | CAMLprim value 100 | uint56_of_int64(value v) 101 | { 102 | CAMLparam1(v); 103 | CAMLreturn (copy_uint64(((uint64_t)Int64_val(v)) << 8)); 104 | } 105 | 106 | CAMLprim value 107 | uint56_of_int128(value v) 108 | { 109 | CAMLparam1(v); 110 | #ifdef HAVE_INT128 111 | CAMLreturn (copy_uint64(((uint64_t)Int128_val(v)) << 8)); 112 | #else 113 | caml_failwith(__func__); 114 | CAMLreturn(Val_unit); 115 | #endif 116 | } 117 | 118 | CAMLprim value 119 | uint56_of_uint8(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (copy_uint64(((uint64_t)Uint8_val(v)) << 8)); 123 | } 124 | 125 | CAMLprim value 126 | uint56_of_uint16(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (copy_uint64(((uint64_t)Uint16_val(v)) << 8)); 130 | } 131 | 132 | CAMLprim value 133 | uint56_of_uint24(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (copy_uint64(((uint64_t)Uint24_val(v)) << 8)); 137 | } 138 | 139 | CAMLprim value 140 | uint56_of_uint32(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (copy_uint64(((uint64_t)Uint32_val(v)) << 8)); 144 | } 145 | 146 | CAMLprim value 147 | uint56_of_uint40(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (copy_uint64(((uint64_t)Uint40_val(v)) << 8)); 151 | } 152 | 153 | CAMLprim value 154 | uint56_of_uint48(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (copy_uint64(((uint64_t)Uint48_val(v)) << 8)); 158 | } 159 | 160 | CAMLprim value 161 | uint56_of_uint64(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (copy_uint64(((uint64_t)Uint64_val(v)) << 8)); 165 | } 166 | 167 | CAMLprim value 168 | uint56_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (copy_uint64(((uint64_t)Uint128_val(v)) << 8)); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | -------------------------------------------------------------------------------- /lib/uint56_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | #include "uint56.h" 12 | 13 | static const uint64_t mask = 0xFFFFFFFFFFFFFF00ULL; 14 | 15 | CAMLprim value 16 | uint56_mul(value v1, value v2) 17 | { 18 | CAMLparam2(v1, v2); 19 | CAMLreturn (copy_uint56(Uint56_val(v1) * Uint64_val(v2))); 20 | } 21 | 22 | CAMLprim value 23 | uint56_div(value v1, value v2) 24 | { 25 | CAMLparam2(v1, v2); 26 | uint64_t divisor = Uint64_val(v2); 27 | if (divisor == 0) 28 | caml_raise_zero_divide(); 29 | CAMLreturn (copy_uint56((Uint64_val(v1) / divisor) << 8)); 30 | } 31 | 32 | CAMLprim value 33 | uint56_xor(value v1, value v2) 34 | { 35 | CAMLparam2(v1, v2); 36 | CAMLreturn (copy_uint56((Uint64_val(v1) ^ Uint64_val(v2)) & mask)); 37 | } 38 | 39 | CAMLprim value 40 | uint56_shift_right(value v1, value v2) 41 | { 42 | CAMLparam2(v1, v2); 43 | CAMLreturn (copy_uint56((Uint64_val(v1) >> Long_val(v2)) & mask)); 44 | } 45 | 46 | static const uint64_t uint56_max = 0xFFFFFFFFFFFFFF00ULL; 47 | static const uint64_t uint56_one = (1 << 8); 48 | 49 | CAMLprim value 50 | uint56_max_int(void) 51 | { 52 | CAMLparam0(); 53 | CAMLreturn (copy_uint56(uint56_max)); 54 | } 55 | 56 | CAMLprim value 57 | uint56_neg(value v) 58 | { 59 | CAMLparam1(v); 60 | CAMLreturn (copy_uint64(uint56_max - Uint64_val(v) + uint56_one)); 61 | } 62 | 63 | -------------------------------------------------------------------------------- /lib/uint64.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_UINT64_H 2 | #define OCAML_UINT64_H 3 | 4 | #define Uint64_val(v) (*((uint64_t *)Data_custom_val(v))) 5 | 6 | CAMLextern value copy_uint64(uint64_t i); 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /lib/uint64_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | uint64_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (copy_uint64((uint64_t)Long_val(v))); 34 | } 35 | 36 | CAMLprim value 37 | uint64_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (copy_uint64((uint64_t)Nativeint_val(v))); 41 | } 42 | 43 | CAMLprim value 44 | uint64_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (copy_uint64((uint64_t)Double_val(v))); 48 | } 49 | 50 | CAMLprim value 51 | uint64_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (copy_uint64((uint64_t)Int8_val(v))); 55 | } 56 | 57 | CAMLprim value 58 | uint64_of_int16(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (copy_uint64((uint64_t)Int16_val(v))); 62 | } 63 | 64 | CAMLprim value 65 | uint64_of_int24(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (copy_uint64((uint64_t)Int24_val(v))); 69 | } 70 | 71 | CAMLprim value 72 | uint64_of_int32(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (copy_uint64((uint64_t)Int32_val(v))); 76 | } 77 | 78 | CAMLprim value 79 | uint64_of_int40(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (copy_uint64((uint64_t)Int40_val(v))); 83 | } 84 | 85 | CAMLprim value 86 | uint64_of_int48(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (copy_uint64((uint64_t)Int48_val(v))); 90 | } 91 | 92 | CAMLprim value 93 | uint64_of_int56(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (copy_uint64((uint64_t)Int56_val(v))); 97 | } 98 | 99 | CAMLprim value 100 | uint64_of_int64(value v) 101 | { 102 | CAMLparam1(v); 103 | CAMLreturn (copy_uint64((uint64_t)Int64_val(v))); 104 | } 105 | 106 | CAMLprim value 107 | uint64_of_int128(value v) 108 | { 109 | CAMLparam1(v); 110 | #ifdef HAVE_INT128 111 | CAMLreturn (copy_uint64((uint64_t)Int128_val(v))); 112 | #else 113 | caml_failwith(__func__); 114 | CAMLreturn(Val_unit); 115 | #endif 116 | } 117 | 118 | CAMLprim value 119 | uint64_of_uint8(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (copy_uint64((uint64_t)Uint8_val(v))); 123 | } 124 | 125 | CAMLprim value 126 | uint64_of_uint16(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (copy_uint64((uint64_t)Uint16_val(v))); 130 | } 131 | 132 | CAMLprim value 133 | uint64_of_uint24(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (copy_uint64((uint64_t)Uint24_val(v))); 137 | } 138 | 139 | CAMLprim value 140 | uint64_of_uint32(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (copy_uint64((uint64_t)Uint32_val(v))); 144 | } 145 | 146 | CAMLprim value 147 | uint64_of_uint40(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (copy_uint64((uint64_t)Uint40_val(v))); 151 | } 152 | 153 | CAMLprim value 154 | uint64_of_uint48(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (copy_uint64((uint64_t)Uint48_val(v))); 158 | } 159 | 160 | CAMLprim value 161 | uint64_of_uint56(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (copy_uint64((uint64_t)Uint56_val(v))); 165 | } 166 | 167 | CAMLprim value 168 | uint64_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (copy_uint64((uint64_t)Uint128_val(v))); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | -------------------------------------------------------------------------------- /lib/uint64_stubs.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | 13 | #include "uint64.h" 14 | 15 | static int 16 | uint64_cmp(value v1, value v2) 17 | { 18 | uint64_t i1 = Uint64_val(v1); 19 | uint64_t i2 = Uint64_val(v2); 20 | return (i1 > i2) - (i1 < i2); 21 | } 22 | 23 | static intnat 24 | uint64_hash(value v) 25 | { 26 | return((intnat)Uint64_val(v)); 27 | } 28 | 29 | static void 30 | uint64_serialize(value v, uintnat *wsize_32, uintnat *wsize_64) 31 | { 32 | caml_serialize_int_8(Uint64_val(v)); 33 | *wsize_32 = *wsize_64 = 8; 34 | } 35 | 36 | static uintnat 37 | uint64_deserialize(void *dst) 38 | { 39 | *((uint64_t *) dst) = caml_deserialize_uint_8(); 40 | return 8; 41 | } 42 | 43 | #if OCAML_VERSION_MAJOR > 4 || OCAML_VERSION_MAJOR == 4 && OCAML_VERSION_MINOR >= 8 44 | static const struct custom_fixed_length uint64_length = { 8, 8 }; 45 | #endif 46 | 47 | struct custom_operations uint64_ops = { 48 | "uint.uint64", 49 | custom_finalize_default, 50 | uint64_cmp, 51 | uint64_hash, 52 | uint64_serialize, 53 | uint64_deserialize, 54 | custom_compare_ext_default 55 | #if OCAML_VERSION_MAJOR > 4 || OCAML_VERSION_MAJOR == 4 && OCAML_VERSION_MINOR >= 8 56 | , &uint64_length 57 | #endif 58 | }; 59 | 60 | CAMLprim value 61 | copy_uint64(uint64_t i) 62 | { 63 | CAMLparam0(); 64 | value res = caml_alloc_custom(&uint64_ops, 8, 0, 1); 65 | Uint64_val(res) = i; 66 | CAMLreturn (res); 67 | } 68 | 69 | CAMLprim value 70 | uint64_add(value v1, value v2) 71 | { 72 | CAMLparam2(v1, v2); 73 | CAMLreturn (copy_uint64(Uint64_val(v1) + Uint64_val(v2))); 74 | } 75 | 76 | CAMLprim value 77 | uint64_sub(value v1, value v2) 78 | { 79 | CAMLparam2(v1, v2); 80 | CAMLreturn (copy_uint64(Uint64_val(v1) - Uint64_val(v2))); 81 | } 82 | 83 | CAMLprim value 84 | uint64_mul(value v1, value v2) 85 | { 86 | CAMLparam2(v1, v2); 87 | CAMLreturn (copy_uint64(Uint64_val(v1) * Uint64_val(v2))); 88 | } 89 | 90 | CAMLprim value 91 | uint64_div(value v1, value v2) 92 | { 93 | CAMLparam2(v1, v2); 94 | uint64_t divisor = Uint64_val(v2); 95 | if (divisor == 0) 96 | caml_raise_zero_divide(); 97 | CAMLreturn (copy_uint64(Uint64_val(v1) / divisor)); 98 | } 99 | 100 | CAMLprim value 101 | uint64_mod(value v1, value v2) 102 | { 103 | CAMLparam2(v1, v2); 104 | uint64_t divisor = Uint64_val(v2); 105 | if (divisor == 0) 106 | caml_raise_zero_divide(); 107 | CAMLreturn (copy_uint64(Uint64_val(v1) % divisor)); 108 | } 109 | 110 | CAMLprim value 111 | uint64_and(value v1, value v2) 112 | { 113 | CAMLparam2(v1, v2); 114 | CAMLreturn (copy_uint64(Uint64_val(v1) & Uint64_val(v2))); 115 | } 116 | 117 | CAMLprim value 118 | uint64_or(value v1, value v2) 119 | { 120 | CAMLparam2(v1, v2); 121 | CAMLreturn (copy_uint64(Uint64_val(v1) | Uint64_val(v2))); 122 | } 123 | 124 | CAMLprim value 125 | uint64_xor(value v1, value v2) 126 | { 127 | CAMLparam2(v1, v2); 128 | CAMLreturn (copy_uint64(Uint64_val(v1) ^ Uint64_val(v2))); 129 | } 130 | 131 | CAMLprim value 132 | uint64_shift_left(value v1, value v2) 133 | { 134 | CAMLparam2(v1, v2); 135 | CAMLreturn (copy_uint64(Uint64_val(v1) << Long_val(v2))); 136 | } 137 | 138 | CAMLprim value 139 | uint64_shift_right(value v1, value v2) 140 | { 141 | CAMLparam2(v1, v2); 142 | CAMLreturn (copy_uint64(Uint64_val(v1) >> Long_val(v2))); 143 | } 144 | 145 | CAMLprim value 146 | uint64_bits_of_float(value v) 147 | { 148 | CAMLparam1(v); 149 | union { double d; uint64_t i; uint32_t h[2]; } u; 150 | u.d = Double_val(v); 151 | CAMLreturn (copy_uint64(u.i)); 152 | } 153 | 154 | CAMLprim value 155 | uint64_float_of_bits(value v) 156 | { 157 | CAMLparam1(v); 158 | union { double d; uint64_t i; uint32_t h[2]; } u; 159 | u.i = Uint64_val(v); 160 | CAMLreturn (caml_copy_double(u.d)); 161 | } 162 | 163 | CAMLprim value 164 | uint64_neg(value v) 165 | { 166 | CAMLparam1(v); 167 | CAMLreturn (copy_uint64(UINT64_MAX - Uint64_val(v) + 1)); 168 | } 169 | 170 | CAMLprim value 171 | uint64_max_int(void) 172 | { 173 | CAMLparam0(); 174 | CAMLreturn (copy_uint64(UINT64_MAX)); 175 | } 176 | 177 | CAMLprim value 178 | uint64_init_custom_ops(void) 179 | { 180 | CAMLparam0(); 181 | caml_register_custom_operations(&uint64_ops); 182 | CAMLreturn (Val_unit); 183 | } 184 | -------------------------------------------------------------------------------- /lib/uint8.h: -------------------------------------------------------------------------------- 1 | #ifndef OCAML_UINT8_H 2 | #define OCAML_UINT8_H 3 | 4 | #define Uint8_val(x) ((uint8_t)(Unsigned_long_val(x))) 5 | #define Val_uint8(x) (Val_long((x) & 0xFF)) 6 | 7 | #endif 8 | 9 | -------------------------------------------------------------------------------- /lib/uint8_conv.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #include "int8.h" 13 | #include "int16.h" 14 | #include "int24.h" 15 | #include "int40.h" 16 | #include "int48.h" 17 | #include "int56.h" 18 | #include "int128.h" 19 | #include "uint8.h" 20 | #include "uint16.h" 21 | #include "uint24.h" 22 | #include "uint32.h" 23 | #include "uint40.h" 24 | #include "uint48.h" 25 | #include "uint56.h" 26 | #include "uint64.h" 27 | #include "uint128.h" 28 | 29 | CAMLprim value 30 | uint8_of_int(value v) 31 | { 32 | CAMLparam1(v); 33 | CAMLreturn (Val_uint8((uint8_t)Long_val(v))); 34 | } 35 | 36 | CAMLprim value 37 | uint8_of_nativeint(value v) 38 | { 39 | CAMLparam1(v); 40 | CAMLreturn (Val_uint8((uint8_t)Nativeint_val(v))); 41 | } 42 | 43 | CAMLprim value 44 | uint8_of_float(value v) 45 | { 46 | CAMLparam1(v); 47 | CAMLreturn (Val_uint8((uint8_t)Double_val(v))); 48 | } 49 | 50 | CAMLprim value 51 | uint8_of_int8(value v) 52 | { 53 | CAMLparam1(v); 54 | CAMLreturn (Val_uint8((uint8_t)Int8_val(v))); 55 | } 56 | 57 | CAMLprim value 58 | uint8_of_int16(value v) 59 | { 60 | CAMLparam1(v); 61 | CAMLreturn (Val_uint8((uint8_t)Int16_val(v))); 62 | } 63 | 64 | CAMLprim value 65 | uint8_of_int24(value v) 66 | { 67 | CAMLparam1(v); 68 | CAMLreturn (Val_uint8((uint8_t)Int24_val(v))); 69 | } 70 | 71 | CAMLprim value 72 | uint8_of_int32(value v) 73 | { 74 | CAMLparam1(v); 75 | CAMLreturn (Val_uint8((uint8_t)Int32_val(v))); 76 | } 77 | 78 | CAMLprim value 79 | uint8_of_int40(value v) 80 | { 81 | CAMLparam1(v); 82 | CAMLreturn (Val_uint8((uint8_t)Int40_val(v))); 83 | } 84 | 85 | CAMLprim value 86 | uint8_of_int48(value v) 87 | { 88 | CAMLparam1(v); 89 | CAMLreturn (Val_uint8((uint8_t)Int48_val(v))); 90 | } 91 | 92 | CAMLprim value 93 | uint8_of_int56(value v) 94 | { 95 | CAMLparam1(v); 96 | CAMLreturn (Val_uint8((uint8_t)Int56_val(v))); 97 | } 98 | 99 | CAMLprim value 100 | uint8_of_int64(value v) 101 | { 102 | CAMLparam1(v); 103 | CAMLreturn (Val_uint8((uint8_t)Int64_val(v))); 104 | } 105 | 106 | CAMLprim value 107 | uint8_of_int128(value v) 108 | { 109 | CAMLparam1(v); 110 | #ifdef HAVE_INT128 111 | CAMLreturn (Val_uint8((uint8_t)Int128_val(v))); 112 | #else 113 | caml_failwith(__func__); 114 | CAMLreturn(Val_unit); 115 | #endif 116 | } 117 | 118 | CAMLprim value 119 | uint8_of_uint16(value v) 120 | { 121 | CAMLparam1(v); 122 | CAMLreturn (Val_uint8((uint8_t)Uint16_val(v))); 123 | } 124 | 125 | CAMLprim value 126 | uint8_of_uint24(value v) 127 | { 128 | CAMLparam1(v); 129 | CAMLreturn (Val_uint8((uint8_t)Uint24_val(v))); 130 | } 131 | 132 | CAMLprim value 133 | uint8_of_uint32(value v) 134 | { 135 | CAMLparam1(v); 136 | CAMLreturn (Val_uint8((uint8_t)Uint32_val(v))); 137 | } 138 | 139 | CAMLprim value 140 | uint8_of_uint40(value v) 141 | { 142 | CAMLparam1(v); 143 | CAMLreturn (Val_uint8((uint8_t)Uint40_val(v))); 144 | } 145 | 146 | CAMLprim value 147 | uint8_of_uint48(value v) 148 | { 149 | CAMLparam1(v); 150 | CAMLreturn (Val_uint8((uint8_t)Uint48_val(v))); 151 | } 152 | 153 | CAMLprim value 154 | uint8_of_uint56(value v) 155 | { 156 | CAMLparam1(v); 157 | CAMLreturn (Val_uint8((uint8_t)Uint56_val(v))); 158 | } 159 | 160 | CAMLprim value 161 | uint8_of_uint64(value v) 162 | { 163 | CAMLparam1(v); 164 | CAMLreturn (Val_uint8((uint8_t)Uint64_val(v))); 165 | } 166 | 167 | CAMLprim value 168 | uint8_of_uint128(value v) 169 | { 170 | CAMLparam1(v); 171 | #ifdef HAVE_UINT128 172 | CAMLreturn (Val_uint8((uint8_t)Uint128_val(v))); 173 | #else 174 | caml_failwith(__func__); 175 | CAMLreturn(Val_unit); 176 | #endif 177 | } 178 | 179 | -------------------------------------------------------------------------------- /spec/common.ml: -------------------------------------------------------------------------------- 1 | describe "An unsigned integer" do 2 | it "should not modify an int when converted" do 3 | forall int x . (to_int (of_int x)) should = x 4 | done; 5 | 6 | it "should not modify an int32 when converted" do 7 | forall int32 x . (to_int32 (of_int32 x)) should = x 8 | done; 9 | 10 | it "should not modify strings when converted" do 11 | (of_string (to_string max_int)) should = max_int; 12 | forall int32 x . (to_string (of_int32 x)) should = (Int32.to_string x) 13 | done; 14 | 15 | it "should perform logical and correctly" do 16 | forall int x . forall int y . 17 | (to_int (logand (of_int x) (of_int y))) should = (x land y) 18 | done; 19 | 20 | it "should perform logical or correctly" do 21 | forall int x . forall int y . 22 | (to_int (logor (of_int x) (of_int y))) should = (x lor y) 23 | done; 24 | 25 | it "should perform logical xor correctly" do 26 | forall int x . forall int y . 27 | (to_int (logxor (of_int x) (of_int y))) should = (x lxor y) 28 | done; 29 | 30 | it "should perform logical not correctly" do 31 | forall int32 x . (to_int32 (lognot (of_int32 x))) should = (Int32.lognot x) 32 | done; 33 | 34 | it "should perform left-shifts correctly" do 35 | forall int32 x . forall (int_in_range 0 31) y . 36 | (to_int32 (shift_left (of_int32 x) y)) should = (Int32.shift_left x y) 37 | done; 38 | 39 | it "should perform right-shifts correctly" do 40 | forall int x . forall (int_in_range 0 31) y . 41 | (to_int (shift_right (of_int x) y)) should = (x asr y) 42 | done; 43 | 44 | it "should perform float conversions correctly" do 45 | forall float x . 46 | (to_float (of_float x)) should = (float_of_int (int_of_float x)) 47 | done; 48 | done 49 | -------------------------------------------------------------------------------- /spec/int128.ml: -------------------------------------------------------------------------------- 1 | #load "stdint.cma";; 2 | #load "str.cma";; 3 | open Stdint.Int128;; 4 | #use "spec/common.ml";; 5 | 6 | describe "A signed 128-bit integer" do 7 | it "should be converted from strings correctly" do 8 | (* Note: this would fail if the string was only 0s *) 9 | forall (string_of ~length:(fun () -> 38) digit) s . 10 | let str = Str.replace_first (Str.regexp "^0+") "" s in 11 | (to_string (of_string str)) should = str; 12 | (fun () -> (of_string ("2" ^ s))) should raise_an_exception 13 | done; 14 | it "...even when sign is present" do 15 | forall (string_of ~length:(fun () -> 38) digit) s . 16 | let str = Str.replace_first (Str.regexp "^0+") "" s in 17 | (to_string (of_string ("+" ^ str))) should = str; 18 | done; 19 | it "...even for negative values" do 20 | forall (string_of ~length:(fun () -> 38) digit) s . 21 | let str = "-" ^ Str.replace_first (Str.regexp "^0+") "" s in 22 | (to_string (of_string str)) should = str; 23 | done; 24 | done 25 | -------------------------------------------------------------------------------- /spec/int32.ml: -------------------------------------------------------------------------------- 1 | #load "stdint.cma";; 2 | open Stdint.Int32;; 3 | #use "spec/common.ml";; 4 | 5 | describe "An int32" do 6 | it "should convert to/from an uint8 correctly" do 7 | forall (int_in_range 0 255) x . 8 | (Stdint.Uint8.of_int x |> of_uint8 |> to_int) should = x 9 | done; 10 | it "should convert to/from an int8 correctly" do 11 | forall (int_in_range ~-128 127) x . 12 | (Stdint.Int8.of_int x |> of_int8 |> to_int) should = x 13 | done; 14 | done 15 | -------------------------------------------------------------------------------- /spec/uint128.ml: -------------------------------------------------------------------------------- 1 | #load "stdint.cma";; 2 | #load "str.cma";; 3 | open Stdint.Uint128;; 4 | #use "spec/common.ml";; 5 | 6 | describe "A 128-bit integer" do 7 | it "should be converted from strings correctly" do 8 | forall (string_of ~length:(fun () -> 38) digit) s . 9 | let str = Str.replace_first (Str.regexp "^0+") "" s in 10 | (to_string (of_string str)) should = str; 11 | (fun () -> of_string ("4" ^ s)) should raise_an_exception 12 | done; 13 | it "...even when sign is present" do 14 | forall (string_of ~length:(fun () -> 38) digit) s . 15 | let str = Str.replace_first (Str.regexp "^0+") "" s in 16 | (to_string (of_string ("+" ^ str))) should = str; 17 | done; 18 | it "should be converted from/to an ocaml positive integer losslessly" do 19 | (of_int 0 |> to_int) should = 0; 20 | let i = Pervasives.max_int |> Pervasives.pred in 21 | (of_int i |> to_int) should = i; 22 | (of_int Pervasives.max_int |> to_int) should = Pervasives.max_int; 23 | done 24 | done 25 | -------------------------------------------------------------------------------- /spec/uint32.ml: -------------------------------------------------------------------------------- 1 | #load "stdint.cma";; 2 | open Stdint.Uint32;; 3 | #use "spec/common.ml";; 4 | 5 | describe "An uint32" do 6 | it "should convert to/from an uint8 correctly" do 7 | forall (int_in_range 0 255) x . 8 | (Stdint.Uint8.of_int x |> of_uint8 |> to_int) should = x 9 | done; 10 | it "should convert to/from an int8 correctly" do 11 | forall (int_in_range 0 127) x . 12 | (Stdint.Int8.of_int x |> of_int8 |> to_int) should = x 13 | done; 14 | done 15 | -------------------------------------------------------------------------------- /spec/uint64.ml: -------------------------------------------------------------------------------- 1 | #load "stdint.cma";; 2 | #load "str.cma";; 3 | open Stdint.Uint64;; 4 | open Str;; 5 | #use "spec/common.ml";; 6 | 7 | describe "A 64-bit integer" do 8 | it "should be converted from strings correctly" do 9 | forall (string_of ~length:(fun () -> 19) digit) s . 10 | let str = replace_first (regexp "^0+") "" s in 11 | (to_string (of_string str)) should = str; 12 | (fun () -> of_string ("3" ^ s)) should raise_an_exception 13 | done; 14 | it "should be converted from/to an ocaml positive integer losslessly" do 15 | (of_int 0 |> to_int) should = 0; 16 | let i = Pervasives.max_int |> Pervasives.pred in 17 | (of_int i |> to_int) should = i; 18 | (of_int Pervasives.max_int |> to_int) should = Pervasives.max_int; 19 | done 20 | done 21 | -------------------------------------------------------------------------------- /stdint.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Signed and unsigned integer types having specified widths" 4 | description: """ 5 | The stdint library provides signed and unsigned integer types of various fixed 6 | widths: 8, 16, 24, 32, 40, 48, 56, 64 and 128 bit. 7 | 8 | This interface is similar to Int32 and Int64 from the base library but provides 9 | more functions and constants like arithmetic and bit-wise operations, constants 10 | like maximum and minimum values, infix operators conversion to and from every 11 | other integer type (including int, float and nativeint), parsing from and 12 | conversion to readable strings (binary, octal, decimal, hexademical), conversion 13 | to and from buffers in both big endian and little endian byte order.""" 14 | maintainer: ["Markus W. Weissmann "] 15 | authors: [ 16 | "Andre Nathan " 17 | "Jeff Shaw " 18 | "Markus W. Weissmann " 19 | "Florian Pichlmeier " 20 | ] 21 | license: "MIT" 22 | homepage: "https://github.com/andrenth/ocaml-stdint" 23 | doc: "https://andrenth.github.io/ocaml-stdint/" 24 | bug-reports: "https://github.com/andrenth/ocaml-stdint/issues" 25 | depends: [ 26 | "dune" {>= "3.0"} 27 | "ocaml" {>= "4.03"} 28 | "qcheck" {with-test} 29 | "odoc" {with-doc} 30 | ] 31 | dev-repo: "git+https://github.com/andrenth/ocaml-stdint.git" 32 | build: [ 33 | ["dune" "subst"] {pinned} 34 | [ 35 | "dune" 36 | "build" 37 | "-p" 38 | name 39 | "-j" 40 | jobs 41 | "@install" 42 | "@doc" {with-doc} 43 | ] 44 | ] 45 | -------------------------------------------------------------------------------- /stdint.opam.template: -------------------------------------------------------------------------------- 1 | build: [ 2 | ["dune" "subst"] {pinned} 3 | [ 4 | "dune" 5 | "build" 6 | "-p" 7 | name 8 | "-j" 9 | jobs 10 | "@install" 11 | "@doc" {with-doc} 12 | ] 13 | ] 14 | -------------------------------------------------------------------------------- /tests/.gitignore: -------------------------------------------------------------------------------- 1 | stdint_test.o 2 | stdint_test 3 | stdint_test.cmi 4 | stdint_test.cmx 5 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name stdint_test) 3 | (libraries str stdint qcheck) 4 | (flags (:standard -w -32))) 5 | -------------------------------------------------------------------------------- /tests/stdint_test.ml: -------------------------------------------------------------------------------- 1 | module type TESTER = 2 | sig 3 | val tests : QCheck.Test.t list 4 | end 5 | 6 | let skip name = QCheck.Test.make ~count:0 ~name 7 | let test name = QCheck.Test.make ~count:10 ~name 8 | 9 | let rec binary_string_of_int n = 10 | if n = 0 then "0" else 11 | binary_string_of_int (n asr 1) ^ 12 | (if n land 1 = 0 then "0" else "1") 13 | 14 | module IntBounds (I : Stdint.Int) = 15 | struct 16 | let mini, maxi = 17 | if I.(to_int max_int) = -1 then 18 | if I.(min_int < zero) then 19 | (* halved because int_range must be able to diff the two boundaries *) 20 | min_int/2, max_int/2 21 | else 22 | 0, max_int 23 | else 24 | I.(to_int min_int), 25 | I.(to_int max_int) 26 | 27 | let () = assert (mini < maxi) 28 | 29 | let in_range = QCheck.int_range mini maxi 30 | let pos_int = QCheck.int_range 0 maxi 31 | let in_range_float = 32 | QCheck.float_range (float_of_int mini) (float_of_int maxi) 33 | end 34 | 35 | module Tester (I : Stdint.Int) : TESTER = 36 | struct 37 | include IntBounds (I) 38 | 39 | let ( *** ) = ( * ) (* Preserve int mul for later use *) 40 | 41 | open I 42 | 43 | let tests = [ 44 | QCheck.Test.make ~count:1 ~name:"Maximum value is greater than minimum" 45 | QCheck.unit (fun () -> min_int < max_int) ; 46 | 47 | test "An integer should not modify an int when converted" 48 | in_range (fun x -> to_int (of_int x) = x) ; 49 | 50 | test "An integer should not modify strings when converted" 51 | in_range (fun x -> to_string (of_int x) = string_of_int x) ; 52 | 53 | test "An integer should perform logical-and correctly" 54 | (QCheck.pair pos_int pos_int) (fun (x, y) -> 55 | to_int (logand (of_int x) (of_int y)) = x land y) ; 56 | 57 | test "An integer should perform logical-or correctly" 58 | (QCheck.pair pos_int pos_int) (fun (x, y) -> 59 | to_int (logor (of_int x) (of_int y)) = x lor y) ; 60 | 61 | test "An integer should perform logical-xor correctly" 62 | (QCheck.pair pos_int pos_int) (fun (x, y) -> 63 | to_int (logxor (of_int x) (of_int y)) = x lxor y) ; 64 | 65 | test "An integer should perform logical-not correctly" 66 | pos_int (fun x -> lognot (of_int x) = of_int (lnot x)) ; 67 | 68 | test "An integer should perform left-shifts correctly" 69 | QCheck.(pair in_range (int_bound 31)) (fun (x, y) -> 70 | shift_left (of_int x) y = of_int (x lsl y)) ; 71 | 72 | test "An integer should perform right-shifts correctly" 73 | QCheck.(pair in_range (int_bound 31)) (fun (x, y) -> 74 | shift_right (of_int x) y = of_int (x asr y)) ; 75 | 76 | test "Arithmetic shifts must sign-extend" 77 | QCheck.(int_range 0 200) (fun i -> 78 | let v = shift_right min_int i in 79 | (compare min_int zero) *** (compare v zero) >= 0) ; 80 | 81 | test "Logical shifts must not sign-extend" 82 | QCheck.(int_range 0 200) (fun i -> 83 | let v = shift_right_logical min_int i in 84 | compare v zero >= 0) ; 85 | 86 | test "An integer should perform float conversions correctly" 87 | in_range_float (fun x -> 88 | to_float (of_float x) = float_of_int (int_of_float x)) ; 89 | ] 90 | end 91 | 92 | module Tester2 (I1 : Stdint.Int) (I2 : Stdint.Int) 93 | (C : sig val of_i2 : I2.t -> I1.t end) : TESTER = 94 | struct 95 | let mini, maxi = 96 | if I2.(to_int max_int) = -1 then 97 | if I2.(min_int < zero) then 98 | min_int, max_int 99 | else 100 | 0, max_int 101 | else 102 | I2.(to_int min_int), 103 | I2.(to_int max_int) 104 | 105 | open I1 106 | 107 | let tests = [ 108 | test "Conversion to/from a smaller integer" 109 | QCheck.(int_range mini maxi) (fun x -> 110 | I2.of_int x |> C.of_i2 |> to_int = x) 111 | ] 112 | end 113 | 114 | module OfStringTester (I : Stdint.Int) = 115 | struct 116 | let max_str = I.(to_string max_int) 117 | let max_str_len = String.length max_str 118 | 119 | let integer_str_gen = 120 | QCheck.(string_gen_of_size (Gen.return max_str_len) Gen.numeral |> 121 | map_same_type (fun s -> 122 | if s <= max_str then s else String.sub s 1 (max_str_len - 1))) 123 | 124 | let str_gen = 125 | QCheck.pair integer_str_gen ( 126 | QCheck.(string_gen_of_size (Gen.return 1) (Gen.oneofl ['k';'!']))) 127 | 128 | open I 129 | 130 | let tests = [ 131 | test "An integer should be converted from strings correctly" 132 | integer_str_gen (fun s -> 133 | let str = Str.(replace_first (regexp "^0+") "" s) in 134 | to_string (of_string str) = str && 135 | (try 136 | ignore (of_string ("9" ^ s)) ; 137 | false 138 | with _ -> true)) ; 139 | 140 | test "An integer should be converted from signed (+) strings correctly" 141 | integer_str_gen (fun s -> 142 | let str = Str.(replace_first (regexp "^0+") "" s) in 143 | to_string (of_string ("+" ^ str)) = str) ; 144 | 145 | test "An integer should be converted from signed (-) strings correctly" 146 | integer_str_gen (fun s -> 147 | let str = "-" ^ Str.(replace_first (regexp "^0+") "" s) in 148 | min_int = zero || 149 | to_string (of_string str) = str) ; 150 | 151 | test "An integer should be converted from strings with right offset correctly" 152 | str_gen (fun (i, s) -> 153 | let i_str = Str.(replace_first (regexp "^0+") "" i) in 154 | let str = i_str ^ s in 155 | let s, o = of_substring ~pos:0 str in 156 | to_string s = i_str && o = String.length i_str) ; 157 | 158 | test "An integer should be converted from substrings correctly" 159 | QCheck.(triple small_nat small_nat small_nat) (fun (pos, n, tail) -> 160 | let str = String.make pos ' ' ^ string_of_int n in 161 | let exp_len = String.length str in 162 | let str = str ^ String.make tail ' ' in 163 | of_substring ~pos str = (of_int n, exp_len)) ; 164 | 165 | test "An integer should be converted from signed (+) substrings correctly" 166 | QCheck.(triple small_nat small_nat small_nat) (fun (pos, n, tail) -> 167 | let str = String.make pos ' ' ^ "+" ^ string_of_int n in 168 | let exp_len = String.length str in 169 | let str = str ^ String.make tail ' ' in 170 | of_substring ~pos str = (of_int n, exp_len)) ; 171 | 172 | test "An integer should be converted from signed (-) substrings correctly" 173 | QCheck.(triple small_nat small_nat small_nat) (fun (pos, n, tail) -> 174 | min_int = zero || 175 | let str = String.make pos ' ' ^ "-" ^ string_of_int n in 176 | let exp_len = String.length str in 177 | let str = str ^ String.make tail ' ' in 178 | of_substring ~pos str = (of_int ~-n, exp_len)) ; 179 | 180 | test "All your binary bases do not belong to us" 181 | QCheck.small_nat (fun n -> 182 | let bits = "0b" ^ binary_string_of_int n in 183 | let str = "XX" ^ bits in 184 | let exp_len = String.length str in 185 | let str = str ^ "2345" in 186 | of_substring ~pos:2 str = (of_int n, exp_len)) ; 187 | 188 | test "All your decimal bases do not belong to us" 189 | QCheck.small_nat (fun n -> 190 | let str = Printf.sprintf "XX%d" n in 191 | let exp_len = String.length str in 192 | let str = str ^ "abcd" in 193 | of_substring ~pos:2 str = (of_int n, exp_len)) ; 194 | 195 | test "All your hexadecimal bases do not belong to us" 196 | QCheck.small_nat (fun n -> 197 | let str = Printf.sprintf "XX0x%x" n in 198 | let exp_len = String.length str in 199 | let str = str ^ "ghij" in 200 | of_substring ~pos:2 str = (of_int n, exp_len)) 201 | ] 202 | end 203 | 204 | module SignTester (I : Stdint.Int) = 205 | struct 206 | include IntBounds (I) 207 | 208 | open I 209 | 210 | let tests = [ 211 | test "A signed integer should perform negation correctly" 212 | pos_int (fun x -> neg (of_int x) = of_int (~- x)) ; 213 | 214 | test "Neg is like multiply by minus one" 215 | in_range (fun x -> neg (of_int x) = mul (neg one) (of_int x)) ; 216 | 217 | test "One can print after neg" 218 | in_range (fun x -> mul (neg one) (of_int x) |> to_string = string_of_int ~-x) ; 219 | ] 220 | end 221 | 222 | let () = 223 | Printexc.record_backtrace true; 224 | let ok = ref 0 and ko = ref 0 in 225 | 226 | let have_128 = try Stdint.(Int8.of_int128 (Int128.zero) = Int8.zero) with Failure _ -> false in 227 | let test_128bits_mods = 228 | if have_128 then 229 | Stdint.[ 230 | "Int128", (module Tester (Int128) : TESTER) ; 231 | "Uint128", (module Tester (Uint128) : TESTER) ; 232 | "Uint128 x Uint8", (module Tester2 (Uint128) (Uint8) (struct let of_i2 = Uint128.of_uint8 end): TESTER) ; 233 | "Int128 x Uint8", (module Tester2 (Int128) (Uint8) (struct let of_i2 = Int128.of_uint8 end): TESTER) ; 234 | "Uint128 x Uint16", (module Tester2 (Uint128) (Uint16) (struct let of_i2 = Uint128.of_uint16 end): TESTER) ; 235 | "Int128 x Uint16", (module Tester2 (Int128) (Uint16) (struct let of_i2 = Int128.of_uint16 end): TESTER) ; 236 | "Uint128 x Uint24", (module Tester2 (Uint128) (Uint24) (struct let of_i2 = Uint128.of_uint24 end): TESTER) ; 237 | "Int128 x Uint24", (module Tester2 (Int128) (Uint24) (struct let of_i2 = Int128.of_uint24 end): TESTER) ; 238 | "Uint128 x Uint32", (module Tester2 (Uint128) (Uint32) (struct let of_i2 = Uint128.of_uint32 end): TESTER) ; 239 | "Int128 x Uint32", (module Tester2 (Int128) (Uint32) (struct let of_i2 = Int128.of_uint32 end): TESTER) ; 240 | "Uint128 x Uint40", (module Tester2 (Uint128) (Uint40) (struct let of_i2 = Uint128.of_uint40 end): TESTER) ; 241 | "Int128 x Uint40", (module Tester2 (Int128) (Uint40) (struct let of_i2 = Int128.of_uint40 end): TESTER) ; 242 | "Uint128 x Uint48", (module Tester2 (Uint128) (Uint48) (struct let of_i2 = Uint128.of_uint48 end): TESTER) ; 243 | "Int128 x Uint48", (module Tester2 (Int128) (Uint48) (struct let of_i2 = Int128.of_uint48 end): TESTER) ; 244 | "Uint128 x Uint56", (module Tester2 (Uint128) (Uint56) (struct let of_i2 = Uint128.of_uint56 end): TESTER) ; 245 | "Int128 x Uint56", (module Tester2 (Int128) (Uint56) (struct let of_i2 = Int128.of_uint56 end): TESTER) ; 246 | "Uint128 x Uint64", (module Tester2 (Uint128) (Uint64) (struct let of_i2 = Uint128.of_uint64 end): TESTER) ; 247 | "Int128 x Uint64", (module Tester2 (Int128) (Uint64) (struct let of_i2 = Int128.of_uint64 end): TESTER) ; 248 | 249 | "Uint128 strings", (module OfStringTester (Stdint.Uint128) : TESTER) ; 250 | "Int128 strings", (module OfStringTester (Stdint.Int128) : TESTER) ; 251 | "Int128 sign ops", (module SignTester (Stdint.Int128) : TESTER) ; 252 | ] else [] 253 | in 254 | 255 | let test_mods = test_128bits_mods @ Stdint.[ 256 | "Int8", (module Tester (Int8) : TESTER) ; 257 | "Int16", (module Tester (Int16) : TESTER) ; 258 | "Int24", (module Tester (Int24) : TESTER) ; 259 | "Int32", (module Tester (Int32) : TESTER) ; 260 | "Int40", (module Tester (Int40) : TESTER) ; 261 | "Int48", (module Tester (Int48) : TESTER) ; 262 | "Int56", (module Tester (Int56) : TESTER) ; 263 | "Int64", (module Tester (Int64) : TESTER) ; 264 | "Uint8", (module Tester (Uint8) : TESTER) ; 265 | "Uint16", (module Tester (Uint16) : TESTER) ; 266 | "Uint24", (module Tester (Uint24) : TESTER) ; 267 | "Uint32", (module Tester (Uint32) : TESTER) ; 268 | "Uint40", (module Tester (Uint40) : TESTER) ; 269 | "Uint48", (module Tester (Uint48) : TESTER) ; 270 | "Uint56", (module Tester (Uint56) : TESTER) ; 271 | "Uint64", (module Tester (Uint64) : TESTER) ; 272 | 273 | "Uint16 x Uint8", (module Tester2 (Uint16) (Uint8) (struct let of_i2 = Uint16.of_uint8 end): TESTER) ; 274 | "Uint24 x Uint8", (module Tester2 (Uint24) (Uint8) (struct let of_i2 = Uint24.of_uint8 end): TESTER) ; 275 | "Uint32 x Uint8", (module Tester2 (Uint32) (Uint8) (struct let of_i2 = Uint32.of_uint8 end): TESTER) ; 276 | "Uint40 x Uint8", (module Tester2 (Uint40) (Uint8) (struct let of_i2 = Uint40.of_uint8 end): TESTER) ; 277 | "Uint48 x Uint8", (module Tester2 (Uint48) (Uint8) (struct let of_i2 = Uint48.of_uint8 end): TESTER) ; 278 | "Uint56 x Uint8", (module Tester2 (Uint56) (Uint8) (struct let of_i2 = Uint56.of_uint8 end): TESTER) ; 279 | "Uint64 x Uint8", (module Tester2 (Uint64) (Uint8) (struct let of_i2 = Uint64.of_uint8 end): TESTER) ; 280 | "Int16 x Uint8", (module Tester2 (Int16) (Uint8) (struct let of_i2 = Int16.of_uint8 end): TESTER) ; 281 | "Int24 x Uint8", (module Tester2 (Int24) (Uint8) (struct let of_i2 = Int24.of_uint8 end): TESTER) ; 282 | "Int32 x Uint8", (module Tester2 (Int32) (Uint8) (struct let of_i2 = Int32.of_uint8 end): TESTER) ; 283 | "Int40 x Uint8", (module Tester2 (Int40) (Uint8) (struct let of_i2 = Int40.of_uint8 end): TESTER) ; 284 | "Int48 x Uint8", (module Tester2 (Int48) (Uint8) (struct let of_i2 = Int48.of_uint8 end): TESTER) ; 285 | "Int56 x Uint8", (module Tester2 (Int56) (Uint8) (struct let of_i2 = Int56.of_uint8 end): TESTER) ; 286 | "Int64 x Uint8", (module Tester2 (Int64) (Uint8) (struct let of_i2 = Int64.of_uint8 end): TESTER) ; 287 | 288 | "Uint24 x Uint16", (module Tester2 (Uint24) (Uint16) (struct let of_i2 = Uint24.of_uint16 end): TESTER) ; 289 | "Uint32 x Uint16", (module Tester2 (Uint32) (Uint16) (struct let of_i2 = Uint32.of_uint16 end): TESTER) ; 290 | "Uint40 x Uint16", (module Tester2 (Uint40) (Uint16) (struct let of_i2 = Uint40.of_uint16 end): TESTER) ; 291 | "Uint48 x Uint16", (module Tester2 (Uint48) (Uint16) (struct let of_i2 = Uint48.of_uint16 end): TESTER) ; 292 | "Uint56 x Uint16", (module Tester2 (Uint56) (Uint16) (struct let of_i2 = Uint56.of_uint16 end): TESTER) ; 293 | "Uint64 x Uint16", (module Tester2 (Uint64) (Uint16) (struct let of_i2 = Uint64.of_uint16 end): TESTER) ; 294 | "Int24 x Uint16", (module Tester2 (Int24) (Uint16) (struct let of_i2 = Int24.of_uint16 end): TESTER) ; 295 | "Int32 x Uint16", (module Tester2 (Int32) (Uint16) (struct let of_i2 = Int32.of_uint16 end): TESTER) ; 296 | "Int40 x Uint16", (module Tester2 (Int40) (Uint16) (struct let of_i2 = Int40.of_uint16 end): TESTER) ; 297 | "Int48 x Uint16", (module Tester2 (Int48) (Uint16) (struct let of_i2 = Int48.of_uint16 end): TESTER) ; 298 | "Int56 x Uint16", (module Tester2 (Int56) (Uint16) (struct let of_i2 = Int56.of_uint16 end): TESTER) ; 299 | "Int64 x Uint16", (module Tester2 (Int64) (Uint16) (struct let of_i2 = Int64.of_uint16 end): TESTER) ; 300 | 301 | "Uint32 x Uint24", (module Tester2 (Uint32) (Uint24) (struct let of_i2 = Uint32.of_uint24 end): TESTER) ; 302 | "Uint40 x Uint24", (module Tester2 (Uint40) (Uint24) (struct let of_i2 = Uint40.of_uint24 end): TESTER) ; 303 | "Uint48 x Uint24", (module Tester2 (Uint48) (Uint24) (struct let of_i2 = Uint48.of_uint24 end): TESTER) ; 304 | "Uint56 x Uint24", (module Tester2 (Uint56) (Uint24) (struct let of_i2 = Uint56.of_uint24 end): TESTER) ; 305 | "Uint64 x Uint24", (module Tester2 (Uint64) (Uint24) (struct let of_i2 = Uint64.of_uint24 end): TESTER) ; 306 | "Int32 x Uint24", (module Tester2 (Int32) (Uint24) (struct let of_i2 = Int32.of_uint24 end): TESTER) ; 307 | "Int40 x Uint24", (module Tester2 (Int40) (Uint24) (struct let of_i2 = Int40.of_uint24 end): TESTER) ; 308 | "Int48 x Uint24", (module Tester2 (Int48) (Uint24) (struct let of_i2 = Int48.of_uint24 end): TESTER) ; 309 | "Int56 x Uint24", (module Tester2 (Int56) (Uint24) (struct let of_i2 = Int56.of_uint24 end): TESTER) ; 310 | "Int64 x Uint24", (module Tester2 (Int64) (Uint24) (struct let of_i2 = Int64.of_uint24 end): TESTER) ; 311 | 312 | "Uint40 x Uint32", (module Tester2 (Uint40) (Uint32) (struct let of_i2 = Uint40.of_uint32 end): TESTER) ; 313 | "Uint48 x Uint32", (module Tester2 (Uint48) (Uint32) (struct let of_i2 = Uint48.of_uint32 end): TESTER) ; 314 | "Uint56 x Uint32", (module Tester2 (Uint56) (Uint32) (struct let of_i2 = Uint56.of_uint32 end): TESTER) ; 315 | "Uint64 x Uint32", (module Tester2 (Uint64) (Uint32) (struct let of_i2 = Uint64.of_uint32 end): TESTER) ; 316 | "Int40 x Uint32", (module Tester2 (Int40) (Uint32) (struct let of_i2 = Int40.of_uint32 end): TESTER) ; 317 | "Int48 x Uint32", (module Tester2 (Int48) (Uint32) (struct let of_i2 = Int48.of_uint32 end): TESTER) ; 318 | "Int56 x Uint32", (module Tester2 (Int56) (Uint32) (struct let of_i2 = Int56.of_uint32 end): TESTER) ; 319 | "Int64 x Uint32", (module Tester2 (Int64) (Uint32) (struct let of_i2 = Int64.of_uint32 end): TESTER) ; 320 | 321 | "Uint48 x Uint40", (module Tester2 (Uint48) (Uint40) (struct let of_i2 = Uint48.of_uint40 end): TESTER) ; 322 | "Uint56 x Uint40", (module Tester2 (Uint56) (Uint40) (struct let of_i2 = Uint56.of_uint40 end): TESTER) ; 323 | "Uint64 x Uint40", (module Tester2 (Uint64) (Uint40) (struct let of_i2 = Uint64.of_uint40 end): TESTER) ; 324 | "Int48 x Uint40", (module Tester2 (Int48) (Uint40) (struct let of_i2 = Int48.of_uint40 end): TESTER) ; 325 | "Int56 x Uint40", (module Tester2 (Int56) (Uint40) (struct let of_i2 = Int56.of_uint40 end): TESTER) ; 326 | "Int64 x Uint40", (module Tester2 (Int64) (Uint40) (struct let of_i2 = Int64.of_uint40 end): TESTER) ; 327 | 328 | "Uint56 x Uint48", (module Tester2 (Uint56) (Uint48) (struct let of_i2 = Uint56.of_uint48 end): TESTER) ; 329 | "Uint64 x Uint48", (module Tester2 (Uint64) (Uint48) (struct let of_i2 = Uint64.of_uint48 end): TESTER) ; 330 | "Int56 x Uint48", (module Tester2 (Int56) (Uint48) (struct let of_i2 = Int56.of_uint48 end): TESTER) ; 331 | "Int64 x Uint48", (module Tester2 (Int64) (Uint48) (struct let of_i2 = Int64.of_uint48 end): TESTER) ; 332 | 333 | "Uint64 x Uint56", (module Tester2 (Uint64) (Uint56) (struct let of_i2 = Uint64.of_uint56 end): TESTER) ; 334 | "Int64 x Uint56", (module Tester2 (Int64) (Uint56) (struct let of_i2 = Int64.of_uint56 end): TESTER) ; 335 | 336 | "Uint8 strings", (module OfStringTester (Stdint.Uint8) : TESTER) ; 337 | "Int8 strings", (module OfStringTester (Stdint.Int8) : TESTER) ; 338 | "Uint16 strings", (module OfStringTester (Stdint.Uint16) : TESTER) ; 339 | "Int16 strings", (module OfStringTester (Stdint.Int16) : TESTER) ; 340 | "Uint24 strings", (module OfStringTester (Stdint.Uint24) : TESTER) ; 341 | "Int24 strings", (module OfStringTester (Stdint.Int24) : TESTER) ; 342 | "Uint32 strings", (module OfStringTester (Stdint.Uint32) : TESTER) ; 343 | "Int32 strings", (module OfStringTester (Stdint.Int32) : TESTER) ; 344 | "Uint40 strings", (module OfStringTester (Stdint.Uint40) : TESTER) ; 345 | "Int40 strings", (module OfStringTester (Stdint.Int40) : TESTER) ; 346 | "Uint48 strings", (module OfStringTester (Stdint.Uint48) : TESTER) ; 347 | "Int48 strings", (module OfStringTester (Stdint.Int48) : TESTER) ; 348 | "Uint56 strings", (module OfStringTester (Stdint.Uint56) : TESTER) ; 349 | "Int56 strings", (module OfStringTester (Stdint.Int56) : TESTER) ; 350 | "Uint64 strings", (module OfStringTester (Stdint.Uint64) : TESTER) ; 351 | "Int64 strings", (module OfStringTester (Stdint.Int64) : TESTER) ; 352 | 353 | "Int8 sign ops", (module SignTester (Stdint.Int8) : TESTER) ; 354 | "Int16 sign ops", (module SignTester (Stdint.Int16) : TESTER) ; 355 | "Int24 sign ops", (module SignTester (Stdint.Int24) : TESTER) ; 356 | "Int32 sign ops", (module SignTester (Stdint.Int32) : TESTER) ; 357 | "Int40 sign ops", (module SignTester (Stdint.Int40) : TESTER) ; 358 | "Int48 sign ops", (module SignTester (Stdint.Int48) : TESTER) ; 359 | "Int56 sign ops", (module SignTester (Stdint.Int56) : TESTER) ; 360 | "Int64 sign ops", (module SignTester (Stdint.Int64) : TESTER) ; 361 | ] in 362 | 363 | List.iter (fun (n, m) -> 364 | Printf.printf "\n== Testing %s ==\n%!" n ; 365 | let module T = (val m : TESTER) in 366 | 367 | List.iter (fun t -> 368 | try 369 | QCheck.Test.check_exn t ; 370 | incr ok 371 | with e -> 372 | print_endline (Printexc.to_string e) ; 373 | Printexc.print_backtrace stdout ; 374 | incr ko 375 | ) T.tests 376 | ) test_mods ; 377 | 378 | if !ko = 0 then 379 | Printf.printf "%d/%d Ok\n" !ok !ok 380 | else ( 381 | Printf.printf "%d/%d FAILURE\n" !ko (!ko + !ok) ; 382 | exit 1 383 | ) 384 | --------------------------------------------------------------------------------