From 058e3465c16bb4610b0c9a9b82a7757253091c20 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Thu, 16 Jul 2020 14:57:45 +0200 Subject: [PATCH 01/27] Preliminary support for LibTomMath as backend instead of GMP. Enable with ./configure -tommath Requires LibTomMath 1.2.0. Not all Zarith functions are supported. Not fully tested. This backend is also slower than the GMP / MPIR version. --- caml_z_tommath.c | 1865 ++++++++++++++++++++++++++++++++++++++++++++++ configure | 21 +- project.mak | 3 +- tests/zq.ml | 12 +- 4 files changed, 1896 insertions(+), 5 deletions(-) create mode 100644 caml_z_tommath.c diff --git a/caml_z_tommath.c b/caml_z_tommath.c new file mode 100644 index 0000000..a795e9b --- /dev/null +++ b/caml_z_tommath.c @@ -0,0 +1,1865 @@ +/** + Implementation of Z module. + + This version uses LibTomMath instead of GMP / MPIR. + Not all functions are supported. + Requires LibTomMath 1.2.0. + + This file is part of the Zarith library + http://forge.ocamlcore.org/projects/zarith . + It is distributed under LGPL 2 licensing, with static linking exception. + See the LICENSE file included in the distribution. + + Copyright (c) 2010-2011 Antoine Miné, Abstraction project. + Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS), + a joint laboratory by: + CNRS (Centre national de la recherche scientifique, France), + ENS (École normale supérieure, Paris, France), + INRIA Rocquencourt (Institut national de recherche en informatique, France). + +*/ + + +/*--------------------------------------------------- + INCLUDES + ---------------------------------------------------*/ + +#include +#include +#include +#include +#include +#include + +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#ifdef Z_OCAML_HASH +#include +#endif + +#define inline __inline + +#ifdef _MSC_VER +#include +#endif + + + +/*--------------------------------------------------- + DATA STRUCTURES + ---------------------------------------------------*/ + + +/* bounds of an Ocaml int */ +#ifdef ARCH_SIXTYFOUR +#define Z_MAX_INT 0x3fffffffffffffff +#define Z_MIN_INT (-0x4000000000000000) +#else +#define Z_MAX_INT 0x3fffffff +#define Z_MIN_INT (-0x40000000) +#endif +#define Z_FITS_INT(v) ((v) >= Z_MIN_INT && (v) <= Z_MAX_INT) + +static mp_int z_max_int, z_min_int; +static mp_int z_max_intnat, z_min_intnat; +static mp_int z_max_int32, z_min_int32; +static mp_int z_max_int64, z_min_int64; + +/* Z_MAX_INT may not be representable exactly as a double => we use a + lower approximation to be safe + */ +#ifdef ARCH_SIXTYFOUR +#define Z_MAX_INT_FL 0x3ffffffffffff000 +#define Z_MIN_INT_FL (-Z_MAX_INT_FL) +#else +#define Z_MAX_INT_FL Z_MAX_INT +#define Z_MIN_INT_FL Z_MIN_INT +#endif + +/* safe bounds to avoid overflow in multiplication */ +#ifdef ARCH_SIXTYFOUR +#define Z_MAX_HINT 0x3fffffff +#else +#define Z_MAX_HINT 0x3fff +#endif +#define Z_MIN_HINT (-Z_MAX_HINT) +#define Z_FITS_HINT(v) ((v) >= Z_MIN_HINT && (v) <= Z_MAX_HINT) + +/* hi bit of OCaml int32, int64 & nativeint */ +#define Z_HI_INT32 0x80000000 +#define Z_HI_INT64 0x8000000000000000LL +#ifdef ARCH_SIXTYFOUR +#define Z_HI_INTNAT Z_HI_INT64 +#define Z_HI_INT 0x4000000000000000 +#define Z_INTNAT_BITS 64 +#else +#define Z_HI_INTNAT Z_HI_INT32 +#define Z_HI_INT 0x40000000 +#define Z_INTNAT_BITS 32 +#endif + +/* safe bounds for the length of a base n string fitting in a native + int. Defined as the result of (n - 2) log_base(2) with n = 64 or + 32. +*/ +#ifdef ARCH_SIXTYFOUR +#define Z_BASE16_LENGTH_OP 15 +#define Z_BASE10_LENGTH_OP 18 +#define Z_BASE8_LENGTH_OP 20 +#define Z_BASE2_LENGTH_OP 62 +#else +#define Z_BASE16_LENGTH_OP 7 +#define Z_BASE10_LENGTH_OP 9 +#define Z_BASE8_LENGTH_OP 10 +#define Z_BASE2_LENGTH_OP 30 +#endif + +#define Z_MP(x) ((mp_int*)Data_custom_val((x))) + +#define Z_ISZERO(x) (Is_long((x)) ? Long_val((x)) == 0 : mp_iszero(Z_MP((x)))) +#define Z_ISNEG(x) (Is_long((x)) ? Long_val((x)) < 0 : mp_isneg(Z_MP((x)))) + + +/*--------------------------------------------------- + UTILITIES + ---------------------------------------------------*/ + + +extern struct custom_operations ml_z_custom_ops; + +static void ml_z_raise_overflow() +{ + caml_raise_constant(*caml_named_value("ml_z_overflow")); +} + +#define ml_z_raise_divide_by_zero() \ + caml_raise_zero_divide() + +#define ml_z_raise_out_of_memory() \ + caml_raise_out_of_memory() + +static value ml_z_alloc() +{ + value v; + v = caml_alloc_custom(&ml_z_custom_ops, sizeof(mp_int), 0, 1); + if (mp_init(Z_MP(v)) != MP_OKAY) + ml_z_raise_out_of_memory(); + return v; +} + + +#ifdef ARCH_SIXTYFOUR +#define MP_INIT_VALUE mp_init_i64 +#else +#define MP_INIT_VALUE mp_init_i32 +#endif + +#define Z_DECL(arg) \ + const mp_int *mp_##arg; \ + mp_int mp_s_##arg \ + +#define Z_ARG(arg) \ + if (Is_long(arg)) { \ + mp_##arg = & mp_s_##arg; \ + if (MP_INIT_VALUE((mp_int*)mp_##arg, Long_val(arg)) != MP_OKAY) \ + ml_z_raise_out_of_memory(); \ + } \ + else { \ + mp_##arg = Z_MP(arg); \ + } + +#define Z_REFRESH(arg) \ + if (!Is_long(arg)) \ + mp_##arg = Z_MP(arg); + +#define Z_END_ARG(arg) \ + if (Is_long(arg)) { \ + mp_clear((mp_int*)mp_##arg); \ + } + +static value ml_z_reduce(value r) +{ + if (mp_cmp(Z_MP(r), &z_min_int) >= 0 && + mp_cmp(Z_MP(r), &z_max_int) <= 0) { + /* can be represented in a value, we free the mp_int */ + intnat x = mp_get_i64(Z_MP(r)); + mp_clear(Z_MP(r)); + return Val_long(x); + } + return r; +} + + +/*--------------------------------------------------- + CONVERSION FUNCTIONS + ---------------------------------------------------*/ + +CAMLprim value ml_z_of_int(value v) +{ + return v; +} + +CAMLprim value ml_z_of_nativeint(value v) +{ + intnat x; + value r; + x = Nativeint_val(v); + if (Z_FITS_INT(x)) return Val_long(x); + r = ml_z_alloc(); +#ifdef ARCH_SIXTYFOUR + mp_set_i64(Z_MP(r), x); +#else + mp_set_i32(Z_MP(r), x); +#endif + return r; +} + +CAMLprim value ml_z_of_int32(value v) +{ + int32_t x; + value r; + x = Int32_val(v); +#ifdef ARCH_SIXTYFOUR + return Val_long(x); +#else + if (Z_FITS_INT(x)) return Val_long(x); +#endif + r = ml_z_alloc(); + mp_set_i32(Z_MP(r), x); + return r; +} + +CAMLprim value ml_z_of_int64(value v) +{ + int64_t x; + value r; + x = Int64_val(v); + if (Z_FITS_INT(x)) return Val_long(x); + r = ml_z_alloc(); + mp_set_i64(Z_MP(r), x); + return r; +} + +CAMLprim value ml_z_of_float(value v) +{ + double x; + value r; + x = Double_val(v); + if (x >= Z_MIN_INT_FL && x <= Z_MAX_INT_FL) return Val_long((intnat) x); + r = ml_z_alloc(); + if (mp_set_double(Z_MP(r), x) != MP_OKAY) { + mp_clear(Z_MP(r)); + ml_z_raise_overflow(); + } + return r; +} + +CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value length) +{ + CAMLparam1(v); + CAMLlocal1(r); + intnat ofs = Long_val(offset); + intnat len = Long_val(length); + /* make sure the ofs/length make sense */ + if (ofs < 0 + || len < 0 + || (intnat)caml_string_length(v) < ofs + len) + caml_invalid_argument("Z.of_substring_base: invalid offset or length"); + /* process the string */ + const char *d = String_val(v) + ofs; + const char *end = d + len; + ssize_t i, sz; + int sign = 0; + intnat base = Long_val(b); + /* We allow [d] to advance beyond [end] while parsing the prefix: + sign, base, and/or leading zeros. + This simplifies the code, and reading these locations is safe since + we don't progress beyond a terminating null character. + At the end of the prefix, if we ran past the end, we return 0. + */ + /* get optional sign */ + if (*d == '-') { sign = 1; d++; } + if (*d == '+') d++; + /* get optional base */ + if (!base) { + base = 10; + if (*d == '0') { + d++; + if (*d == 'o' || *d == 'O') { base = 8; d++; } + else if (*d == 'x' || *d == 'X') { base = 16; d++; } + else if (*d == 'b' || *d == 'B') { base = 2; d++; } + } + } + if (base < 2 || base > 16) + caml_invalid_argument("Z.of_substring_base: base must be between 2 and 16"); + while (*d == '0') d++; + /* sz is the length of the substring that has not been consumed above. */ + sz = end - d; + if (sz <= 0) { + /* "+", "-", "0x" are parsed as 0. */ + r = Val_long(0); + } + /* Process common cases (fits into a native integer) */ + else if ((base == 10 && sz <= Z_BASE10_LENGTH_OP) + || (base == 16 && sz <= Z_BASE16_LENGTH_OP) + || (base == 8 && sz <= Z_BASE8_LENGTH_OP) + || (base == 2 && sz <= Z_BASE2_LENGTH_OP)) { + intnat ret = 0; + for (i = 0; i < sz; i++) { + int digit = 0; + if (d[i] >= '0' && d[i] <= '9') digit = d[i] - '0'; + else if (d[i] >= 'a' && d[i] <= 'f') digit = d[i] - 'a' + 10; + else if (d[i] >= 'A' && d[i] <= 'F') digit = d[i] - 'A' + 10; + else caml_invalid_argument("Z.of_substring_base: invalid digit"); + if (digit >= base) + caml_invalid_argument("Z.of_substring_base: invalid digit"); + ret = ret * base + digit; + } + r = Val_long(ret * (sign ? -1 : 1)); + } else { + r = ml_z_alloc(); + if (mp_read_radix(Z_MP(r), d, base) != MP_OKAY) { + mp_clear(Z_MP(r)); + caml_invalid_argument("Z.of_substring_base: invalid string"); + } + if (sign) { + if (mp_neg(Z_MP(r), Z_MP(r)) != MP_OKAY) { + mp_clear(Z_MP(r)); + caml_failwith("Z.of_substring_base: internal error"); + } + } + } + CAMLreturn(r); +} + +CAMLprim value ml_z_to_int(value v) +{ + if (Is_long(v)) return v; + if (mp_cmp(Z_MP(v), &z_min_int) >= 0 && + mp_cmp(Z_MP(v), &z_max_int) <= 0) { +#ifdef ARCH_SIXTYFOUR + return Val_long(mp_get_i64(Z_MP(v))); +#else + return Val_long(mp_get_i32(Z_MP(v))); +#endif + } + ml_z_raise_overflow(); + return 0; +} + +CAMLprim value ml_z_to_nativeint(value v) +{ + if (Is_long(v)) return caml_copy_nativeint(Long_val(v)); + if (mp_cmp(Z_MP(v), &z_min_intnat) >= 0 && + mp_cmp(Z_MP(v), &z_max_intnat) <= 0) { +#ifdef ARCH_SIXTYFOUR + return caml_copy_nativeint(mp_get_i64(Z_MP(v))); +#else + return caml_copy_nativeint(mp_get_i32(Z_MP(v))); +#endif + } + ml_z_raise_overflow(); + return 0; +} + +CAMLprim value ml_z_to_int32(value v) +{ + if (Is_long(v)) { + intnat x = Long_val(v); +#ifdef ARCH_SIXTYFOUR + if (x >= (intnat)Z_HI_INT32 || x < -(intnat)Z_HI_INT32) + ml_z_raise_overflow(); +#endif + return caml_copy_int32(x); + } + if (mp_cmp(Z_MP(v), &z_min_int32) >= 0 && + mp_cmp(Z_MP(v), &z_max_int32) <= 0) { + return caml_copy_int32(mp_get_i32(Z_MP(v))); + } + ml_z_raise_overflow(); + return 0; +} + +CAMLprim value ml_z_to_int64(value v) +{ + if (Is_long(v)) return caml_copy_int64(Long_val(v)); + if (mp_cmp(Z_MP(v), &z_min_int64) >= 0 && + mp_cmp(Z_MP(v), &z_max_int64) <= 0) { + return caml_copy_int64(mp_get_i64(Z_MP(v))); + } + ml_z_raise_overflow(); + return 0; +} + +CAMLprim value ml_z_format(value f, value v) +{ + CAMLparam2(f,v); + Z_DECL(v); + char* buf, *dst; + int sz = 0; + size_t i, max_size, size_dst = 0; + value r; + const char* fmt = String_val(f); + int base = 10; /* base */ + int cas = 0; /* uppercase X / lowercase x */ + size_t width = 0; + int alt = 0; /* alternate # */ + int dir = 0; /* right / left adjusted */ + char sign = 0; /* sign char */ + char pad = ' '; /* padding char */ + char *prefix = ""; + Z_ARG(v); + + /* parse format */ + while (*fmt == '%') fmt++; + for (; ; fmt++) { + if (*fmt == '#') alt = 1; + else if (*fmt == '0') pad = '0'; + else if (*fmt == '-') dir = 1; + else if (*fmt == ' ' || *fmt == '+') sign = *fmt; + else break; + } + if (mp_isneg(mp_v)) sign = '-'; + for (;*fmt>='0' && *fmt<='9';fmt++) + width = 10*width + *fmt-'0'; + switch (*fmt) { + case 'i': case 'd': case 'u': break; + case 'b': base = 2; if (alt) prefix = "0b"; break; + case 'o': base = 8; if (alt) prefix = "0o"; break; + case 'x': base = 16; if (alt) prefix = "0x"; cas = 1; break; + case 'X': base = 16; if (alt) prefix = "0X"; break; + default: Z_END_ARG(v); caml_invalid_argument("Z.format: invalid format"); + } + if (dir) pad = ' '; + + /* get number of digits (can be overapproximated) */ + if (mp_radix_size(mp_v, base, &sz) != MP_OKAY || sz == 0) { + Z_END_ARG(v); + caml_failwith("Z.format: internal error"); + } + + /* we need space for sign + prefix + digits + 1 + padding + terminal 0 */ + max_size = 1 + 2 + sz + 1 + 2*width + 1; + buf = (char*) malloc(max_size); + if (!buf) caml_raise_out_of_memory(); + dst = buf + 1 + 2 + width; + + /* get digits */ + if (mp_to_radix (mp_v, dst, sz, &size_dst, base) != MP_OKAY || + size_dst == 0 || + dst + size_dst >= buf + max_size) { + Z_END_ARG(v); + free(buf); + caml_failwith("Z.format: internal error"); + } + size_dst--; + + /* undo sign */ + if (mp_isneg(mp_v)) { + dst++; + size_dst--; + } + + /* lower-case conversion */ + if (cas) { + for (i = 0; i < size_dst; i++) + if (dst[i] >= 'A') + dst[i] += ('a' - 'A'); + } + + /* add prefix, sign & padding */ + if (pad == ' ') { + if (dir) { + /* left alignment */ + for (i = strlen(prefix); i > 0; i--, size_dst++) + *(--dst) = prefix[i-1]; + if (sign) { *(--dst) = sign; size_dst++; } + for (; size_dst < width; size_dst++) + dst[size_dst] = pad; + } + else { + /* right alignment, space padding */ + for (i = strlen(prefix); i > 0; i--, size_dst++) + *(--dst) = prefix[i-1]; + if (sign) { *(--dst) = sign; size_dst++; } + for (; size_dst < width; size_dst++) *(--dst) = pad; + } + } + else { + /* right alignment, non-space padding */ + width -= strlen(prefix) + (sign ? 1 : 0); + for (; size_dst < width; size_dst++) *(--dst) = pad; + for (i = strlen(prefix); i > 0; i--, size_dst++) + *(--dst) = prefix[i-1]; + if (sign) { *(--dst) = sign; size_dst++; } + } + dst[size_dst] = 0; + if (dst < buf || dst + size_dst >= buf + max_size) + caml_failwith("Z.format: internal error"); + r = caml_copy_string(dst); + free(buf); + Z_END_ARG(v); + CAMLreturn(r); +} + +CAMLprim value ml_z_extract(value arg, value off, value len) +{ + caml_failwith("Z.extract: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_to_bits(value arg) +{ + caml_failwith("Z.to_bits: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_of_bits(value arg) +{ + caml_failwith("Z.of_bits: not implemented in LibTomMath backend"); +} + + +/*--------------------------------------------------- + TESTS AND COMPARISONS + ---------------------------------------------------*/ + +CAMLprim value ml_z_compare(value arg1, value arg2) +{ + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + if (arg1 > arg2) return Val_long(1); + else if (arg1 < arg2) return Val_long(-1); + else return Val_long(0); + } + else { + /* slow path */ + mp_ord r; + Z_DECL(arg1); + Z_DECL(arg2); + Z_ARG(arg1); + Z_ARG(arg2); + r = mp_cmp(mp_arg1, mp_arg2); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + /* we assume MP_LT==-1, MP_EQ==0, MP_GT==1 */ + return Val_long(r); + } +} + + +CAMLprim value ml_z_equal(value arg1, value arg2) +{ + mp_ord r; + Z_DECL(arg1); + Z_DECL(arg2); + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + return (arg1 == arg2) ? Val_true : Val_false; + } + /* slow path */ + Z_ARG(arg1); + Z_ARG(arg2); + r = mp_cmp(mp_arg1, mp_arg2); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + return (r == MP_EQ) ? Val_true : Val_false; +} + +CAMLprim value ml_z_sign(value arg) +{ + if (Is_long(arg)) { + if (arg > Val_long(0)) return Val_long(1); + else if (arg < Val_long(0)) return Val_long(-1); + else return Val_long(0); + } + else { + if (mp_iszero(Z_MP(arg))) return Val_long(0); + else if (mp_isneg(Z_MP(arg))) return Val_long(-1); + else return Val_long(1); + } +} + +CAMLprim value ml_z_fits_int(value v) +{ + if (Is_long(v)) return Val_true; + if (mp_cmp(Z_MP(v), &z_min_int) >= 0 && + mp_cmp(Z_MP(v), &z_max_int) <= 0) + return Val_true; + return Val_false; +} + +CAMLprim value ml_z_fits_nativeint(value v) +{ + if (Is_long(v)) return Val_true; + if (mp_cmp(Z_MP(v), &z_min_intnat) >= 0 && + mp_cmp(Z_MP(v), &z_max_intnat) <= 0) + return Val_true; + return Val_false; +} + +CAMLprim value ml_z_fits_int32(value v) +{ + if (Is_long(v)) { +#ifdef ARCH_SIXTYFOUR + intnat x = Long_val(v); + if (x >= (intnat)Z_HI_INT32 || x < -(intnat)Z_HI_INT32) + return Val_false; +#else + return Val_true; +#endif + } + if (mp_cmp(Z_MP(v), &z_min_int32) >= 0 && + mp_cmp(Z_MP(v), &z_max_int32) <= 0) + return Val_true; + return Val_false; +} + + +CAMLprim value ml_z_fits_int64(value v) +{ + if (Is_long(v)) return Val_true; + if (mp_cmp(Z_MP(v), &z_min_int64) >= 0 && + mp_cmp(Z_MP(v), &z_max_int64) <= 0) + return Val_true; + return Val_false; +} + +CAMLprim value ml_z_size(value v) +{ + if (Is_long(v)) return Val_long(1); + else return Val_long(Z_MP(v)->used); +} + + +/*--------------------------------------------------- + ARITHMETIC OPERATORS + ---------------------------------------------------*/ + +CAMLprim value ml_z_neg(value arg) +{ +#ifndef Z_ASM_neg + if (Is_long(arg)) { + /* fast path */ + if (arg > Val_long(Z_MIN_INT)) return 2 - arg; + } +#endif + { + /* slow path */ + CAMLparam1(arg); + value r; + Z_DECL(arg); + r = ml_z_alloc(); + Z_ARG(arg); + if (mp_neg(mp_arg, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg); + mp_clear(Z_MP(r)); + caml_failwith("Z.neg: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_abs(value arg) +{ +#ifndef Z_ASM_abs + if (Is_long(arg)) { + /* fast path */ + if (arg >= Val_long(0)) return arg; + if (arg > Val_long(Z_MIN_INT)) return 2 - arg; + } +#endif + { + /* slow path */ + CAMLparam1(arg); + value r; + if (Z_ISNEG(arg)) { + Z_DECL(arg); + r = ml_z_alloc(); + Z_ARG(arg); + if (mp_neg(mp_arg, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg); + mp_clear(Z_MP(r)); + caml_failwith("Z.neg: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg); + } + else r = arg; + CAMLreturn(r); + } +} + +CAMLprim value ml_z_add(value arg1, value arg2) +{ +#ifndef Z_ASM_add + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat v = a1 + a2; + if (Z_FITS_INT(v)) return Val_long(v); + } +#endif + { + /* slow path */ + CAMLparam2(arg1,arg2); + value r; + Z_DECL(arg1); + Z_DECL(arg2); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_add(mp_arg1, mp_arg2, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + caml_failwith("Z.add: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_sub(value arg1, value arg2) +{ +#ifndef Z_ASM_sub + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat v = a1 - a2; + if (Z_FITS_INT(v)) return Val_long(v); + } +#endif + { + /* slow path */ + CAMLparam2(arg1,arg2); + value r; + Z_DECL(arg1); + Z_DECL(arg2); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_sub(mp_arg1, mp_arg2, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + caml_failwith("Z.sub: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_mul(value arg1, value arg2) +{ +#ifndef ASM_mul + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + if (!a1 || !a2) return Val_long(0); + /* small argument case */ + if (Z_FITS_HINT(arg1) && Z_FITS_HINT(arg2)) return Val_long(a1 * a2); + } +#endif + { + /* slow path */ + CAMLparam2(arg1,arg2); + value r; + Z_DECL(arg1); + Z_DECL(arg2); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_mul(mp_arg1, mp_arg2, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + caml_failwith("Z.mul: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_div_rem(value arg1, value arg2) +{ + if (Z_ISZERO(arg2)) ml_z_raise_divide_by_zero(); + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat q,r; + q = a1 / a2; + r = a1 % a2; + if (Z_FITS_INT(q) && Z_FITS_INT(r)) { + value p = caml_alloc_small(2, 0); + Field(p,0) = Val_long(q); + Field(p,1) = Val_long(r); + return p; + } + } + /* slow path */ + { + CAMLparam2(arg1, arg2); + CAMLlocal3(q, r, p); + Z_DECL(arg1); + Z_DECL(arg2); + q = ml_z_alloc(); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_div(mp_arg1, mp_arg2, Z_MP(q), Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(q)); + mp_clear(Z_MP(r)); + caml_failwith("Z.div_rem: internal error"); + } + q = ml_z_reduce(q); + r = ml_z_reduce(r); + p = caml_alloc_small(2, 0); + Field(p,0) = q; + Field(p,1) = r; + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(p); + } +} + +CAMLprim value ml_z_div(value arg1, value arg2) +{ + if (Z_ISZERO(arg2)) ml_z_raise_divide_by_zero(); + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat q = a1 / a2; + if (Z_FITS_INT(q)) return Val_long(q); + } + /* slow path */ + { + CAMLparam2(arg1, arg2); + CAMLlocal1(q); + Z_DECL(arg1); + Z_DECL(arg2); + q = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_div(mp_arg1, mp_arg2, Z_MP(q), NULL) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(q)); + caml_failwith("Z.div: internal error"); + } + q = ml_z_reduce(q); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(q); + } +} + + +CAMLprim value ml_z_rem(value arg1, value arg2) +{ + if (Z_ISZERO(arg2)) ml_z_raise_divide_by_zero(); + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat r = a1 % a2; + if (Z_FITS_INT(r)) return Val_long(r); + } + /* slow path */ + { + CAMLparam2(arg1, arg2); + CAMLlocal1(r); + Z_DECL(arg1); + Z_DECL(arg2); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_div(mp_arg1, mp_arg2, NULL, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + caml_failwith("Z.rem: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(r); + } +} + + +/* helper function for division with rounding towards +oo / -oo */ +static value ml_z_rdiv(value arg1, value arg2, intnat dir) +{ + CAMLparam2(arg1, arg2); + CAMLlocal2(q, r); + Z_DECL(arg1); + Z_DECL(arg2); + q = ml_z_alloc(); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_div(mp_arg1, mp_arg2, Z_MP(q), Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(q)); + mp_clear(Z_MP(r)); + caml_failwith("Z.[cf]div: internal error"); + } + + if (!mp_iszero(Z_MP(r))) { + if (dir > 0 && mp_isneg(mp_arg1) == mp_isneg(mp_arg2)) { + if (mp_incr(Z_MP(q)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(q)); + mp_clear(Z_MP(r)); + caml_failwith("Z.[cf]div: internal error"); + } + } + if (dir < 0 && mp_isneg(mp_arg1) != mp_isneg(mp_arg2)) + if (mp_decr(Z_MP(q)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(q)); + mp_clear(Z_MP(r)); + caml_failwith("Z.[cf]div: internal error"); + } + } + q = ml_z_reduce(q); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + CAMLreturn(q); +} + +CAMLprim value ml_z_cdiv(value arg1, value arg2) +{ + if (Z_ISZERO(arg2)) ml_z_raise_divide_by_zero(); + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat q; + /* adjust to round towards +oo */ + if (a1 > 0 && a2 > 0) a1 += a2-1; + else if (a1 < 0 && a2 < 0) a1 += a2+1; + q = a1 / a2; + if (Z_FITS_INT(q)) return Val_long(q); + } + /* slow path */ + return ml_z_rdiv(arg1, arg2, 1); +} + +CAMLprim value ml_z_fdiv(value arg1, value arg2) +{ + if (Z_ISZERO(arg2)) ml_z_raise_divide_by_zero(); + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + intnat q; + /* adjust to round towards -oo */ + if (a1 < 0 && a2 > 0) a1 -= a2-1; + else if (a1 > 0 && a2 < 0) a1 -= a2+1; + q = a1 / a2; + if (Z_FITS_INT(q)) return Val_long(q); + } + /* slow path */ + return ml_z_rdiv(arg1, arg2, -1); +} + + +CAMLprim value ml_z_succ(value arg) +{ +#ifndef Z_ASM_succ + if (Is_long(arg)) { + /* fast path */ + if (arg < Val_long(Z_MAX_INT)) return arg + 2; + } +#endif + { + /* slow path */ + CAMLparam1(arg); + value r; + Z_DECL(arg); + r = ml_z_alloc(); + Z_ARG(arg); + if (mp_add_d(mp_arg, 1, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg); + mp_clear(Z_MP(r)); + caml_failwith("Z.succ: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg); + CAMLreturn(r); + } +} + + +CAMLprim value ml_z_pred(value arg) +{ +#ifndef Z_ASM_pred + if (Is_long(arg)) { + /* fast path */ + if (arg > Val_long(Z_MIN_INT)) return arg - 2; + } +#endif + { + /* slow path */ + CAMLparam1(arg); + value r; + Z_DECL(arg); + r = ml_z_alloc(); + Z_ARG(arg); + if (mp_sub_d(mp_arg, 1, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg); + mp_clear(Z_MP(r)); + caml_failwith("Z.pred: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_sqrt(value arg) +{ + CAMLparam1(arg); + Z_DECL(arg); + value r; + Z_ARG(arg); + if (mp_isneg(mp_arg)) { + Z_END_ARG(arg); + caml_invalid_argument("Z.sqrt: square root of a negative number"); + } + r = ml_z_alloc(); + Z_REFRESH(arg); + if (mp_sqrt(mp_arg, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg); + mp_clear(Z_MP(r)); + caml_failwith("Z.sqrt: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg); + CAMLreturn(r); +} + +CAMLprim value ml_z_sqrt_rem(value arg) +{ + caml_failwith("Z.sqrt_rem: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_gcd(value arg1, value arg2) +{ + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + if (a1 < 0) a1 = -a1; + if (a2 < 0) a2 = -a2; + if (a1 < a2) { intnat t = a1; a1 = a2; a2 = t; } + while (a2) { + intnat r = a1 % a2; + a1 = a2; a2 = r; + } + return Val_long(a1); + } + { + /* slow path */ + CAMLparam2(arg1, arg2); + CAMLlocal1(r); + Z_DECL(arg1); + Z_DECL(arg2); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_gcd(mp_arg1, mp_arg2, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + caml_failwith("Z.gcd: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(r); + } +} + +/* only computes one cofactor */ +CAMLprim value ml_z_gcdext_intern(value arg1, value arg2) +{ + CAMLparam2(arg1, arg2); + CAMLlocal3(r, s, p); + Z_DECL(arg1); + Z_DECL(arg2); + if (Z_ISZERO(arg1)) ml_z_raise_divide_by_zero(); + if (Z_ISZERO(arg2)) ml_z_raise_divide_by_zero(); + r = ml_z_alloc(); + s = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_exteuclid(mp_arg1, mp_arg2, Z_MP(s), NULL, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + mp_clear(Z_MP(s)); + caml_failwith("Z.gcdext: internal error"); + } + r = ml_z_reduce(r); + s = ml_z_reduce(s); + p = caml_alloc_small(3, 0); + Field(p,0) = r; + Field(p,1) = s; + Field(p,2) = Val_true; + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(p); +} + + +/*--------------------------------------------------- + BITWISE OPERATORS + ---------------------------------------------------*/ + +CAMLprim value ml_z_logand(value arg1, value arg2) +{ +#ifndef Z_ASM_logand + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + return arg1 & arg2; + } +#endif + { + /* slow path */ + CAMLparam2(arg1,arg2); + value r; + Z_DECL(arg1); + Z_DECL(arg2); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_and(mp_arg1, mp_arg2, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + caml_failwith("Z.logand: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_logor(value arg1, value arg2) +{ +#ifndef Z_ASM_logor + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + return arg1 | arg2; + } +#endif + { + /* slow path */ + CAMLparam2(arg1,arg2); + value r; + Z_DECL(arg1); + Z_DECL(arg2); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_or(mp_arg1, mp_arg2, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + caml_failwith("Z.logor: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_logxor(value arg1, value arg2) +{ +#ifndef Z_ASM_logxor + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + return (arg1 ^ arg2) | 1; + } +#endif + { + /* slow path */ + CAMLparam2(arg1,arg2); + value r; + Z_DECL(arg1); + Z_DECL(arg2); + r = ml_z_alloc(); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_xor(mp_arg1, mp_arg2, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(Z_MP(r)); + caml_failwith("Z.logxor: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_lognot(value arg) +{ +#ifndef Z_ASM_lognot + if (Is_long(arg)) { + /* fast path */ + return (~arg) | 1; + } +#endif + { + /* slow path */ + CAMLparam1(arg); + value r; + Z_DECL(arg); + r = ml_z_alloc(); + Z_ARG(arg); + if (mp_complement(mp_arg, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg); + mp_clear(Z_MP(r)); + caml_failwith("Z.lognot: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_shift_left(value arg, value count) +{ + intnat c = Long_val(count); + if (c < 0) + caml_invalid_argument("Z.shift_left: count argument must be positive"); + if (c > INT_MAX) + caml_invalid_argument("Z.shift_left: count argument too large"); + if (!c) return arg; +#ifndef Z_ASM_shift_left + if (Is_long(arg) && c < Z_INTNAT_BITS) { + /* fast path */ + value a = arg - 1; + value r = arg << c; + if (a == (r >> c)) return r | 1; + } +#endif + { + /* slow path */ + CAMLparam1(arg); + Z_DECL(arg); + value r; + r = ml_z_alloc(); + Z_ARG(arg); + if (mp_mul_2d(mp_arg, c, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg); + mp_clear(Z_MP(r)); + caml_failwith("Z.shift_left: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_shift_right(value arg, value count) +{ + intnat c = Long_val(count); + if (c < 0) + caml_invalid_argument("Z.shift_right: count argument must be positive"); + if (c > INT_MAX) + caml_invalid_argument("Z.shift_left: count argument too large"); + if (!c) return arg; +#ifndef Z_ASM_shift_right + if (Is_long(arg)) { + /* fast path */ + if (c >= Z_INTNAT_BITS) { + if (arg < 0) return Val_long(-1); + else return Val_long(0); + } + return (arg >> c) | 1; + } +#endif + { + /* slow path */ + CAMLparam1(arg); + Z_DECL(arg); + value r; + r = ml_z_alloc(); + Z_ARG(arg); + if (mp_signed_rsh(mp_arg, c, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(arg); + mp_clear(Z_MP(r)); + caml_failwith("Z.shift_right: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg); + CAMLreturn(r); + } +} + +CAMLprim value ml_z_shift_right_trunc(value arg, value count) +{ + intnat c = Long_val(count); + if (c < 0) + caml_invalid_argument("Z.shift_right_trunc: count argument must be positive"); + if (c > INT_MAX) + caml_invalid_argument("Z.shift_left: count argument too large"); + if (!c) return arg; + if (Is_long(arg)) { + /* fast path */ + if (c >= Z_INTNAT_BITS) return Val_long(0); + if (arg >= 1) return (arg >> c) | 1; + else return 2 - (((2 - arg) >> c) | 1); + } + { + /* slow path */ + CAMLparam1(arg); + Z_DECL(arg); + value r; + r = ml_z_alloc(); + Z_ARG(arg); + if (mp_div_2d(mp_arg, c, Z_MP(r), NULL) != MP_OKAY) { + Z_END_ARG(arg); + mp_clear(Z_MP(r)); + caml_failwith("Z.shift_right_trunc: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(arg); + CAMLreturn(r); + } +} + + +/* Helper function for numbits: number of leading 0 bits in x */ + +#ifdef _LONG_LONG_LIMB +#define BUILTIN_CLZ __builtin_clzll +#else +#define BUILTIN_CLZ __builtin_clzl +#endif + +/* Use GCC or Clang built-in if available. The argument must be != 0. */ +#if defined(__clang__) || __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#define ml_z_clz BUILTIN_CLZ +#else +/* Portable C implementation - Hacker's Delight fig 5.12 */ +int ml_z_clz(mp_limb_t x) +{ + int n; + mp_limb_t y; +#ifdef ARCH_SIXTYFOUR + n = 64; + y = x >> 32; if (y != 0) { n = n - 32; x = y; } +#else + n = 32; +#endif + y = x >> 16; if (y != 0) { n = n - 16; x = y; } + y = x >> 8; if (y != 0) { n = n - 8; x = y; } + y = x >> 4; if (y != 0) { n = n - 4; x = y; } + y = x >> 2; if (y != 0) { n = n - 2; x = y; } + y = x >> 1; if (y != 0) return n - 2; + return n - x; +} +#endif + +CAMLprim value ml_z_numbits(value arg) +{ + if (Is_long(arg)) { + intnat r = Long_val(arg); + if (r == 0) { + return Val_int(0); + } else { + int n = ml_z_clz(r > 0 ? r : -r); + return Val_long(sizeof(intnat) * 8 - n); + } + } + else { + if (mp_iszero(Z_MP(arg))) return Val_long(0); + return Val_long(mp_count_bits(Z_MP(arg)) + 1); + } +} + + +/* Helper function for trailing_zeros: number of trailing 0 bits in x */ + +#ifdef _LONG_LONG_LIMB +#define BUILTIN_CTZ __builtin_ctzll +#else +#define BUILTIN_CTZ __builtin_ctzl +#endif + +/* Use GCC or Clang built-in if available. The argument must be != 0. */ +#if defined(__clang__) || __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#define ml_z_ctz BUILTIN_CTZ +#else +/* Portable C implementation - Hacker's Delight fig 5.21 */ +int ml_z_ctz(mp_limb_t x) +{ + int n; + mp_limb_t y; + CAMLassert (x != 0); +#ifdef ARCH_SIXTYFOUR + n = 63; + y = x << 32; if (y != 0) { n = n - 32; x = y; } +#else + n = 31; +#endif + y = x << 16; if (y != 0) { n = n - 16; x = y; } + y = x << 8; if (y != 0) { n = n - 8; x = y; } + y = x << 4; if (y != 0) { n = n - 4; x = y; } + y = x << 2; if (y != 0) { n = n - 2; x = y; } + y = x << 1; if (y != 0) { n = n - 1; } + return n; +} +#endif + +CAMLprim value ml_z_trailing_zeros(value arg) +{ + if (Is_long(arg)) { + /* fast path */ + intnat r = Long_val(arg); + if (r == 0) { + return Val_long (Max_long); + } else { + /* No need to take absolute value of r, as ctz(-x) = ctz(x) */ + return Val_long (ml_z_ctz(r)); + } + } + else { + if (mp_iszero(Z_MP(arg))) return Val_long(Max_long); + return Val_long(mp_cnt_lsb(Z_MP(arg))); + } +} + + +/* helper function for popcount & hamdist: number of bits at 1 in x */ +/* maybe we should use the mpn_ function even for small arguments, in case + the CPU has a fast popcount opcode? + */ +uintnat ml_z_count(uintnat x) +{ +#ifdef ARCH_SIXTYFOUR + x = (x & 0x5555555555555555UL) + ((x >> 1) & 0x5555555555555555UL); + x = (x & 0x3333333333333333UL) + ((x >> 2) & 0x3333333333333333UL); + x = (x & 0x0f0f0f0f0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0f0f0f0f0fUL); + x = (x & 0x00ff00ff00ff00ffUL) + ((x >> 8) & 0x00ff00ff00ff00ffUL); + x = (x & 0x0000ffff0000ffffUL) + ((x >> 16) & 0x0000ffff0000ffffUL); + x = (x & 0x00000000ffffffffUL) + ((x >> 32) & 0x00000000ffffffffUL); +#else + x = (x & 0x55555555UL) + ((x >> 1) & 0x55555555UL); + x = (x & 0x33333333UL) + ((x >> 2) & 0x33333333UL); + x = (x & 0x0f0f0f0fUL) + ((x >> 4) & 0x0f0f0f0fUL); + x = (x & 0x00ff00ffUL) + ((x >> 8) & 0x00ff00ffUL); + x = (x & 0x0000ffffUL) + ((x >> 16) & 0x0000ffffUL); +#endif + return x; +} + +CAMLprim value ml_z_popcount(value arg) +{ + if (Is_long(arg)) { + /* fast path */ + intnat r = Long_val(arg); + if (r < 0) ml_z_raise_overflow(); + return Val_long(ml_z_count(r)); + } + else { + intnat r; + int i; + mp_digit* p; + if (mp_isneg(Z_MP(arg))) ml_z_raise_overflow(); + for (i=0, r=0, p=Z_MP(arg)->dp; i < Z_MP(arg)->used; i++, p++) + r += ml_z_count(*p); + if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); + return Val_long(r); + } +} + +CAMLprim value ml_z_hamdist(value arg1, value arg2) +{ + caml_failwith("Z.hamdist: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_testbit(value arg, value index) +{ + intnat b_idx; + b_idx = Long_val(index); /* Caml code checked index >= 0 */ + if (Is_long(arg)) { + if (b_idx >= Z_INTNAT_BITS) b_idx = Z_INTNAT_BITS - 1; + return Val_int((Long_val(arg) >> b_idx) & 1); + } + else { + intnat l_idx = b_idx / MP_DIGIT_BIT; + mp_digit d; + if (mp_isneg(Z_MP(arg))) { + mp_int a; + if (l_idx >= Z_MP(arg)->used) return Val_long(1); + /* we need to compute ~(|arg|-1) */ + if (mp_init(&a) != MP_OKAY || + mp_sub_d(Z_MP(arg), 1, &a) != MP_OKAY || + mp_complement(&a, &a) != MP_OKAY) { + /* we probably die horribly here as testbit_internal is declared @@noalloc */ + caml_raise_out_of_memory(); + } + d = a.dp[l_idx]; + mp_clear(&a); + } + else { + if (l_idx >= Z_MP(arg)->used) return Val_long(0); + d = Z_MP(arg)->dp[l_idx]; + } + return Val_int((d >> (b_idx % MP_DIGIT_BIT)) & 1); + } +} + +CAMLprim value ml_z_divexact(value arg1, value arg2) +{ + return ml_z_div(arg1,arg2); +} + +CAMLprim value ml_z_powm(value base, value exp, value mod) +{ + caml_failwith("Z.powm: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_powm_sec(value base, value exp, value mod) +{ + caml_failwith("Z.powm_sec: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_pow(value base, value exp) +{ + CAMLparam2(base,exp); + CAMLlocal1(r); + Z_DECL(base); + intnat e = Long_val(exp); + if (e < 0) + caml_invalid_argument("Z.pow: exponent must be nonnegative"); + Z_ARG(base); + r = ml_z_alloc(); + if (mp_expt_u32(mp_base, e, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(base); + mp_clear(Z_MP(r)); + caml_failwith("Z.pow: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(base); + CAMLreturn(r); +} + +CAMLprim value ml_z_root(value a, value b) +{ + caml_failwith("Z.root: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_rootrem(value a, value b) +{ + caml_failwith("Z.rootrem: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_perfect_power(value a) +{ + caml_failwith("Z.perfect_power: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_perfect_square(value a) +{ + caml_failwith("Z.perfect_square: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_probab_prime(value a, int b) +{ + caml_failwith("Z.probab_prime: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_nextprime(value a) +{ + caml_failwith("Z.nextprime: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_invert(value base, value mod) +{ + caml_failwith("Z.invert: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_divisible(value a, value b) +{ + caml_failwith("Z.divisible: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_congruent(value a, value b, value c) +{ + caml_failwith("Z.congruent: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_jacobi(value a, value b) +{ + caml_failwith("Z.jacobi: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_legendre(value a, value b) +{ + caml_failwith("Z.legendre: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_kronecker(value a, value b) +{ + caml_failwith("Z.kronecker: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_remove(value a, value b) +{ + caml_failwith("Z.remove: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_fac(value a) +{ + caml_failwith("Z.fac: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_fac2(value a) +{ + caml_failwith("Z.fac2: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_facM(value a, value b) +{ + caml_failwith("Z.facM: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_primorial(value a) +{ + caml_failwith("Z.primorial: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_bin(value a, value b) +{ + caml_failwith("Z.bin: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_fib(value a) +{ + caml_failwith("Z.fib: not implemented in LibTomMath backend"); +} + +CAMLprim value ml_z_lucnum(value a) +{ + caml_failwith("Z.lucnum: not implemented in LibTomMath backend"); +} + + +/*--------------------------------------------------- + CUSTOMS BLOCKS + ---------------------------------------------------*/ + +static void ml_z_custom_finalize(value v) { + mp_clear(Z_MP(v)); +} + +/* With OCaml < 3.12.1, comparing a block an int with OCaml's + polymorphic compare will give erroneous results (int always + strictly smaller than block). OCaml 3.12.1 and above + give the correct result. +*/ +int ml_z_custom_compare(value arg1, value arg2) +{ + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + if (arg1 > arg2) return 1; + else if (arg1 < arg2) return -1; + else return 0; + } + else { + /* slow path */ + int r; + Z_DECL(arg1); + Z_DECL(arg2); + Z_ARG(arg1); + Z_ARG(arg2); + r = mp_cmp(mp_arg1, mp_arg2); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + /* we assume MP_LT==-1, MP_EQ==0, MP_GT==1 */ + return r; + } +} + +#ifndef Z_OCAML_HASH +#define caml_hash_mix_uint32(h,n) ((h) * 65599 + (n)) +#endif + +static intnat ml_z_custom_hash(value v) +{ + /* TODO: the hash depends on the platform */ + if (Is_long(v)) { +#ifdef ARCH_SIXTYFOUR + return caml_hash_mix_uint32((uint32_t)v, (uint32_t)(v >> 32)); +#else + return v; +#endif + } + else { + uint32_t r = 0; + int i; + mp_digit* p; + if (mp_isneg(Z_MP(v))) r = 1; + for (i=0, p=Z_MP(v)->dp; i < Z_MP(v)->used; i++, p++) { +#ifdef MP_64BIT + r = caml_hash_mix_uint32(r, (uint32_t)*p); + r = caml_hash_mix_uint32(r, (uint32_t)((*p) >> 32)); +#else + r = caml_hash_mix_uint32(r, (uint32_t)*p); +#endif + } + return r; + } +} + +CAMLprim value ml_z_hash(value v) +{ + return Val_long(ml_z_custom_hash(v)); +} + +static void ml_z_custom_serialize(value v, + uintnat * wsize_32, + uintnat * wsize_64) +{ + size_t i, nb; + uint8_t* buf; + Z_DECL(v); + Z_ARG(v); + nb = mp_sbin_size(mp_v); + if (nb != (uint32_t)nb) { + caml_failwith("Z.serialize: number is too large"); + } + buf = (uint8_t*)malloc(nb); + if (!buf) caml_raise_out_of_memory(); + if (mp_to_sbin(mp_v, buf, nb, NULL) != MP_OKAY) { + free(buf); + Z_END_ARG(v); + ml_z_raise_out_of_memory(); + } + caml_serialize_int_4(nb); + for (i = 0; i < nb; i++) + caml_serialize_int_1(buf[i]); + /* struct { int; int; enum; ptr; } */ + *wsize_32 = 16; + *wsize_64 = 24; + free(buf); + Z_END_ARG(v); +} + +static uintnat ml_z_custom_deserialize(void * dst) +{ + uint32_t i, nb; + uint8_t* buf; + if (mp_init(dst) != MP_OKAY) + ml_z_raise_out_of_memory(); + nb = caml_deserialize_uint_4(); + buf = (uint8_t*)malloc(nb); + if (!buf) caml_raise_out_of_memory(); + for (i = 0; i < nb; i++) + buf[i] = caml_deserialize_uint_1(); + if (mp_to_sbin((mp_int*)dst, buf, nb, NULL) != MP_OKAY) { + free(buf); + ml_z_raise_out_of_memory(); + } + free(buf); + return sizeof(mp_int); +} + +struct custom_operations ml_z_custom_ops = { + /* Identifiers starting with _ are normally reserved for the OCaml runtime + system, but we got authorization form Gallium to use "_z". + It is very compact and stays in the spirit of identifiers used for + int32 & co ("_i" & co.). + */ + "_z", + ml_z_custom_finalize, + ml_z_custom_compare, + ml_z_custom_hash, + ml_z_custom_serialize, + ml_z_custom_deserialize, +#if Z_OCAML_COMPARE_EXT + ml_z_custom_compare, +#else + custom_compare_ext_default, +#endif +#ifndef Z_OCAML_LEGACY_CUSTOM_OPERATIONS + custom_fixed_length_default +#endif +}; + + +/*--------------------------------------------------- + INIT / EXIT + ---------------------------------------------------*/ + +CAMLprim value ml_z_install_frametable() +{ + /* nothing to do for bytecode version */ + return Val_unit; +} + +CAMLprim value ml_z_init() +{ + mp_err err = MP_OKAY; + /* checks */ + if (MP_LT!=-1 || MP_EQ!=0 || MP_GT!=1) + caml_failwith("Z.init: invalid values for MP_LT, MP_EQ, MP_GT"); + /* useful constants */ + err |= mp_init_i32(&z_max_int32, 0x7fffffff); + err |= mp_init_i32(&z_min_int32, -0x80000000); + err |= mp_init_i64(&z_max_int64, 0x7fffffffffffffffLL); + err |= mp_init_i64(&z_min_int64, -0x8000000000000000LL); +#ifdef ARCH_SIXTYFOUR + err |= mp_init_i64(&z_max_int, 0x3fffffffffffffffLL); + err |= mp_init_i64(&z_min_int, -0x4000000000000000LL); + err |= mp_init_i64(&z_max_intnat, 0x7fffffffffffffffLL); + err |= mp_init_i64(&z_min_intnat, -0x8000000000000000LL); +#else + err |= mp_init_i32(&z_max_int, 0x3fffffff); + err |= mp_init_i32(&z_min_int, -0x40000000); + err |= mp_init_i32(&z_max_intnat, 0x7fffffff); + err |= mp_init_i32(&z_min_intnat, -0x80000000); +#endif + if (err != MP_OKAY) { + caml_failwith("Z.init: failed to create constants"); + } + /* install functions */ + caml_register_custom_operations(&ml_z_custom_ops); + return Val_unit; +} diff --git a/configure b/configure index 57fa5a0..0c52390 100755 --- a/configure +++ b/configure @@ -58,6 +58,7 @@ where options include: -noasm disable platform-specific asm code -gmp use GMP library (default if found) -mpir use MPIR library instead of GMP + -tommath use TomMath library instead of GMP -perf enable performance statistics -prefixnonocaml add for non ocaml tool, e.g. -prefixnonocaml x86_64-w64-mingw32- @@ -99,6 +100,8 @@ while : ; do gmp='gmp';; -mpir|--mpir) gmp='mpir';; + -tommath|--tommath) + gmp='tommath';; -perf|--perf) perf='yes';; -prefixnonocaml|--prefixnonocaml) @@ -363,8 +366,9 @@ if test "$arch" != 'none'; then fi -# check GMP, MPIR +# check GMP, MPIR, TomMath +csrc="caml_z.c" if test "$gmp" = 'gmp' -o "$gmp" = 'auto'; then checkinc gmp.h if test $? -eq 1; then @@ -387,7 +391,19 @@ if test "$gmp" = 'mpir' -o "$gmp" = 'auto'; then fi fi fi -if test "$gmp" != 'OK'; then echo "cannot find GMP nor MPIR"; exit 2; fi +if test "$gmp" = 'tommath' -o "$gmp" = 'auto'; then + checkinc tommath.h + if test $? -eq 1; then + checklib tommath + if test $? -eq 1; then + gmp='OK' + cclib="$cclib -ltommath" + ccdef="-DHAS_TOMMATH $ccdef" + csrc="caml_z_tommath.c" + fi + fi +fi +if test "$gmp" != 'OK'; then echo "cannot find GMP nor MPIR nor TomMath"; exit 2; fi # OCaml version @@ -447,6 +463,7 @@ OCAMLDOC=$ocamldoc OCAMLFLAGS=$mlflags OCAMLOPTFLAGS=$mloptflags OCAMLINC=$mlinc +CSRC=$csrc CFLAGS=$ccinc $ccdef $ccopt ASFLAGS=$ccdef $asopt LIBS=$cclib diff --git a/project.mak b/project.mak index 41f192b..0af053d 100644 --- a/project.mak +++ b/project.mak @@ -31,7 +31,6 @@ endif # project files ############### -CSRC = caml_z.c SSRC = $(wildcard caml_z_$(ARCH).S) MLSRC = z.ml q.ml big_int_Z.ml MLISRC = z.mli q.mli big_int_Z.mli @@ -139,7 +138,7 @@ $(AUTOGEN): z.mlp z.mlip $(SSRC) z_pp.pl $(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLINC) -c $< %.$(OBJSUFFIX): %.c - $(OCAMLC) -ccopt "$(CFLAGS)" -c $< + $(OCAMLC) -ccopt "$(CFLAGS) -g" -c $< clean: /bin/rm -rf *.$(OBJSUFFIX) *.$(LIBSUFFIX) *.$(DLLSUFFIX) *.cmi *.cmo *.cmx *.cmxa *.cmxs *.cma *.cmt *.cmti *~ \#* depend test $(AUTOGEN) tmp.c depend diff --git a/tests/zq.ml b/tests/zq.ml index d600605..3a636f9 100644 --- a/tests/zq.ml +++ b/tests/zq.ml @@ -568,17 +568,20 @@ let test_Z() = Printf.printf "sqrt 2\n = %a\n" pr (I.sqrt p2); Printf.printf "sqrt 2^120\n = %a\n" pr (I.sqrt p120); Printf.printf "sqrt 2^121\n = %a\n" pr (I.sqrt p121); + (* Printf.printf "sqrt_rem 0\n = %a\n" pr2 (I.sqrt_rem I.zero); Printf.printf "sqrt_rem 1\n = %a\n" pr2 (I.sqrt_rem I.one); Printf.printf "sqrt_rem 2\n = %a\n" pr2 (I.sqrt_rem p2); Printf.printf "sqrt_rem 2^120\n = %a\n" pr2 (I.sqrt_rem p120); Printf.printf "sqrt_rem 2^121\n = %a\n" pr2 (I.sqrt_rem p121); + *) Printf.printf "popcount 0\n = %i\n" (I.popcount I.zero); Printf.printf "popcount 1\n = %i\n" (I.popcount I.one); Printf.printf "popcount 2\n = %i\n" (I.popcount p2); Printf.printf "popcount max_int32\n = %i\n" (I.popcount maxi32); Printf.printf "popcount 2^120\n = %i\n" (I.popcount p120); Printf.printf "popcount (2^120-1)\n = %i\n" (I.popcount (I.pred p120)); + (* Printf.printf "hamdist 0 0\n = %i\n" (I.hamdist I.zero I.zero); Printf.printf "hamdist 0 1\n = %i\n" (I.hamdist I.zero I.one); Printf.printf "hamdist 0 2^300\n = %i\n" (I.hamdist I.zero p300); @@ -586,6 +589,7 @@ let test_Z() = Printf.printf "hamdist 2^120 (2^120-1)\n = %i\n" (I.hamdist p120 (I.pred p120)); Printf.printf "hamdist 2^120 2^300\n = %i\n" (I.hamdist p120 p300); Printf.printf "hamdist (2^120-1) (2^300-1)\n = %i\n" (I.hamdist (I.pred p120) (I.pred p300)); + *) (* always 0 when not using custom blocks *) Printf.printf "hash(2^120)\n = %i\n" (Hashtbl.hash p120); Printf.printf "hash(2^121)\n = %i\n" (Hashtbl.hash p121); @@ -713,9 +717,12 @@ let test_Z() = b,1,1; b,1,5; b,1,32; b,1,63; b,1,64; b,1,127; b,1,128; b,69,12; c,0,1; c,0,64; c,128,1; c,128,5; c,131,32; c,175,63; c,277,123] in +(* List.iter chk_extract extract_testdata; List.iter chk_signed_extract extract_testdata; + *) + (* chk_bits I.zero; chk_bits p2; chk_bits (I.neg p2); @@ -734,18 +741,21 @@ let test_Z() = chk_bits mini64; chk_bits maxni; chk_bits minni; + *) + (* List.iter chk_testbit [ I.zero; I.one; I.of_int (-42); I.of_string "31415926535897932384626433832795028841971693993751058209749445923078164062862089986"; I.neg (I.shift_left (I.of_int 123456) 64); ]; - + List.iter chk_numbits_tz [ I.zero; I.one; I.of_int (-42); I.shift_left (I.of_int 9999) 77; I.neg (I.shift_left (I.of_int 123456) 64); ]; + *) () From 1ccc6be5b335e919bf2a8d04bef0d8aacb9e065f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Thu, 16 Jul 2020 21:12:43 +0200 Subject: [PATCH 02/27] minor fixes for Windows compatibility --- caml_z_tommath.c | 14 +++++++------- project.mak | 2 +- z_pp.pl | 2 +- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index a795e9b..288c9f4 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -276,7 +276,7 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng /* process the string */ const char *d = String_val(v) + ofs; const char *end = d + len; - ssize_t i, sz; + ptrdiff_t i, sz; int sign = 0; intnat base = Long_val(b); /* We allow [d] to advance beyond [end] while parsing the prefix: @@ -1365,7 +1365,7 @@ CAMLprim value ml_z_shift_right_trunc(value arg, value count) /* Helper function for numbits: number of leading 0 bits in x */ -#ifdef _LONG_LONG_LIMB +#ifdef ARCH_SIXTYFOUR #define BUILTIN_CLZ __builtin_clzll #else #define BUILTIN_CLZ __builtin_clzl @@ -1376,10 +1376,10 @@ CAMLprim value ml_z_shift_right_trunc(value arg, value count) #define ml_z_clz BUILTIN_CLZ #else /* Portable C implementation - Hacker's Delight fig 5.12 */ -int ml_z_clz(mp_limb_t x) +int ml_z_clz(uintnat x) { int n; - mp_limb_t y; + unintnat y; #ifdef ARCH_SIXTYFOUR n = 64; y = x >> 32; if (y != 0) { n = n - 32; x = y; } @@ -1415,7 +1415,7 @@ CAMLprim value ml_z_numbits(value arg) /* Helper function for trailing_zeros: number of trailing 0 bits in x */ -#ifdef _LONG_LONG_LIMB +#ifdef ARCH_SIXTYFOUR #define BUILTIN_CTZ __builtin_ctzll #else #define BUILTIN_CTZ __builtin_ctzl @@ -1426,10 +1426,10 @@ CAMLprim value ml_z_numbits(value arg) #define ml_z_ctz BUILTIN_CTZ #else /* Portable C implementation - Hacker's Delight fig 5.21 */ -int ml_z_ctz(mp_limb_t x) +int ml_z_ctz(uintnat x) { int n; - mp_limb_t y; + uintnat y; CAMLassert (x != 0); #ifdef ARCH_SIXTYFOUR n = 63; diff --git a/project.mak b/project.mak index 0af053d..70cfc44 100644 --- a/project.mak +++ b/project.mak @@ -120,7 +120,7 @@ endif ####### $(AUTOGEN): z.mlp z.mlip $(SSRC) z_pp.pl - ./z_pp.pl $(ARCH) + perl z_pp.pl $(ARCH) %.cmi: %.mli $(OCAMLC) $(OCAMLFLAGS) $(OCAMLINC) -c $< diff --git a/z_pp.pl b/z_pp.pl index aa92959..c7a1029 100755 --- a/z_pp.pl +++ b/z_pp.pl @@ -26,7 +26,7 @@ ($ver) = $v =~ /version\s*=\s*(\S+)/; $ov = `ocamlc -version`; -($major,$minor,$extra) = split(/\./, $ov, 3); +($major,$minor,undef) = split(/\./, $ov, 3); if ($major > 4 || ($major == 4 && $minor >= 3)) { $noalloc = "[\@\@noalloc]"; } else { From dbd97db2d6d6b8621079721a130afc1d83ff72b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Thu, 16 Jul 2020 21:58:24 +0200 Subject: [PATCH 03/27] typos --- caml_z_tommath.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 288c9f4..57014ca 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -1379,7 +1379,7 @@ CAMLprim value ml_z_shift_right_trunc(value arg, value count) int ml_z_clz(uintnat x) { int n; - unintnat y; + uintnat y; #ifdef ARCH_SIXTYFOUR n = 64; y = x >> 32; if (y != 0) { n = n - 32; x = y; } From 278b5d022b399aa0f43e5ae844f0bbcfdbb2f70f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Fri, 17 Jul 2020 16:25:15 +0200 Subject: [PATCH 04/27] build against the develop branch of LibTomMath, fix compile warnings Building against the develop branch of LibTomMath is necessary on Windows as get mp_get_float is missing in 1.2.0. However, due to API changes, this version does not compile against 1.2.0 anymore. --- caml_z_tommath.c | 64 ++++++++++++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 29 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 57014ca..53b0cf2 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -122,6 +122,12 @@ static mp_int z_max_int64, z_min_int64; #define Z_BASE2_LENGTH_OP 30 #endif +#ifdef _MSC_VER +#define UNUSED_PARAM +#else +#define UNUSED_PARAM __attribute__((unused)) +#endif + #define Z_MP(x) ((mp_int*)Data_custom_val((x))) #define Z_ISZERO(x) (Is_long((x)) ? Long_val((x)) == 0 : mp_iszero(Z_MP((x)))) @@ -404,7 +410,7 @@ CAMLprim value ml_z_format(value f, value v) CAMLparam2(f,v); Z_DECL(v); char* buf, *dst; - int sz = 0; + size_t sz = 0; size_t i, max_size, size_dst = 0; value r; const char* fmt = String_val(f); @@ -510,17 +516,17 @@ CAMLprim value ml_z_format(value f, value v) CAMLreturn(r); } -CAMLprim value ml_z_extract(value arg, value off, value len) +CAMLprim value ml_z_extract(UNUSED_PARAM value arg, UNUSED_PARAM value off, UNUSED_PARAM value len) { caml_failwith("Z.extract: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_to_bits(value arg) +CAMLprim value ml_z_to_bits(UNUSED_PARAM value arg) { caml_failwith("Z.to_bits: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_of_bits(value arg) +CAMLprim value ml_z_of_bits(UNUSED_PARAM value arg) { caml_failwith("Z.of_bits: not implemented in LibTomMath backend"); } @@ -1066,7 +1072,7 @@ CAMLprim value ml_z_sqrt(value arg) CAMLreturn(r); } -CAMLprim value ml_z_sqrt_rem(value arg) +CAMLprim value ml_z_sqrt_rem(UNUSED_PARAM value arg) { caml_failwith("Z.sqrt_rem: not implemented in LibTomMath backend"); } @@ -1508,7 +1514,7 @@ CAMLprim value ml_z_popcount(value arg) } } -CAMLprim value ml_z_hamdist(value arg1, value arg2) +CAMLprim value ml_z_hamdist(UNUSED_PARAM value arg1, UNUSED_PARAM value arg2) { caml_failwith("Z.hamdist: not implemented in LibTomMath backend"); } @@ -1550,12 +1556,12 @@ CAMLprim value ml_z_divexact(value arg1, value arg2) return ml_z_div(arg1,arg2); } -CAMLprim value ml_z_powm(value base, value exp, value mod) +CAMLprim value ml_z_powm(UNUSED_PARAM value base, UNUSED_PARAM value exp, UNUSED_PARAM value mod) { caml_failwith("Z.powm: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_powm_sec(value base, value exp, value mod) +CAMLprim value ml_z_powm_sec(UNUSED_PARAM value base, UNUSED_PARAM value exp, UNUSED_PARAM value mod) { caml_failwith("Z.powm_sec: not implemented in LibTomMath backend"); } @@ -1570,7 +1576,7 @@ CAMLprim value ml_z_pow(value base, value exp) caml_invalid_argument("Z.pow: exponent must be nonnegative"); Z_ARG(base); r = ml_z_alloc(); - if (mp_expt_u32(mp_base, e, Z_MP(r)) != MP_OKAY) { + if (mp_expt_n(mp_base, e, Z_MP(r)) != MP_OKAY) { Z_END_ARG(base); mp_clear(Z_MP(r)); caml_failwith("Z.pow: internal error"); @@ -1580,102 +1586,102 @@ CAMLprim value ml_z_pow(value base, value exp) CAMLreturn(r); } -CAMLprim value ml_z_root(value a, value b) +CAMLprim value ml_z_root(UNUSED_PARAM value a, UNUSED_PARAM value b) { caml_failwith("Z.root: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_rootrem(value a, value b) +CAMLprim value ml_z_rootrem(UNUSED_PARAM value a, UNUSED_PARAM value b) { caml_failwith("Z.rootrem: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_perfect_power(value a) +CAMLprim value ml_z_perfect_power(UNUSED_PARAM value a) { caml_failwith("Z.perfect_power: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_perfect_square(value a) +CAMLprim value ml_z_perfect_square(UNUSED_PARAM value a) { caml_failwith("Z.perfect_square: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_probab_prime(value a, int b) +CAMLprim value ml_z_probab_prime(UNUSED_PARAM value a, UNUSED_PARAM int b) { caml_failwith("Z.probab_prime: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_nextprime(value a) +CAMLprim value ml_z_nextprime(UNUSED_PARAM value a) { caml_failwith("Z.nextprime: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_invert(value base, value mod) +CAMLprim value ml_z_invert(UNUSED_PARAM value base, UNUSED_PARAM value mod) { caml_failwith("Z.invert: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_divisible(value a, value b) +CAMLprim value ml_z_divisible(UNUSED_PARAM value a, UNUSED_PARAM value b) { caml_failwith("Z.divisible: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_congruent(value a, value b, value c) +CAMLprim value ml_z_congruent(UNUSED_PARAM value a, UNUSED_PARAM value b, UNUSED_PARAM value c) { caml_failwith("Z.congruent: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_jacobi(value a, value b) +CAMLprim value ml_z_jacobi(UNUSED_PARAM value a, UNUSED_PARAM value b) { caml_failwith("Z.jacobi: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_legendre(value a, value b) +CAMLprim value ml_z_legendre(UNUSED_PARAM value a, UNUSED_PARAM value b) { caml_failwith("Z.legendre: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_kronecker(value a, value b) +CAMLprim value ml_z_kronecker(UNUSED_PARAM value a, UNUSED_PARAM value b) { caml_failwith("Z.kronecker: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_remove(value a, value b) +CAMLprim value ml_z_remove(UNUSED_PARAM value a, UNUSED_PARAM value b) { caml_failwith("Z.remove: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_fac(value a) +CAMLprim value ml_z_fac(UNUSED_PARAM value a) { caml_failwith("Z.fac: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_fac2(value a) +CAMLprim value ml_z_fac2(UNUSED_PARAM value a) { caml_failwith("Z.fac2: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_facM(value a, value b) +CAMLprim value ml_z_facM(UNUSED_PARAM value a, UNUSED_PARAM value b) { caml_failwith("Z.facM: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_primorial(value a) +CAMLprim value ml_z_primorial(UNUSED_PARAM value a) { caml_failwith("Z.primorial: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_bin(value a, value b) +CAMLprim value ml_z_bin(UNUSED_PARAM value a, UNUSED_PARAM value b) { caml_failwith("Z.bin: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_fib(value a) +CAMLprim value ml_z_fib(UNUSED_PARAM value a) { caml_failwith("Z.fib: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_lucnum(value a) +CAMLprim value ml_z_lucnum(UNUSED_PARAM value a) { caml_failwith("Z.lucnum: not implemented in LibTomMath backend"); } From 17a5f5a82e4996eae780fa396f2105283cd2d2fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Mon, 20 Jul 2020 11:31:39 +0200 Subject: [PATCH 05/27] fixed deserialization --- caml_z_tommath.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 53b0cf2..d757d98 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -1799,7 +1799,7 @@ static uintnat ml_z_custom_deserialize(void * dst) if (!buf) caml_raise_out_of_memory(); for (i = 0; i < nb; i++) buf[i] = caml_deserialize_uint_1(); - if (mp_to_sbin((mp_int*)dst, buf, nb, NULL) != MP_OKAY) { + if (mp_from_sbin((mp_int*)dst, buf, nb) != MP_OKAY) { free(buf); ml_z_raise_out_of_memory(); } From 5c79b982a56f9512c702d842868f23bd104be1fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Fri, 31 Jul 2020 13:22:03 +0200 Subject: [PATCH 06/27] fix bugs in the TomMath backend --- caml_z_tommath.c | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index d757d98..1c7611a 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -331,11 +331,18 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng } r = Val_long(ret * (sign ? -1 : 1)); } else { + // copy the substring + char* dd = (char*)malloc(sz + 1); + if (!dd) caml_raise_out_of_memory(); + memcpy(dd, d, sz); + dd[sz] = 0; r = ml_z_alloc(); - if (mp_read_radix(Z_MP(r), d, base) != MP_OKAY) { + if (mp_read_radix(Z_MP(r), dd, base) != MP_OKAY) { + free(dd); mp_clear(Z_MP(r)); caml_invalid_argument("Z.of_substring_base: invalid string"); } + free(dd); if (sign) { if (mp_neg(Z_MP(r), Z_MP(r)) != MP_OKAY) { mp_clear(Z_MP(r)); @@ -416,7 +423,7 @@ CAMLprim value ml_z_format(value f, value v) const char* fmt = String_val(f); int base = 10; /* base */ int cas = 0; /* uppercase X / lowercase x */ - size_t width = 0; + ptrdiff_t width = 0; int alt = 0; /* alternate # */ int dir = 0; /* right / left adjusted */ char sign = 0; /* sign char */ @@ -480,7 +487,7 @@ CAMLprim value ml_z_format(value f, value v) if (dst[i] >= 'A') dst[i] += ('a' - 'A'); } - + /* add prefix, sign & padding */ if (pad == ' ') { if (dir) { @@ -488,7 +495,7 @@ CAMLprim value ml_z_format(value f, value v) for (i = strlen(prefix); i > 0; i--, size_dst++) *(--dst) = prefix[i-1]; if (sign) { *(--dst) = sign; size_dst++; } - for (; size_dst < width; size_dst++) + for (; (ptrdiff_t)size_dst < width; size_dst++) dst[size_dst] = pad; } else { @@ -496,13 +503,13 @@ CAMLprim value ml_z_format(value f, value v) for (i = strlen(prefix); i > 0; i--, size_dst++) *(--dst) = prefix[i-1]; if (sign) { *(--dst) = sign; size_dst++; } - for (; size_dst < width; size_dst++) *(--dst) = pad; + for (; (ptrdiff_t)size_dst < width; size_dst++) *(--dst) = pad; } } else { /* right alignment, non-space padding */ width -= strlen(prefix) + (sign ? 1 : 0); - for (; size_dst < width; size_dst++) *(--dst) = pad; + for (; (ptrdiff_t)size_dst < width; size_dst++) *(--dst) = pad; for (i = strlen(prefix); i > 0; i--, size_dst++) *(--dst) = prefix[i-1]; if (sign) { *(--dst) = sign; size_dst++; } @@ -1414,7 +1421,7 @@ CAMLprim value ml_z_numbits(value arg) } else { if (mp_iszero(Z_MP(arg))) return Val_long(0); - return Val_long(mp_count_bits(Z_MP(arg)) + 1); + return Val_long(mp_count_bits(Z_MP(arg))); } } From f903b16fe8d686c142030a9f4d0ebed690191532 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Fri, 31 Jul 2020 13:28:00 +0200 Subject: [PATCH 07/27] Better support for multiple backends. Z.backend is a string with value "GMP", "MPIR" or "LibTomMath". Test zq.ml continues after uncountering unimplemented functions. Test zq.ml now has backend-dependent reference outputs. --- configure | 7 +- tests/Makefile | 9 +- tests/ofstring.ml | 30 +- tests/zq.ml | 113 +- tests/{zq.output32 => zq.output-GMP-32} | 0 tests/{zq.output64 => zq.output-GMP-64} | 0 tests/zq.output-LibTomMath-64 | 1214 ++++++++++++++++++++ tests/zq.output-MPIR-32 | 1373 +++++++++++++++++++++++ tests/zq.output-MPIR-64 | 1373 +++++++++++++++++++++++ z.mlip | 6 + z.mlp | 1 + z_pp.pl | 5 + 12 files changed, 4056 insertions(+), 75 deletions(-) rename tests/{zq.output32 => zq.output-GMP-32} (100%) rename tests/{zq.output64 => zq.output-GMP-64} (100%) create mode 100644 tests/zq.output-LibTomMath-64 create mode 100644 tests/zq.output-MPIR-32 create mode 100644 tests/zq.output-MPIR-64 diff --git a/configure b/configure index 0c52390..e4e5783 100755 --- a/configure +++ b/configure @@ -373,7 +373,8 @@ if test "$gmp" = 'gmp' -o "$gmp" = 'auto'; then checkinc gmp.h if test $? -eq 1; then checklib gmp - if test $? -eq 1; then + if test $? -eq 1; then + backend='GMP' gmp='OK' cclib="$cclib -lgmp" ccdef="-DHAS_GMP $ccdef" @@ -385,6 +386,7 @@ if test "$gmp" = 'mpir' -o "$gmp" = 'auto'; then if test $? -eq 1; then checklib mpir if test $? -eq 1; then + backend='MPIR' gmp='OK' cclib="$cclib -lmpir" ccdef="-DHAS_MPIR $ccdef" @@ -396,6 +398,7 @@ if test "$gmp" = 'tommath' -o "$gmp" = 'auto'; then if test $? -eq 1; then checklib tommath if test $? -eq 1; then + backend='LibTomMath' gmp='OK' cclib="$cclib -ltommath" ccdef="-DHAS_TOMMATH $ccdef" @@ -477,6 +480,7 @@ OBJSUFFIX=$objsuffix HASOCAMLOPT=$hasocamlopt HASDYNLINK=$hasdynlink HASBINANNOT=$hasbinannot +BACKEND=$backend include project.mak EOF @@ -488,6 +492,7 @@ cat < Printf.printf "Failure: %s\n" f + let test_Z() = Printf.printf "0\n = %a\n" pr I.zero; Printf.printf "1\n = %a\n" pr I.one; @@ -568,28 +572,28 @@ let test_Z() = Printf.printf "sqrt 2\n = %a\n" pr (I.sqrt p2); Printf.printf "sqrt 2^120\n = %a\n" pr (I.sqrt p120); Printf.printf "sqrt 2^121\n = %a\n" pr (I.sqrt p121); - (* - Printf.printf "sqrt_rem 0\n = %a\n" pr2 (I.sqrt_rem I.zero); - Printf.printf "sqrt_rem 1\n = %a\n" pr2 (I.sqrt_rem I.one); - Printf.printf "sqrt_rem 2\n = %a\n" pr2 (I.sqrt_rem p2); - Printf.printf "sqrt_rem 2^120\n = %a\n" pr2 (I.sqrt_rem p120); - Printf.printf "sqrt_rem 2^121\n = %a\n" pr2 (I.sqrt_rem p121); - *) + failure_harness (fun () -> + Printf.printf "sqrt_rem 0\n = %a\n" pr2 (I.sqrt_rem I.zero); + Printf.printf "sqrt_rem 1\n = %a\n" pr2 (I.sqrt_rem I.one); + Printf.printf "sqrt_rem 2\n = %a\n" pr2 (I.sqrt_rem p2); + Printf.printf "sqrt_rem 2^120\n = %a\n" pr2 (I.sqrt_rem p120); + Printf.printf "sqrt_rem 2^121\n = %a\n" pr2 (I.sqrt_rem p121); + ); Printf.printf "popcount 0\n = %i\n" (I.popcount I.zero); Printf.printf "popcount 1\n = %i\n" (I.popcount I.one); Printf.printf "popcount 2\n = %i\n" (I.popcount p2); Printf.printf "popcount max_int32\n = %i\n" (I.popcount maxi32); Printf.printf "popcount 2^120\n = %i\n" (I.popcount p120); Printf.printf "popcount (2^120-1)\n = %i\n" (I.popcount (I.pred p120)); - (* - Printf.printf "hamdist 0 0\n = %i\n" (I.hamdist I.zero I.zero); - Printf.printf "hamdist 0 1\n = %i\n" (I.hamdist I.zero I.one); - Printf.printf "hamdist 0 2^300\n = %i\n" (I.hamdist I.zero p300); - Printf.printf "hamdist 2^120 2^120\n = %i\n" (I.hamdist p120 p120); - Printf.printf "hamdist 2^120 (2^120-1)\n = %i\n" (I.hamdist p120 (I.pred p120)); - Printf.printf "hamdist 2^120 2^300\n = %i\n" (I.hamdist p120 p300); - Printf.printf "hamdist (2^120-1) (2^300-1)\n = %i\n" (I.hamdist (I.pred p120) (I.pred p300)); - *) + failure_harness (fun () -> + Printf.printf "hamdist 0 0\n = %i\n" (I.hamdist I.zero I.zero); + Printf.printf "hamdist 0 1\n = %i\n" (I.hamdist I.zero I.one); + Printf.printf "hamdist 0 2^300\n = %i\n" (I.hamdist I.zero p300); + Printf.printf "hamdist 2^120 2^120\n = %i\n" (I.hamdist p120 p120); + Printf.printf "hamdist 2^120 (2^120-1)\n = %i\n" (I.hamdist p120 (I.pred p120)); + Printf.printf "hamdist 2^120 2^300\n = %i\n" (I.hamdist p120 p300); + Printf.printf "hamdist (2^120-1) (2^300-1)\n = %i\n" (I.hamdist (I.pred p120) (I.pred p300)); + ); (* always 0 when not using custom blocks *) Printf.printf "hash(2^120)\n = %i\n" (Hashtbl.hash p120); Printf.printf "hash(2^121)\n = %i\n" (Hashtbl.hash p121); @@ -717,45 +721,44 @@ let test_Z() = b,1,1; b,1,5; b,1,32; b,1,63; b,1,64; b,1,127; b,1,128; b,69,12; c,0,1; c,0,64; c,128,1; c,128,5; c,131,32; c,175,63; c,277,123] in -(* - List.iter chk_extract extract_testdata; - List.iter chk_signed_extract extract_testdata; - *) - - (* - chk_bits I.zero; - chk_bits p2; - chk_bits (I.neg p2); - chk_bits p30; - chk_bits (I.neg p30); - chk_bits p62; - chk_bits (I.neg p62); - chk_bits p300; - chk_bits p120; - chk_bits p121; - chk_bits maxi; - chk_bits mini; - chk_bits maxi32; - chk_bits mini32; - chk_bits maxi64; - chk_bits mini64; - chk_bits maxni; - chk_bits minni; - *) - - (* - List.iter chk_testbit [ - I.zero; I.one; I.of_int (-42); - I.of_string "31415926535897932384626433832795028841971693993751058209749445923078164062862089986"; - I.neg (I.shift_left (I.of_int 123456) 64); - ]; - - List.iter chk_numbits_tz [ - I.zero; I.one; I.of_int (-42); - I.shift_left (I.of_int 9999) 77; - I.neg (I.shift_left (I.of_int 123456) 64); - ]; - *) + failure_harness (fun () -> + List.iter chk_extract extract_testdata; + List.iter chk_signed_extract extract_testdata; + ); + failure_harness (fun () -> + chk_bits I.zero; + chk_bits p2; + chk_bits (I.neg p2); + chk_bits p30; + chk_bits (I.neg p30); + chk_bits p62; + chk_bits (I.neg p62); + chk_bits p300; + chk_bits p120; + chk_bits p121; + chk_bits maxi; + chk_bits mini; + chk_bits maxi32; + chk_bits mini32; + chk_bits maxi64; + chk_bits mini64; + chk_bits maxni; + chk_bits minni; + ); + failure_harness (fun () -> + List.iter chk_testbit [ + I.zero; I.one; I.of_int (-42); + I.of_string "31415926535897932384626433832795028841971693993751058209749445923078164062862089986"; + I.neg (I.shift_left (I.of_int 123456) 64); + ]; + ); + failure_harness (fun () -> + List.iter chk_numbits_tz [ + I.zero; I.one; I.of_int (-42); + I.shift_left (I.of_int 9999) 77; + I.neg (I.shift_left (I.of_int 123456) 64); + ]; + ); () diff --git a/tests/zq.output32 b/tests/zq.output-GMP-32 similarity index 100% rename from tests/zq.output32 rename to tests/zq.output-GMP-32 diff --git a/tests/zq.output64 b/tests/zq.output-GMP-64 similarity index 100% rename from tests/zq.output64 rename to tests/zq.output-GMP-64 diff --git a/tests/zq.output-LibTomMath-64 b/tests/zq.output-LibTomMath-64 new file mode 100644 index 0000000..ba54289 --- /dev/null +++ b/tests/zq.output-LibTomMath-64 @@ -0,0 +1,1214 @@ +0 + = 0 +1 + = 1 +-1 + = -1 +42 + = 42 +1+1 + = 2 +1-1 + = 0 +- 1 + = -1 +0-1 + = -1 +max_int + = 4611686018427387903 +min_int + = -4611686018427387904 +-max_int + = -4611686018427387903 +-min_int + = 4611686018427387904 +2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 + = 1329227995784915872903807060280344576 +2^300+2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^300+(-(2^120)) + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120-2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-(2^120)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-(2^120)-2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^300 + = 0 +2^121 + = 2658455991569831745807614120560689152 +2^121+2^120 + = 3987683987354747618711421180841033728 +2^121-2^120 + = 1329227995784915872903807060280344576 +2^121+(-(2^120)) + = 1329227995784915872903807060280344576 +2^120-2^121 + = -1329227995784915872903807060280344576 +2^120+(-(2^121)) + = -1329227995784915872903807060280344576 +-(2^120)+(-(2^121)) + = -3987683987354747618711421180841033728 +-(2^120)-2^121 + = -3987683987354747618711421180841033728 +2^121+0 + = 2658455991569831745807614120560689152 +2^121-0 + = 2658455991569831745807614120560689152 +0+2^121 + = 2658455991569831745807614120560689152 +0-2^121 + = -2658455991569831745807614120560689152 +2^300+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^300-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300+(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300-(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)-(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +max_int+1 + = 4611686018427387904 +min_int-1 + = -4611686018427387905 +-max_int-1 + = -4611686018427387904 +-min_int-1 + = 4611686018427387903 +5! = 120 +12! = 479001600 +15! = 1307674368000 +20! = 2432902008176640000 +25! = 15511210043330985984000000 +50! = 30414093201713378043612608166064768844377641568960512000000000000 +2^300*2^120 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*2^300 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^300*(-(2^120)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*(-(2^300)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +-(2^120)*(-(2^300)) + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^121*2^120 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^120*2^121 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^121*0 + = 0 +0*2^121 + = 0 +2^300*1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300*(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(2^30) + = 1073741824 +1*(2^62) + = 4611686018427387904 +(2^30)*(2^30) + = 1152921504606846976 +(2^62)*(2^62) + = 21267647932558653966460912964485513216 +0+1 + = 1 +1+1 + = 2 +-1+1 + = 0 +2+1 + = 3 +-2+1 + = -1 +(2^300)+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0-1 + = -1 +1-1 + = 0 +-1-1 + = -2 +2-1 + = 1 +-2-1 + = -3 +(2^300)-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +max_int+1 + = 4611686018427387904 +min_int-1 + = -4611686018427387905 +-max_int-1 + = -4611686018427387904 +-min_int-1 + = 4611686018427387903 +abs(0) + = 0 +abs(1) + = 1 +abs(-1) + = 1 +abs(min_int) + = 4611686018427387904 +abs(2^300) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +abs(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +max_natint + = 9223372036854775807 +max_int32 + = 2147483647 +max_int64 + = 9223372036854775807 +to_int 1 + = 1 +to_int max_int + = 4611686018427387903 +to_int max_natint + = ovf +to_int max_int32 + = 2147483647 +to_int max_int64 + = ovf +to_int32 1 + = 1 +to_int32 max_int + = ovf +to_int32 max_natint + = ovf +to_int32 max_int32 + = 2147483647 +to_int32 max_int64 + = ovf +to_int64 1 + = 1 +to_int64 max_int + = 4611686018427387903 +to_int64 max_natint + = 9223372036854775807 +to_int64 max_int32 + = 2147483647 +to_int64 max_int64 + = 9223372036854775807 +to_natint 1 + = 1 +to_natint max_int + = 4611686018427387903 +to_natint max_natint + = 9223372036854775807 +to_natint max_int32 + = 2147483647 +to_natint max_int64 + = 9223372036854775807 +to_int -min_int + = ovf +to_int -min_natint + = ovf +to_int -min_int32 + = 2147483648 +to_int -min_int64 + = ovf +to_int32 -min_int + = ovf +to_int32 -min_natint + = ovf +to_int32 -min_int32 + = ovf +to_int32 -min_int64 + = ovf +to_int64 -min_int + = 4611686018427387904 +to_int64 -min_natint + = ovf +to_int64 -min_int32 + = 2147483648 +to_int64 -min_int64 + = ovf +to_natint -min_int + = 4611686018427387904 +to_natint -min_natint + = ovf +to_natint -min_int32 + = 2147483648 +to_natint -min_int64 + = ovf +of_float 1. + = 1 +of_float -1. + = -1 +of_float pi + = 3 +of_float 2^30 + = 1073741824 +of_float 2^31 + = 2147483648 +of_float 2^32 + = 4294967296 +of_float 2^33 + = 8589934592 +of_float -2^30 + = -1073741824 +of_float -2^31 + = -2147483648 +of_float -2^32 + = -4294967296 +of_float -2^33 + = -8589934592 +of_float 2^61 + = 2305843009213693952 +of_float 2^62 + = 4611686018427387904 +of_float 2^63 + = 9223372036854775808 +of_float 2^64 + = 18446744073709551616 +of_float 2^65 + = 36893488147419103232 +of_float -2^61 + = -2305843009213693952 +of_float -2^62 + = -4611686018427387904 +of_float -2^63 + = -9223372036854775808 +of_float -2^64 + = -18446744073709551616 +of_float -2^65 + = -36893488147419103232 +of_float 2^120 + = 1329227995784915872903807060280344576 +of_float 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float -2^120 + = -1329227995784915872903807060280344576 +of_float -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float 0.5 + = 0 +of_float -0.5 + = 0 +of_float 200.5 + = 200 +of_float -200.5 + = -200 +to_float 0 + = OK +to_float 1 + = OK +to_float -1 + = OK +to_float 2^120 + = OK +to_float -2^120 + = OK +to_float (2^120-1) + = OK +to_float (-2^120+1) + = OK +to_float 2^63 + = OK +to_float -2^63 + = OK +to_float (2^63-1) + = OK +to_float (-2^63-1) + = OK +to_float (-2^63+1) + = OK +to_float 2^300 + = OK +to_float -2^300 + = OK +to_float (2^300-1) + = OK +to_float (-2^300+1) + = OK +of_string 12 + = 12 +of_string 0x12 + = 18 +of_string 0b10 + = 2 +of_string 0o12 + = 10 +of_string -12 + = -12 +of_string -0x12 + = -18 +of_string -0b10 + = -2 +of_string -0o12 + = -10 +of_string 000123456789012345678901234567890 + = 123456789012345678901234567890 +2^120 / 2^300 (trunc) + = 0 +max_int / 2 (trunc) + = 2305843009213693951 +(2^300+1) / 2^120 (trunc) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (trunc) + = 1532495540865888858358347027150309183618739122183602176 +2^120 / 2^300 (ceil) + = 1 +max_int / 2 (ceil) + = 2305843009213693952 +(2^300+1) / 2^120 (ceil) + = 1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / 2^120 (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (ceil) + = 1532495540865888858358347027150309183618739122183602177 +2^120 / 2^300 (floor) + = 0 +max_int / 2 (floor) + = 2305843009213693951 +(2^300+1) / 2^120 (floor) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (floor) + = -1532495540865888858358347027150309183618739122183602177 +(2^300+1) / (-(2^120)) (floor) + = -1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / (-(2^120)) (floor) + = 1532495540865888858358347027150309183618739122183602176 +2^120 % 2^300 + = 1329227995784915872903807060280344576 +max_int % 2 + = 1 +(2^300+1) % 2^120 + = 1 +(-(2^300+1)) % 2^120 + = -1 +(2^300+1) % (-(2^120)) + = 1 +(-(2^300+1)) % (-(2^120)) + = -1 +2^120 /,% 2^300 + = 0, 1329227995784915872903807060280344576 +max_int /,% 2 + = 2305843009213693951, 1 +(2^300+1) /,% 2^120 + = 1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% 2^120 + = -1532495540865888858358347027150309183618739122183602176, -1 +(2^300+1) /,% (-(2^120)) + = -1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% (-(2^120)) + = 1532495540865888858358347027150309183618739122183602176, -1 +1 & 2 + = 0 +1 & 2^300 + = 0 +2^120 & 2^300 + = 0 +2^300 & 2^120 + = 0 +2^300 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 & 0 + = 0 +-2^120 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + 2^120 & -2^300 + = 0 +-2^120 & -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & 2^120 + = 0 + 2^300 & -2^120 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & -2^120 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1 | 2 + = 3 +1 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 | 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 | 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 | 2^300 + = -1329227995784915872903807060280344576 + 2^120 | -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 | -2^300 + = -1329227995784915872903807060280344576 +-2^300 | 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 | -2^120 + = -1329227995784915872903807060280344576 +-2^300 | -2^120 + = -1329227995784915872903807060280344576 +1 ^ 2 + = 3 +1 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^300 + = 0 +2^300 ^ 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 ^ 2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 + 2^120 ^ -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 ^ -2^300 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^300 ^ 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 ^ -2^120 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-2^300 ^ -2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +~0 + = -1 +~1 + = -2 +~2 + = -3 +~2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +~(-1) + = 0 +~(-2) + = 1 +~(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0 >> 1 + = 0 +0 >> 100 + = 0 +2 >> 1 + = 1 +2 >> 2 + = 0 +2 >> 100 + = 0 +2^300 >> 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >> 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >> 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >> 200 + = 1267650600228229401496703205376 +2^300 >> 300 + = 1 +2^300 >> 400 + = 0 +-1 >> 1 + = -1 +-2 >> 1 + = -1 +-2 >> 2 + = -1 +-2 >> 100 + = -1 +-2^300 >> 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >> 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >> 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >> 200 + = -1267650600228229401496703205376 +-2^300 >> 300 + = -1 +-2^300 >> 400 + = -1 +0 >>0 1 + = 0 +0 >>0 100 + = 0 +2 >>0 1 + = 1 +2 >>0 2 + = 0 +2 >>0 100 + = 0 +2^300 >>0 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >>0 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >>0 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >>0 200 + = 1267650600228229401496703205376 +2^300 >>0 300 + = 1 +2^300 >>0 400 + = 0 +-1 >>0 1 + = 0 +-2 >>0 1 + = -1 +-2 >>0 2 + = 0 +-2 >>0 100 + = 0 +-2^300 >>0 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >>0 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >>0 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >>0 200 + = -1267650600228229401496703205376 +-2^300 >>0 300 + = -1 +-2^300 >>0 400 + = 0 +0 << 1 + = 0 +0 << 100 + = 0 +2 << 1 + = 4 +2 << 32 + = 8589934592 +2 << 64 + = 36893488147419103232 +2 << 299 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 << 1 + = 2658455991569831745807614120560689152 +2^120 << 180 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +compare 1 2 + = -1 +compare 1 1 + = 0 +compare 2 1 + = 1 +compare 2^300 2^120 + = 1 +compare 2^120 2^120 + = 0 +compare 2^120 2^300 + = -1 +compare 2^121 2^120 + = 1 +compare 2^120 2^121 + = -1 +compare 2^300 -2^120 + = 1 +compare 2^120 -2^120 + = 1 +compare 2^120 -2^300 + = 1 +compare -2^300 2^120 + = -1 +compare -2^120 2^120 + = -1 +compare -2^120 2^300 + = -1 +compare -2^300 -2^120 + = -1 +compare -2^120 -2^120 + = 0 +compare -2^120 -2^300 + = 1 +equal 1 2 + = false +equal 1 1 + = true +equal 2 1 + = false +equal 2^300 2^120 + = false +equal 2^120 2^120 + = true +equal 2^120 2^300 + = false +equal 2^121 2^120 + = false +equal 2^120 2^121 + = false +equal 2^120 -2^120 + = false +equal -2^120 2^120 + = false +equal -2^120 -2^120 + = true +sign 0 + = 0 +sign 1 + = 1 +sign -1 + = -1 +sign 2^300 + = 1 +sign -2^300 + = -1 +gcd 0 0 + = 0 +gcd 0 -137 + = 137 +gcd 12 27 + = 3 +gcd 27 12 + = 3 +gcd 27 27 + = 27 +gcd -12 27 + = 3 +gcd 12 -27 + = 3 +gcd -12 -27 + = 3 +gcd 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 2^120 + = 1329227995784915872903807060280344576 +gcd 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 -2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 -2^120 + = 1329227995784915872903807060280344576 +gcdext 12 27 + = 3, -2, 1 +gcdext 27 12 + = 3, 1, -2 +gcdext 27 27 + = 27, 0, 1 +gcdext -12 27 + = 3, 2, 1 +gcdext 12 -27 + = 3, -2, -1 +gcdext -12 -27 + = 3, 2, -1 +gcdext 2^120 2^300 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 2^300 2^120 + = 1329227995784915872903807060280344576, 0, 1 +gcdext 12 0 + = 12, 1, 0 +gcdext 0 27 + = 27, 0, 1 +gcdext -12 0 + = 12, -1, 0 +gcdext 0 -27 + = 27, 0, -1 +gcdext 2^120 0 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, 1 +gcdext -2^120 0 + = 1329227995784915872903807060280344576, -1, 0 +gcdext 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, -1 +gcdext 0 0 + = 0, 0, 0 +lcm 0 0 = 0 +lcm 10 12 = 60 +lcm -10 12 = 60 +lcm 10 -12 = 60 +lcm -10 -12 = 60 +lcm 0 12 = 0 +lcm 0 -12 = 0 +lcm 10 0 = 0 +lcm -10 0 = 0 +lcm 2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 0 = 0 +lcm -2^120 0 = 0 +is_odd 0 + = false +is_odd 1 + = true +is_odd 2 + = false +is_odd 3 + = true +is_odd 2^120 + = false +is_odd 2^120+1 + = true +is_odd 2^300 + = false +is_odd 2^300+1 + = true +sqrt 0 + = 0 +sqrt 1 + = 1 +sqrt 2 + = 1 +sqrt 2^120 + = 1152921504606846976 +sqrt 2^121 + = 1630477228166597776 +Failure: Z.sqrt_rem: not implemented in LibTomMath backend +popcount 0 + = 0 +popcount 1 + = 1 +popcount 2 + = 1 +popcount max_int32 + = 31 +popcount 2^120 + = 1 +popcount (2^120-1) + = 120 +Failure: Z.hamdist: not implemented in LibTomMath backend +hash(2^120) + = 900619431 +hash(2^121) + = 324032971 +hash(2^300) + = 49167343 +2^120 = 2^300 + = false +2^120 = 2^120 + = true +2^120 = 2^120 + = true +2^120 > 2^300 + = false +2^120 < 2^300 + = true +2^120 = 1 + = false +2^120 > 1 + = true +2^120 < 1 + = false +-2^120 > 1 + = false +-2^120 < 1 + = true +demarshal 2^120, 2^300, 1 + = 1329227995784915872903807060280344576, 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 1 +demarshal -2^120, -2^300, -1 + = -1329227995784915872903807060280344576, -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, -1 +format %i 0 = /0/ +format %i 1 = /1/ +format %i -1 = /-1/ +format %i 2^30 = /1073741824/ +format %i -2^30 = /-1073741824/ +format % i 1 = / 1/ +format %+i 1 = /+1/ +format %x 0 = /0/ +format %x 1 = /1/ +format %x -1 = /-1/ +format %x 2^30 = /40000000/ +format %x -2^30 = /-40000000/ +format %X 0 = /0/ +format %X 1 = /1/ +format %X -1 = /-1/ +format %X 2^30 = /40000000/ +format %X -2^30 = /-40000000/ +format %o 0 = /0/ +format %o 1 = /1/ +format %o -1 = /-1/ +format %o 2^30 = /10000000000/ +format %o -2^30 = /-10000000000/ +format %10i 0 = / 0/ +format %10i 1 = / 1/ +format %10i -1 = / -1/ +format %10i 2^30 = /1073741824/ +format %10i -2^30 = /-1073741824/ +format %-10i 0 = /0 / +format %-10i 1 = /1 / +format %-10i -1 = /-1 / +format %-10i 2^30 = /1073741824/ +format %-10i -2^30 = /-1073741824/ +format %+10i 0 = / +0/ +format %+10i 1 = / +1/ +format %+10i -1 = / -1/ +format %+10i 2^30 = /+1073741824/ +format %+10i -2^30 = /-1073741824/ +format % 10i 0 = / 0/ +format % 10i 1 = / 1/ +format % 10i -1 = / -1/ +format % 10i 2^30 = / 1073741824/ +format % 10i -2^30 = /-1073741824/ +format %010i 0 = /0000000000/ +format %010i 1 = /0000000001/ +format %010i -1 = /-000000001/ +format %010i 2^30 = /1073741824/ +format %010i -2^30 = /-1073741824/ +format %#x 0 = /0x0/ +format %#x 1 = /0x1/ +format %#x -1 = /-0x1/ +format %#x 2^30 = /0x40000000/ +format %#x -2^30 = /-0x40000000/ +format %#X 0 = /0X0/ +format %#X 1 = /0X1/ +format %#X -1 = /-0X1/ +format %#X 2^30 = /0X40000000/ +format %#X -2^30 = /-0X40000000/ +format %#o 0 = /0o0/ +format %#o 1 = /0o1/ +format %#o -1 = /-0o1/ +format %#o 2^30 = /0o10000000000/ +format %#o -2^30 = /-0o10000000000/ +format %#10x 0 = / 0x0/ +format %#10x 1 = / 0x1/ +format %#10x -1 = / -0x1/ +format %#10x 2^30 = /0x40000000/ +format %#10x -2^30 = /-0x40000000/ +format %#10X 0 = / 0X0/ +format %#10X 1 = / 0X1/ +format %#10X -1 = / -0X1/ +format %#10X 2^30 = /0X40000000/ +format %#10X -2^30 = /-0X40000000/ +format %#10o 0 = / 0o0/ +format %#10o 1 = / 0o1/ +format %#10o -1 = / -0o1/ +format %#10o 2^30 = /0o10000000000/ +format %#10o -2^30 = /-0o10000000000/ +format %#-10x 0 = /0x0 / +format %#-10x 1 = /0x1 / +format %#-10x -1 = /-0x1 / +format %#-10x 2^30 = /0x40000000/ +format %#-10x -2^30 = /-0x40000000/ +format %#-10X 0 = /0X0 / +format %#-10X 1 = /0X1 / +format %#-10X -1 = /-0X1 / +format %#-10X 2^30 = /0X40000000/ +format %#-10X -2^30 = /-0X40000000/ +format %#-10o 0 = /0o0 / +format %#-10o 1 = /0o1 / +format %#-10o -1 = /-0o1 / +format %#-10o 2^30 = /0o10000000000/ +format %#-10o -2^30 = /-0o10000000000/ +Failure: Z.extract: not implemented in LibTomMath backend +to_bits 0 + =Failure: Z.to_bits: not implemented in LibTomMath backend +testbit 0 Failure: Z.extract: not implemented in LibTomMath backend +numbits / trailing_zeros 0 (passed) +numbits / trailing_zeros 1 (passed) +numbits / trailing_zeros -42 Failure: Z.extract: not implemented in LibTomMath backend +- 0 = 0 +- 1 = -1 +- -1 = 1 +- +inf = -inf +- -inf = +inf +- undef = undef +1/ 0 = +inf +1/ 1 = 1 +1/ -1 = -1 +1/ +inf = 0 +1/ -inf = 0 +1/ undef = undef +abs 0 = 0 +abs 1 = 1 +abs -1 = 1 +abs +inf = +inf +abs -inf = +inf +abs undef = undef +0 + 0 = 0 +0 + 1 = 1 +0 + -1 = -1 +0 + +inf = +inf +0 + -inf = -inf +0 + undef = undef +1 + 0 = 1 +1 + 1 = 2 +1 + -1 = 0 +1 + +inf = +inf +1 + -inf = -inf +1 + undef = undef +-1 + 0 = -1 +-1 + 1 = 0 +-1 + -1 = -2 +-1 + +inf = +inf +-1 + -inf = -inf +-1 + undef = undef ++inf + 0 = +inf ++inf + 1 = +inf ++inf + -1 = +inf ++inf + +inf = +inf ++inf + -inf = undef ++inf + undef = undef +-inf + 0 = -inf +-inf + 1 = -inf +-inf + -1 = -inf +-inf + +inf = undef +-inf + -inf = -inf +-inf + undef = undef +undef + 0 = undef +undef + 1 = undef +undef + -1 = undef +undef + +inf = undef +undef + -inf = undef +undef + undef = undef +0 - 0 = 0 +0 - 1 = -1 +0 - -1 = 1 +0 - +inf = -inf +0 - -inf = +inf +0 - undef = undef +1 - 0 = 1 +1 - 1 = 0 +1 - -1 = 2 +1 - +inf = -inf +1 - -inf = +inf +1 - undef = undef +-1 - 0 = -1 +-1 - 1 = -2 +-1 - -1 = 0 +-1 - +inf = -inf +-1 - -inf = +inf +-1 - undef = undef ++inf - 0 = +inf ++inf - 1 = +inf ++inf - -1 = +inf ++inf - +inf = undef ++inf - -inf = +inf ++inf - undef = undef +-inf - 0 = -inf +-inf - 1 = -inf +-inf - -1 = -inf +-inf - +inf = -inf +-inf - -inf = undef +-inf - undef = undef +undef - 0 = undef +undef - 1 = undef +undef - -1 = undef +undef - +inf = undef +undef - -inf = undef +undef - undef = undef +0 * 0 = 0 +0 * 1 = 0 +0 * -1 = 0 +0 * +inf = undef +0 * -inf = undef +0 * undef = undef +1 * 0 = 0 +1 * 1 = 1 +1 * -1 = -1 +1 * +inf = +inf +1 * -inf = -inf +1 * undef = undef +-1 * 0 = 0 +-1 * 1 = -1 +-1 * -1 = 1 +-1 * +inf = -inf +-1 * -inf = +inf +-1 * undef = undef ++inf * 0 = undef ++inf * 1 = +inf ++inf * -1 = -inf ++inf * +inf = +inf ++inf * -inf = -inf ++inf * undef = undef +-inf * 0 = undef +-inf * 1 = -inf +-inf * -1 = +inf +-inf * +inf = -inf +-inf * -inf = +inf +-inf * undef = undef +undef * 0 = undef +undef * 1 = undef +undef * -1 = undef +undef * +inf = undef +undef * -inf = undef +undef * undef = undef +0 / 0 = undef +0 / 1 = 0 +0 / -1 = 0 +0 / +inf = 0 +0 / -inf = 0 +0 / undef = undef +1 / 0 = +inf +1 / 1 = 1 +1 / -1 = -1 +1 / +inf = 0 +1 / -inf = 0 +1 / undef = undef +-1 / 0 = -inf +-1 / 1 = -1 +-1 / -1 = 1 +-1 / +inf = 0 +-1 / -inf = 0 +-1 / undef = undef ++inf / 0 = +inf ++inf / 1 = +inf ++inf / -1 = -inf ++inf / +inf = undef ++inf / -inf = undef ++inf / undef = undef +-inf / 0 = -inf +-inf / 1 = -inf +-inf / -1 = +inf +-inf / +inf = undef +-inf / -inf = undef +-inf / undef = undef +undef / 0 = undef +undef / 1 = undef +undef / -1 = undef +undef / +inf = undef +undef / -inf = undef +undef / undef = undef +0 * 1/ 0 = undef +0 * 1/ 1 = 0 +0 * 1/ -1 = 0 +0 * 1/ +inf = 0 +0 * 1/ -inf = 0 +0 * 1/ undef = undef +1 * 1/ 0 = +inf +1 * 1/ 1 = 1 +1 * 1/ -1 = -1 +1 * 1/ +inf = 0 +1 * 1/ -inf = 0 +1 * 1/ undef = undef +-1 * 1/ 0 = -inf +-1 * 1/ 1 = -1 +-1 * 1/ -1 = 1 +-1 * 1/ +inf = 0 +-1 * 1/ -inf = 0 +-1 * 1/ undef = undef ++inf * 1/ 0 = +inf ++inf * 1/ 1 = +inf ++inf * 1/ -1 = -inf ++inf * 1/ +inf = undef ++inf * 1/ -inf = undef ++inf * 1/ undef = undef +-inf * 1/ 0 = -inf +-inf * 1/ 1 = -inf +-inf * 1/ -1 = +inf +-inf * 1/ +inf = undef +-inf * 1/ -inf = undef +-inf * 1/ undef = undef +undef * 1/ 0 = undef +undef * 1/ 1 = undef +undef * 1/ -1 = undef +undef * 1/ +inf = undef +undef * 1/ -inf = undef +undef * 1/ undef = undef +mul_2exp (1) 0 = 0 +mul_2exp (1) 1 = 2 +mul_2exp (1) -1 = -2 +mul_2exp (1) +inf = +inf +mul_2exp (1) -inf = -inf +mul_2exp (1) undef = undef +mul_2exp (2) 0 = 0 +mul_2exp (2) 1 = 4 +mul_2exp (2) -1 = -4 +mul_2exp (2) +inf = +inf +mul_2exp (2) -inf = -inf +mul_2exp (2) undef = undef +div_2exp (1) 0 = 0 +div_2exp (1) 1 = 1/2 +div_2exp (1) -1 = -1/2 +div_2exp (1) +inf = +inf +div_2exp (1) -inf = -inf +div_2exp (1) undef = undef +div_2exp (2) 0 = 0 +div_2exp (2) 1 = 1/4 +div_2exp (2) -1 = -1/4 +div_2exp (2) +inf = +inf +div_2exp (2) -inf = -inf +div_2exp (2) undef = undef +identity checking 0 0 +identity checking 0 1 +identity checking 0 -1 +identity checking 0 +inf +identity checking 0 -inf +identity checking 0 undef +identity checking 1 0 +identity checking 1 1 +identity checking 1 -1 +identity checking 1 +inf +identity checking 1 -inf +identity checking 1 undef +identity checking -1 0 +identity checking -1 1 +identity checking -1 -1 +identity checking -1 +inf +identity checking -1 -inf +identity checking -1 undef +identity checking +inf 0 +identity checking +inf 1 +identity checking +inf -1 +identity checking +inf +inf +identity checking +inf -inf +identity checking +inf undef +identity checking -inf 0 +identity checking -inf 1 +identity checking -inf -1 +identity checking -inf +inf +identity checking -inf -inf +identity checking -inf undef +identity checking undef 0 +identity checking undef 1 +identity checking undef -1 +identity checking undef +inf +identity checking undef -inf +identity checking undef undef diff --git a/tests/zq.output-MPIR-32 b/tests/zq.output-MPIR-32 new file mode 100644 index 0000000..376984a --- /dev/null +++ b/tests/zq.output-MPIR-32 @@ -0,0 +1,1373 @@ +0 + = 0 +1 + = 1 +-1 + = -1 +42 + = 42 +1+1 + = 2 +1-1 + = 0 +- 1 + = -1 +0-1 + = -1 +max_int + = 1073741823 +min_int + = -1073741824 +-max_int + = -1073741823 +-min_int + = 1073741824 +2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 + = 1329227995784915872903807060280344576 +2^300+2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^300+(-(2^120)) + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120-2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-(2^120)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-(2^120)-2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^300 + = 0 +2^121 + = 2658455991569831745807614120560689152 +2^121+2^120 + = 3987683987354747618711421180841033728 +2^121-2^120 + = 1329227995784915872903807060280344576 +2^121+(-(2^120)) + = 1329227995784915872903807060280344576 +2^120-2^121 + = -1329227995784915872903807060280344576 +2^120+(-(2^121)) + = -1329227995784915872903807060280344576 +-(2^120)+(-(2^121)) + = -3987683987354747618711421180841033728 +-(2^120)-2^121 + = -3987683987354747618711421180841033728 +2^121+0 + = 2658455991569831745807614120560689152 +2^121-0 + = 2658455991569831745807614120560689152 +0+2^121 + = 2658455991569831745807614120560689152 +0-2^121 + = -2658455991569831745807614120560689152 +2^300+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^300-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300+(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300-(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)-(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +max_int+1 + = 1073741824 +min_int-1 + = -1073741825 +-max_int-1 + = -1073741824 +-min_int-1 + = 1073741823 +5! = 120 +12! = 479001600 +15! = 1307674368000 +20! = 2432902008176640000 +25! = 15511210043330985984000000 +50! = 30414093201713378043612608166064768844377641568960512000000000000 +2^300*2^120 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*2^300 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^300*(-(2^120)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*(-(2^300)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +-(2^120)*(-(2^300)) + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^121*2^120 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^120*2^121 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^121*0 + = 0 +0*2^121 + = 0 +2^300*1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300*(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(2^30) + = 1073741824 +1*(2^62) + = 4611686018427387904 +(2^30)*(2^30) + = 1152921504606846976 +(2^62)*(2^62) + = 21267647932558653966460912964485513216 +0+1 + = 1 +1+1 + = 2 +-1+1 + = 0 +2+1 + = 3 +-2+1 + = -1 +(2^300)+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0-1 + = -1 +1-1 + = 0 +-1-1 + = -2 +2-1 + = 1 +-2-1 + = -3 +(2^300)-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +max_int+1 + = 1073741824 +min_int-1 + = -1073741825 +-max_int-1 + = -1073741824 +-min_int-1 + = 1073741823 +abs(0) + = 0 +abs(1) + = 1 +abs(-1) + = 1 +abs(min_int) + = 1073741824 +abs(2^300) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +abs(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +max_natint + = 2147483647 +max_int32 + = 2147483647 +max_int64 + = 9223372036854775807 +to_int 1 + = 1 +to_int max_int + = 1073741823 +to_int max_natint + = ovf +to_int max_int32 + = ovf +to_int max_int64 + = ovf +to_int32 1 + = 1 +to_int32 max_int + = 1073741823 +to_int32 max_natint + = 2147483647 +to_int32 max_int32 + = 2147483647 +to_int32 max_int64 + = ovf +to_int64 1 + = 1 +to_int64 max_int + = 1073741823 +to_int64 max_natint + = 2147483647 +to_int64 max_int32 + = 2147483647 +to_int64 max_int64 + = 9223372036854775807 +to_natint 1 + = 1 +to_natint max_int + = 1073741823 +to_natint max_natint + = 2147483647 +to_natint max_int32 + = 2147483647 +to_natint max_int64 + = ovf +to_int -min_int + = ovf +to_int -min_natint + = ovf +to_int -min_int32 + = ovf +to_int -min_int64 + = ovf +to_int32 -min_int + = 1073741824 +to_int32 -min_natint + = ovf +to_int32 -min_int32 + = ovf +to_int32 -min_int64 + = ovf +to_int64 -min_int + = 1073741824 +to_int64 -min_natint + = 2147483648 +to_int64 -min_int32 + = 2147483648 +to_int64 -min_int64 + = ovf +to_natint -min_int + = 1073741824 +to_natint -min_natint + = ovf +to_natint -min_int32 + = ovf +to_natint -min_int64 + = ovf +of_float 1. + = 1 +of_float -1. + = -1 +of_float pi + = 3 +of_float 2^30 + = 1073741824 +of_float 2^31 + = 2147483648 +of_float 2^32 + = 4294967296 +of_float 2^33 + = 8589934592 +of_float -2^30 + = -1073741824 +of_float -2^31 + = -2147483648 +of_float -2^32 + = -4294967296 +of_float -2^33 + = -8589934592 +of_float 2^61 + = 2305843009213693952 +of_float 2^62 + = 4611686018427387904 +of_float 2^63 + = 9223372036854775808 +of_float 2^64 + = 18446744073709551616 +of_float 2^65 + = 36893488147419103232 +of_float -2^61 + = -2305843009213693952 +of_float -2^62 + = -4611686018427387904 +of_float -2^63 + = -9223372036854775808 +of_float -2^64 + = -18446744073709551616 +of_float -2^65 + = -36893488147419103232 +of_float 2^120 + = 1329227995784915872903807060280344576 +of_float 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float -2^120 + = -1329227995784915872903807060280344576 +of_float -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float 0.5 + = 0 +of_float -0.5 + = 0 +of_float 200.5 + = 200 +of_float -200.5 + = -200 +to_float 0 + = OK +to_float 1 + = OK +to_float -1 + = OK +to_float 2^120 + = OK +to_float -2^120 + = OK +to_float (2^120-1) + = OK +to_float (-2^120+1) + = OK +to_float 2^63 + = OK +to_float -2^63 + = OK +to_float (2^63-1) + = OK +to_float (-2^63-1) + = OK +to_float (-2^63+1) + = OK +to_float 2^300 + = OK +to_float -2^300 + = OK +to_float (2^300-1) + = OK +to_float (-2^300+1) + = OK +of_string 12 + = 12 +of_string 0x12 + = 18 +of_string 0b10 + = 2 +of_string 0o12 + = 10 +of_string -12 + = -12 +of_string -0x12 + = -18 +of_string -0b10 + = -2 +of_string -0o12 + = -10 +of_string 000123456789012345678901234567890 + = 123456789012345678901234567890 +2^120 / 2^300 (trunc) + = 0 +max_int / 2 (trunc) + = 536870911 +(2^300+1) / 2^120 (trunc) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (trunc) + = 1532495540865888858358347027150309183618739122183602176 +2^120 / 2^300 (ceil) + = 1 +max_int / 2 (ceil) + = 536870912 +(2^300+1) / 2^120 (ceil) + = 1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / 2^120 (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (ceil) + = 1532495540865888858358347027150309183618739122183602177 +2^120 / 2^300 (floor) + = 0 +max_int / 2 (floor) + = 536870911 +(2^300+1) / 2^120 (floor) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (floor) + = -1532495540865888858358347027150309183618739122183602177 +(2^300+1) / (-(2^120)) (floor) + = -1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / (-(2^120)) (floor) + = 1532495540865888858358347027150309183618739122183602176 +2^120 % 2^300 + = 1329227995784915872903807060280344576 +max_int % 2 + = 1 +(2^300+1) % 2^120 + = 1 +(-(2^300+1)) % 2^120 + = -1 +(2^300+1) % (-(2^120)) + = 1 +(-(2^300+1)) % (-(2^120)) + = -1 +2^120 /,% 2^300 + = 0, 1329227995784915872903807060280344576 +max_int /,% 2 + = 536870911, 1 +(2^300+1) /,% 2^120 + = 1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% 2^120 + = -1532495540865888858358347027150309183618739122183602176, -1 +(2^300+1) /,% (-(2^120)) + = -1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% (-(2^120)) + = 1532495540865888858358347027150309183618739122183602176, -1 +1 & 2 + = 0 +1 & 2^300 + = 0 +2^120 & 2^300 + = 0 +2^300 & 2^120 + = 0 +2^300 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 & 0 + = 0 +-2^120 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + 2^120 & -2^300 + = 0 +-2^120 & -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & 2^120 + = 0 + 2^300 & -2^120 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & -2^120 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1 | 2 + = 3 +1 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 | 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 | 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 | 2^300 + = -1329227995784915872903807060280344576 + 2^120 | -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 | -2^300 + = -1329227995784915872903807060280344576 +-2^300 | 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 | -2^120 + = -1329227995784915872903807060280344576 +-2^300 | -2^120 + = -1329227995784915872903807060280344576 +1 ^ 2 + = 3 +1 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^300 + = 0 +2^300 ^ 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 ^ 2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 + 2^120 ^ -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 ^ -2^300 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^300 ^ 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 ^ -2^120 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-2^300 ^ -2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +~0 + = -1 +~1 + = -2 +~2 + = -3 +~2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +~(-1) + = 0 +~(-2) + = 1 +~(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0 >> 1 + = 0 +0 >> 100 + = 0 +2 >> 1 + = 1 +2 >> 2 + = 0 +2 >> 100 + = 0 +2^300 >> 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >> 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >> 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >> 200 + = 1267650600228229401496703205376 +2^300 >> 300 + = 1 +2^300 >> 400 + = 0 +-1 >> 1 + = -1 +-2 >> 1 + = -1 +-2 >> 2 + = -1 +-2 >> 100 + = -1 +-2^300 >> 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >> 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >> 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >> 200 + = -1267650600228229401496703205376 +-2^300 >> 300 + = -1 +-2^300 >> 400 + = -1 +0 >>0 1 + = 0 +0 >>0 100 + = 0 +2 >>0 1 + = 1 +2 >>0 2 + = 0 +2 >>0 100 + = 0 +2^300 >>0 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >>0 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >>0 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >>0 200 + = 1267650600228229401496703205376 +2^300 >>0 300 + = 1 +2^300 >>0 400 + = 0 +-1 >>0 1 + = 0 +-2 >>0 1 + = -1 +-2 >>0 2 + = 0 +-2 >>0 100 + = 0 +-2^300 >>0 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >>0 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >>0 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >>0 200 + = -1267650600228229401496703205376 +-2^300 >>0 300 + = -1 +-2^300 >>0 400 + = 0 +0 << 1 + = 0 +0 << 100 + = 0 +2 << 1 + = 4 +2 << 32 + = 8589934592 +2 << 64 + = 36893488147419103232 +2 << 299 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 << 1 + = 2658455991569831745807614120560689152 +2^120 << 180 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +compare 1 2 + = -1 +compare 1 1 + = 0 +compare 2 1 + = 1 +compare 2^300 2^120 + = 1 +compare 2^120 2^120 + = 0 +compare 2^120 2^300 + = -1 +compare 2^121 2^120 + = 1 +compare 2^120 2^121 + = -1 +compare 2^300 -2^120 + = 1 +compare 2^120 -2^120 + = 1 +compare 2^120 -2^300 + = 1 +compare -2^300 2^120 + = -1 +compare -2^120 2^120 + = -1 +compare -2^120 2^300 + = -1 +compare -2^300 -2^120 + = -1 +compare -2^120 -2^120 + = 0 +compare -2^120 -2^300 + = 1 +equal 1 2 + = false +equal 1 1 + = true +equal 2 1 + = false +equal 2^300 2^120 + = false +equal 2^120 2^120 + = true +equal 2^120 2^300 + = false +equal 2^121 2^120 + = false +equal 2^120 2^121 + = false +equal 2^120 -2^120 + = false +equal -2^120 2^120 + = false +equal -2^120 -2^120 + = true +sign 0 + = 0 +sign 1 + = 1 +sign -1 + = -1 +sign 2^300 + = 1 +sign -2^300 + = -1 +gcd 0 0 + = 0 +gcd 0 -137 + = 137 +gcd 12 27 + = 3 +gcd 27 12 + = 3 +gcd 27 27 + = 27 +gcd -12 27 + = 3 +gcd 12 -27 + = 3 +gcd -12 -27 + = 3 +gcd 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 2^120 + = 1329227995784915872903807060280344576 +gcd 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 -2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 -2^120 + = 1329227995784915872903807060280344576 +gcdext 12 27 + = 3, -2, 1 +gcdext 27 12 + = 3, 1, -2 +gcdext 27 27 + = 27, 0, 1 +gcdext -12 27 + = 3, 2, 1 +gcdext 12 -27 + = 3, -2, -1 +gcdext -12 -27 + = 3, 2, -1 +gcdext 2^120 2^300 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 2^300 2^120 + = 1329227995784915872903807060280344576, 0, 1 +gcdext 12 0 + = 12, 1, 0 +gcdext 0 27 + = 27, 0, 1 +gcdext -12 0 + = 12, -1, 0 +gcdext 0 -27 + = 27, 0, -1 +gcdext 2^120 0 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, 1 +gcdext -2^120 0 + = 1329227995784915872903807060280344576, -1, 0 +gcdext 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, -1 +gcdext 0 0 + = 0, 0, 0 +lcm 0 0 = 0 +lcm 10 12 = 60 +lcm -10 12 = 60 +lcm 10 -12 = 60 +lcm -10 -12 = 60 +lcm 0 12 = 0 +lcm 0 -12 = 0 +lcm 10 0 = 0 +lcm -10 0 = 0 +lcm 2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 0 = 0 +lcm -2^120 0 = 0 +is_odd 0 + = false +is_odd 1 + = true +is_odd 2 + = false +is_odd 3 + = true +is_odd 2^120 + = false +is_odd 2^120+1 + = true +is_odd 2^300 + = false +is_odd 2^300+1 + = true +sqrt 0 + = 0 +sqrt 1 + = 1 +sqrt 2 + = 1 +sqrt 2^120 + = 1152921504606846976 +sqrt 2^121 + = 1630477228166597776 +sqrt_rem 0 + = 0, 0 +sqrt_rem 1 + = 1, 0 +sqrt_rem 2 + = 1, 1 +sqrt_rem 2^120 + = 1152921504606846976, 0 +sqrt_rem 2^121 + = 1630477228166597776, 1772969445592542976 +popcount 0 + = 0 +popcount 1 + = 1 +popcount 2 + = 1 +popcount max_int32 + = 31 +popcount 2^120 + = 1 +popcount (2^120-1) + = 120 +hamdist 0 0 + = 0 +hamdist 0 1 + = 1 +hamdist 0 2^300 + = 1 +hamdist 2^120 2^120 + = 0 +hamdist 2^120 (2^120-1) + = 121 +hamdist 2^120 2^300 + = 2 +hamdist (2^120-1) (2^300-1) + = 180 +hash(2^120) + = 691199303 +hash(2^121) + = 382412560 +hash(2^300) + = 61759632 +2^120 = 2^300 + = false +2^120 = 2^120 + = true +2^120 = 2^120 + = true +2^120 > 2^300 + = false +2^120 < 2^300 + = true +2^120 = 1 + = false +2^120 > 1 + = true +2^120 < 1 + = false +-2^120 > 1 + = false +-2^120 < 1 + = true +demarshal 2^120, 2^300, 1 + = 1329227995784915872903807060280344576, 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 1 +demarshal -2^120, -2^300, -1 + = -1329227995784915872903807060280344576, -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, -1 +format %i 0 = /0/ +format %i 1 = /1/ +format %i -1 = /-1/ +format %i 2^30 = /1073741824/ +format %i -2^30 = /-1073741824/ +format % i 1 = / 1/ +format %+i 1 = /+1/ +format %x 0 = /0/ +format %x 1 = /1/ +format %x -1 = /-1/ +format %x 2^30 = /40000000/ +format %x -2^30 = /-40000000/ +format %X 0 = /0/ +format %X 1 = /1/ +format %X -1 = /-1/ +format %X 2^30 = /40000000/ +format %X -2^30 = /-40000000/ +format %o 0 = /0/ +format %o 1 = /1/ +format %o -1 = /-1/ +format %o 2^30 = /10000000000/ +format %o -2^30 = /-10000000000/ +format %10i 0 = / 0/ +format %10i 1 = / 1/ +format %10i -1 = / -1/ +format %10i 2^30 = /1073741824/ +format %10i -2^30 = /-1073741824/ +format %-10i 0 = /0 / +format %-10i 1 = /1 / +format %-10i -1 = /-1 / +format %-10i 2^30 = /1073741824/ +format %-10i -2^30 = /-1073741824/ +format %+10i 0 = / +0/ +format %+10i 1 = / +1/ +format %+10i -1 = / -1/ +format %+10i 2^30 = /+1073741824/ +format %+10i -2^30 = /-1073741824/ +format % 10i 0 = / 0/ +format % 10i 1 = / 1/ +format % 10i -1 = / -1/ +format % 10i 2^30 = / 1073741824/ +format % 10i -2^30 = /-1073741824/ +format %010i 0 = /0000000000/ +format %010i 1 = /0000000001/ +format %010i -1 = /-000000001/ +format %010i 2^30 = /1073741824/ +format %010i -2^30 = /-1073741824/ +format %#x 0 = /0x0/ +format %#x 1 = /0x1/ +format %#x -1 = /-0x1/ +format %#x 2^30 = /0x40000000/ +format %#x -2^30 = /-0x40000000/ +format %#X 0 = /0X0/ +format %#X 1 = /0X1/ +format %#X -1 = /-0X1/ +format %#X 2^30 = /0X40000000/ +format %#X -2^30 = /-0X40000000/ +format %#o 0 = /0o0/ +format %#o 1 = /0o1/ +format %#o -1 = /-0o1/ +format %#o 2^30 = /0o10000000000/ +format %#o -2^30 = /-0o10000000000/ +format %#10x 0 = / 0x0/ +format %#10x 1 = / 0x1/ +format %#10x -1 = / -0x1/ +format %#10x 2^30 = /0x40000000/ +format %#10x -2^30 = /-0x40000000/ +format %#10X 0 = / 0X0/ +format %#10X 1 = / 0X1/ +format %#10X -1 = / -0X1/ +format %#10X 2^30 = /0X40000000/ +format %#10X -2^30 = /-0X40000000/ +format %#10o 0 = / 0o0/ +format %#10o 1 = / 0o1/ +format %#10o -1 = / -0o1/ +format %#10o 2^30 = /0o10000000000/ +format %#10o -2^30 = /-0o10000000000/ +format %#-10x 0 = /0x0 / +format %#-10x 1 = /0x1 / +format %#-10x -1 = /-0x1 / +format %#-10x 2^30 = /0x40000000/ +format %#-10x -2^30 = /-0x40000000/ +format %#-10X 0 = /0X0 / +format %#-10X 1 = /0X1 / +format %#-10X -1 = /-0X1 / +format %#-10X 2^30 = /0X40000000/ +format %#-10X -2^30 = /-0X40000000/ +format %#-10o 0 = /0o0 / +format %#-10o 1 = /0o1 / +format %#-10o -1 = /-0o1 / +format %#-10o 2^30 = /0o10000000000/ +format %#-10o -2^30 = /-0o10000000000/ +extract 42 0 1 = 0 (passed) +extract 42 0 5 = 10 (passed) +extract 42 0 32 = 42 (passed) +extract 42 0 64 = 42 (passed) +extract 42 1 1 = 1 (passed) +extract 42 1 5 = 21 (passed) +extract 42 1 32 = 21 (passed) +extract 42 1 63 = 21 (passed) +extract 42 1 64 = 21 (passed) +extract 42 1 127 = 21 (passed) +extract 42 1 128 = 21 (passed) +extract 42 69 12 = 0 (passed) +extract -42 0 1 = 0 (passed) +extract -42 0 5 = 22 (passed) +extract -42 0 32 = 4294967254 (passed) +extract -42 0 64 = 18446744073709551574 (passed) +extract -42 1 1 = 1 (passed) +extract -42 1 5 = 11 (passed) +extract -42 1 32 = 4294967275 (passed) +extract -42 1 63 = 9223372036854775787 (passed) +extract -42 1 64 = 18446744073709551595 (passed) +extract -42 1 127 = 170141183460469231731687303715884105707 (passed) +extract -42 1 128 = 340282366920938463463374607431768211435 (passed) +extract -42 69 12 = 4095 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = 15536040655639606317 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = 19 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = 2516587394 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = 7690089207107781587 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = 9888429935207999867003931753264634841 (passed) +signed_extract 42 0 1 = 0 (passed) +signed_extract 42 0 5 = 10 (passed) +signed_extract 42 0 32 = 42 (passed) +signed_extract 42 0 64 = 42 (passed) +signed_extract 42 1 1 = -1 (passed) +signed_extract 42 1 5 = -11 (passed) +signed_extract 42 1 32 = 21 (passed) +signed_extract 42 1 63 = 21 (passed) +signed_extract 42 1 64 = 21 (passed) +signed_extract 42 1 127 = 21 (passed) +signed_extract 42 1 128 = 21 (passed) +signed_extract 42 69 12 = 0 (passed) +signed_extract -42 0 1 = 0 (passed) +signed_extract -42 0 5 = -10 (passed) +signed_extract -42 0 32 = -42 (passed) +signed_extract -42 0 64 = -42 (passed) +signed_extract -42 1 1 = -1 (passed) +signed_extract -42 1 5 = 11 (passed) +signed_extract -42 1 32 = -21 (passed) +signed_extract -42 1 63 = -21 (passed) +signed_extract -42 1 64 = -21 (passed) +signed_extract -42 1 127 = -21 (passed) +signed_extract -42 1 128 = -21 (passed) +signed_extract -42 69 12 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = -2910703418069945299 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = -13 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = -1778379902 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = -1533282829746994221 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = -745394031071327116226524728978121767 (passed) +to_bits 0 + = +marshal round trip 0 + = OK +to_bits 2 + = 02 00 00 00 +marshal round trip 2 + = OK +to_bits -2 + = 02 00 00 00 +marshal round trip -2 + = OK +to_bits 1073741824 + = 00 00 00 40 +marshal round trip 1073741824 + = OK +to_bits -1073741824 + = 00 00 00 40 +marshal round trip -1073741824 + = OK +to_bits 4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip 4611686018427387904 + = OK +to_bits -4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip -4611686018427387904 + = OK +to_bits 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 10 00 00 +marshal round trip 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = OK +to_bits 1329227995784915872903807060280344576 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 +marshal round trip 1329227995784915872903807060280344576 + = OK +to_bits 2658455991569831745807614120560689152 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02 +marshal round trip 2658455991569831745807614120560689152 + = OK +to_bits 1073741823 + = ff ff ff 3f +marshal round trip 1073741823 + = OK +to_bits -1073741824 + = 00 00 00 40 +marshal round trip -1073741824 + = OK +to_bits 2147483647 + = ff ff ff 7f +marshal round trip 2147483647 + = OK +to_bits -2147483648 + = 00 00 00 80 +marshal round trip -2147483648 + = OK +to_bits 9223372036854775807 + = ff ff ff ff ff ff ff 7f +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + = 00 00 00 00 00 00 00 80 +marshal round trip -9223372036854775808 + = OK +to_bits 2147483647 + = ff ff ff 7f +marshal round trip 2147483647 + = OK +to_bits -2147483648 + = 00 00 00 80 +marshal round trip -2147483648 + = OK +testbit 0 (passed) +testbit 1 (passed) +testbit -42 (passed) +testbit 31415926535897932384626433832795028841971693993751058209749445923078164062862089986 (passed) +testbit -2277361236363886404304896 (passed) +numbits / trailing_zeros 0 (passed) +numbits / trailing_zeros 1 (passed) +numbits / trailing_zeros -42 (passed) +numbits / trailing_zeros 1511006158790834639735881728 (passed) +numbits / trailing_zeros -2277361236363886404304896 (passed) +- 0 = 0 +- 1 = -1 +- -1 = 1 +- +inf = -inf +- -inf = +inf +- undef = undef +1/ 0 = +inf +1/ 1 = 1 +1/ -1 = -1 +1/ +inf = 0 +1/ -inf = 0 +1/ undef = undef +abs 0 = 0 +abs 1 = 1 +abs -1 = 1 +abs +inf = +inf +abs -inf = +inf +abs undef = undef +0 + 0 = 0 +0 + 1 = 1 +0 + -1 = -1 +0 + +inf = +inf +0 + -inf = -inf +0 + undef = undef +1 + 0 = 1 +1 + 1 = 2 +1 + -1 = 0 +1 + +inf = +inf +1 + -inf = -inf +1 + undef = undef +-1 + 0 = -1 +-1 + 1 = 0 +-1 + -1 = -2 +-1 + +inf = +inf +-1 + -inf = -inf +-1 + undef = undef ++inf + 0 = +inf ++inf + 1 = +inf ++inf + -1 = +inf ++inf + +inf = +inf ++inf + -inf = undef ++inf + undef = undef +-inf + 0 = -inf +-inf + 1 = -inf +-inf + -1 = -inf +-inf + +inf = undef +-inf + -inf = -inf +-inf + undef = undef +undef + 0 = undef +undef + 1 = undef +undef + -1 = undef +undef + +inf = undef +undef + -inf = undef +undef + undef = undef +0 - 0 = 0 +0 - 1 = -1 +0 - -1 = 1 +0 - +inf = -inf +0 - -inf = +inf +0 - undef = undef +1 - 0 = 1 +1 - 1 = 0 +1 - -1 = 2 +1 - +inf = -inf +1 - -inf = +inf +1 - undef = undef +-1 - 0 = -1 +-1 - 1 = -2 +-1 - -1 = 0 +-1 - +inf = -inf +-1 - -inf = +inf +-1 - undef = undef ++inf - 0 = +inf ++inf - 1 = +inf ++inf - -1 = +inf ++inf - +inf = undef ++inf - -inf = +inf ++inf - undef = undef +-inf - 0 = -inf +-inf - 1 = -inf +-inf - -1 = -inf +-inf - +inf = -inf +-inf - -inf = undef +-inf - undef = undef +undef - 0 = undef +undef - 1 = undef +undef - -1 = undef +undef - +inf = undef +undef - -inf = undef +undef - undef = undef +0 * 0 = 0 +0 * 1 = 0 +0 * -1 = 0 +0 * +inf = undef +0 * -inf = undef +0 * undef = undef +1 * 0 = 0 +1 * 1 = 1 +1 * -1 = -1 +1 * +inf = +inf +1 * -inf = -inf +1 * undef = undef +-1 * 0 = 0 +-1 * 1 = -1 +-1 * -1 = 1 +-1 * +inf = -inf +-1 * -inf = +inf +-1 * undef = undef ++inf * 0 = undef ++inf * 1 = +inf ++inf * -1 = -inf ++inf * +inf = +inf ++inf * -inf = -inf ++inf * undef = undef +-inf * 0 = undef +-inf * 1 = -inf +-inf * -1 = +inf +-inf * +inf = -inf +-inf * -inf = +inf +-inf * undef = undef +undef * 0 = undef +undef * 1 = undef +undef * -1 = undef +undef * +inf = undef +undef * -inf = undef +undef * undef = undef +0 / 0 = undef +0 / 1 = 0 +0 / -1 = 0 +0 / +inf = 0 +0 / -inf = 0 +0 / undef = undef +1 / 0 = +inf +1 / 1 = 1 +1 / -1 = -1 +1 / +inf = 0 +1 / -inf = 0 +1 / undef = undef +-1 / 0 = -inf +-1 / 1 = -1 +-1 / -1 = 1 +-1 / +inf = 0 +-1 / -inf = 0 +-1 / undef = undef ++inf / 0 = +inf ++inf / 1 = +inf ++inf / -1 = -inf ++inf / +inf = undef ++inf / -inf = undef ++inf / undef = undef +-inf / 0 = -inf +-inf / 1 = -inf +-inf / -1 = +inf +-inf / +inf = undef +-inf / -inf = undef +-inf / undef = undef +undef / 0 = undef +undef / 1 = undef +undef / -1 = undef +undef / +inf = undef +undef / -inf = undef +undef / undef = undef +0 * 1/ 0 = undef +0 * 1/ 1 = 0 +0 * 1/ -1 = 0 +0 * 1/ +inf = 0 +0 * 1/ -inf = 0 +0 * 1/ undef = undef +1 * 1/ 0 = +inf +1 * 1/ 1 = 1 +1 * 1/ -1 = -1 +1 * 1/ +inf = 0 +1 * 1/ -inf = 0 +1 * 1/ undef = undef +-1 * 1/ 0 = -inf +-1 * 1/ 1 = -1 +-1 * 1/ -1 = 1 +-1 * 1/ +inf = 0 +-1 * 1/ -inf = 0 +-1 * 1/ undef = undef ++inf * 1/ 0 = +inf ++inf * 1/ 1 = +inf ++inf * 1/ -1 = -inf ++inf * 1/ +inf = undef ++inf * 1/ -inf = undef ++inf * 1/ undef = undef +-inf * 1/ 0 = -inf +-inf * 1/ 1 = -inf +-inf * 1/ -1 = +inf +-inf * 1/ +inf = undef +-inf * 1/ -inf = undef +-inf * 1/ undef = undef +undef * 1/ 0 = undef +undef * 1/ 1 = undef +undef * 1/ -1 = undef +undef * 1/ +inf = undef +undef * 1/ -inf = undef +undef * 1/ undef = undef +mul_2exp (1) 0 = 0 +mul_2exp (1) 1 = 2 +mul_2exp (1) -1 = -2 +mul_2exp (1) +inf = +inf +mul_2exp (1) -inf = -inf +mul_2exp (1) undef = undef +mul_2exp (2) 0 = 0 +mul_2exp (2) 1 = 4 +mul_2exp (2) -1 = -4 +mul_2exp (2) +inf = +inf +mul_2exp (2) -inf = -inf +mul_2exp (2) undef = undef +div_2exp (1) 0 = 0 +div_2exp (1) 1 = 1/2 +div_2exp (1) -1 = -1/2 +div_2exp (1) +inf = +inf +div_2exp (1) -inf = -inf +div_2exp (1) undef = undef +div_2exp (2) 0 = 0 +div_2exp (2) 1 = 1/4 +div_2exp (2) -1 = -1/4 +div_2exp (2) +inf = +inf +div_2exp (2) -inf = -inf +div_2exp (2) undef = undef +identity checking 0 0 +identity checking 0 1 +identity checking 0 -1 +identity checking 0 +inf +identity checking 0 -inf +identity checking 0 undef +identity checking 1 0 +identity checking 1 1 +identity checking 1 -1 +identity checking 1 +inf +identity checking 1 -inf +identity checking 1 undef +identity checking -1 0 +identity checking -1 1 +identity checking -1 -1 +identity checking -1 +inf +identity checking -1 -inf +identity checking -1 undef +identity checking +inf 0 +identity checking +inf 1 +identity checking +inf -1 +identity checking +inf +inf +identity checking +inf -inf +identity checking +inf undef +identity checking -inf 0 +identity checking -inf 1 +identity checking -inf -1 +identity checking -inf +inf +identity checking -inf -inf +identity checking -inf undef +identity checking undef 0 +identity checking undef 1 +identity checking undef -1 +identity checking undef +inf +identity checking undef -inf +identity checking undef undef diff --git a/tests/zq.output-MPIR-64 b/tests/zq.output-MPIR-64 new file mode 100644 index 0000000..5c09e7e --- /dev/null +++ b/tests/zq.output-MPIR-64 @@ -0,0 +1,1373 @@ +0 + = 0 +1 + = 1 +-1 + = -1 +42 + = 42 +1+1 + = 2 +1-1 + = 0 +- 1 + = -1 +0-1 + = -1 +max_int + = 4611686018427387903 +min_int + = -4611686018427387904 +-max_int + = -4611686018427387903 +-min_int + = 4611686018427387904 +2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 + = 1329227995784915872903807060280344576 +2^300+2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^300+(-(2^120)) + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120-2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-(2^120)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-(2^120)-2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^300 + = 0 +2^121 + = 2658455991569831745807614120560689152 +2^121+2^120 + = 3987683987354747618711421180841033728 +2^121-2^120 + = 1329227995784915872903807060280344576 +2^121+(-(2^120)) + = 1329227995784915872903807060280344576 +2^120-2^121 + = -1329227995784915872903807060280344576 +2^120+(-(2^121)) + = -1329227995784915872903807060280344576 +-(2^120)+(-(2^121)) + = -3987683987354747618711421180841033728 +-(2^120)-2^121 + = -3987683987354747618711421180841033728 +2^121+0 + = 2658455991569831745807614120560689152 +2^121-0 + = 2658455991569831745807614120560689152 +0+2^121 + = 2658455991569831745807614120560689152 +0-2^121 + = -2658455991569831745807614120560689152 +2^300+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^300-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300+(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300-(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)-(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +max_int+1 + = 4611686018427387904 +min_int-1 + = -4611686018427387905 +-max_int-1 + = -4611686018427387904 +-min_int-1 + = 4611686018427387903 +5! = 120 +12! = 479001600 +15! = 1307674368000 +20! = 2432902008176640000 +25! = 15511210043330985984000000 +50! = 30414093201713378043612608166064768844377641568960512000000000000 +2^300*2^120 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*2^300 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^300*(-(2^120)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*(-(2^300)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +-(2^120)*(-(2^300)) + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^121*2^120 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^120*2^121 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^121*0 + = 0 +0*2^121 + = 0 +2^300*1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300*(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(2^30) + = 1073741824 +1*(2^62) + = 4611686018427387904 +(2^30)*(2^30) + = 1152921504606846976 +(2^62)*(2^62) + = 21267647932558653966460912964485513216 +0+1 + = 1 +1+1 + = 2 +-1+1 + = 0 +2+1 + = 3 +-2+1 + = -1 +(2^300)+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0-1 + = -1 +1-1 + = 0 +-1-1 + = -2 +2-1 + = 1 +-2-1 + = -3 +(2^300)-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +max_int+1 + = 4611686018427387904 +min_int-1 + = -4611686018427387905 +-max_int-1 + = -4611686018427387904 +-min_int-1 + = 4611686018427387903 +abs(0) + = 0 +abs(1) + = 1 +abs(-1) + = 1 +abs(min_int) + = 4611686018427387904 +abs(2^300) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +abs(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +max_natint + = 9223372036854775807 +max_int32 + = 2147483647 +max_int64 + = 9223372036854775807 +to_int 1 + = 1 +to_int max_int + = 4611686018427387903 +to_int max_natint + = ovf +to_int max_int32 + = 2147483647 +to_int max_int64 + = ovf +to_int32 1 + = 1 +to_int32 max_int + = ovf +to_int32 max_natint + = ovf +to_int32 max_int32 + = 2147483647 +to_int32 max_int64 + = ovf +to_int64 1 + = 1 +to_int64 max_int + = 4611686018427387903 +to_int64 max_natint + = 9223372036854775807 +to_int64 max_int32 + = 2147483647 +to_int64 max_int64 + = 9223372036854775807 +to_natint 1 + = 1 +to_natint max_int + = 4611686018427387903 +to_natint max_natint + = 9223372036854775807 +to_natint max_int32 + = 2147483647 +to_natint max_int64 + = 9223372036854775807 +to_int -min_int + = ovf +to_int -min_natint + = ovf +to_int -min_int32 + = 2147483648 +to_int -min_int64 + = ovf +to_int32 -min_int + = ovf +to_int32 -min_natint + = ovf +to_int32 -min_int32 + = ovf +to_int32 -min_int64 + = ovf +to_int64 -min_int + = 4611686018427387904 +to_int64 -min_natint + = ovf +to_int64 -min_int32 + = 2147483648 +to_int64 -min_int64 + = ovf +to_natint -min_int + = 4611686018427387904 +to_natint -min_natint + = ovf +to_natint -min_int32 + = 2147483648 +to_natint -min_int64 + = ovf +of_float 1. + = 1 +of_float -1. + = -1 +of_float pi + = 3 +of_float 2^30 + = 1073741824 +of_float 2^31 + = 2147483648 +of_float 2^32 + = 4294967296 +of_float 2^33 + = 8589934592 +of_float -2^30 + = -1073741824 +of_float -2^31 + = -2147483648 +of_float -2^32 + = -4294967296 +of_float -2^33 + = -8589934592 +of_float 2^61 + = 2305843009213693952 +of_float 2^62 + = 4611686018427387904 +of_float 2^63 + = 9223372036854775808 +of_float 2^64 + = 18446744073709551616 +of_float 2^65 + = 36893488147419103232 +of_float -2^61 + = -2305843009213693952 +of_float -2^62 + = -4611686018427387904 +of_float -2^63 + = -9223372036854775808 +of_float -2^64 + = -18446744073709551616 +of_float -2^65 + = -36893488147419103232 +of_float 2^120 + = 1329227995784915872903807060280344576 +of_float 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float -2^120 + = -1329227995784915872903807060280344576 +of_float -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float 0.5 + = 0 +of_float -0.5 + = 0 +of_float 200.5 + = 200 +of_float -200.5 + = -200 +to_float 0 + = OK +to_float 1 + = OK +to_float -1 + = OK +to_float 2^120 + = OK +to_float -2^120 + = OK +to_float (2^120-1) + = OK +to_float (-2^120+1) + = OK +to_float 2^63 + = OK +to_float -2^63 + = OK +to_float (2^63-1) + = OK +to_float (-2^63-1) + = OK +to_float (-2^63+1) + = OK +to_float 2^300 + = OK +to_float -2^300 + = OK +to_float (2^300-1) + = OK +to_float (-2^300+1) + = OK +of_string 12 + = 12 +of_string 0x12 + = 18 +of_string 0b10 + = 2 +of_string 0o12 + = 10 +of_string -12 + = -12 +of_string -0x12 + = -18 +of_string -0b10 + = -2 +of_string -0o12 + = -10 +of_string 000123456789012345678901234567890 + = 123456789012345678901234567890 +2^120 / 2^300 (trunc) + = 0 +max_int / 2 (trunc) + = 2305843009213693951 +(2^300+1) / 2^120 (trunc) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (trunc) + = 1532495540865888858358347027150309183618739122183602176 +2^120 / 2^300 (ceil) + = 1 +max_int / 2 (ceil) + = 2305843009213693952 +(2^300+1) / 2^120 (ceil) + = 1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / 2^120 (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (ceil) + = 1532495540865888858358347027150309183618739122183602177 +2^120 / 2^300 (floor) + = 0 +max_int / 2 (floor) + = 2305843009213693951 +(2^300+1) / 2^120 (floor) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (floor) + = -1532495540865888858358347027150309183618739122183602177 +(2^300+1) / (-(2^120)) (floor) + = -1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / (-(2^120)) (floor) + = 1532495540865888858358347027150309183618739122183602176 +2^120 % 2^300 + = 1329227995784915872903807060280344576 +max_int % 2 + = 1 +(2^300+1) % 2^120 + = 1 +(-(2^300+1)) % 2^120 + = -1 +(2^300+1) % (-(2^120)) + = 1 +(-(2^300+1)) % (-(2^120)) + = -1 +2^120 /,% 2^300 + = 0, 1329227995784915872903807060280344576 +max_int /,% 2 + = 2305843009213693951, 1 +(2^300+1) /,% 2^120 + = 1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% 2^120 + = -1532495540865888858358347027150309183618739122183602176, -1 +(2^300+1) /,% (-(2^120)) + = -1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% (-(2^120)) + = 1532495540865888858358347027150309183618739122183602176, -1 +1 & 2 + = 0 +1 & 2^300 + = 0 +2^120 & 2^300 + = 0 +2^300 & 2^120 + = 0 +2^300 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 & 0 + = 0 +-2^120 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + 2^120 & -2^300 + = 0 +-2^120 & -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & 2^120 + = 0 + 2^300 & -2^120 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & -2^120 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1 | 2 + = 3 +1 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 | 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 | 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 | 2^300 + = -1329227995784915872903807060280344576 + 2^120 | -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 | -2^300 + = -1329227995784915872903807060280344576 +-2^300 | 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 | -2^120 + = -1329227995784915872903807060280344576 +-2^300 | -2^120 + = -1329227995784915872903807060280344576 +1 ^ 2 + = 3 +1 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^300 + = 0 +2^300 ^ 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 ^ 2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 + 2^120 ^ -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 ^ -2^300 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^300 ^ 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 ^ -2^120 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-2^300 ^ -2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +~0 + = -1 +~1 + = -2 +~2 + = -3 +~2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +~(-1) + = 0 +~(-2) + = 1 +~(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0 >> 1 + = 0 +0 >> 100 + = 0 +2 >> 1 + = 1 +2 >> 2 + = 0 +2 >> 100 + = 0 +2^300 >> 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >> 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >> 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >> 200 + = 1267650600228229401496703205376 +2^300 >> 300 + = 1 +2^300 >> 400 + = 0 +-1 >> 1 + = -1 +-2 >> 1 + = -1 +-2 >> 2 + = -1 +-2 >> 100 + = -1 +-2^300 >> 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >> 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >> 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >> 200 + = -1267650600228229401496703205376 +-2^300 >> 300 + = -1 +-2^300 >> 400 + = -1 +0 >>0 1 + = 0 +0 >>0 100 + = 0 +2 >>0 1 + = 1 +2 >>0 2 + = 0 +2 >>0 100 + = 0 +2^300 >>0 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >>0 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >>0 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >>0 200 + = 1267650600228229401496703205376 +2^300 >>0 300 + = 1 +2^300 >>0 400 + = 0 +-1 >>0 1 + = 0 +-2 >>0 1 + = -1 +-2 >>0 2 + = 0 +-2 >>0 100 + = 0 +-2^300 >>0 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >>0 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >>0 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >>0 200 + = -1267650600228229401496703205376 +-2^300 >>0 300 + = -1 +-2^300 >>0 400 + = 0 +0 << 1 + = 0 +0 << 100 + = 0 +2 << 1 + = 4 +2 << 32 + = 8589934592 +2 << 64 + = 36893488147419103232 +2 << 299 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 << 1 + = 2658455991569831745807614120560689152 +2^120 << 180 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +compare 1 2 + = -1 +compare 1 1 + = 0 +compare 2 1 + = 1 +compare 2^300 2^120 + = 1 +compare 2^120 2^120 + = 0 +compare 2^120 2^300 + = -1 +compare 2^121 2^120 + = 1 +compare 2^120 2^121 + = -1 +compare 2^300 -2^120 + = 1 +compare 2^120 -2^120 + = 1 +compare 2^120 -2^300 + = 1 +compare -2^300 2^120 + = -1 +compare -2^120 2^120 + = -1 +compare -2^120 2^300 + = -1 +compare -2^300 -2^120 + = -1 +compare -2^120 -2^120 + = 0 +compare -2^120 -2^300 + = 1 +equal 1 2 + = false +equal 1 1 + = true +equal 2 1 + = false +equal 2^300 2^120 + = false +equal 2^120 2^120 + = true +equal 2^120 2^300 + = false +equal 2^121 2^120 + = false +equal 2^120 2^121 + = false +equal 2^120 -2^120 + = false +equal -2^120 2^120 + = false +equal -2^120 -2^120 + = true +sign 0 + = 0 +sign 1 + = 1 +sign -1 + = -1 +sign 2^300 + = 1 +sign -2^300 + = -1 +gcd 0 0 + = 0 +gcd 0 -137 + = 137 +gcd 12 27 + = 3 +gcd 27 12 + = 3 +gcd 27 27 + = 27 +gcd -12 27 + = 3 +gcd 12 -27 + = 3 +gcd -12 -27 + = 3 +gcd 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 2^120 + = 1329227995784915872903807060280344576 +gcd 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 -2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 -2^120 + = 1329227995784915872903807060280344576 +gcdext 12 27 + = 3, -2, 1 +gcdext 27 12 + = 3, 1, -2 +gcdext 27 27 + = 27, 0, 1 +gcdext -12 27 + = 3, 2, 1 +gcdext 12 -27 + = 3, -2, -1 +gcdext -12 -27 + = 3, 2, -1 +gcdext 2^120 2^300 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 2^300 2^120 + = 1329227995784915872903807060280344576, 0, 1 +gcdext 12 0 + = 12, 1, 0 +gcdext 0 27 + = 27, 0, 1 +gcdext -12 0 + = 12, -1, 0 +gcdext 0 -27 + = 27, 0, -1 +gcdext 2^120 0 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, 1 +gcdext -2^120 0 + = 1329227995784915872903807060280344576, -1, 0 +gcdext 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, -1 +gcdext 0 0 + = 0, 0, 0 +lcm 0 0 = 0 +lcm 10 12 = 60 +lcm -10 12 = 60 +lcm 10 -12 = 60 +lcm -10 -12 = 60 +lcm 0 12 = 0 +lcm 0 -12 = 0 +lcm 10 0 = 0 +lcm -10 0 = 0 +lcm 2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 0 = 0 +lcm -2^120 0 = 0 +is_odd 0 + = false +is_odd 1 + = true +is_odd 2 + = false +is_odd 3 + = true +is_odd 2^120 + = false +is_odd 2^120+1 + = true +is_odd 2^300 + = false +is_odd 2^300+1 + = true +sqrt 0 + = 0 +sqrt 1 + = 1 +sqrt 2 + = 1 +sqrt 2^120 + = 1152921504606846976 +sqrt 2^121 + = 1630477228166597776 +sqrt_rem 0 + = 0, 0 +sqrt_rem 1 + = 1, 0 +sqrt_rem 2 + = 1, 1 +sqrt_rem 2^120 + = 1152921504606846976, 0 +sqrt_rem 2^121 + = 1630477228166597776, 1772969445592542976 +popcount 0 + = 0 +popcount 1 + = 1 +popcount 2 + = 1 +popcount max_int32 + = 31 +popcount 2^120 + = 1 +popcount (2^120-1) + = 120 +hamdist 0 0 + = 0 +hamdist 0 1 + = 1 +hamdist 0 2^300 + = 1 +hamdist 2^120 2^120 + = 0 +hamdist 2^120 (2^120-1) + = 121 +hamdist 2^120 2^300 + = 2 +hamdist (2^120-1) (2^300-1) + = 180 +hash(2^120) + = 691199303 +hash(2^121) + = 382412560 +hash(2^300) + = 61759632 +2^120 = 2^300 + = false +2^120 = 2^120 + = true +2^120 = 2^120 + = true +2^120 > 2^300 + = false +2^120 < 2^300 + = true +2^120 = 1 + = false +2^120 > 1 + = true +2^120 < 1 + = false +-2^120 > 1 + = false +-2^120 < 1 + = true +demarshal 2^120, 2^300, 1 + = 1329227995784915872903807060280344576, 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 1 +demarshal -2^120, -2^300, -1 + = -1329227995784915872903807060280344576, -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, -1 +format %i 0 = /0/ +format %i 1 = /1/ +format %i -1 = /-1/ +format %i 2^30 = /1073741824/ +format %i -2^30 = /-1073741824/ +format % i 1 = / 1/ +format %+i 1 = /+1/ +format %x 0 = /0/ +format %x 1 = /1/ +format %x -1 = /-1/ +format %x 2^30 = /40000000/ +format %x -2^30 = /-40000000/ +format %X 0 = /0/ +format %X 1 = /1/ +format %X -1 = /-1/ +format %X 2^30 = /40000000/ +format %X -2^30 = /-40000000/ +format %o 0 = /0/ +format %o 1 = /1/ +format %o -1 = /-1/ +format %o 2^30 = /10000000000/ +format %o -2^30 = /-10000000000/ +format %10i 0 = / 0/ +format %10i 1 = / 1/ +format %10i -1 = / -1/ +format %10i 2^30 = /1073741824/ +format %10i -2^30 = /-1073741824/ +format %-10i 0 = /0 / +format %-10i 1 = /1 / +format %-10i -1 = /-1 / +format %-10i 2^30 = /1073741824/ +format %-10i -2^30 = /-1073741824/ +format %+10i 0 = / +0/ +format %+10i 1 = / +1/ +format %+10i -1 = / -1/ +format %+10i 2^30 = /+1073741824/ +format %+10i -2^30 = /-1073741824/ +format % 10i 0 = / 0/ +format % 10i 1 = / 1/ +format % 10i -1 = / -1/ +format % 10i 2^30 = / 1073741824/ +format % 10i -2^30 = /-1073741824/ +format %010i 0 = /0000000000/ +format %010i 1 = /0000000001/ +format %010i -1 = /-000000001/ +format %010i 2^30 = /1073741824/ +format %010i -2^30 = /-1073741824/ +format %#x 0 = /0x0/ +format %#x 1 = /0x1/ +format %#x -1 = /-0x1/ +format %#x 2^30 = /0x40000000/ +format %#x -2^30 = /-0x40000000/ +format %#X 0 = /0X0/ +format %#X 1 = /0X1/ +format %#X -1 = /-0X1/ +format %#X 2^30 = /0X40000000/ +format %#X -2^30 = /-0X40000000/ +format %#o 0 = /0o0/ +format %#o 1 = /0o1/ +format %#o -1 = /-0o1/ +format %#o 2^30 = /0o10000000000/ +format %#o -2^30 = /-0o10000000000/ +format %#10x 0 = / 0x0/ +format %#10x 1 = / 0x1/ +format %#10x -1 = / -0x1/ +format %#10x 2^30 = /0x40000000/ +format %#10x -2^30 = /-0x40000000/ +format %#10X 0 = / 0X0/ +format %#10X 1 = / 0X1/ +format %#10X -1 = / -0X1/ +format %#10X 2^30 = /0X40000000/ +format %#10X -2^30 = /-0X40000000/ +format %#10o 0 = / 0o0/ +format %#10o 1 = / 0o1/ +format %#10o -1 = / -0o1/ +format %#10o 2^30 = /0o10000000000/ +format %#10o -2^30 = /-0o10000000000/ +format %#-10x 0 = /0x0 / +format %#-10x 1 = /0x1 / +format %#-10x -1 = /-0x1 / +format %#-10x 2^30 = /0x40000000/ +format %#-10x -2^30 = /-0x40000000/ +format %#-10X 0 = /0X0 / +format %#-10X 1 = /0X1 / +format %#-10X -1 = /-0X1 / +format %#-10X 2^30 = /0X40000000/ +format %#-10X -2^30 = /-0X40000000/ +format %#-10o 0 = /0o0 / +format %#-10o 1 = /0o1 / +format %#-10o -1 = /-0o1 / +format %#-10o 2^30 = /0o10000000000/ +format %#-10o -2^30 = /-0o10000000000/ +extract 42 0 1 = 0 (passed) +extract 42 0 5 = 10 (passed) +extract 42 0 32 = 42 (passed) +extract 42 0 64 = 42 (passed) +extract 42 1 1 = 1 (passed) +extract 42 1 5 = 21 (passed) +extract 42 1 32 = 21 (passed) +extract 42 1 63 = 21 (passed) +extract 42 1 64 = 21 (passed) +extract 42 1 127 = 21 (passed) +extract 42 1 128 = 21 (passed) +extract 42 69 12 = 0 (passed) +extract -42 0 1 = 0 (passed) +extract -42 0 5 = 22 (passed) +extract -42 0 32 = 4294967254 (passed) +extract -42 0 64 = 18446744073709551574 (passed) +extract -42 1 1 = 1 (passed) +extract -42 1 5 = 11 (passed) +extract -42 1 32 = 4294967275 (passed) +extract -42 1 63 = 9223372036854775787 (passed) +extract -42 1 64 = 18446744073709551595 (passed) +extract -42 1 127 = 170141183460469231731687303715884105707 (passed) +extract -42 1 128 = 340282366920938463463374607431768211435 (passed) +extract -42 69 12 = 4095 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = 15536040655639606317 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = 19 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = 2516587394 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = 7690089207107781587 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = 9888429935207999867003931753264634841 (passed) +signed_extract 42 0 1 = 0 (passed) +signed_extract 42 0 5 = 10 (passed) +signed_extract 42 0 32 = 42 (passed) +signed_extract 42 0 64 = 42 (passed) +signed_extract 42 1 1 = -1 (passed) +signed_extract 42 1 5 = -11 (passed) +signed_extract 42 1 32 = 21 (passed) +signed_extract 42 1 63 = 21 (passed) +signed_extract 42 1 64 = 21 (passed) +signed_extract 42 1 127 = 21 (passed) +signed_extract 42 1 128 = 21 (passed) +signed_extract 42 69 12 = 0 (passed) +signed_extract -42 0 1 = 0 (passed) +signed_extract -42 0 5 = -10 (passed) +signed_extract -42 0 32 = -42 (passed) +signed_extract -42 0 64 = -42 (passed) +signed_extract -42 1 1 = -1 (passed) +signed_extract -42 1 5 = 11 (passed) +signed_extract -42 1 32 = -21 (passed) +signed_extract -42 1 63 = -21 (passed) +signed_extract -42 1 64 = -21 (passed) +signed_extract -42 1 127 = -21 (passed) +signed_extract -42 1 128 = -21 (passed) +signed_extract -42 69 12 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = -2910703418069945299 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = -13 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = -1778379902 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = -1533282829746994221 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = -745394031071327116226524728978121767 (passed) +to_bits 0 + = +marshal round trip 0 + = OK +to_bits 2 + = 02 00 00 00 00 00 00 00 +marshal round trip 2 + = OK +to_bits -2 + = 02 00 00 00 00 00 00 00 +marshal round trip -2 + = OK +to_bits 1073741824 + = 00 00 00 40 00 00 00 00 +marshal round trip 1073741824 + = OK +to_bits -1073741824 + = 00 00 00 40 00 00 00 00 +marshal round trip -1073741824 + = OK +to_bits 4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip 4611686018427387904 + = OK +to_bits -4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip -4611686018427387904 + = OK +to_bits 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 10 00 00 +marshal round trip 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = OK +to_bits 1329227995784915872903807060280344576 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 +marshal round trip 1329227995784915872903807060280344576 + = OK +to_bits 2658455991569831745807614120560689152 + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02 +marshal round trip 2658455991569831745807614120560689152 + = OK +to_bits 4611686018427387903 + = ff ff ff ff ff ff ff 3f +marshal round trip 4611686018427387903 + = OK +to_bits -4611686018427387904 + = 00 00 00 00 00 00 00 40 +marshal round trip -4611686018427387904 + = OK +to_bits 2147483647 + = ff ff ff 7f 00 00 00 00 +marshal round trip 2147483647 + = OK +to_bits -2147483648 + = 00 00 00 80 00 00 00 00 +marshal round trip -2147483648 + = OK +to_bits 9223372036854775807 + = ff ff ff ff ff ff ff 7f +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + = 00 00 00 00 00 00 00 80 +marshal round trip -9223372036854775808 + = OK +to_bits 9223372036854775807 + = ff ff ff ff ff ff ff 7f +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + = 00 00 00 00 00 00 00 80 +marshal round trip -9223372036854775808 + = OK +testbit 0 (passed) +testbit 1 (passed) +testbit -42 (passed) +testbit 31415926535897932384626433832795028841971693993751058209749445923078164062862089986 (passed) +testbit -2277361236363886404304896 (passed) +numbits / trailing_zeros 0 (passed) +numbits / trailing_zeros 1 (passed) +numbits / trailing_zeros -42 (passed) +numbits / trailing_zeros 1511006158790834639735881728 (passed) +numbits / trailing_zeros -2277361236363886404304896 (passed) +- 0 = 0 +- 1 = -1 +- -1 = 1 +- +inf = -inf +- -inf = +inf +- undef = undef +1/ 0 = +inf +1/ 1 = 1 +1/ -1 = -1 +1/ +inf = 0 +1/ -inf = 0 +1/ undef = undef +abs 0 = 0 +abs 1 = 1 +abs -1 = 1 +abs +inf = +inf +abs -inf = +inf +abs undef = undef +0 + 0 = 0 +0 + 1 = 1 +0 + -1 = -1 +0 + +inf = +inf +0 + -inf = -inf +0 + undef = undef +1 + 0 = 1 +1 + 1 = 2 +1 + -1 = 0 +1 + +inf = +inf +1 + -inf = -inf +1 + undef = undef +-1 + 0 = -1 +-1 + 1 = 0 +-1 + -1 = -2 +-1 + +inf = +inf +-1 + -inf = -inf +-1 + undef = undef ++inf + 0 = +inf ++inf + 1 = +inf ++inf + -1 = +inf ++inf + +inf = +inf ++inf + -inf = undef ++inf + undef = undef +-inf + 0 = -inf +-inf + 1 = -inf +-inf + -1 = -inf +-inf + +inf = undef +-inf + -inf = -inf +-inf + undef = undef +undef + 0 = undef +undef + 1 = undef +undef + -1 = undef +undef + +inf = undef +undef + -inf = undef +undef + undef = undef +0 - 0 = 0 +0 - 1 = -1 +0 - -1 = 1 +0 - +inf = -inf +0 - -inf = +inf +0 - undef = undef +1 - 0 = 1 +1 - 1 = 0 +1 - -1 = 2 +1 - +inf = -inf +1 - -inf = +inf +1 - undef = undef +-1 - 0 = -1 +-1 - 1 = -2 +-1 - -1 = 0 +-1 - +inf = -inf +-1 - -inf = +inf +-1 - undef = undef ++inf - 0 = +inf ++inf - 1 = +inf ++inf - -1 = +inf ++inf - +inf = undef ++inf - -inf = +inf ++inf - undef = undef +-inf - 0 = -inf +-inf - 1 = -inf +-inf - -1 = -inf +-inf - +inf = -inf +-inf - -inf = undef +-inf - undef = undef +undef - 0 = undef +undef - 1 = undef +undef - -1 = undef +undef - +inf = undef +undef - -inf = undef +undef - undef = undef +0 * 0 = 0 +0 * 1 = 0 +0 * -1 = 0 +0 * +inf = undef +0 * -inf = undef +0 * undef = undef +1 * 0 = 0 +1 * 1 = 1 +1 * -1 = -1 +1 * +inf = +inf +1 * -inf = -inf +1 * undef = undef +-1 * 0 = 0 +-1 * 1 = -1 +-1 * -1 = 1 +-1 * +inf = -inf +-1 * -inf = +inf +-1 * undef = undef ++inf * 0 = undef ++inf * 1 = +inf ++inf * -1 = -inf ++inf * +inf = +inf ++inf * -inf = -inf ++inf * undef = undef +-inf * 0 = undef +-inf * 1 = -inf +-inf * -1 = +inf +-inf * +inf = -inf +-inf * -inf = +inf +-inf * undef = undef +undef * 0 = undef +undef * 1 = undef +undef * -1 = undef +undef * +inf = undef +undef * -inf = undef +undef * undef = undef +0 / 0 = undef +0 / 1 = 0 +0 / -1 = 0 +0 / +inf = 0 +0 / -inf = 0 +0 / undef = undef +1 / 0 = +inf +1 / 1 = 1 +1 / -1 = -1 +1 / +inf = 0 +1 / -inf = 0 +1 / undef = undef +-1 / 0 = -inf +-1 / 1 = -1 +-1 / -1 = 1 +-1 / +inf = 0 +-1 / -inf = 0 +-1 / undef = undef ++inf / 0 = +inf ++inf / 1 = +inf ++inf / -1 = -inf ++inf / +inf = undef ++inf / -inf = undef ++inf / undef = undef +-inf / 0 = -inf +-inf / 1 = -inf +-inf / -1 = +inf +-inf / +inf = undef +-inf / -inf = undef +-inf / undef = undef +undef / 0 = undef +undef / 1 = undef +undef / -1 = undef +undef / +inf = undef +undef / -inf = undef +undef / undef = undef +0 * 1/ 0 = undef +0 * 1/ 1 = 0 +0 * 1/ -1 = 0 +0 * 1/ +inf = 0 +0 * 1/ -inf = 0 +0 * 1/ undef = undef +1 * 1/ 0 = +inf +1 * 1/ 1 = 1 +1 * 1/ -1 = -1 +1 * 1/ +inf = 0 +1 * 1/ -inf = 0 +1 * 1/ undef = undef +-1 * 1/ 0 = -inf +-1 * 1/ 1 = -1 +-1 * 1/ -1 = 1 +-1 * 1/ +inf = 0 +-1 * 1/ -inf = 0 +-1 * 1/ undef = undef ++inf * 1/ 0 = +inf ++inf * 1/ 1 = +inf ++inf * 1/ -1 = -inf ++inf * 1/ +inf = undef ++inf * 1/ -inf = undef ++inf * 1/ undef = undef +-inf * 1/ 0 = -inf +-inf * 1/ 1 = -inf +-inf * 1/ -1 = +inf +-inf * 1/ +inf = undef +-inf * 1/ -inf = undef +-inf * 1/ undef = undef +undef * 1/ 0 = undef +undef * 1/ 1 = undef +undef * 1/ -1 = undef +undef * 1/ +inf = undef +undef * 1/ -inf = undef +undef * 1/ undef = undef +mul_2exp (1) 0 = 0 +mul_2exp (1) 1 = 2 +mul_2exp (1) -1 = -2 +mul_2exp (1) +inf = +inf +mul_2exp (1) -inf = -inf +mul_2exp (1) undef = undef +mul_2exp (2) 0 = 0 +mul_2exp (2) 1 = 4 +mul_2exp (2) -1 = -4 +mul_2exp (2) +inf = +inf +mul_2exp (2) -inf = -inf +mul_2exp (2) undef = undef +div_2exp (1) 0 = 0 +div_2exp (1) 1 = 1/2 +div_2exp (1) -1 = -1/2 +div_2exp (1) +inf = +inf +div_2exp (1) -inf = -inf +div_2exp (1) undef = undef +div_2exp (2) 0 = 0 +div_2exp (2) 1 = 1/4 +div_2exp (2) -1 = -1/4 +div_2exp (2) +inf = +inf +div_2exp (2) -inf = -inf +div_2exp (2) undef = undef +identity checking 0 0 +identity checking 0 1 +identity checking 0 -1 +identity checking 0 +inf +identity checking 0 -inf +identity checking 0 undef +identity checking 1 0 +identity checking 1 1 +identity checking 1 -1 +identity checking 1 +inf +identity checking 1 -inf +identity checking 1 undef +identity checking -1 0 +identity checking -1 1 +identity checking -1 -1 +identity checking -1 +inf +identity checking -1 -inf +identity checking -1 undef +identity checking +inf 0 +identity checking +inf 1 +identity checking +inf -1 +identity checking +inf +inf +identity checking +inf -inf +identity checking +inf undef +identity checking -inf 0 +identity checking -inf 1 +identity checking -inf -1 +identity checking -inf +inf +identity checking -inf -inf +identity checking -inf undef +identity checking undef 0 +identity checking undef 1 +identity checking undef -1 +identity checking undef +inf +identity checking undef -inf +identity checking undef undef diff --git a/z.mlip b/z.mlip index 4c70e3f..1e85b77 100644 --- a/z.mlip +++ b/z.mlip @@ -713,6 +713,12 @@ end val version: string (** Library version (this file refers to version [@VERSION]). *) +val backend: string +(** Backend implementing large integer operations. + Can be GMP, MPIR, LibTomMath. + This file refers to [@BACKEND]. + *) + (**/**) (** For internal use in module [Q]. *) diff --git a/z.mlp b/z.mlp index 09377ab..f5ffcdc 100644 --- a/z.mlp +++ b/z.mlp @@ -251,3 +251,4 @@ module Compare = struct end let version = @VERSION +let backend = @BACKEND diff --git a/z_pp.pl b/z_pp.pl index c7a1029..9b0e522 100755 --- a/z_pp.pl +++ b/z_pp.pl @@ -33,6 +33,10 @@ $noalloc = "\"noalloc\""; } +# backend, from Makefile +$b = `grep BACKEND Makefile`; +($backend) = $b =~ /BACKEND\s*=\s*(\S+)/; + # scan assembly $ASM = "caml_z_${ARGV[0]}.S"; @@ -71,6 +75,7 @@ sub doml { $l =~ s/$f\@ASM/$r/g; } $l =~ s/\@VERSION/$ver/; + $l =~ s/\@BACKEND/\"$backend\"/; $l =~ s/\@NOALLOC/$noalloc/; print O "$l"; } From 20d7625dd828c234757ad00d255b6a6eda0044a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Fri, 31 Jul 2020 19:33:36 +0200 Subject: [PATCH 08/27] changed backend detection in tests --- tests/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/Makefile b/tests/Makefile index b5307bc..29a9037 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -1,6 +1,6 @@ -WORDSIZE:=$(shell echo 'print_int Sys.word_size' | ocaml -stdin) +WORDSIZE:=$(shell echo print_int Sys.word_size | ocaml -stdin) +BACKEND:=$(shell echo print_string Z.backend | ocaml -I .. zarith.cma -stdin) STDLIBDIR:=$(shell ocamlc -where) -BACKEND:=$(shell grep BACKEND ../Makefile | sed s/BACKEND=//) ifeq ($(wildcard $(STDLIBDIR)/big_int.cmi),) HAS_NUM=false NUMS_CMA= From 1b2a460ec3f2af6818a1fb8261addbd5bc8984c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Mon, 17 Aug 2020 11:02:25 +0200 Subject: [PATCH 09/27] hash function that gives the same result as the GMP one independent from the digit size used by LibTomMath. --- caml_z_tommath.c | 59 ++++++++++++++++++++++++++--------- tests/zq.output-LibTomMath-64 | 6 ++-- 2 files changed, 48 insertions(+), 17 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 1c7611a..21515c9 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -1736,28 +1736,59 @@ int ml_z_custom_compare(value arg1, value arg2) static intnat ml_z_custom_hash(value v) { - /* TODO: the hash depends on the platform */ if (Is_long(v)) { + intnat n = Long_val(v); + intnat a = n >= 0 ? n : -n; + uint32_t h; #ifdef ARCH_SIXTYFOUR - return caml_hash_mix_uint32((uint32_t)v, (uint32_t)(v >> 32)); + h = caml_hash_mix_uint32((uint32_t)a, (uint32_t)(a >> 32)); #else - return v; + h = a; #endif + if (n < 0) h++; + return h; } else { - uint32_t r = 0; - int i; + uint32_t acc = 0; mp_digit* p; - if (mp_isneg(Z_MP(v))) r = 1; - for (i=0, p=Z_MP(v)->dp; i < Z_MP(v)->used; i++, p++) { -#ifdef MP_64BIT - r = caml_hash_mix_uint32(r, (uint32_t)*p); - r = caml_hash_mix_uint32(r, (uint32_t)((*p) >> 32)); -#else - r = caml_hash_mix_uint32(r, (uint32_t)*p); -#endif + uint32_t word = 0; // 32-bit word in construction + int bits = 0; // actual bits in word + size_t nb = 0; // nb words + size_t i; + + for (p = Z_MP(v)->dp, i = Z_MP(v)->used; i > 0; p++, i--) { + // eat a new digit + mp_digit d = *p; + word |= (uint32_t)d << bits; + bits += MP_DIGIT_BIT; + if (bits >= 32) { + // word complete + nb++; + acc = caml_hash_mix_uint32(acc, word); + // remaining bits in d + bits -= 32; + d >>= MP_DIGIT_BIT - bits; + while (bits >= 32 && (d || i > 1)) { + // additional words + nb++; + acc = caml_hash_mix_uint32(acc, d); + bits -= 32; + d >>= 32; + } + word = d; + } } - return r; + if (bits > 0 && word) { + // last piece of digit + nb++; + acc = caml_hash_mix_uint32(acc, word); + } + /* ensure an even number of words (compatibility with 64-bit GMP) */ + if (nb % 2 != 0) { + acc = caml_hash_mix_uint32(acc, 0); + } + if (mp_isneg(Z_MP(v))) acc++; + return acc; } } diff --git a/tests/zq.output-LibTomMath-64 b/tests/zq.output-LibTomMath-64 index ba54289..b4827d5 100644 --- a/tests/zq.output-LibTomMath-64 +++ b/tests/zq.output-LibTomMath-64 @@ -826,11 +826,11 @@ popcount (2^120-1) = 120 Failure: Z.hamdist: not implemented in LibTomMath backend hash(2^120) - = 900619431 + = 691199303 hash(2^121) - = 324032971 + = 382412560 hash(2^300) - = 49167343 + = 61759632 2^120 = 2^300 = false 2^120 = 2^120 From 7cce0ffb10c8363fc7b568dadaff1a0a6f87ad10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Mon, 17 Aug 2020 11:13:13 +0200 Subject: [PATCH 10/27] enable 'marshal round trip' tests with LibTomMath backend --- tests/zq.ml | 21 ++++++----- tests/zq.output-LibTomMath-64 | 70 +++++++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+), 9 deletions(-) diff --git a/tests/zq.ml b/tests/zq.ml index 8e59dbf..a0244df 100644 --- a/tests/zq.ml +++ b/tests/zq.ml @@ -16,6 +16,11 @@ *) +let failure_harness f = + try f () + with Failure f -> Printf.printf "Failure: %s\n" f + + (* testing Z *) module I = Z @@ -89,11 +94,13 @@ let maxni = I.of_nativeint Nativeint.max_int let minni = I.of_nativeint Nativeint.min_int let chk_bits x = - Printf.printf "to_bits %a\n =" pr x; - String.iter (fun c -> Printf.printf " %02x" (Char.code c)) (I.to_bits x); - Printf.printf "\n"; - assert(I.equal (I.abs x) (I.of_bits (I.to_bits x))); - assert((I.to_bits x) = (I.to_bits (I.neg x))); + failure_harness (fun () -> + Printf.printf "to_bits %a\n =" pr x; + String.iter (fun c -> Printf.printf " %02x" (Char.code c)) (I.to_bits x); + Printf.printf "\n"; + assert(I.equal (I.abs x) (I.of_bits (I.to_bits x))); + assert((I.to_bits x) = (I.to_bits (I.neg x))); + ); Printf.printf "marshal round trip %a\n =" pr x; let y = Marshal.(from_string (to_string x []) 0) in Printf.printf " %a\n" prmarshal (y, x) @@ -150,10 +157,6 @@ let chk_testbit x = then Printf.printf "(passed)\n" else Printf.printf "(FAILED)\n" -let failure_harness f = - try f () - with Failure f -> Printf.printf "Failure: %s\n" f - let test_Z() = Printf.printf "0\n = %a\n" pr I.zero; Printf.printf "1\n = %a\n" pr I.one; diff --git a/tests/zq.output-LibTomMath-64 b/tests/zq.output-LibTomMath-64 index b4827d5..ba485e4 100644 --- a/tests/zq.output-LibTomMath-64 +++ b/tests/zq.output-LibTomMath-64 @@ -950,6 +950,76 @@ format %#-10o -2^30 = /-0o10000000000/ Failure: Z.extract: not implemented in LibTomMath backend to_bits 0 =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 0 + = OK +to_bits 2 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 2 + = OK +to_bits -2 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -2 + = OK +to_bits 1073741824 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 1073741824 + = OK +to_bits -1073741824 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -1073741824 + = OK +to_bits 4611686018427387904 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 4611686018427387904 + = OK +to_bits -4611686018427387904 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -4611686018427387904 + = OK +to_bits 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = OK +to_bits 1329227995784915872903807060280344576 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 1329227995784915872903807060280344576 + = OK +to_bits 2658455991569831745807614120560689152 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 2658455991569831745807614120560689152 + = OK +to_bits 4611686018427387903 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 4611686018427387903 + = OK +to_bits -4611686018427387904 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -4611686018427387904 + = OK +to_bits 2147483647 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 2147483647 + = OK +to_bits -2147483648 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -2147483648 + = OK +to_bits 9223372036854775807 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -9223372036854775808 + = OK +to_bits 9223372036854775807 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -9223372036854775808 + = OK testbit 0 Failure: Z.extract: not implemented in LibTomMath backend numbits / trailing_zeros 0 (passed) numbits / trailing_zeros 1 (passed) From c7a16c3a0677ed52389bda5b97bd3b0db005367c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Tue, 18 Aug 2020 18:57:42 +0200 Subject: [PATCH 11/27] Z.digit_bits () returns the number of bits used in each limb/digit --- caml_z.c | 5 +++++ caml_z_tommath.c | 5 +++++ z.mlip | 6 ++++++ z.mlp | 1 + 4 files changed, 17 insertions(+) diff --git a/caml_z.c b/caml_z.c index 11fa47f..e85fca6 100644 --- a/caml_z.c +++ b/caml_z.c @@ -3329,6 +3329,11 @@ CAMLprim value ml_z_init() return Val_unit; } +CAMLprim value ml_z_digit_bits() +{ + return Val_long(sizeof(mp_limb_t) * 8); +} + #ifdef __cplusplus } #endif diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 21515c9..014f917 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -1907,3 +1907,8 @@ CAMLprim value ml_z_init() caml_register_custom_operations(&ml_z_custom_ops); return Val_unit; } + +CAMLprim value ml_z_digit_bits() +{ + return Val_long(MP_DIGIT_BIT); +} diff --git a/z.mlip b/z.mlip index 1e85b77..7ca0985 100644 --- a/z.mlip +++ b/z.mlip @@ -719,6 +719,12 @@ val backend: string This file refers to [@BACKEND]. *) +external digit_bits: unit -> int = "ml_z_digit_bits" +(** Number of useful bits in each individual word (so-called 'limb' or 'digit'). + Can be 32 or 64 for GMP, and 28 or 60 for LibTomMath. + *) + + (**/**) (** For internal use in module [Q]. *) diff --git a/z.mlp b/z.mlp index f5ffcdc..77631b2 100644 --- a/z.mlp +++ b/z.mlp @@ -252,3 +252,4 @@ end let version = @VERSION let backend = @BACKEND +external digit_bits: unit -> int = "ml_z_digit_bits" From 16777fbc4fd393619f712c55018b3eaa288b3f6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Tue, 18 Aug 2020 19:46:14 +0200 Subject: [PATCH 12/27] LibTomMath: hashing, testing and doc - reverted the hashing function in LibTomMath backend (simple and fast, but not GMP compatible) - the tests now depends on the digit_bits value - some infomration about LibTomMath in the README --- README.md | 20 ++++++++- caml_z_tommath.c | 45 +++++++++++++++++++ tests/Makefile | 9 ++-- .../{zq.output-GMP-32 => zq.output-GMP-32-32} | 0 .../{zq.output-GMP-64 => zq.output-GMP-64-64} | 0 ...bTomMath-64 => zq.output-LibTomMath-64-60} | 6 +-- ...zq.output-MPIR-32 => zq.output-MPIR-32-32} | 0 ...zq.output-MPIR-64 => zq.output-MPIR-64-64} | 0 z.mlip | 4 ++ 9 files changed, 76 insertions(+), 8 deletions(-) rename tests/{zq.output-GMP-32 => zq.output-GMP-32-32} (100%) rename tests/{zq.output-GMP-64 => zq.output-GMP-64-64} (100%) rename tests/{zq.output-LibTomMath-64 => zq.output-LibTomMath-64-60} (99%) rename tests/{zq.output-MPIR-32 => zq.output-MPIR-32-32} (100%) rename tests/{zq.output-MPIR-64 => zq.output-MPIR-64-64} (100%) diff --git a/README.md b/README.md index 6de7ab6..6f469ce 100644 --- a/README.md +++ b/README.md @@ -117,7 +117,8 @@ INRIA Rocquencourt (Institut national de recherche en informatique, France). Source files | Description --------------------|----------------------------------------- configure | configuration script - caml_z.c | C implementation of all functions + caml_z.c | C implementation of all functions using GMP/MPIR + caml_z_tommath.c | C implementation using LibTomMath caml_z_*.S | asm implementation for a few functions z_pp.pl | script to generate z.ml[i] from z.ml[i]p z.ml[i]p | templates used to generate z.ml[i]p @@ -131,3 +132,20 @@ Note: `z_pp.pl` simply scans the asm file (if any) to see which functions have an asm implementation. It then fixes the external statements in .mlp and .mlip accordingly. The argument to `z_pp.pl` is the suffix `*` of the `caml_z_*.S` to use (guessed by configure). + + +## BACK-END COMPATIBILITY + +Zarith supports several back-ends to implement multi-word integers: GMP, MPIR, and LibTomMath. +GMP is the default. +The `configure` script will try them in the following order: GMP, MPIR, LibTomMath. +The choice of back-end can be overridden with the `-gmp`, `-mpir`, and `-tommath` configure options. + +GMP and MPIR support all functions and should give identical results. +The hashing function is notably identical and the marshalling format is compatible for GMP and MPIR, and for 32-bit and 64-bit. + +LibTomMath support is experimental. +Not all functions are implemented. +Unsupported functions raise a `Failure` exception. +The hashing function is different from the GMP/MPIR one, and the hashed value actually depends on the digit bit-size used by LibTomMath (which can be queried with `digit_bits ()`). +Additionally, the marshaling format is incompatible with the GMP/MPIR one, although is independent from the digit bit-size. diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 014f917..00c079b 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -1734,6 +1734,49 @@ int ml_z_custom_compare(value arg1, value arg2) #define caml_hash_mix_uint32(h,n) ((h) * 65599 + (n)) #endif +#if 1 /* Select the ml_z_custom_hash implementation */ + +/* + This version of hash does not give the same result as the GMP one. + Moreover, the hash value depends on MP_DIGIT_BIT. + However, it is simple and fast, and so, enabled by default. +*/ + +static intnat ml_z_custom_hash(value v) +{ + if (Is_long(v)) { +#ifdef ARCH_SIXTYFOUR + return caml_hash_mix_uint32((uint32_t)v, (uint32_t)(v >> 32)); +#else + return v; +#endif + } + else { + uint32_t r = 0; + int i; + mp_digit* p; + if (mp_isneg(Z_MP(v))) r = 1; + for (i=0, p=Z_MP(v)->dp; i < Z_MP(v)->used; i++, p++) { +#ifdef MP_64BIT + r = caml_hash_mix_uint32(r, (uint32_t)*p); + r = caml_hash_mix_uint32(r, (uint32_t)((*p) >> 32)); +#else + r = caml_hash_mix_uint32(r, (uint32_t)*p); +#endif + } + return r; + } +} + +#else + +/* + This version of hash gives the same result as the GMP one and + does not depend on the value of MP_DIGIT_BITS. + However, it is complex, slower and not much tested. + It is currently disabled by #if +*/ + static intnat ml_z_custom_hash(value v) { if (Is_long(v)) { @@ -1792,6 +1835,8 @@ static intnat ml_z_custom_hash(value v) } } +#endif + CAMLprim value ml_z_hash(value v) { return Val_long(ml_z_custom_hash(v)); diff --git a/tests/Makefile b/tests/Makefile index 29a9037..c57abab 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -1,5 +1,6 @@ WORDSIZE:=$(shell echo print_int Sys.word_size | ocaml -stdin) BACKEND:=$(shell echo print_string Z.backend | ocaml -I .. zarith.cma -stdin) +DIGITSIZE:=$(shell echo print_int \(Z.digit_bits \(\)\) | ocaml -I .. zarith.cma -stdin) STDLIBDIR:=$(shell ocamlc -where) ifeq ($(wildcard $(STDLIBDIR)/big_int.cmi),) HAS_NUM=false @@ -12,12 +13,12 @@ NUMS_CMXA=nums.cmxa endif test:: zq.exe - @echo "Testing zq (native) for $(BACKEND)..." - @if ./zq.exe | cmp -s zq.output-$(BACKEND)-$(WORDSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi + @echo "Testing zq (native) for $(WORDSIZE)-bit OCaml, $(BACKEND) backend with $(DIGITSIZE)-bit limbs/digits..." + @if ./zq.exe | cmp -s zq.output-$(BACKEND)-$(WORDSIZE)-$(DIGITSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi test:: zq.byt - @echo "Testing zq (bytecode) for $(BACKEND)..." - @if ocamlrun -I .. ./zq.byt | cmp -s zq.output-$(BACKEND)-$(WORDSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi + @echo "Testing zq (bytecode) for $(WORDSIZE)-bit OCaml, $(BACKEND) backend with $(DIGITSIZE)-bit limbs/digits..." + @if ocamlrun -I .. ./zq.byt | cmp -s zq.output-$(BACKEND)-$(WORDSIZE)-$(DIGITSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi ifeq ($(HAS_NUM),true) test:: bi.exe diff --git a/tests/zq.output-GMP-32 b/tests/zq.output-GMP-32-32 similarity index 100% rename from tests/zq.output-GMP-32 rename to tests/zq.output-GMP-32-32 diff --git a/tests/zq.output-GMP-64 b/tests/zq.output-GMP-64-64 similarity index 100% rename from tests/zq.output-GMP-64 rename to tests/zq.output-GMP-64-64 diff --git a/tests/zq.output-LibTomMath-64 b/tests/zq.output-LibTomMath-64-60 similarity index 99% rename from tests/zq.output-LibTomMath-64 rename to tests/zq.output-LibTomMath-64-60 index ba485e4..b2fd38a 100644 --- a/tests/zq.output-LibTomMath-64 +++ b/tests/zq.output-LibTomMath-64-60 @@ -826,11 +826,11 @@ popcount (2^120-1) = 120 Failure: Z.hamdist: not implemented in LibTomMath backend hash(2^120) - = 691199303 + = 900619431 hash(2^121) - = 382412560 + = 324032971 hash(2^300) - = 61759632 + = 49167343 2^120 = 2^300 = false 2^120 = 2^120 diff --git a/tests/zq.output-MPIR-32 b/tests/zq.output-MPIR-32-32 similarity index 100% rename from tests/zq.output-MPIR-32 rename to tests/zq.output-MPIR-32-32 diff --git a/tests/zq.output-MPIR-64 b/tests/zq.output-MPIR-64-64 similarity index 100% rename from tests/zq.output-MPIR-64 rename to tests/zq.output-MPIR-64-64 diff --git a/z.mlip b/z.mlip index 7ca0985..8926ee6 100644 --- a/z.mlip +++ b/z.mlip @@ -420,6 +420,10 @@ external hash: t -> int = "ml_z_hash" @NOALLOC function. The result is consistent with equality: if [a] = [b], then [hash a] = [hash b]. + + Currently, the value depend on the backend (GMP or LibTomMath). + Moreover, the GMP backend gives the same result on 32-bit and 64-bit, + but the LibTomMath result depends on the bit-size of limbs/digits. *) (** {1 Elementary number theory} *) From 72c9899780b85e85349fcd2eb99cb747a40f1387 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Wed, 19 Aug 2020 20:12:04 +0200 Subject: [PATCH 13/27] use 'diff -u' for tests instead of 'cmp -s' --- .gitignore | 3 +++ tests/Makefile | 6 +++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index 1a82586..a29b89d 100644 --- a/.gitignore +++ b/.gitignore @@ -4,6 +4,7 @@ *.cmxs *.cmti *.exe +*.byt *.o *.so Makefile @@ -11,3 +12,5 @@ depend z.ml z.mli z_features.h +html + diff --git a/tests/Makefile b/tests/Makefile index c57abab..5e56c3b 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -14,11 +14,11 @@ endif test:: zq.exe @echo "Testing zq (native) for $(WORDSIZE)-bit OCaml, $(BACKEND) backend with $(DIGITSIZE)-bit limbs/digits..." - @if ./zq.exe | cmp -s zq.output-$(BACKEND)-$(WORDSIZE)-$(DIGITSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi + @if ./zq.exe | diff -u zq.output-$(BACKEND)-$(WORDSIZE)-$(DIGITSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi test:: zq.byt @echo "Testing zq (bytecode) for $(WORDSIZE)-bit OCaml, $(BACKEND) backend with $(DIGITSIZE)-bit limbs/digits..." - @if ocamlrun -I .. ./zq.byt | cmp -s zq.output-$(BACKEND)-$(WORDSIZE)-$(DIGITSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi + @if ocamlrun -I .. ./zq.byt | diff -u zq.output-$(BACKEND)-$(WORDSIZE)-$(DIGITSIZE) - ; then echo "zq: passed"; else echo "zq: FAILED"; exit 2; fi ifeq ($(HAS_NUM),true) test:: bi.exe @@ -28,7 +28,7 @@ endif test:: pi.exe @echo "Testing pi..." - @if ./pi.exe 500 | cmp -s pi.output - ; then echo "pi: passed"; else echo "pi: FAILED"; exit 2; fi + @if ./pi.exe 500 | diff -u pi.output - ; then echo "pi: passed"; else echo "pi: FAILED"; exit 2; fi test:: tofloat.exe @echo "Testing tofloat..." From 8ba4099036c4700d27c057fa07705fb4a754f00d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Thu, 20 Aug 2020 10:10:45 +0200 Subject: [PATCH 14/27] add reference test results for LibTomMath on 64-bit Windows VS --- tests/zq.output-LibTomMath-64-28 | 1284 ++++++++++++++++++++++++++++++ 1 file changed, 1284 insertions(+) create mode 100644 tests/zq.output-LibTomMath-64-28 diff --git a/tests/zq.output-LibTomMath-64-28 b/tests/zq.output-LibTomMath-64-28 new file mode 100644 index 0000000..5847b83 --- /dev/null +++ b/tests/zq.output-LibTomMath-64-28 @@ -0,0 +1,1284 @@ +0 + = 0 +1 + = 1 +-1 + = -1 +42 + = 42 +1+1 + = 2 +1-1 + = 0 +- 1 + = -1 +0-1 + = -1 +max_int + = 4611686018427387903 +min_int + = -4611686018427387904 +-max_int + = -4611686018427387903 +-min_int + = 4611686018427387904 +2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 + = 1329227995784915872903807060280344576 +2^300+2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^300+(-(2^120)) + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120-2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +2^120+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-(2^120)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-(2^120)-2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300-2^300 + = 0 +2^121 + = 2658455991569831745807614120560689152 +2^121+2^120 + = 3987683987354747618711421180841033728 +2^121-2^120 + = 1329227995784915872903807060280344576 +2^121+(-(2^120)) + = 1329227995784915872903807060280344576 +2^120-2^121 + = -1329227995784915872903807060280344576 +2^120+(-(2^121)) + = -1329227995784915872903807060280344576 +-(2^120)+(-(2^121)) + = -3987683987354747618711421180841033728 +-(2^120)-2^121 + = -3987683987354747618711421180841033728 +2^121+0 + = 2658455991569831745807614120560689152 +2^121-0 + = 2658455991569831745807614120560689152 +0+2^121 + = 2658455991569831745807614120560689152 +0-2^121 + = -2658455991569831745807614120560689152 +2^300+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^300-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300+(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +2^300-(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)+2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)-2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +1+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +1-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)-(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +(-1)+(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +(-1)-(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +max_int+1 + = 4611686018427387904 +min_int-1 + = -4611686018427387905 +-max_int-1 + = -4611686018427387904 +-min_int-1 + = 4611686018427387903 +5! = 120 +12! = 479001600 +15! = 1307674368000 +20! = 2432902008176640000 +25! = 15511210043330985984000000 +50! = 30414093201713378043612608166064768844377641568960512000000000000 +2^300*2^120 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*2^300 + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^300*(-(2^120)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^120*(-(2^300)) + = -2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +-(2^120)*(-(2^300)) + = 2707685248164858261307045101702230179137145581421695874189921465443966120903931272499975005961073806735733604454495675614232576 +2^121*2^120 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^120*2^121 + = 3533694129556768659166595001485837031654967793751237916243212402585239552 +2^121*0 + = 0 +0*2^121 + = 0 +2^300*1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300*(-1) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(-(2^300)) + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-(2^300)*(-1) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +(-1)*(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1*(2^30) + = 1073741824 +1*(2^62) + = 4611686018427387904 +(2^30)*(2^30) + = 1152921504606846976 +(2^62)*(2^62) + = 21267647932558653966460912964485513216 +0+1 + = 1 +1+1 + = 2 +-1+1 + = 0 +2+1 + = 3 +-2+1 + = -1 +(2^300)+1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +-(2^300)+1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0-1 + = -1 +1-1 + = 0 +-1-1 + = -2 +2-1 + = 1 +-2-1 + = -3 +(2^300)-1 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +-(2^300)-1 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +max_int+1 + = 4611686018427387904 +min_int-1 + = -4611686018427387905 +-max_int-1 + = -4611686018427387904 +-min_int-1 + = 4611686018427387903 +abs(0) + = 0 +abs(1) + = 1 +abs(-1) + = 1 +abs(min_int) + = 4611686018427387904 +abs(2^300) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +abs(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +max_natint + = 9223372036854775807 +max_int32 + = 2147483647 +max_int64 + = 9223372036854775807 +to_int 1 + = 1 +to_int max_int + = 4611686018427387903 +to_int max_natint + = ovf +to_int max_int32 + = 2147483647 +to_int max_int64 + = ovf +to_int32 1 + = 1 +to_int32 max_int + = ovf +to_int32 max_natint + = ovf +to_int32 max_int32 + = 2147483647 +to_int32 max_int64 + = ovf +to_int64 1 + = 1 +to_int64 max_int + = 4611686018427387903 +to_int64 max_natint + = 9223372036854775807 +to_int64 max_int32 + = 2147483647 +to_int64 max_int64 + = 9223372036854775807 +to_natint 1 + = 1 +to_natint max_int + = 4611686018427387903 +to_natint max_natint + = 9223372036854775807 +to_natint max_int32 + = 2147483647 +to_natint max_int64 + = 9223372036854775807 +to_int -min_int + = ovf +to_int -min_natint + = ovf +to_int -min_int32 + = 2147483648 +to_int -min_int64 + = ovf +to_int32 -min_int + = ovf +to_int32 -min_natint + = ovf +to_int32 -min_int32 + = ovf +to_int32 -min_int64 + = ovf +to_int64 -min_int + = 4611686018427387904 +to_int64 -min_natint + = ovf +to_int64 -min_int32 + = 2147483648 +to_int64 -min_int64 + = ovf +to_natint -min_int + = 4611686018427387904 +to_natint -min_natint + = ovf +to_natint -min_int32 + = 2147483648 +to_natint -min_int64 + = ovf +of_float 1. + = 1 +of_float -1. + = -1 +of_float pi + = 3 +of_float 2^30 + = 1073741824 +of_float 2^31 + = 2147483648 +of_float 2^32 + = 4294967296 +of_float 2^33 + = 8589934592 +of_float -2^30 + = -1073741824 +of_float -2^31 + = -2147483648 +of_float -2^32 + = -4294967296 +of_float -2^33 + = -8589934592 +of_float 2^61 + = 2305843009213693952 +of_float 2^62 + = 4611686018427387904 +of_float 2^63 + = 9223372036854775808 +of_float 2^64 + = 18446744073709551616 +of_float 2^65 + = 36893488147419103232 +of_float -2^61 + = -2305843009213693952 +of_float -2^62 + = -4611686018427387904 +of_float -2^63 + = -9223372036854775808 +of_float -2^64 + = -18446744073709551616 +of_float -2^65 + = -36893488147419103232 +of_float 2^120 + = 1329227995784915872903807060280344576 +of_float 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float -2^120 + = -1329227995784915872903807060280344576 +of_float -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +of_float 0.5 + = 0 +of_float -0.5 + = 0 +of_float 200.5 + = 200 +of_float -200.5 + = -200 +to_float 0 + = OK +to_float 1 + = OK +to_float -1 + = OK +to_float 2^120 + = OK +to_float -2^120 + = OK +to_float (2^120-1) + = OK +to_float (-2^120+1) + = OK +to_float 2^63 + = OK +to_float -2^63 + = OK +to_float (2^63-1) + = OK +to_float (-2^63-1) + = OK +to_float (-2^63+1) + = OK +to_float 2^300 + = OK +to_float -2^300 + = OK +to_float (2^300-1) + = OK +to_float (-2^300+1) + = OK +of_string 12 + = 12 +of_string 0x12 + = 18 +of_string 0b10 + = 2 +of_string 0o12 + = 10 +of_string -12 + = -12 +of_string -0x12 + = -18 +of_string -0b10 + = -2 +of_string -0o12 + = -10 +of_string 000123456789012345678901234567890 + = 123456789012345678901234567890 +2^120 / 2^300 (trunc) + = 0 +max_int / 2 (trunc) + = 2305843009213693951 +(2^300+1) / 2^120 (trunc) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (trunc) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (trunc) + = 1532495540865888858358347027150309183618739122183602176 +2^120 / 2^300 (ceil) + = 1 +max_int / 2 (ceil) + = 2305843009213693952 +(2^300+1) / 2^120 (ceil) + = 1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / 2^120 (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(2^300+1) / (-(2^120)) (ceil) + = -1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / (-(2^120)) (ceil) + = 1532495540865888858358347027150309183618739122183602177 +2^120 / 2^300 (floor) + = 0 +max_int / 2 (floor) + = 2305843009213693951 +(2^300+1) / 2^120 (floor) + = 1532495540865888858358347027150309183618739122183602176 +(-(2^300+1)) / 2^120 (floor) + = -1532495540865888858358347027150309183618739122183602177 +(2^300+1) / (-(2^120)) (floor) + = -1532495540865888858358347027150309183618739122183602177 +(-(2^300+1)) / (-(2^120)) (floor) + = 1532495540865888858358347027150309183618739122183602176 +2^120 % 2^300 + = 1329227995784915872903807060280344576 +max_int % 2 + = 1 +(2^300+1) % 2^120 + = 1 +(-(2^300+1)) % 2^120 + = -1 +(2^300+1) % (-(2^120)) + = 1 +(-(2^300+1)) % (-(2^120)) + = -1 +2^120 /,% 2^300 + = 0, 1329227995784915872903807060280344576 +max_int /,% 2 + = 2305843009213693951, 1 +(2^300+1) /,% 2^120 + = 1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% 2^120 + = -1532495540865888858358347027150309183618739122183602176, -1 +(2^300+1) /,% (-(2^120)) + = -1532495540865888858358347027150309183618739122183602176, 1 +(-(2^300+1)) /,% (-(2^120)) + = 1532495540865888858358347027150309183618739122183602176, -1 +1 & 2 + = 0 +1 & 2^300 + = 0 +2^120 & 2^300 + = 0 +2^300 & 2^120 + = 0 +2^300 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 & 0 + = 0 +-2^120 & 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + 2^120 & -2^300 + = 0 +-2^120 & -2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & 2^120 + = 0 + 2^300 & -2^120 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^300 & -2^120 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +1 | 2 + = 3 +1 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 | 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 | 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^300 | 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 | 2^300 + = -1329227995784915872903807060280344576 + 2^120 | -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 | -2^300 + = -1329227995784915872903807060280344576 +-2^300 | 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 | -2^120 + = -1329227995784915872903807060280344576 +-2^300 | -2^120 + = -1329227995784915872903807060280344576 +1 ^ 2 + = 3 +1 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +2^120 ^ 2^300 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^120 + = 2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +2^300 ^ 2^300 + = 0 +2^300 ^ 0 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +-2^120 ^ 2^300 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 + 2^120 ^ -2^300 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^120 ^ -2^300 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +-2^300 ^ 2^120 + = -2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 + 2^300 ^ -2^120 + = -2037035976334486086268445688409378161051468393665936251965368445139297172667143766463741952 +-2^300 ^ -2^120 + = 2037035976334486086268445688409378161051468393665936249306912453569465426859529645903052800 +~0 + = -1 +~1 + = -2 +~2 + = -3 +~2^300 + = -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397377 +~(-1) + = 0 +~(-2) + = 1 +~(-(2^300)) + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397375 +0 >> 1 + = 0 +0 >> 100 + = 0 +2 >> 1 + = 1 +2 >> 2 + = 0 +2 >> 100 + = 0 +2^300 >> 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >> 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >> 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >> 200 + = 1267650600228229401496703205376 +2^300 >> 300 + = 1 +2^300 >> 400 + = 0 +-1 >> 1 + = -1 +-2 >> 1 + = -1 +-2 >> 2 + = -1 +-2 >> 100 + = -1 +-2^300 >> 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >> 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >> 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >> 200 + = -1267650600228229401496703205376 +-2^300 >> 300 + = -1 +-2^300 >> 400 + = -1 +0 >>0 1 + = 0 +0 >>0 100 + = 0 +2 >>0 1 + = 1 +2 >>0 2 + = 0 +2 >>0 100 + = 0 +2^300 >>0 1 + = 1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +2^300 >>0 2 + = 509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +2^300 >>0 100 + = 1606938044258990275541962092341162602522202993782792835301376 +2^300 >>0 200 + = 1267650600228229401496703205376 +2^300 >>0 300 + = 1 +2^300 >>0 400 + = 0 +-1 >>0 1 + = 0 +-2 >>0 1 + = -1 +-2 >>0 2 + = 0 +-2 >>0 100 + = 0 +-2^300 >>0 1 + = -1018517988167243043134222844204689080525734196832968125318070224677190649881668353091698688 +-2^300 >>0 2 + = -509258994083621521567111422102344540262867098416484062659035112338595324940834176545849344 +-2^300 >>0 100 + = -1606938044258990275541962092341162602522202993782792835301376 +-2^300 >>0 200 + = -1267650600228229401496703205376 +-2^300 >>0 300 + = -1 +-2^300 >>0 400 + = 0 +0 << 1 + = 0 +0 << 100 + = 0 +2 << 1 + = 4 +2 << 32 + = 8589934592 +2 << 64 + = 36893488147419103232 +2 << 299 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +2^120 << 1 + = 2658455991569831745807614120560689152 +2^120 << 180 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +compare 1 2 + = -1 +compare 1 1 + = 0 +compare 2 1 + = 1 +compare 2^300 2^120 + = 1 +compare 2^120 2^120 + = 0 +compare 2^120 2^300 + = -1 +compare 2^121 2^120 + = 1 +compare 2^120 2^121 + = -1 +compare 2^300 -2^120 + = 1 +compare 2^120 -2^120 + = 1 +compare 2^120 -2^300 + = 1 +compare -2^300 2^120 + = -1 +compare -2^120 2^120 + = -1 +compare -2^120 2^300 + = -1 +compare -2^300 -2^120 + = -1 +compare -2^120 -2^120 + = 0 +compare -2^120 -2^300 + = 1 +equal 1 2 + = false +equal 1 1 + = true +equal 2 1 + = false +equal 2^300 2^120 + = false +equal 2^120 2^120 + = true +equal 2^120 2^300 + = false +equal 2^121 2^120 + = false +equal 2^120 2^121 + = false +equal 2^120 -2^120 + = false +equal -2^120 2^120 + = false +equal -2^120 -2^120 + = true +sign 0 + = 0 +sign 1 + = 1 +sign -1 + = -1 +sign 2^300 + = 1 +sign -2^300 + = -1 +gcd 0 0 + = 0 +gcd 0 -137 + = 137 +gcd 12 27 + = 3 +gcd 27 12 + = 3 +gcd 27 27 + = 27 +gcd -12 27 + = 3 +gcd 12 -27 + = 3 +gcd -12 -27 + = 3 +gcd 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 2^120 + = 1329227995784915872903807060280344576 +gcd 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +gcd 2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd 2^300 -2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 2^120 + = 1329227995784915872903807060280344576 +gcd -2^120 -2^300 + = 1329227995784915872903807060280344576 +gcd -2^300 -2^120 + = 1329227995784915872903807060280344576 +gcdext 12 27 + = 3, -2, 1 +gcdext 27 12 + = 3, 1, -2 +gcdext 27 27 + = 27, 0, 1 +gcdext -12 27 + = 3, 2, 1 +gcdext 12 -27 + = 3, -2, -1 +gcdext -12 -27 + = 3, 2, -1 +gcdext 2^120 2^300 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 2^300 2^120 + = 1329227995784915872903807060280344576, 0, 1 +gcdext 12 0 + = 12, 1, 0 +gcdext 0 27 + = 27, 0, 1 +gcdext -12 0 + = 12, -1, 0 +gcdext 0 -27 + = 27, 0, -1 +gcdext 2^120 0 + = 1329227995784915872903807060280344576, 1, 0 +gcdext 0 2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, 1 +gcdext -2^120 0 + = 1329227995784915872903807060280344576, -1, 0 +gcdext 0 -2^300 + = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 0, -1 +gcdext 0 0 + = 0, 0, 0 +lcm 0 0 = 0 +lcm 10 12 = 60 +lcm -10 12 = 60 +lcm 10 -12 = 60 +lcm -10 -12 = 60 +lcm 0 12 = 0 +lcm 0 -12 = 0 +lcm 10 0 = 0 +lcm -10 0 = 0 +lcm 2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm -2^120 -2^300 = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 +lcm 2^120 0 = 0 +lcm -2^120 0 = 0 +is_odd 0 + = false +is_odd 1 + = true +is_odd 2 + = false +is_odd 3 + = true +is_odd 2^120 + = false +is_odd 2^120+1 + = true +is_odd 2^300 + = false +is_odd 2^300+1 + = true +sqrt 0 + = 0 +sqrt 1 + = 1 +sqrt 2 + = 1 +sqrt 2^120 + = 1152921504606846976 +sqrt 2^121 + = 1630477228166597776 +Failure: Z.sqrt_rem: not implemented in LibTomMath backend +popcount 0 + = 0 +popcount 1 + = 1 +popcount 2 + = 1 +popcount max_int32 + = 31 +popcount 2^120 + = 1 +popcount (2^120-1) + = 120 +Failure: Z.hamdist: not implemented in LibTomMath backend +hash(2^120) + = 337659727 +hash(2^121) + = 2072150 +hash(2^300) + = 684456904 +2^120 = 2^300 + = false +2^120 = 2^120 + = true +2^120 = 2^120 + = true +2^120 > 2^300 + = false +2^120 < 2^300 + = true +2^120 = 1 + = false +2^120 > 1 + = true +2^120 < 1 + = false +-2^120 > 1 + = false +-2^120 < 1 + = true +demarshal 2^120, 2^300, 1 + = 1329227995784915872903807060280344576, 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, 1 +demarshal -2^120, -2^300, -1 + = -1329227995784915872903807060280344576, -2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376, -1 +format %i 0 = /0/ +format %i 1 = /1/ +format %i -1 = /-1/ +format %i 2^30 = /1073741824/ +format %i -2^30 = /-1073741824/ +format % i 1 = / 1/ +format %+i 1 = /+1/ +format %x 0 = /0/ +format %x 1 = /1/ +format %x -1 = /-1/ +format %x 2^30 = /40000000/ +format %x -2^30 = /-40000000/ +format %X 0 = /0/ +format %X 1 = /1/ +format %X -1 = /-1/ +format %X 2^30 = /40000000/ +format %X -2^30 = /-40000000/ +format %o 0 = /0/ +format %o 1 = /1/ +format %o -1 = /-1/ +format %o 2^30 = /10000000000/ +format %o -2^30 = /-10000000000/ +format %10i 0 = / 0/ +format %10i 1 = / 1/ +format %10i -1 = / -1/ +format %10i 2^30 = /1073741824/ +format %10i -2^30 = /-1073741824/ +format %-10i 0 = /0 / +format %-10i 1 = /1 / +format %-10i -1 = /-1 / +format %-10i 2^30 = /1073741824/ +format %-10i -2^30 = /-1073741824/ +format %+10i 0 = / +0/ +format %+10i 1 = / +1/ +format %+10i -1 = / -1/ +format %+10i 2^30 = /+1073741824/ +format %+10i -2^30 = /-1073741824/ +format % 10i 0 = / 0/ +format % 10i 1 = / 1/ +format % 10i -1 = / -1/ +format % 10i 2^30 = / 1073741824/ +format % 10i -2^30 = /-1073741824/ +format %010i 0 = /0000000000/ +format %010i 1 = /0000000001/ +format %010i -1 = /-000000001/ +format %010i 2^30 = /1073741824/ +format %010i -2^30 = /-1073741824/ +format %#x 0 = /0x0/ +format %#x 1 = /0x1/ +format %#x -1 = /-0x1/ +format %#x 2^30 = /0x40000000/ +format %#x -2^30 = /-0x40000000/ +format %#X 0 = /0X0/ +format %#X 1 = /0X1/ +format %#X -1 = /-0X1/ +format %#X 2^30 = /0X40000000/ +format %#X -2^30 = /-0X40000000/ +format %#o 0 = /0o0/ +format %#o 1 = /0o1/ +format %#o -1 = /-0o1/ +format %#o 2^30 = /0o10000000000/ +format %#o -2^30 = /-0o10000000000/ +format %#10x 0 = / 0x0/ +format %#10x 1 = / 0x1/ +format %#10x -1 = / -0x1/ +format %#10x 2^30 = /0x40000000/ +format %#10x -2^30 = /-0x40000000/ +format %#10X 0 = / 0X0/ +format %#10X 1 = / 0X1/ +format %#10X -1 = / -0X1/ +format %#10X 2^30 = /0X40000000/ +format %#10X -2^30 = /-0X40000000/ +format %#10o 0 = / 0o0/ +format %#10o 1 = / 0o1/ +format %#10o -1 = / -0o1/ +format %#10o 2^30 = /0o10000000000/ +format %#10o -2^30 = /-0o10000000000/ +format %#-10x 0 = /0x0 / +format %#-10x 1 = /0x1 / +format %#-10x -1 = /-0x1 / +format %#-10x 2^30 = /0x40000000/ +format %#-10x -2^30 = /-0x40000000/ +format %#-10X 0 = /0X0 / +format %#-10X 1 = /0X1 / +format %#-10X -1 = /-0X1 / +format %#-10X 2^30 = /0X40000000/ +format %#-10X -2^30 = /-0X40000000/ +format %#-10o 0 = /0o0 / +format %#-10o 1 = /0o1 / +format %#-10o -1 = /-0o1 / +format %#-10o 2^30 = /0o10000000000/ +format %#-10o -2^30 = /-0o10000000000/ +Failure: Z.extract: not implemented in LibTomMath backend +to_bits 0 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 0 + = OK +to_bits 2 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 2 + = OK +to_bits -2 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -2 + = OK +to_bits 1073741824 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 1073741824 + = OK +to_bits -1073741824 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -1073741824 + = OK +to_bits 4611686018427387904 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 4611686018427387904 + = OK +to_bits -4611686018427387904 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -4611686018427387904 + = OK +to_bits 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 + = OK +to_bits 1329227995784915872903807060280344576 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 1329227995784915872903807060280344576 + = OK +to_bits 2658455991569831745807614120560689152 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 2658455991569831745807614120560689152 + = OK +to_bits 4611686018427387903 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 4611686018427387903 + = OK +to_bits -4611686018427387904 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -4611686018427387904 + = OK +to_bits 2147483647 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 2147483647 + = OK +to_bits -2147483648 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -2147483648 + = OK +to_bits 9223372036854775807 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -9223372036854775808 + = OK +to_bits 9223372036854775807 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip 9223372036854775807 + = OK +to_bits -9223372036854775808 + =Failure: Z.to_bits: not implemented in LibTomMath backend +marshal round trip -9223372036854775808 + = OK +testbit 0 Failure: Z.extract: not implemented in LibTomMath backend +numbits / trailing_zeros 0 (passed) +numbits / trailing_zeros 1 (passed) +numbits / trailing_zeros -42 Failure: Z.extract: not implemented in LibTomMath backend +- 0 = 0 +- 1 = -1 +- -1 = 1 +- +inf = -inf +- -inf = +inf +- undef = undef +1/ 0 = +inf +1/ 1 = 1 +1/ -1 = -1 +1/ +inf = 0 +1/ -inf = 0 +1/ undef = undef +abs 0 = 0 +abs 1 = 1 +abs -1 = 1 +abs +inf = +inf +abs -inf = +inf +abs undef = undef +0 + 0 = 0 +0 + 1 = 1 +0 + -1 = -1 +0 + +inf = +inf +0 + -inf = -inf +0 + undef = undef +1 + 0 = 1 +1 + 1 = 2 +1 + -1 = 0 +1 + +inf = +inf +1 + -inf = -inf +1 + undef = undef +-1 + 0 = -1 +-1 + 1 = 0 +-1 + -1 = -2 +-1 + +inf = +inf +-1 + -inf = -inf +-1 + undef = undef ++inf + 0 = +inf ++inf + 1 = +inf ++inf + -1 = +inf ++inf + +inf = +inf ++inf + -inf = undef ++inf + undef = undef +-inf + 0 = -inf +-inf + 1 = -inf +-inf + -1 = -inf +-inf + +inf = undef +-inf + -inf = -inf +-inf + undef = undef +undef + 0 = undef +undef + 1 = undef +undef + -1 = undef +undef + +inf = undef +undef + -inf = undef +undef + undef = undef +0 - 0 = 0 +0 - 1 = -1 +0 - -1 = 1 +0 - +inf = -inf +0 - -inf = +inf +0 - undef = undef +1 - 0 = 1 +1 - 1 = 0 +1 - -1 = 2 +1 - +inf = -inf +1 - -inf = +inf +1 - undef = undef +-1 - 0 = -1 +-1 - 1 = -2 +-1 - -1 = 0 +-1 - +inf = -inf +-1 - -inf = +inf +-1 - undef = undef ++inf - 0 = +inf ++inf - 1 = +inf ++inf - -1 = +inf ++inf - +inf = undef ++inf - -inf = +inf ++inf - undef = undef +-inf - 0 = -inf +-inf - 1 = -inf +-inf - -1 = -inf +-inf - +inf = -inf +-inf - -inf = undef +-inf - undef = undef +undef - 0 = undef +undef - 1 = undef +undef - -1 = undef +undef - +inf = undef +undef - -inf = undef +undef - undef = undef +0 * 0 = 0 +0 * 1 = 0 +0 * -1 = 0 +0 * +inf = undef +0 * -inf = undef +0 * undef = undef +1 * 0 = 0 +1 * 1 = 1 +1 * -1 = -1 +1 * +inf = +inf +1 * -inf = -inf +1 * undef = undef +-1 * 0 = 0 +-1 * 1 = -1 +-1 * -1 = 1 +-1 * +inf = -inf +-1 * -inf = +inf +-1 * undef = undef ++inf * 0 = undef ++inf * 1 = +inf ++inf * -1 = -inf ++inf * +inf = +inf ++inf * -inf = -inf ++inf * undef = undef +-inf * 0 = undef +-inf * 1 = -inf +-inf * -1 = +inf +-inf * +inf = -inf +-inf * -inf = +inf +-inf * undef = undef +undef * 0 = undef +undef * 1 = undef +undef * -1 = undef +undef * +inf = undef +undef * -inf = undef +undef * undef = undef +0 / 0 = undef +0 / 1 = 0 +0 / -1 = 0 +0 / +inf = 0 +0 / -inf = 0 +0 / undef = undef +1 / 0 = +inf +1 / 1 = 1 +1 / -1 = -1 +1 / +inf = 0 +1 / -inf = 0 +1 / undef = undef +-1 / 0 = -inf +-1 / 1 = -1 +-1 / -1 = 1 +-1 / +inf = 0 +-1 / -inf = 0 +-1 / undef = undef ++inf / 0 = +inf ++inf / 1 = +inf ++inf / -1 = -inf ++inf / +inf = undef ++inf / -inf = undef ++inf / undef = undef +-inf / 0 = -inf +-inf / 1 = -inf +-inf / -1 = +inf +-inf / +inf = undef +-inf / -inf = undef +-inf / undef = undef +undef / 0 = undef +undef / 1 = undef +undef / -1 = undef +undef / +inf = undef +undef / -inf = undef +undef / undef = undef +0 * 1/ 0 = undef +0 * 1/ 1 = 0 +0 * 1/ -1 = 0 +0 * 1/ +inf = 0 +0 * 1/ -inf = 0 +0 * 1/ undef = undef +1 * 1/ 0 = +inf +1 * 1/ 1 = 1 +1 * 1/ -1 = -1 +1 * 1/ +inf = 0 +1 * 1/ -inf = 0 +1 * 1/ undef = undef +-1 * 1/ 0 = -inf +-1 * 1/ 1 = -1 +-1 * 1/ -1 = 1 +-1 * 1/ +inf = 0 +-1 * 1/ -inf = 0 +-1 * 1/ undef = undef ++inf * 1/ 0 = +inf ++inf * 1/ 1 = +inf ++inf * 1/ -1 = -inf ++inf * 1/ +inf = undef ++inf * 1/ -inf = undef ++inf * 1/ undef = undef +-inf * 1/ 0 = -inf +-inf * 1/ 1 = -inf +-inf * 1/ -1 = +inf +-inf * 1/ +inf = undef +-inf * 1/ -inf = undef +-inf * 1/ undef = undef +undef * 1/ 0 = undef +undef * 1/ 1 = undef +undef * 1/ -1 = undef +undef * 1/ +inf = undef +undef * 1/ -inf = undef +undef * 1/ undef = undef +mul_2exp (1) 0 = 0 +mul_2exp (1) 1 = 2 +mul_2exp (1) -1 = -2 +mul_2exp (1) +inf = +inf +mul_2exp (1) -inf = -inf +mul_2exp (1) undef = undef +mul_2exp (2) 0 = 0 +mul_2exp (2) 1 = 4 +mul_2exp (2) -1 = -4 +mul_2exp (2) +inf = +inf +mul_2exp (2) -inf = -inf +mul_2exp (2) undef = undef +div_2exp (1) 0 = 0 +div_2exp (1) 1 = 1/2 +div_2exp (1) -1 = -1/2 +div_2exp (1) +inf = +inf +div_2exp (1) -inf = -inf +div_2exp (1) undef = undef +div_2exp (2) 0 = 0 +div_2exp (2) 1 = 1/4 +div_2exp (2) -1 = -1/4 +div_2exp (2) +inf = +inf +div_2exp (2) -inf = -inf +div_2exp (2) undef = undef +identity checking 0 0 +identity checking 0 1 +identity checking 0 -1 +identity checking 0 +inf +identity checking 0 -inf +identity checking 0 undef +identity checking 1 0 +identity checking 1 1 +identity checking 1 -1 +identity checking 1 +inf +identity checking 1 -inf +identity checking 1 undef +identity checking -1 0 +identity checking -1 1 +identity checking -1 -1 +identity checking -1 +inf +identity checking -1 -inf +identity checking -1 undef +identity checking +inf 0 +identity checking +inf 1 +identity checking +inf -1 +identity checking +inf +inf +identity checking +inf -inf +identity checking +inf undef +identity checking -inf 0 +identity checking -inf 1 +identity checking -inf -1 +identity checking -inf +inf +identity checking -inf -inf +identity checking -inf undef +identity checking undef 0 +identity checking undef 1 +identity checking undef -1 +identity checking undef +inf +identity checking undef -inf +identity checking undef undef From 5512639b6e582247c05741c3bcff4dfbe69d4c2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Wed, 11 Nov 2020 16:01:58 +0100 Subject: [PATCH 15/27] import #78, #84 and #85 from caml_z.c --- caml_z_tommath.c | 92 +++++++++++++++++++++++++++++++++++------------- 1 file changed, 68 insertions(+), 24 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 00c079b..25a2259 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -129,6 +129,7 @@ static mp_int z_max_int64, z_min_int64; #endif #define Z_MP(x) ((mp_int*)Data_custom_val((x))) +#define Z_SIGN(x) (Z_MP((x))->sign) #define Z_ISZERO(x) (Is_long((x)) ? Long_val((x)) == 0 : mp_iszero(Z_MP((x)))) #define Z_ISNEG(x) (Is_long((x)) ? Long_val((x)) < 0 : mp_isneg(Z_MP((x)))) @@ -282,7 +283,7 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng /* process the string */ const char *d = String_val(v) + ofs; const char *end = d + len; - ptrdiff_t i, sz; + ptrdiff_t i, j, sz; int sign = 0; intnat base = Long_val(b); /* We allow [d] to advance beyond [end] while parsing the prefix: @@ -302,11 +303,20 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng if (*d == 'o' || *d == 'O') { base = 8; d++; } else if (*d == 'x' || *d == 'X') { base = 16; d++; } else if (*d == 'b' || *d == 'B') { base = 2; d++; } + else { + /* The leading zero is not part of a base prefix. This is an + important distinction for the check below looking at + leading underscore + */ + d--; } } } if (base < 2 || base > 16) caml_invalid_argument("Z.of_substring_base: base must be between 2 and 16"); - while (*d == '0') d++; + /* we do not allow leading underscore */ + if (*d == '_') + caml_invalid_argument("Z.of_substring_base: invalid digit"); + while (*d == '0' || *d == '_') d++; /* sz is the length of the substring that has not been consumed above. */ sz = end - d; if (sz <= 0) { @@ -321,6 +331,7 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng intnat ret = 0; for (i = 0; i < sz; i++) { int digit = 0; + if (d[i] == '_') continue; if (d[i] >= '0' && d[i] <= '9') digit = d[i] - '0'; else if (d[i] >= 'a' && d[i] <= 'f') digit = d[i] - 'a' + 10; else if (d[i] >= 'A' && d[i] <= 'F') digit = d[i] - 'A' + 10; @@ -331,11 +342,14 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng } r = Val_long(ret * (sign ? -1 : 1)); } else { - // copy the substring + /* copy the substring, ignoring underscores */ char* dd = (char*)malloc(sz + 1); if (!dd) caml_raise_out_of_memory(); - memcpy(dd, d, sz); - dd[sz] = 0; + for (i = 0, j = 0; i < sz; i++) { + if (d[i] == '_') continue; + dd[j++] = d[i]; + } + dd[j] = 0; r = ml_z_alloc(); if (mp_read_radix(Z_MP(r), dd, base) != MP_OKAY) { free(dd); @@ -349,6 +363,7 @@ CAMLprim value ml_z_of_substring_base(value b, value v, value offset, value leng caml_failwith("Z.of_substring_base: internal error"); } } + r = ml_z_reduce(r); } CAMLreturn(r); } @@ -545,11 +560,22 @@ CAMLprim value ml_z_of_bits(UNUSED_PARAM value arg) CAMLprim value ml_z_compare(value arg1, value arg2) { - if (Is_long(arg1) && Is_long(arg2)) { - /* fast path */ - if (arg1 > arg2) return Val_long(1); - else if (arg1 < arg2) return Val_long(-1); - else return Val_long(0); + /* Value-equal small integers are equal. + Pointer-equal big integers are equal as well. */ + if (arg1 == arg2) return Val_long(0); + if (Is_long(arg2)) { + if (Is_long(arg1)) { + return arg1 > arg2 ? Val_long(1) : Val_long(-1); + } else { + /* Either arg1 is positive and arg1 > Z_MAX_INT >= arg2 -> result +1 + or arg1 is negative and arg1 < Z_MIN_INT <= arg2 -> result -1 */ + return Z_SIGN(arg1) ? Val_long(-1) : Val_long(1); + } + } + else if (Is_long(arg1)) { + /* Either arg2 is positive and arg2 > Z_MAX_INT >= arg1 -> result -1 + or arg2 is negative and arg2 < Z_MIN_INT <= arg1 -> result +1 */ + return Z_SIGN(arg2) ? Val_long(1) : Val_long(-1); } else { /* slow path */ @@ -572,10 +598,15 @@ CAMLprim value ml_z_equal(value arg1, value arg2) mp_ord r; Z_DECL(arg1); Z_DECL(arg2); - if (Is_long(arg1) && Is_long(arg2)) { - /* fast path */ - return (arg1 == arg2) ? Val_true : Val_false; - } + /* Value-equal small integers are equal. + Pointer-equal big integers are equal as well. */ + if (arg1 == arg2) return Val_true; + /* If both arg1 and arg2 are small integers but failed the equality + test above, they are different. + If one of arg1/arg2 is a small integer and the other is a big integer, + they are different: one is in the range [Z_MIN_INT,Z_MAX_INT] + and the other is outside this range. */ + if (Is_long(arg2) || Is_long(arg1)) return Val_false; /* slow path */ Z_ARG(arg1); Z_ARG(arg2); @@ -593,9 +624,9 @@ CAMLprim value ml_z_sign(value arg) else return Val_long(0); } else { - if (mp_iszero(Z_MP(arg))) return Val_long(0); - else if (mp_isneg(Z_MP(arg))) return Val_long(-1); - else return Val_long(1); + /* zero is a small integer, treated above */ + if (mp_isneg(Z_MP(arg))) return Val_long(-1); + return Val_long(1); } } @@ -1097,7 +1128,9 @@ CAMLprim value ml_z_gcd(value arg1, value arg2) intnat r = a1 % a2; a1 = a2; a2 = r; } - return Val_long(a1); + /* If arg1 = arg2 = min_int, the result a1 is -min_int, not representable +  as a tagged integer; fall through the slow case, then. */ + if (a1 <= Z_MAX_INT) return Val_long(a1); } { /* slow path */ @@ -1355,7 +1388,7 @@ CAMLprim value ml_z_shift_right_trunc(value arg, value count) /* fast path */ if (c >= Z_INTNAT_BITS) return Val_long(0); if (arg >= 1) return (arg >> c) | 1; - else return 2 - (((2 - arg) >> c) | 1); + else return Val_long(- ((- Long_val(arg)) >> c)); } { /* slow path */ @@ -1709,11 +1742,22 @@ static void ml_z_custom_finalize(value v) { */ int ml_z_custom_compare(value arg1, value arg2) { - if (Is_long(arg1) && Is_long(arg2)) { - /* fast path */ - if (arg1 > arg2) return 1; - else if (arg1 < arg2) return -1; - else return 0; + /* Value-equal small integers are equal. + Pointer-equal big integers are equal as well. */ + if (arg1 == arg2) return 0; + if (Is_long(arg2)) { + if (Is_long(arg1)) { + return arg1 > arg2 ? 1 : -1; + } else { + /* Either arg1 is positive and arg1 > Z_MAX_INT >= arg2 -> result +1 + or arg1 is negative and arg1 < Z_MIN_INT <= arg2 -> result -1 */ + return Z_SIGN(arg1) ? -1 : 1; + } + } + else if (Is_long(arg1)) { + /* Either arg2 is positive and arg2 > Z_MAX_INT >= arg1 -> result -1 + or arg2 is negative and arg2 < Z_MIN_INT <= arg1 -> result +1 */ + return Z_SIGN(arg2) ? 1 : -1; } else { /* slow path */ From 6ce46a5d11f5e13c89068f12fd85ce9b9497cd96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Tue, 2 Mar 2021 18:27:59 +0100 Subject: [PATCH 16/27] generate zarith_version.ml from configure instead of Makefile shoud help with compilation on Windows --- configure | 8 ++++++++ project.mak | 4 +--- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/configure b/configure index 2679864..a823e1d 100755 --- a/configure +++ b/configure @@ -368,6 +368,14 @@ case "$ocamlver" in ;; esac + +# zarith version + +version=`grep "version" META | head -1` +echo "let $version" > zarith_version.ml +echo "let backend = \"$backend\"" >> zarith_version.ml + + # dump Makefile cat > Makefile < zarith_version.ml # install targets From 2bb4cdbe9c8d091c1f384f1cd21e8ecd02db209e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Tue, 28 Mar 2023 09:28:13 +0200 Subject: [PATCH 17/27] fix 64-bit bounds for convertion from double --- caml_z.c | 8 +++----- caml_z_tommath.c | 8 +++----- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/caml_z.c b/caml_z.c index 17e5dde..6816de9 100644 --- a/caml_z.c +++ b/caml_z.c @@ -160,12 +160,10 @@ extern "C" { #endif #define Z_FITS_INT(v) ((v) >= Z_MIN_INT && (v) <= Z_MAX_INT) -/* Z_MAX_INT may not be representable exactly as a double => we use a - lower approximation to be safe - */ +/* greatest/smallest double that can fit in an int */ #ifdef ARCH_SIXTYFOUR -#define Z_MAX_INT_FL 0x3ffffffffffff000 -#define Z_MIN_INT_FL (-Z_MAX_INT_FL) +#define Z_MAX_INT_FL 0x3ffffffffffffe00 +#define Z_MIN_INT_FL (-0x4000000000000000) #else #define Z_MAX_INT_FL Z_MAX_INT #define Z_MIN_INT_FL Z_MIN_INT diff --git a/caml_z_tommath.c b/caml_z_tommath.c index b8a9f38..7fbd56a 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -86,12 +86,10 @@ static mp_int z_max_intnat, z_min_intnat; static mp_int z_max_int32, z_min_int32; static mp_int z_max_int64, z_min_int64; -/* Z_MAX_INT may not be representable exactly as a double => we use a - lower approximation to be safe - */ +/* greatest/smallest double that can fit in an int */ #ifdef ARCH_SIXTYFOUR -#define Z_MAX_INT_FL 0x3ffffffffffff000 -#define Z_MIN_INT_FL (-Z_MAX_INT_FL) +#define Z_MAX_INT_FL 0x3ffffffffffffe00 +#define Z_MIN_INT_FL (-0x4000000000000000) #else #define Z_MAX_INT_FL Z_MAX_INT #define Z_MIN_INT_FL Z_MIN_INT From ee7fba8450848f944fa20fe1cad5c585dcf8bb4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Fri, 31 Mar 2023 16:44:49 +0200 Subject: [PATCH 18/27] pow function for LibTomMath --- caml_z_tommath.c | 37 +++++++++++++++++++++++++++++++------ 1 file changed, 31 insertions(+), 6 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 7fbd56a..a9fc3ca 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -443,7 +443,7 @@ CAMLprim value ml_z_format(value f, value v) CAMLparam2(f,v); Z_DECL(v); char* buf, *dst; - size_t sz = 0; + int sz = 0; size_t i, max_size, size_dst = 0; value r; const char* fmt = String_val(f); @@ -1656,14 +1656,35 @@ CAMLprim value ml_z_divexact(value arg1, value arg2) return ml_z_div(arg1,arg2); } -CAMLprim value ml_z_powm(UNUSED_PARAM value base, UNUSED_PARAM value exp, UNUSED_PARAM value mod) +CAMLprim value ml_z_powm(value base, value exp, value mod) { - caml_failwith("Z.powm: not implemented in LibTomMath backend"); + CAMLparam3(base,exp,mod); + CAMLlocal1(r); + Z_DECL(base); + Z_DECL(exp); + Z_DECL(mod); + + Z_ARG(base); + Z_ARG(exp); + Z_ARG(mod); + r = ml_z_alloc(); + if (mp_exptmod(mp_base, mp_exp, mp_mod, Z_MP(r)) != MP_OKAY) { + Z_END_ARG(base); + Z_END_ARG(exp); + Z_END_ARG(mod); + mp_clear(Z_MP(r)); + caml_failwith("Z.powm: internal error"); + } + r = ml_z_reduce(r); + Z_END_ARG(base); + Z_END_ARG(exp); + Z_END_ARG(mod); + CAMLreturn(r); } -CAMLprim value ml_z_powm_sec(UNUSED_PARAM value base, UNUSED_PARAM value exp, UNUSED_PARAM value mod) +CAMLprim value ml_z_powm_sec(value base, value exp, value mod) { - caml_failwith("Z.powm_sec: not implemented in LibTomMath backend"); + return ml_z_powm(base, exp, mod); } CAMLprim value ml_z_pow(value base, value exp) @@ -1674,9 +1695,13 @@ CAMLprim value ml_z_pow(value base, value exp) intnat e = Long_val(exp); if (e < 0) caml_invalid_argument("Z.pow: exponent must be nonnegative"); +#ifdef ARCH_SIXTYFOUR + if (e > 0x7fffffff) + caml_invalid_argument("Z.pow: exponent too large"); +#endif Z_ARG(base); r = ml_z_alloc(); - if (mp_expt_n(mp_base, e, Z_MP(r)) != MP_OKAY) { + if (mp_expt_u32(mp_base, e, Z_MP(r)) != MP_OKAY) { Z_END_ARG(base); mp_clear(Z_MP(r)); caml_failwith("Z.pow: internal error"); From f7bb20ba09868643d6f17c91d23d8e8d70238b42 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Mon, 30 Oct 2023 16:07:59 +0100 Subject: [PATCH 19/27] Fix overflow error when compiling with LLVM 17. --- caml_z_tommath.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index a9fc3ca..5dd2e0b 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -2048,12 +2048,12 @@ CAMLprim value ml_z_init() err |= mp_init_i32(&z_max_int32, 0x7fffffff); err |= mp_init_i32(&z_min_int32, -0x80000000); err |= mp_init_i64(&z_max_int64, 0x7fffffffffffffffLL); - err |= mp_init_i64(&z_min_int64, -0x8000000000000000LL); + err |= mp_init_i64(&z_min_int64, -0x7fffffffffffffffLL - 1); #ifdef ARCH_SIXTYFOUR err |= mp_init_i64(&z_max_int, 0x3fffffffffffffffLL); err |= mp_init_i64(&z_min_int, -0x4000000000000000LL); err |= mp_init_i64(&z_max_intnat, 0x7fffffffffffffffLL); - err |= mp_init_i64(&z_min_intnat, -0x8000000000000000LL); + err |= mp_init_i64(&z_min_intnat, -0x7fffffffffffffffLL - 1); #else err |= mp_init_i32(&z_max_int, 0x3fffffff); err |= mp_init_i32(&z_min_int, -0x40000000); From e708423925adc17d4e6ea2199ed02f4e66712faa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Tue, 20 Aug 2024 21:53:46 +0200 Subject: [PATCH 20/27] add bit extraction operations to LibTomMath backend --- caml_z_tommath.c | 135 +++++++++++---- tests/zq.output-LibTomMath-64-60 | 274 +++++++++++++++++++++++-------- 2 files changed, 306 insertions(+), 103 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index f73ea32..fdbbfbb 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -145,6 +145,7 @@ static mp_int z_max_int64_unsigned; #define Z_MP(x) ((mp_int*)Data_custom_val((x))) #define Z_SIGN(x) (Z_MP((x))->sign) +#define Z_LIMB(x) (Z_MP((x))->dp) #define Z_ISZERO(x) (Is_long((x)) ? Long_val((x)) == 0 : mp_iszero(Z_MP((x)))) #define Z_ISNEG(x) (Is_long((x)) ? Long_val((x)) < 0 : mp_isneg(Z_MP((x)))) @@ -605,24 +606,109 @@ CAMLprim value ml_z_format(value f, value v) CAMLreturn(r); } -CAMLprim value ml_z_extract(UNUSED_PARAM value arg, UNUSED_PARAM value off, UNUSED_PARAM value len) +/* common part to ml_z_extract and ml_z_extract_internal */ +void ml_z_extract_internal(mp_int* dst, value arg, uintnat o, uintnat l) { + Z_DECL(arg); + size_t sz, i; + mp_int rem; + + sz = (l + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT; + Z_ARG(arg); + + /* shift */ + if (mp_init(&rem) != MP_OKAY || + mp_div_2d(mp_arg, o, dst, &rem) != MP_OKAY || + mp_grow(dst, sz) != MP_OKAY) { + mp_clear(&rem); + Z_END_ARG(arg); + caml_failwith("Z.extract: internal error"); + } + + /* 0-pad */ + for (i = dst->used; i < sz; i++) + dst->dp[i] = 0; + dst->used = sz; + dst->sign = MP_ZPOS; + + /* 2's complement */ + if (mp_isneg(mp_arg)) { + for (i = 0; i < sz; i++) + dst->dp[i] = (~dst->dp[i]) & MP_MASK; + if (mp_iszero(&rem)) { + /* all shifted-out bits are 0 */ + if (mp_incr(dst) != MP_OKAY) { + mp_clear(&rem); + Z_END_ARG(arg); + caml_failwith("Z.extract: internal error"); + } + /* in case of overflow in incr, ignore the new digit */ + dst->used = sz; + } + } + + /* mask out high bits */ + l %= MP_DIGIT_BIT; + if (l) dst->dp[sz-1] &= MP_MASK >> (MP_DIGIT_BIT - l); + mp_clamp(dst); + mp_clear(&rem); + Z_END_ARG(arg); +} + + +CAMLprim value ml_z_extract(value arg, value off, value len) { - caml_failwith("Z.extract: not implemented in LibTomMath backend"); + CAMLparam1(arg); + CAMLlocal1(r); + r = ml_z_alloc(); + ml_z_extract_internal(Z_MP(r), arg, (uintnat)Long_val(off), (uintnat)Long_val(len)); + r = ml_z_reduce(r); + CAMLreturn(r); } -CAMLprim value ml_z_extract_small(UNUSED_PARAM value arg, UNUSED_PARAM value off, UNUSED_PARAM value len) +/* version without OCaml allocation */ +CAMLprim value ml_z_extract_small(value arg, value off, value len) { - caml_failwith("Z.extract_small: not implemented in LibTomMath backend"); + mp_int r; + if (mp_init(&r) != MP_OKAY) + caml_failwith("Z.extract: internal error"); + + ml_z_extract_internal(&r, arg, (uintnat)Long_val(off), (uintnat)Long_val(len)); + + if (mp_cmp(&r, &z_min_int) < 0 || + mp_cmp(&r, &z_max_int) > 0) + /* The result should fit in an integer */ + caml_failwith("Z.extract: internal error"); + intnat x = mp_get_i64(&r); + mp_clear(&r); + return Val_long(x); } -CAMLprim value ml_z_to_bits(UNUSED_PARAM value arg) +CAMLprim value ml_z_to_bits(value arg) { - caml_failwith("Z.to_bits: not implemented in LibTomMath backend"); + CAMLparam1(arg); + CAMLlocal1(r); + Z_DECL(arg); + size_t sz; + Z_ARG(arg); + sz = mp_pack_count(mp_arg, 0, 1); + r = caml_alloc_string(sz); + if (mp_pack((void*)String_val(r), sz, NULL, MP_LSB_FIRST, 1, MP_NATIVE_ENDIAN, 0, mp_arg) != MP_OKAY) { + caml_failwith("Z.to_bits: internal error"); + } + Z_END_ARG(arg); + CAMLreturn(r); } -CAMLprim value ml_z_of_bits(UNUSED_PARAM value arg) +CAMLprim value ml_z_of_bits(value arg) { - caml_failwith("Z.of_bits: not implemented in LibTomMath backend"); + CAMLparam1(arg); + CAMLlocal1(r); + r = ml_z_alloc(); + if (mp_unpack(Z_MP(r), caml_string_length(arg), MP_LSB_FIRST, 1, MP_NATIVE_ENDIAN, 0, String_val(arg)) != MP_OKAY) { + caml_failwith("Z.of_bits: internal error"); + } + r = ml_z_reduce(r); + CAMLreturn(r); } @@ -1722,34 +1808,23 @@ CAMLprim value ml_z_hamdist(UNUSED_PARAM value arg1, UNUSED_PARAM value arg2) CAMLprim value ml_z_testbit(value arg, value index) { - intnat b_idx; - b_idx = Long_val(index); /* Caml code checked index >= 0 */ + intnat b_idx = Long_val(index); /* Caml code checked index >= 0 */ + intnat l_idx = b_idx / MP_DIGIT_BIT; + mp_digit d; if (Is_long(arg)) { if (b_idx >= Z_INTNAT_BITS) b_idx = Z_INTNAT_BITS - 1; return Val_int((Long_val(arg) >> b_idx) & 1); } - else { - intnat l_idx = b_idx / MP_DIGIT_BIT; - mp_digit d; - if (mp_isneg(Z_MP(arg))) { - mp_int a; - if (l_idx >= Z_MP(arg)->used) return Val_long(1); - /* we need to compute ~(|arg|-1) */ - if (mp_init(&a) != MP_OKAY || - mp_sub_d(Z_MP(arg), 1, &a) != MP_OKAY || - mp_complement(&a, &a) != MP_OKAY) { - /* we probably die horribly here as testbit_internal is declared @@noalloc */ - caml_raise_out_of_memory(); - } - d = a.dp[l_idx]; - mp_clear(&a); - } - else { - if (l_idx >= Z_MP(arg)->used) return Val_long(0); - d = Z_MP(arg)->dp[l_idx]; + if (l_idx >= Z_MP(arg)->used) return Val_bool(mp_isneg(Z_MP(arg))); + d = Z_LIMB(arg)[l_idx]; + if (mp_isneg(Z_MP(arg))) { + for (intnat i = 0; i < l_idx; i++) { + if (Z_LIMB(arg)[i] != 0) { d = ~d; goto extract; } } - return Val_int((d >> (b_idx % MP_DIGIT_BIT)) & 1); + d = -d; } + extract: + return Val_int((d >> (b_idx % MP_DIGIT_BIT)) & 1); } CAMLprim value ml_z_divexact(value arg1, value arg2) diff --git a/tests/zq.output-LibTomMath-64-60 b/tests/zq.output-LibTomMath-64-60 index b2fd38a..43b09b8 100644 --- a/tests/zq.output-LibTomMath-64-60 +++ b/tests/zq.output-LibTomMath-64-60 @@ -202,84 +202,140 @@ abs(2^300) = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 abs(-(2^300)) = 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 -max_natint +max_nativeint = 9223372036854775807 max_int32 = 2147483647 max_int64 = 9223372036854775807 to_int 1 - = 1 + = true,1 to_int max_int - = 4611686018427387903 -to_int max_natint - = ovf + = true,4611686018427387903 +to_int max_nativeint + = false,ovf to_int max_int32 - = 2147483647 + = true,2147483647 to_int max_int64 - = ovf + = false,ovf to_int32 1 - = 1 + = true,1 to_int32 max_int - = ovf -to_int32 max_natint - = ovf + = false,ovf +to_int32 max_nativeint + = false,ovf to_int32 max_int32 - = 2147483647 + = true,2147483647 to_int32 max_int64 - = ovf + = false,ovf to_int64 1 - = 1 + = true,1 to_int64 max_int - = 4611686018427387903 -to_int64 max_natint - = 9223372036854775807 + = true,4611686018427387903 +to_int64 max_nativeint + = true,9223372036854775807 to_int64 max_int32 - = 2147483647 + = true,2147483647 to_int64 max_int64 - = 9223372036854775807 -to_natint 1 - = 1 -to_natint max_int - = 4611686018427387903 -to_natint max_natint - = 9223372036854775807 -to_natint max_int32 - = 2147483647 -to_natint max_int64 - = 9223372036854775807 + = true,9223372036854775807 +to_nativeint 1 + = true,1 +to_nativeint max_int + = true,4611686018427387903 +to_nativeint max_nativeint + = true,9223372036854775807 +to_nativeint max_int32 + = true,2147483647 +to_nativeint max_int64 + = true,9223372036854775807 to_int -min_int - = ovf -to_int -min_natint - = ovf + = false,ovf +to_int -min_nativeint + = false,ovf to_int -min_int32 - = 2147483648 + = true,2147483648 to_int -min_int64 - = ovf + = false,ovf to_int32 -min_int - = ovf -to_int32 -min_natint - = ovf + = false,ovf +to_int32 -min_nativeint + = false,ovf to_int32 -min_int32 - = ovf + = false,ovf to_int32 -min_int64 - = ovf + = false,ovf to_int64 -min_int - = 4611686018427387904 -to_int64 -min_natint - = ovf + = true,4611686018427387904 +to_int64 -min_nativeint + = false,ovf to_int64 -min_int32 - = 2147483648 + = true,2147483648 to_int64 -min_int64 - = ovf -to_natint -min_int - = 4611686018427387904 -to_natint -min_natint - = ovf -to_natint -min_int32 - = 2147483648 -to_natint -min_int64 - = ovf + = false,ovf +to_nativeint -min_int + = true,4611686018427387904 +to_nativeint -min_nativeint + = false,ovf +to_nativeint -min_int32 + = true,2147483648 +to_nativeint -min_int64 + = false,ovf +to_int32_unsigned 1 + = true,1 +to_int32_unsigned -1 + = false,ovf +to_int32_unsigned max_int + = false,ovf +to_int32_unsigned max_nativeint + = false,ovf +to_int32_unsigned max_int32 + = true,2147483647 +to_int32_unsigned 2max_int32 + = true,-2 +to_int32_unsigned 3max_int32 + = false,ovf +to_int32_unsigned max_int64 + = false,ovf +to_int64_unsigned 1 + = true,1 +to_int64_unsigned -1 + = false,ovf +to_int64_unsigned max_int + = true,4611686018427387903 +to_int64_unsigned max_nativeint + = true,9223372036854775807 +to_int64_unsigned max_int32 + = true,2147483647 +to_int64_unsigned max_int64 + = true,9223372036854775807 +to_int64_unsigned 2max_int64 + = true,-2 +to_int64_unsigned 3max_int64 + = false,ovf +to_nativeint_unsigned 1 + = true,1 +to_nativeint_unsigned -1 + = false,ovf +to_nativeint_unsigned max_int + = true,4611686018427387903 +to_nativeint_unsigned max_nativeint + = true,9223372036854775807 +to_nativeint_unsigned 2max_nativeint + = true,-2 +to_nativeint_unsigned max_int32 + = true,2147483647 +to_nativeint_unsigned max_int64 + = true,9223372036854775807 +to_nativeint_unsigned 2max_int64 + = true,-2 +to_nativeint_unsigned 3max_int64 + = false,ovf +of_int32_unsigned -1 + = 4294967295 +of_int64_unsigned -1 + = 18446744073709551615 +of_nativeint_unsigned -1 + = 18446744073709551615 of_float 1. = 1 of_float -1. @@ -947,83 +1003,155 @@ format %#-10o 1 = /0o1 / format %#-10o -1 = /-0o1 / format %#-10o 2^30 = /0o10000000000/ format %#-10o -2^30 = /-0o10000000000/ -Failure: Z.extract: not implemented in LibTomMath backend +extract 42 0 1 = 0 (passed) +extract 42 0 5 = 10 (passed) +extract 42 0 32 = 42 (passed) +extract 42 0 64 = 42 (passed) +extract 42 1 1 = 1 (passed) +extract 42 1 5 = 21 (passed) +extract 42 1 32 = 21 (passed) +extract 42 1 63 = 21 (passed) +extract 42 1 64 = 21 (passed) +extract 42 1 127 = 21 (passed) +extract 42 1 128 = 21 (passed) +extract 42 69 12 = 0 (passed) +extract -42 0 1 = 0 (passed) +extract -42 0 5 = 22 (passed) +extract -42 0 32 = 4294967254 (passed) +extract -42 0 64 = 18446744073709551574 (passed) +extract -42 1 1 = 1 (passed) +extract -42 1 5 = 11 (passed) +extract -42 1 32 = 4294967275 (passed) +extract -42 1 63 = 9223372036854775787 (passed) +extract -42 1 64 = 18446744073709551595 (passed) +extract -42 1 127 = 170141183460469231731687303715884105707 (passed) +extract -42 1 128 = 340282366920938463463374607431768211435 (passed) +extract -42 69 12 = 4095 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = 15536040655639606317 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = 1 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = 19 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = 2516587394 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = 7690089207107781587 (passed) +extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = 9888429935207999867003931753264634841 (passed) +signed_extract 42 0 1 = 0 (passed) +signed_extract 42 0 5 = 10 (passed) +signed_extract 42 0 32 = 42 (passed) +signed_extract 42 0 64 = 42 (passed) +signed_extract 42 1 1 = -1 (passed) +signed_extract 42 1 5 = -11 (passed) +signed_extract 42 1 32 = 21 (passed) +signed_extract 42 1 63 = 21 (passed) +signed_extract 42 1 64 = 21 (passed) +signed_extract 42 1 127 = 21 (passed) +signed_extract 42 1 128 = 21 (passed) +signed_extract 42 69 12 = 0 (passed) +signed_extract -42 0 1 = 0 (passed) +signed_extract -42 0 5 = -10 (passed) +signed_extract -42 0 32 = -42 (passed) +signed_extract -42 0 64 = -42 (passed) +signed_extract -42 1 1 = -1 (passed) +signed_extract -42 1 5 = 11 (passed) +signed_extract -42 1 32 = -21 (passed) +signed_extract -42 1 63 = -21 (passed) +signed_extract -42 1 64 = -21 (passed) +signed_extract -42 1 127 = -21 (passed) +signed_extract -42 1 128 = -21 (passed) +signed_extract -42 69 12 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 0 64 = -2910703418069945299 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 1 = -1 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 128 5 = -13 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 131 32 = -1778379902 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 175 63 = -1533282829746994221 (passed) +signed_extract 3141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701 277 123 = -745394031071327116226524728978121767 (passed) to_bits 0 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = marshal round trip 0 = OK to_bits 2 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 02 marshal round trip 2 = OK to_bits -2 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 02 marshal round trip -2 = OK to_bits 1073741824 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 40 marshal round trip 1073741824 = OK to_bits -1073741824 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 40 marshal round trip -1073741824 = OK to_bits 4611686018427387904 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 00 00 00 00 40 marshal round trip 4611686018427387904 = OK to_bits -4611686018427387904 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 00 00 00 00 40 marshal round trip -4611686018427387904 = OK to_bits 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 10 marshal round trip 2037035976334486086268445688409378161051468393665936250636140449354381299763336706183397376 = OK to_bits 1329227995784915872903807060280344576 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 marshal round trip 1329227995784915872903807060280344576 = OK to_bits 2658455991569831745807614120560689152 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02 marshal round trip 2658455991569831745807614120560689152 = OK to_bits 4611686018427387903 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = ff ff ff ff ff ff ff 3f marshal round trip 4611686018427387903 = OK to_bits -4611686018427387904 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 00 00 00 00 40 marshal round trip -4611686018427387904 = OK to_bits 2147483647 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = ff ff ff 7f marshal round trip 2147483647 = OK to_bits -2147483648 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 80 marshal round trip -2147483648 = OK to_bits 9223372036854775807 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = ff ff ff ff ff ff ff 7f marshal round trip 9223372036854775807 = OK to_bits -9223372036854775808 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 00 00 00 00 80 marshal round trip -9223372036854775808 = OK to_bits 9223372036854775807 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = ff ff ff ff ff ff ff 7f marshal round trip 9223372036854775807 = OK to_bits -9223372036854775808 - =Failure: Z.to_bits: not implemented in LibTomMath backend + = 00 00 00 00 00 00 00 80 marshal round trip -9223372036854775808 = OK -testbit 0 Failure: Z.extract: not implemented in LibTomMath backend +testbit 0 (passed) +testbit 1 (passed) +testbit -42 (passed) +testbit 31415926535897932384626433832795028841971693993751058209749445923078164062862089986 (passed) +testbit -2277361236363886404304896 (passed) numbits / trailing_zeros 0 (passed) numbits / trailing_zeros 1 (passed) -numbits / trailing_zeros -42 Failure: Z.extract: not implemented in LibTomMath backend +numbits / trailing_zeros -42 (passed) +numbits / trailing_zeros 1511006158790834639735881728 (passed) +numbits / trailing_zeros -2277361236363886404304896 (passed) +random_bits 45 = 25076743995969 +random_bits 45 = 33510880286625 +random_bits 12 = 1263 +random_int 123456 = 103797 +random_int 9999999 = 1089068 - 0 = 0 - 1 = -1 - -1 = 1 From 9f9f146b470aff2738c504defc82b94d906c1adf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Tue, 20 Aug 2024 22:51:54 +0200 Subject: [PATCH 21/27] added sqrt_rem to LibTomMath backend --- caml_z_tommath.c | 28 ++++++++++++++++++++++++++-- tests/zq.output-LibTomMath-64-60 | 11 ++++++++++- 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index fdbbfbb..412cbeb 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -1357,9 +1357,33 @@ CAMLprim value ml_z_sqrt(value arg) CAMLreturn(r); } -CAMLprim value ml_z_sqrt_rem(UNUSED_PARAM value arg) +CAMLprim value ml_z_sqrt_rem(value arg) { - caml_failwith("Z.sqrt_rem: not implemented in LibTomMath backend"); + CAMLparam1(arg); + CAMLlocal3(r1,r2,r); + Z_DECL(arg); + Z_ARG(arg); + if (mp_isneg(mp_arg)) { + Z_END_ARG(arg); + caml_invalid_argument("Z.sqrt_rem: square root of a negative number"); + } + r1 = ml_z_alloc(); + r2 = ml_z_alloc(); + Z_REFRESH(arg); + if (mp_sqrt(mp_arg, Z_MP(r1)) != MP_OKAY || + mp_mul(Z_MP(r1),Z_MP(r1),Z_MP(r2)) != MP_OKAY || + mp_sub(mp_arg,Z_MP(r2),Z_MP(r2)) != MP_OKAY) { + caml_failwith("Z.sqrt_rem: internal error"); + Z_END_ARG(arg); + } + r1 = ml_z_reduce(r1); + r2 = ml_z_reduce(r2); + r = caml_alloc_small(2, 0); + Field(r,0) = r1; + Field(r,1) = r2; + Z_END_ARG(arg); + CAMLreturn(r); + //caml_failwith("Z.sqrt_rem: not implemented in LibTomMath backend"); } CAMLprim value ml_z_gcd(value arg1, value arg2) diff --git a/tests/zq.output-LibTomMath-64-60 b/tests/zq.output-LibTomMath-64-60 index 43b09b8..69a3708 100644 --- a/tests/zq.output-LibTomMath-64-60 +++ b/tests/zq.output-LibTomMath-64-60 @@ -867,7 +867,16 @@ sqrt 2^120 = 1152921504606846976 sqrt 2^121 = 1630477228166597776 -Failure: Z.sqrt_rem: not implemented in LibTomMath backend +sqrt_rem 0 + = 0, 0 +sqrt_rem 1 + = 1, 0 +sqrt_rem 2 + = 1, 1 +sqrt_rem 2^120 + = 1152921504606846976, 0 +sqrt_rem 2^121 + = 1630477228166597776, 1772969445592542976 popcount 0 = 0 popcount 1 From f3e70f97192abfe7ff4bf787960e91bb6ec1b69e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Tue, 20 Aug 2024 23:06:30 +0200 Subject: [PATCH 22/27] added hamdist to the LibTomMath backend --- caml_z_tommath.c | 37 ++++++++++++++++++++++++++++++-- tests/zq.output-LibTomMath-64-60 | 26 +++++++++++++++++++++- 2 files changed, 60 insertions(+), 3 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 412cbeb..91dc450 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -1825,9 +1825,42 @@ CAMLprim value ml_z_popcount(value arg) } } -CAMLprim value ml_z_hamdist(UNUSED_PARAM value arg1, UNUSED_PARAM value arg2) +CAMLprim value ml_z_hamdist(value arg1, value arg2) { - caml_failwith("Z.hamdist: not implemented in LibTomMath backend"); + if (Z_ISNEG(arg1) != Z_ISNEG(arg2)) + ml_z_raise_overflow(); + /* XXX TODO: case where arg1 & arg2 are both negative */ + if (Z_ISNEG(arg1) || Z_ISNEG(arg2)) + caml_invalid_argument("Z.hamdist: negative arguments"); + if (Is_long(arg1) && Is_long(arg2)) { + return Val_long(ml_z_count(Long_val(arg1) ^ Long_val(arg2))); + } + else { + Z_DECL(arg1); + Z_DECL(arg2); + intnat r = 0; + mp_digit *a1, *a2; + size_t len1, len2; + Z_ARG(arg1); + Z_ARG(arg2); + /* a1 is the shortest one */ + if (mp_arg1->used <= mp_arg2->used) { + a1 = mp_arg1->dp; len1 = mp_arg1->used; + a2 = mp_arg2->dp; len2 = mp_arg2->used; + } + else { + a1 = mp_arg2->dp; len1 = mp_arg2->used; + a2 = mp_arg1->dp; len2 = mp_arg1->used; + } + for (size_t i = 0; i < len1; i++) + r += ml_z_count(a1[i] ^ a2[i]); + for (size_t i = len1; i < len2; i++) + r += ml_z_count(a2[i]); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + if (r < 0 || !Z_FITS_INT(r)) ml_z_raise_overflow(); + return Val_long(r); + } } CAMLprim value ml_z_testbit(value arg, value index) diff --git a/tests/zq.output-LibTomMath-64-60 b/tests/zq.output-LibTomMath-64-60 index 69a3708..f7e5683 100644 --- a/tests/zq.output-LibTomMath-64-60 +++ b/tests/zq.output-LibTomMath-64-60 @@ -889,7 +889,31 @@ popcount 2^120 = 1 popcount (2^120-1) = 120 -Failure: Z.hamdist: not implemented in LibTomMath backend +hamdist 0 0 + = 0 +hamdist 0 1 + = 1 +hamdist 0 2^300 + = 1 +hamdist 2^120 2^120 + = 0 +hamdist 2^120 (2^120-1) + = 121 +hamdist 2^120 2^300 + = 2 +hamdist (2^120-1) (2^300-1) + = 180 +divisible 42 7 + = true +divisible 43 7 + = false +divisible 0 0 + = true +divisible 0 2^120 + = true +divisible 2 2^120 + = false +Failure: Z.divisible: not implemented in LibTomMath backend hash(2^120) = 900619431 hash(2^121) From 34292cd6be12618b585a2636d5878e5613208a64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Tue, 20 Aug 2024 23:27:02 +0200 Subject: [PATCH 23/27] added divisible to LibTomMath backend --- caml_z_tommath.c | 32 ++++++- tests/zq.ml | 148 ++++++++++++++----------------- tests/zq.output-LibTomMath-64-60 | 9 +- 3 files changed, 104 insertions(+), 85 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 91dc450..aa8155f 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -1979,9 +1979,37 @@ CAMLprim value ml_z_invert(UNUSED_PARAM value base, UNUSED_PARAM value mod) caml_failwith("Z.invert: not implemented in LibTomMath backend"); } -CAMLprim value ml_z_divisible(UNUSED_PARAM value a, UNUSED_PARAM value b) +CAMLprim value ml_z_divisible(value arg1, value arg2) { - caml_failwith("Z.divisible: not implemented in LibTomMath backend"); + if (Z_ISZERO(arg2)) ml_z_raise_divide_by_zero(); + if (Is_long(arg1) && Is_long(arg2)) { + /* fast path */ + intnat a1 = Long_val(arg1); + intnat a2 = Long_val(arg2); + return Val_bool(a1 % a2 == 0); + } + /* slow path */ + { + Z_DECL(arg1); + Z_DECL(arg2); + mp_int r; + int res; + if (mp_init(&r) != MP_OKAY) + caml_failwith("Z.divisible: internal error"); + Z_ARG(arg1); + Z_ARG(arg2); + if (mp_div(mp_arg1, mp_arg2, NULL, &r) != MP_OKAY) { + Z_END_ARG(arg1); + Z_END_ARG(arg2); + mp_clear(&r); + caml_failwith("Z.divisible: internal error"); + } + res = mp_iszero(&r); + mp_clear(&r); + Z_END_ARG(arg1); + Z_END_ARG(arg2); + return Val_bool(res); + } } CAMLprim value ml_z_congruent(UNUSED_PARAM value a, UNUSED_PARAM value b, UNUSED_PARAM value c) diff --git a/tests/zq.ml b/tests/zq.ml index 97a201b..63b9caa 100644 --- a/tests/zq.ml +++ b/tests/zq.ml @@ -125,13 +125,11 @@ let maxni = I.of_nativeint Nativeint.max_int let minni = I.of_nativeint Nativeint.min_int let chk_bits x = - failure_harness (fun () -> - Printf.printf "to_bits %a\n =" pr x; - String.iter (fun c -> Printf.printf " %02x" (Char.code c)) (I.to_bits x); - Printf.printf "\n"; - assert(I.equal (I.abs x) (I.of_bits (I.to_bits x))); - assert((I.to_bits x) = (I.to_bits (I.neg x))); - ); + Printf.printf "to_bits %a\n =" pr x; + String.iter (fun c -> Printf.printf " %02x" (Char.code c)) (I.to_bits x); + Printf.printf "\n"; + assert(I.equal (I.abs x) (I.of_bits (I.to_bits x))); + assert((I.to_bits x) = (I.to_bits (I.neg x))); Printf.printf "marshal round trip %a\n =" pr x; let y = Marshal.(from_string (to_string x []) 0) in Printf.printf " %a\n" prmarshal (y, x) @@ -646,37 +644,33 @@ let test_Z() = Printf.printf "sqrt 2\n = %a\n" pr (I.sqrt p2); Printf.printf "sqrt 2^120\n = %a\n" pr (I.sqrt p120); Printf.printf "sqrt 2^121\n = %a\n" pr (I.sqrt p121); - failure_harness (fun () -> - Printf.printf "sqrt_rem 0\n = %a\n" pr2 (I.sqrt_rem I.zero); - Printf.printf "sqrt_rem 1\n = %a\n" pr2 (I.sqrt_rem I.one); - Printf.printf "sqrt_rem 2\n = %a\n" pr2 (I.sqrt_rem p2); - Printf.printf "sqrt_rem 2^120\n = %a\n" pr2 (I.sqrt_rem p120); - Printf.printf "sqrt_rem 2^121\n = %a\n" pr2 (I.sqrt_rem p121); - ); + Printf.printf "sqrt_rem 0\n = %a\n" pr2 (I.sqrt_rem I.zero); + Printf.printf "sqrt_rem 1\n = %a\n" pr2 (I.sqrt_rem I.one); + Printf.printf "sqrt_rem 2\n = %a\n" pr2 (I.sqrt_rem p2); + Printf.printf "sqrt_rem 2^120\n = %a\n" pr2 (I.sqrt_rem p120); + Printf.printf "sqrt_rem 2^121\n = %a\n" pr2 (I.sqrt_rem p121); Printf.printf "popcount 0\n = %i\n" (I.popcount I.zero); Printf.printf "popcount 1\n = %i\n" (I.popcount I.one); Printf.printf "popcount 2\n = %i\n" (I.popcount p2); Printf.printf "popcount max_int32\n = %i\n" (I.popcount maxi32); Printf.printf "popcount 2^120\n = %i\n" (I.popcount p120); Printf.printf "popcount (2^120-1)\n = %i\n" (I.popcount (I.pred p120)); - failure_harness (fun () -> - Printf.printf "hamdist 0 0\n = %i\n" (I.hamdist I.zero I.zero); - Printf.printf "hamdist 0 1\n = %i\n" (I.hamdist I.zero I.one); - Printf.printf "hamdist 0 2^300\n = %i\n" (I.hamdist I.zero p300); - Printf.printf "hamdist 2^120 2^120\n = %i\n" (I.hamdist p120 p120); - Printf.printf "hamdist 2^120 (2^120-1)\n = %i\n" (I.hamdist p120 (I.pred p120)); - Printf.printf "hamdist 2^120 2^300\n = %i\n" (I.hamdist p120 p300); - Printf.printf "hamdist (2^120-1) (2^300-1)\n = %i\n" (I.hamdist (I.pred p120) (I.pred p300)); - Printf.printf "divisible 42 7\n = %B\n" (I.divisible (I.of_int 42) (I.of_int 7)); - Printf.printf "divisible 43 7\n = %B\n" (I.divisible (I.of_int 43) (I.of_int 7)); - Printf.printf "divisible 0 0\n = %B\n" (I.divisible I.zero I.zero); - Printf.printf "divisible 0 2^120\n = %B\n" (I.divisible I.zero p120); - Printf.printf "divisible 2 2^120\n = %B\n" (I.divisible (I.of_int 2) p120); - Printf.printf "divisible 2^300 2^120\n = %B\n" (I.divisible p300 p120); - Printf.printf "divisible (2^300-1) 32\n = %B\n" (I.divisible (I.pred p300) (I.of_int 32)); - Printf.printf "divisible min_int (max_int+1)\n = %B\n" (I.divisible (I.of_int min_int) (I.succ (I.of_int max_int))); - Printf.printf "divisible (max_int+1) min_int\n = %B\n" (I.divisible (I.succ (I.of_int max_int)) (I.of_int min_int)); - ); + Printf.printf "hamdist 0 0\n = %i\n" (I.hamdist I.zero I.zero); + Printf.printf "hamdist 0 1\n = %i\n" (I.hamdist I.zero I.one); + Printf.printf "hamdist 0 2^300\n = %i\n" (I.hamdist I.zero p300); + Printf.printf "hamdist 2^120 2^120\n = %i\n" (I.hamdist p120 p120); + Printf.printf "hamdist 2^120 (2^120-1)\n = %i\n" (I.hamdist p120 (I.pred p120)); + Printf.printf "hamdist 2^120 2^300\n = %i\n" (I.hamdist p120 p300); + Printf.printf "hamdist (2^120-1) (2^300-1)\n = %i\n" (I.hamdist (I.pred p120) (I.pred p300)); + Printf.printf "divisible 42 7\n = %B\n" (I.divisible (I.of_int 42) (I.of_int 7)); + Printf.printf "divisible 43 7\n = %B\n" (I.divisible (I.of_int 43) (I.of_int 7)); + Printf.printf "divisible 0 0\n = %B\n" (I.divisible I.zero I.zero); + Printf.printf "divisible 0 2^120\n = %B\n" (I.divisible I.zero p120); + Printf.printf "divisible 2 2^120\n = %B\n" (I.divisible (I.of_int 2) p120); + Printf.printf "divisible 2^300 2^120\n = %B\n" (I.divisible p300 p120); + Printf.printf "divisible (2^300-1) 32\n = %B\n" (I.divisible (I.pred p300) (I.of_int 32)); + Printf.printf "divisible min_int (max_int+1)\n = %B\n" (I.divisible (I.of_int min_int) (I.succ (I.of_int max_int))); + Printf.printf "divisible (max_int+1) min_int\n = %B\n" (I.divisible (I.succ (I.of_int max_int)) (I.of_int min_int)); (* always 0 when not using custom blocks *) Printf.printf "hash(2^120)\n = %i\n" (Hashtbl.hash p120); Printf.printf "hash(2^121)\n = %i\n" (Hashtbl.hash p121); @@ -804,56 +798,46 @@ let test_Z() = b,1,1; b,1,5; b,1,32; b,1,63; b,1,64; b,1,127; b,1,128; b,69,12; c,0,1; c,0,64; c,128,1; c,128,5; c,131,32; c,175,63; c,277,123] in - failure_harness (fun () -> - List.iter chk_extract extract_testdata; - List.iter chk_signed_extract extract_testdata; - ); - failure_harness (fun () -> - chk_bits I.zero; - chk_bits p2; - chk_bits (I.neg p2); - chk_bits p30; - chk_bits (I.neg p30); - chk_bits p62; - chk_bits (I.neg p62); - chk_bits p300; - chk_bits p120; - chk_bits p121; - chk_bits maxi; - chk_bits mini; - chk_bits maxi32; - chk_bits mini32; - chk_bits maxi64; - chk_bits mini64; - chk_bits maxni; - chk_bits minni; - ); - failure_harness (fun () -> - List.iter chk_testbit [ - I.zero; I.one; I.of_int (-42); - I.of_string "31415926535897932384626433832795028841971693993751058209749445923078164062862089986"; - I.neg (I.shift_left (I.of_int 123456) 64); - ]; - ); - failure_harness (fun () -> - List.iter chk_numbits_tz [ - I.zero; I.one; I.of_int (-42); - I.shift_left (I.of_int 9999) 77; - I.neg (I.shift_left (I.of_int 123456) 64); - ]; - ); - failure_harness (fun () -> - Printf.printf "random_bits 45 = %a\n" - pr (I.random_bits_gen ~fill:pr_bytes 45); - Printf.printf "random_bits 45 = %a\n" - pr (I.random_bits_gen ~fill:pr_bytes 45); - Printf.printf "random_bits 12 = %a\n" - pr (I.random_bits_gen ~fill:pr_bytes 12); - Printf.printf "random_int 123456 = %a\n" - pr (I.random_int_gen ~fill:pr_bytes (I.of_int 123456)); - Printf.printf "random_int 9999999 = %a\n" - pr (I.random_int_gen ~fill:pr_bytes (I.of_int 9999999)); - ); + List.iter chk_extract extract_testdata; + List.iter chk_signed_extract extract_testdata; + chk_bits I.zero; + chk_bits p2; + chk_bits (I.neg p2); + chk_bits p30; + chk_bits (I.neg p30); + chk_bits p62; + chk_bits (I.neg p62); + chk_bits p300; + chk_bits p120; + chk_bits p121; + chk_bits maxi; + chk_bits mini; + chk_bits maxi32; + chk_bits mini32; + chk_bits maxi64; + chk_bits mini64; + chk_bits maxni; + chk_bits minni; + List.iter chk_testbit [ + I.zero; I.one; I.of_int (-42); + I.of_string "31415926535897932384626433832795028841971693993751058209749445923078164062862089986"; + I.neg (I.shift_left (I.of_int 123456) 64); + ]; + List.iter chk_numbits_tz [ + I.zero; I.one; I.of_int (-42); + I.shift_left (I.of_int 9999) 77; + I.neg (I.shift_left (I.of_int 123456) 64); + ]; + Printf.printf "random_bits 45 = %a\n" + pr (I.random_bits_gen ~fill:pr_bytes 45); + Printf.printf "random_bits 45 = %a\n" + pr (I.random_bits_gen ~fill:pr_bytes 45); + Printf.printf "random_bits 12 = %a\n" + pr (I.random_bits_gen ~fill:pr_bytes 12); + Printf.printf "random_int 123456 = %a\n" + pr (I.random_int_gen ~fill:pr_bytes (I.of_int 123456)); + Printf.printf "random_int 9999999 = %a\n" + pr (I.random_int_gen ~fill:pr_bytes (I.of_int 9999999)); () diff --git a/tests/zq.output-LibTomMath-64-60 b/tests/zq.output-LibTomMath-64-60 index f7e5683..bfcd1a2 100644 --- a/tests/zq.output-LibTomMath-64-60 +++ b/tests/zq.output-LibTomMath-64-60 @@ -913,7 +913,14 @@ divisible 0 2^120 = true divisible 2 2^120 = false -Failure: Z.divisible: not implemented in LibTomMath backend +divisible 2^300 2^120 + = true +divisible (2^300-1) 32 + = false +divisible min_int (max_int+1) + = true +divisible (max_int+1) min_int + = true hash(2^120) = 900619431 hash(2^121) From 47c5671dc9e2e95e3944c20f8867a8f86aacd6e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Wed, 21 Aug 2024 10:17:50 +0200 Subject: [PATCH 24/27] Cleaning. --- caml_z_tommath.c | 1 - 1 file changed, 1 deletion(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index aa8155f..0d39fd5 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -1383,7 +1383,6 @@ CAMLprim value ml_z_sqrt_rem(value arg) Field(r,1) = r2; Z_END_ARG(arg); CAMLreturn(r); - //caml_failwith("Z.sqrt_rem: not implemented in LibTomMath backend"); } CAMLprim value ml_z_gcd(value arg1, value arg2) From 906f475b83ef8364c7b11730dc43cc91d1d5dbbb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Wed, 21 Aug 2024 10:45:44 +0200 Subject: [PATCH 25/27] mp_init error checking in LibTomMath backend --- caml_z_tommath.c | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 0d39fd5..0bba508 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -613,11 +613,13 @@ void ml_z_extract_internal(mp_int* dst, value arg, uintnat o, uintnat l) { mp_int rem; sz = (l + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT; - Z_ARG(arg); + + if (mp_init(&rem) != MP_OKAY) + ml_z_raise_out_of_memory(); /* shift */ - if (mp_init(&rem) != MP_OKAY || - mp_div_2d(mp_arg, o, dst, &rem) != MP_OKAY || + Z_ARG(arg); + if (mp_div_2d(mp_arg, o, dst, &rem) != MP_OKAY || mp_grow(dst, sz) != MP_OKAY) { mp_clear(&rem); Z_END_ARG(arg); @@ -670,7 +672,7 @@ CAMLprim value ml_z_extract_small(value arg, value off, value len) { mp_int r; if (mp_init(&r) != MP_OKAY) - caml_failwith("Z.extract: internal error"); + ml_z_raise_out_of_memory(); ml_z_extract_internal(&r, arg, (uintnat)Long_val(off), (uintnat)Long_val(len)); @@ -1994,7 +1996,7 @@ CAMLprim value ml_z_divisible(value arg1, value arg2) mp_int r; int res; if (mp_init(&r) != MP_OKAY) - caml_failwith("Z.divisible: internal error"); + ml_z_raise_out_of_memory(); Z_ARG(arg1); Z_ARG(arg2); if (mp_div(mp_arg1, mp_arg2, NULL, &r) != MP_OKAY) { From 6b02421cab454b6caae05246f434276fe203491b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Wed, 21 Aug 2024 11:16:04 +0200 Subject: [PATCH 26/27] Z_ARG or Z_REFRESH must be called after OCaml memory allocation early clearning of LibTomMath integers check for memory leaks --- caml_z_tommath.c | 16 ++++++++++++---- tests/zq.ml | 2 ++ 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/caml_z_tommath.c b/caml_z_tommath.c index 0bba508..3ca36c8 100644 --- a/caml_z_tommath.c +++ b/caml_z_tommath.c @@ -622,6 +622,7 @@ void ml_z_extract_internal(mp_int* dst, value arg, uintnat o, uintnat l) { if (mp_div_2d(mp_arg, o, dst, &rem) != MP_OKAY || mp_grow(dst, sz) != MP_OKAY) { mp_clear(&rem); + mp_clear(dst); Z_END_ARG(arg); caml_failwith("Z.extract: internal error"); } @@ -639,6 +640,7 @@ void ml_z_extract_internal(mp_int* dst, value arg, uintnat o, uintnat l) { if (mp_iszero(&rem)) { /* all shifted-out bits are 0 */ if (mp_incr(dst) != MP_OKAY) { + mp_clear(dst); mp_clear(&rem); Z_END_ARG(arg); caml_failwith("Z.extract: internal error"); @@ -677,9 +679,11 @@ CAMLprim value ml_z_extract_small(value arg, value off, value len) ml_z_extract_internal(&r, arg, (uintnat)Long_val(off), (uintnat)Long_val(len)); if (mp_cmp(&r, &z_min_int) < 0 || - mp_cmp(&r, &z_max_int) > 0) + mp_cmp(&r, &z_max_int) > 0) { /* The result should fit in an integer */ + mp_clear(&r); caml_failwith("Z.extract: internal error"); + } intnat x = mp_get_i64(&r); mp_clear(&r); return Val_long(x); @@ -695,6 +699,7 @@ CAMLprim value ml_z_to_bits(value arg) sz = mp_pack_count(mp_arg, 0, 1); r = caml_alloc_string(sz); if (mp_pack((void*)String_val(r), sz, NULL, MP_LSB_FIRST, 1, MP_NATIVE_ENDIAN, 0, mp_arg) != MP_OKAY) { + Z_END_ARG(arg); caml_failwith("Z.to_bits: internal error"); } Z_END_ARG(arg); @@ -707,6 +712,7 @@ CAMLprim value ml_z_of_bits(value arg) CAMLlocal1(r); r = ml_z_alloc(); if (mp_unpack(Z_MP(r), caml_string_length(arg), MP_LSB_FIRST, 1, MP_NATIVE_ENDIAN, 0, String_val(arg)) != MP_OKAY) { + mp_clear(Z_MP(r)); caml_failwith("Z.of_bits: internal error"); } r = ml_z_reduce(r); @@ -1375,8 +1381,10 @@ CAMLprim value ml_z_sqrt_rem(value arg) if (mp_sqrt(mp_arg, Z_MP(r1)) != MP_OKAY || mp_mul(Z_MP(r1),Z_MP(r1),Z_MP(r2)) != MP_OKAY || mp_sub(mp_arg,Z_MP(r2),Z_MP(r2)) != MP_OKAY) { - caml_failwith("Z.sqrt_rem: internal error"); + mp_clear(Z_MP(r1)); + mp_clear(Z_MP(r2)); Z_END_ARG(arg); + caml_failwith("Z.sqrt_rem: internal error"); } r1 = ml_z_reduce(r1); r2 = ml_z_reduce(r2); @@ -1898,10 +1906,10 @@ CAMLprim value ml_z_powm(value base, value exp, value mod) Z_DECL(exp); Z_DECL(mod); + r = ml_z_alloc(); Z_ARG(base); Z_ARG(exp); Z_ARG(mod); - r = ml_z_alloc(); if (mp_exptmod(mp_base, mp_exp, mp_mod, Z_MP(r)) != MP_OKAY) { Z_END_ARG(base); Z_END_ARG(exp); @@ -1933,8 +1941,8 @@ CAMLprim value ml_z_pow(value base, value exp) if (e > 0x7fffffff) caml_invalid_argument("Z.pow: exponent too large"); #endif - Z_ARG(base); r = ml_z_alloc(); + Z_ARG(base); if (mp_expt_u32(mp_base, e, Z_MP(r)) != MP_OKAY) { Z_END_ARG(base); mp_clear(Z_MP(r)); diff --git a/tests/zq.ml b/tests/zq.ml index 63b9caa..722ebd8 100644 --- a/tests/zq.ml +++ b/tests/zq.ml @@ -917,3 +917,5 @@ let test_Q () = let _ = test_Z() let _ = test_Q() +let _ = Gc.full_major () + From 0d881883f526d7701bb5a0f5381adb35812ea6ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antoine=20Min=C3=A9?= Date: Wed, 21 Aug 2024 11:44:21 +0200 Subject: [PATCH 27/27] remove hardcoded -g --- project.mak | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.mak b/project.mak index 7c79476..b21a63a 100644 --- a/project.mak +++ b/project.mak @@ -140,7 +140,7 @@ endif $(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLINC) -c $< %.$(OBJSUFFIX): %.c - $(OCAMLC) -ccopt "$(CFLAGS) -g" -c $< + $(OCAMLC) -ccopt "$(CFLAGS)" -c $< clean: /bin/rm -rf *.$(OBJSUFFIX) *.$(LIBSUFFIX) *.$(DLLSUFFIX) *.cmi *.cmo *.cmx *.cmxa *.cmxs *.cma *.cmt *.cmti *~ \#* depend test $(AUTOGEN) tmp.c depend