[Pkg-ocaml-maint-commits] [ocaml-zarith] 01/05: Imported Upstream version 1.3
Mehdi Dogguy
mehdi at moszumanska.debian.org
Fri Jul 31 17:08:13 UTC 2015
This is an automated email from the git hooks/post-receive script.
mehdi pushed a commit to branch master
in repository ocaml-zarith.
commit 4c8d6632dd2fa5579038af75b504495400ba31ac
Author: Mehdi Dogguy <mehdi at debian.org>
Date: Fri Jul 31 18:55:42 2015 +0000
Imported Upstream version 1.3
---
Changes | 11 ++++++
META | 2 +-
caml_z.c | 93 ++++++++++++++++++++++++++-----------------------
caml_z_arm.S | 25 ++++++-------
caml_z_x86_64.S | 3 +-
caml_z_x86_64_mingw64.S | 3 +-
project.mak | 4 ++-
z.mlip | 6 ++--
z.mlp | 6 ++--
z_pp.ml | 10 +++++-
z_pp.pl | 8 +++++
11 files changed, 99 insertions(+), 72 deletions(-)
diff --git a/Changes b/Changes
index 6c9d02b..f935336 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,14 @@
+Release 1.3 (2014-09-03):
+- Fixed inefficiencies in asm fast path for ARM.
+- Revised detection of NaNs and infinities in Z.of_float
+- Suppress the redundant fast paths written in C if a corresponding
+ fast path exists in asm.
+- Use <stdint.h> to ensure compatibility with OCaml 4.02.
+- More prudent implementation of Z.of_int, avoids GC problem
+ with OCaml < 4.02 (PR#6501 in the OCaml bug tracker).
+- PR#1429: of_string accepts 'a' in base 10.
+- Macro change to avoid compiler warnings on unused variables.
+
Release 1.2.1 (2013-06-12):
- Install fixes
diff --git a/META b/META
index beb98da..c082c65 100644
--- a/META
+++ b/META
@@ -1,5 +1,5 @@
description = "Arbitrary precision integers"
requires = ""
-version = "1.2.1"
+version = "1.3"
archive(byte) = "zarith.cma"
archive(native) = "zarith.cmxa"
diff --git a/caml_z.c b/caml_z.c
index d9fe289..8b62d04 100644
--- a/caml_z.c
+++ b/caml_z.c
@@ -25,6 +25,7 @@
#include <stdlib.h>
#include <string.h>
#include <math.h>
+#include <stdint.h>
#ifdef HAS_GMP
#include <gmp.h>
@@ -33,6 +34,9 @@
#include <mpir.h>
#endif
+#include "features.h"
+#include "zarith.h"
+
#ifdef __cplusplus
extern "C" {
#endif
@@ -53,9 +57,6 @@ extern "C" {
#ifdef _MSC_VER
#include <float.h>
-#define isnan _isnan
-static const double inf_helper = 1.0;
-#define isinf(x) ((x == (1.0 / (inf_helper - 1.0))) || (x == -(1.0 / (inf_helper - 1.0))))
#endif
/*---------------------------------------------------
@@ -248,7 +249,7 @@ void ml_z_check(const char* fn, int line, const char* arg, value v)
arg, fn, line);
exit(1);
}
- if ((mp_size_t) Z_LIMB(v)[sz - 2] != (0xDEADBEEF ^ (sz - 2))) {
+ if ((mp_size_t) Z_LIMB(v)[sz - 2] != (mp_size_t)(0xDEADBEEF ^ (sz - 2))) {
printf("ml_z_check: corrupted block for %s at %s:%i.\n",
arg, fn, line);
exit(1);
@@ -334,14 +335,18 @@ static inline mp_limb_t* ml_z_dup_limb(mp_limb_t* src, mp_size_t sz)
#define Z_DECL(arg) \
mp_limb_t loc_##arg, *ptr_##arg; \
mp_size_t size_##arg; \
- intnat sign_##arg
+ intnat sign_##arg; \
+ (void)loc_##arg; \
+ (void)ptr_##arg; \
+ (void)size_##arg; \
+ (void)sign_##arg;
#define Z_ARG(arg) \
if (Is_long(arg)) { \
intnat n = Long_val(arg); \
- if (n < 0) { loc_##arg = -n; sign_##arg = Z_SIGN_MASK; size_##arg = 1; } \
- else if (n > 0) { loc_##arg = n; sign_##arg = 0; size_##arg = 1; } \
- else { loc_##arg = 0; sign_##arg = 0; size_##arg = 0; } \
+ loc_##arg = n < 0 ? -n : n; \
+ sign_##arg = n & Z_SIGN_MASK; \
+ size_##arg = n != 0; \
ptr_##arg = &loc_##arg; \
} \
else { \
@@ -430,7 +435,7 @@ CAMLprim value ml_z_of_nativeint(value v)
CAMLprim value ml_z_of_int32(value v)
{
- int32 x;
+ int32_t x;
value r;
Z_MARK_OP;
x = Int32_val(v);
@@ -452,7 +457,7 @@ CAMLprim value ml_z_of_int32(value v)
CAMLprim value ml_z_of_int64(value v)
{
- int64 x;
+ int64_t x;
value r;
Z_MARK_OP;
x = Int64_val(v);
@@ -484,7 +489,7 @@ CAMLprim value ml_z_of_float(value v)
{
double x;
int exp;
- int64 y, m;
+ int64_t y, m;
value r;
Z_MARK_OP;
x = Double_val(v);
@@ -492,14 +497,14 @@ CAMLprim value ml_z_of_float(value v)
if (x >= Z_MIN_INT_FL && x <= Z_MAX_INT_FL) return Val_long(x);
#endif
Z_MARK_SLOW;
- if (isinf(x) || isnan(x)) ml_z_raise_overflow();
#ifdef ARCH_ALIGN_INT64
- memcpy(&y, v, 8);
+ memcpy(&y, (void *) v, 8);
#else
- y = *((int64*)v);
+ y = *((int64_t*)v);
#endif
exp = ((y >> 52) & 0x7ff) - 1023; /* exponent */
if (exp < 0) return(Val_long(0));
+ if (exp == 1024) ml_z_raise_overflow(); /* NaN or infinity */
m = (y & 0x000fffffffffffffLL) | 0x0010000000000000LL; /* mantissa */
if (exp <= 52) {
m >>= 52-exp;
@@ -570,7 +575,7 @@ CAMLprim value ml_z_of_string_base(value b, value v)
else if (dd[i] >= 'a' && dd[i] <= 'f') dd[i] -= 'a' - 10;
else if (dd[i] >= 'A' && dd[i] <= 'F') dd[i] -= 'A' - 10;
else caml_invalid_argument("Z.of_string_base: invalid number");
- if (dd[i] > base)
+ if (dd[i] >= base)
caml_invalid_argument("Z.of_string_base: invalid number");
}
r = ml_z_alloc(1 + sz / (2 * sizeof(mp_limb_t)));
@@ -663,7 +668,7 @@ CAMLprim value ml_z_to_int32(value v)
CAMLprim value ml_z_to_int64(value v)
{
- int64 x = 0;
+ int64_t x = 0;
Z_DECL(v);
Z_MARK_OP;
Z_CHECK(v);
@@ -674,16 +679,16 @@ CAMLprim value ml_z_to_int64(value v)
case 0: x = 0; break;
case 1: x = ptr_v[0]; break;
#ifndef ARCH_SIXTYFOUR
- case 2: x = ptr_v[0] | ((uint64)ptr_v[1] << 32); break;
+ case 2: x = ptr_v[0] | ((uint64_t)ptr_v[1] << 32); break;
#endif
default: ml_z_raise_overflow(); break;
}
if (sign_v) {
- if ((uint64)x > Z_HI_INT64) ml_z_raise_overflow();
+ if ((uint64_t)x > Z_HI_INT64) ml_z_raise_overflow();
x = -x;
}
else {
- if ((uint64)x >= Z_HI_INT64) ml_z_raise_overflow();
+ if ((uint64_t)x >= Z_HI_INT64) ml_z_raise_overflow();
}
return caml_copy_int64(x);
}
@@ -1128,7 +1133,7 @@ CAMLprim value ml_z_fits_int32(value v)
CAMLprim value ml_z_fits_int64(value v)
{
- int64 x;
+ int64_t x;
Z_DECL(v);
Z_MARK_OP;
Z_CHECK(v);
@@ -1139,15 +1144,15 @@ CAMLprim value ml_z_fits_int64(value v)
case 0: return Val_true;
case 1: x = ptr_v[0]; break;
#ifndef ARCH_SIXTYFOUR
- case 2: x = ptr_v[0] | ((uint64)ptr_v[1] << 32); break;
+ case 2: x = ptr_v[0] | ((uint64_t)ptr_v[1] << 32); break;
#endif
default: return Val_false;
}
if (sign_v) {
- if ((uint64)x > Z_HI_INT64) return Val_false;
+ if ((uint64_t)x > Z_HI_INT64) return Val_false;
}
else {
- if ((uint64)x >= Z_HI_INT64) return Val_false;
+ if ((uint64_t)x >= Z_HI_INT64) return Val_false;
}
return Val_true;
}
@@ -1168,7 +1173,7 @@ CAMLprim value ml_z_neg(value arg)
{
Z_MARK_OP;
Z_CHECK(arg);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_neg)
if (Is_long(arg)) {
/* fast path */
if (arg > Val_long(Z_MIN_INT)) return 2 - arg;
@@ -1194,7 +1199,7 @@ CAMLprim value ml_z_abs(value arg)
{
Z_MARK_OP;
Z_CHECK(arg);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_abs)
if (Is_long(arg)) {
/* fast path */
if (arg >= Val_long(0)) return arg;
@@ -1300,7 +1305,7 @@ CAMLprim value ml_z_add(value arg1, value arg2)
{
Z_MARK_OP;
Z_CHECK(arg1); Z_CHECK(arg2);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_add)
if (Is_long(arg1) && Is_long(arg2)) {
/* fast path */
intnat a1 = Long_val(arg1);
@@ -1318,7 +1323,7 @@ CAMLprim value ml_z_sub(value arg1, value arg2)
{
Z_MARK_OP;
Z_CHECK(arg1); Z_CHECK(arg2);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_sub)
if (Is_long(arg1) && Is_long(arg2)) {
/* fast path */
intnat a1 = Long_val(arg1);
@@ -1337,7 +1342,7 @@ CAMLprim value ml_z_mul(value arg1, value arg2)
Z_DECL(arg1); Z_DECL(arg2);
Z_MARK_OP;
Z_CHECK(arg1); Z_CHECK(arg2);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_mul)
if (Is_long(arg1) && Is_long(arg2)) {
/* fast path */
intnat a1 = Long_val(arg1);
@@ -1452,7 +1457,7 @@ CAMLprim value ml_z_div(value arg1, value arg2)
{
Z_MARK_OP;
Z_CHECK(arg1); Z_CHECK(arg2);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_div)
if (Is_long(arg1) && Is_long(arg2)) {
/* fast path */
intnat a1 = Long_val(arg1);
@@ -1472,7 +1477,7 @@ CAMLprim value ml_z_rem(value arg1, value arg2)
{
Z_MARK_OP;
Z_CHECK(arg1); Z_CHECK(arg2);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_rem)
if (Is_long(arg1) && Is_long(arg2)) {
/* fast path */
intnat a1 = Long_val(arg1);
@@ -1604,7 +1609,7 @@ CAMLprim value ml_z_succ(value arg)
{
Z_MARK_OP;
Z_CHECK(arg);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_succ)
if (Is_long(arg)) {
/* fast path */
if (arg < Val_long(Z_MAX_INT)) return arg + 2;
@@ -1619,7 +1624,7 @@ CAMLprim value ml_z_pred(value arg)
{
Z_MARK_OP;
Z_CHECK(arg);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_pred)
if (Is_long(arg)) {
/* fast path */
if (arg > Val_long(Z_MIN_INT)) return arg - 2;
@@ -1822,7 +1827,7 @@ CAMLprim value ml_z_logand(value arg1, value arg2)
{
Z_MARK_OP;
Z_CHECK(arg1); Z_CHECK(arg2);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_logand)
if (Is_long(arg1) && Is_long(arg2)) {
/* fast path */
return arg1 & arg2;
@@ -1904,7 +1909,7 @@ CAMLprim value ml_z_logor(value arg1, value arg2)
{
Z_MARK_OP;
Z_CHECK(arg1); Z_CHECK(arg2);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_logor)
if (Is_long(arg1) && Is_long(arg2)) {
/* fast path */
return arg1 | arg2;
@@ -1990,7 +1995,7 @@ CAMLprim value ml_z_logxor(value arg1, value arg2)
{
Z_MARK_OP;
Z_CHECK(arg1); Z_CHECK(arg2);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_logxor)
if (Is_long(arg1) && Is_long(arg2)) {
/* fast path */
return (arg1 ^ arg2) | 1;
@@ -2076,7 +2081,7 @@ CAMLprim value ml_z_lognot(value arg)
{
Z_MARK_OP;
Z_CHECK(arg);
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_lognot)
if (Is_long(arg)) {
/* fast path */
return (~arg) | 1;
@@ -2125,7 +2130,7 @@ CAMLprim value ml_z_shift_left(value arg, value count)
if (!c) return arg;
c1 = c / Z_LIMB_BITS;
c2 = c % Z_LIMB_BITS;
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_shift_left)
if (Is_long(arg) && !c1) {
/* fast path */
value a = arg - 1;
@@ -2174,7 +2179,7 @@ CAMLprim value ml_z_shift_right(value arg, value count)
if (!c) return arg;
c1 = c / Z_LIMB_BITS;
c2 = c % Z_LIMB_BITS;
-#if Z_FAST_PATH
+#if Z_FAST_PATH && !defined(Z_ASM_shift_right)
if (Is_long(arg)) {
/* fast path */
if (c1) {
@@ -2600,11 +2605,11 @@ static intnat ml_z_custom_hash(value v)
{
Z_DECL(v);
mp_size_t i;
- uint32 acc = 0;
+ uint32_t acc = 0;
Z_CHECK(v);
Z_ARG(v);
for (i = 0; i < size_v; i++) {
- acc = caml_hash_mix_uint32(acc, (uint32)(ptr_v[i]));
+ acc = caml_hash_mix_uint32(acc, (uint32_t)(ptr_v[i]));
#ifdef ARCH_SIXTYFOUR
acc = caml_hash_mix_uint32(acc, ptr_v[i] >> 32);
#endif
@@ -2636,7 +2641,7 @@ static void ml_z_custom_serialize(value v,
Z_DECL(v);
Z_CHECK(v);
Z_ARG(v);
- if ((mp_size_t)(uint32) size_v != size_v)
+ if ((mp_size_t)(uint32_t) size_v != size_v)
caml_failwith("Z.serialize: number is too large");
nb = size_v * sizeof(mp_limb_t);
caml_serialize_int_1(sign_v ? 1 : 0);
@@ -2671,9 +2676,9 @@ static uintnat ml_z_custom_deserialize(void * dst)
{
mp_limb_t* d = ((mp_limb_t*)dst) + 1;
int sign = caml_deserialize_uint_1();
- uint32 sz = caml_deserialize_uint_4();
- uint32 szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t);
- uint32 i = 0;
+ uint32_t sz = caml_deserialize_uint_4();
+ uint32_t szw = (sz + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t);
+ uint32_t i = 0;
mp_limb_t x;
/* all limbs but last */
if (szw > 1) {
diff --git a/caml_z_arm.S b/caml_z_arm.S
index 221eb3e..033c4c5 100644
--- a/caml_z_arm.S
+++ b/caml_z_arm.S
@@ -88,7 +88,7 @@ L(abs):
PROLOG(succ)
tst r0, #1
beq L(succ)
- add r1, r0, #2
+ adds r1, r0, #2
bvs L(succ)
mov r0, r1
OP
@@ -102,7 +102,7 @@ L(succ):
PROLOG(pred)
tst r0, #1
beq L(pred)
- sub r1, r0, #2
+ subs r1, r0, #2
bvs L(pred)
mov r0, r1
OP
@@ -154,18 +154,14 @@ L(sub):
and r2, r0, r1
tst r2, #1
beq L(mul)
- push {r0, r1}
sub r2, r0, #1
mov r3, r1, asr #1
- smull r0, r1, r2, r3
- cmp r1, r0, asr #31
- bne L(mul2)
- add sp, sp, #8
- add r0, r0, #1
+ smull r3, r12, r2, r3 /* r3 = low half of product, r12 = high half */
+ cmp r12, r3, asr #31 /* high half must equal sign-ext of low half */
+ bne L(mul) /* otherwise, overflow occurred */
+ add r0, r3, #1
OP
bx lr
-L(mul2):
- pop {r0, r1}
L(mul):
C_JMP(mul)
EPILOG(mul)
@@ -231,15 +227,14 @@ L(logxor):
PROLOG(shift_left)
tst r0, #1
beq L(shift_left)
- cmp r1, #63 /* 32 in 2n+1 encoding */
+ cmp r1, #63 /* 31 in 2n+1 encoding */
bhs L(shift_left)
mov r3, r1, asr #1
sub r2, r0, #1
- mov r2, r2, lsl r3
- mov r3, r2, asr r3
- cmp r2, r3
+ mov r12, r2, lsl r3
+ cmp r2, r12, asr r3
bne L(shift_left) /* overflow occurred */
- orr r0, r2, #1
+ orr r0, r12, #1
OP
bx lr
L(shift_left):
diff --git a/caml_z_x86_64.S b/caml_z_x86_64.S
index 7ccf136..b2fa63b 100644
--- a/caml_z_x86_64.S
+++ b/caml_z_x86_64.S
@@ -315,9 +315,8 @@ L(logor):
jz L(logxor)
test $1, %sil
jz L(logxor)
- mov %rdi, %rax
+ lea -1(%rdi), %rax
xor %rsi, %rax
- inc %rax
OP
ret
L(logxor):
diff --git a/caml_z_x86_64_mingw64.S b/caml_z_x86_64_mingw64.S
index 18c5beb..150b473 100644
--- a/caml_z_x86_64_mingw64.S
+++ b/caml_z_x86_64_mingw64.S
@@ -282,9 +282,8 @@ SYMB(ml_as_z_##proc):\
jz .Llogxor
test $1, %rdx
jz .Llogxor
- mov %rcx, %rax
+ lea -1(%rcx), %rax
xor %rdx, %rax
- inc %rax
OP
ret
.Llogxor:
diff --git a/project.mak b/project.mak
index bab8410..dcadf69 100644
--- a/project.mak
+++ b/project.mak
@@ -36,7 +36,7 @@ SSRC = $(wildcard caml_z_$(ARCH).S)
MLSRC = z.ml q.ml big_int_Z.ml
MLISRC = z.mli q.mli big_int_Z.mli
-AUTOGEN = z.ml z.mli
+AUTOGEN = z.ml z.mli features.h
CMIOBJ = $(MLISRC:%.mli=%.cmi)
TOINSTALL := zarith.h zarith.cma libzarith.$(LIBSUFFIX) $(MLISRC) $(CMIOBJ)
@@ -149,4 +149,6 @@ depend: $(AUTOGEN)
include depend
+$(CSRC:%.c=%.$(OBJSUFFIX)): features.h zarith.h
+
.PHONY: clean
diff --git a/z.mlip b/z.mlip
index 758506d..561e1f1 100644
--- a/z.mlip
+++ b/z.mlip
@@ -60,7 +60,7 @@ val one: t
val minus_one: t
(** The number -1. *)
-val of_int: int -> t
+external of_int: int -> t = "ml_z_of_int"
(** Converts from a base integer. *)
external of_int32: int32 -> t = "ml_z_of_int32"
@@ -499,7 +499,7 @@ external of_bits: string -> t = "ml_z_of_bits"
external (~-): t -> t = neg at ASM
(** Negation [neg]. *)
-external (~+): t -> t = "%identity"
+val (~+): t -> t
(** Identity. *)
external (+): t -> t -> t = add at ASM
@@ -544,7 +544,7 @@ external (lsl): t -> int -> t = shift_left at ASM
external (asr): t -> int -> t = shift_right at ASM
(** Bit-wise shift to the right [shift_right]. *)
-external (~$): int -> t = "%identity"
+external (~$): int -> t = "ml_z_of_int"
(** Conversion from [int] [of_int]. *)
external ( ** ): t -> int -> t = "ml_z_pow"
diff --git a/z.mlp b/z.mlp
index 91c844a..c23b424 100644
--- a/z.mlp
+++ b/z.mlp
@@ -86,7 +86,7 @@ external hash: t -> int = "ml_z_hash"
external to_bits: t -> string = "ml_z_to_bits"
external of_bits: string -> t = "ml_z_of_bits"
-external of_int: int -> t = "%identity" (* it's magic... *)
+external of_int: int -> t = "ml_z_of_int"
let zero = of_int 0
let one = of_int 1
@@ -143,7 +143,7 @@ let bprint b x = Buffer.add_string b (to_string x)
let pp_print f x = Format.pp_print_string f (to_string x)
external (~-): t -> t = neg at ASM
-external (~+): t -> t = "%identity"
+let (~+) x = x
external (+): t -> t -> t = add at ASM
external (-): t -> t -> t = sub at ASM
external ( * ): t -> t -> t = mul at ASM
@@ -158,7 +158,7 @@ external (lxor): t -> t -> t = logxor at ASM
external (~!): t -> t = lognot at ASM
external (lsl): t -> int -> t = shift_left at ASM
external (asr): t -> int -> t = shift_right at ASM
-external (~$): int -> t = "%identity"
+external (~$): int -> t = "ml_z_of_int"
external ( ** ): t -> int -> t = "ml_z_pow"
let version = @VERSION
diff --git a/z_pp.ml b/z_pp.ml
index f89f636..472ae98 100644
--- a/z_pp.ml
+++ b/z_pp.ml
@@ -72,6 +72,14 @@ let treat_file =
close_in input
;;
+let generate_config filename =
+ let oc = open_out filename in
+ StringSet.iter
+ (fun f -> Printf.fprintf oc "#define Z_ASM_%s\n" f)
+ !funcnames;
+ close_out oc
+;;
+
let _ = treat_file "ml"
let _ = treat_file "mli"
-
+let _ = generate_config "features.h"
diff --git a/z_pp.pl b/z_pp.pl
index 23acf5c..8262a4f 100755
--- a/z_pp.pl
+++ b/z_pp.pl
@@ -69,3 +69,11 @@ sub doml {
doml "ml";
doml "mli";
+
+# generate a features.h file recording the functions defined in asm
+
+open F, "> features.h";
+for $i (sort (keys %ASM_FUNS)) {
+ print F "#define Z_ASM_$i\n";
+}
+close F;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocaml-zarith.git
More information about the Pkg-ocaml-maint-commits
mailing list