From e1c735f66f882eac3197476e21de84e6a5e2ea14 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 18 Jun 2014 09:30:58 +0100 Subject: [PATCH] win64: fix fixnum-to-extfl conversion --- native-pkgs | 2 +- racket/src/racket/src/jitarith.c | 2 +- racket/src/racket/src/longdouble/longdouble.c | 14 +++++++++++++- racket/src/racket/src/longdouble/longdouble.h | 2 ++ racket/src/racket/src/number.c | 8 ++++---- racket/src/racket/src/ratfloat.inc | 9 +++++---- racket/src/racket/src/rational.c | 9 ++++++--- 7 files changed, 32 insertions(+), 14 deletions(-) diff --git a/native-pkgs b/native-pkgs index a4521921ce..60c510ba85 160000 --- a/native-pkgs +++ b/native-pkgs @@ -1 +1 @@ -Subproject commit a4521921cea66170c4b55373cda6191fb47730d5 +Subproject commit 60c510ba85d702163b317423f3c20f6fd80278c0 diff --git a/racket/src/racket/src/jitarith.c b/racket/src/racket/src/jitarith.c index 89d7a84bfa..9fa0ea0aa3 100644 --- a/racket/src/racket/src/jitarith.c +++ b/racket/src/racket/src/jitarith.c @@ -681,7 +681,7 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator } else { #ifdef MZ_LONG_DOUBLE long_double d; - d = long_double_from_int(second_const); + d = long_double_from_intptr(second_const); if (extfl) { mz_fpu_movi_ld_fppush(fpr1, d, JIT_R2) } else { diff --git a/racket/src/racket/src/longdouble/longdouble.c b/racket/src/racket/src/longdouble/longdouble.c index fc88e5a93a..99dac4e9a6 100644 --- a/racket/src/racket/src/longdouble/longdouble.c +++ b/racket/src/racket/src/longdouble/longdouble.c @@ -141,6 +141,7 @@ long_double get_long_double_half_pi() restore_mode(m); return result; } + long_double long_double_from_int(int a) { long_double result; @@ -150,7 +151,6 @@ long_double long_double_from_int(int a) return result; } - long_double long_double_from_float(float a) { long_double result; @@ -169,6 +169,15 @@ long_double long_double_from_double(double a) return result; } +long_double long_double_from_intptr(intptr_t a) +{ + long_double result; + int m = ext_mode(); + result.val = a; + restore_mode(m); + return result; +} + long_double long_double_from_uintptr(uintptr_t a) { long_double result; @@ -546,6 +555,7 @@ DECLARE_LDBL(void, set_long_double, (long_double a, long_double b)) DECLARE_LDBL(long_double, long_double_from_int, (int a)) DECLARE_LDBL(long_double, long_double_from_float, (float a)) DECLARE_LDBL(long_double, long_double_from_double, (double a)) +DECLARE_LDBL(long_double, long_double_from_intptr, (intptr_t a)) DECLARE_LDBL(long_double, long_double_from_uintptr, (uintptr_t a)) DECLARE_LDBL(double, double_from_long_double, (long_double a)) DECLARE_LDBL(float, float_from_long_double, (long_double a)) @@ -656,6 +666,7 @@ void scheme_load_long_double_dll() EXTRACT_LDBL(long_double_from_int, fail_long_double); EXTRACT_LDBL(long_double_from_float, fail_long_double); EXTRACT_LDBL(long_double_from_double, fail_long_double); + EXTRACT_LDBL(long_double_from_intptr, fail_long_double); EXTRACT_LDBL(long_double_from_uintptr, fail_long_double); EXTRACT_LDBL(double_from_long_double, fail_double); EXTRACT_LDBL(float_from_long_double, fail_float); @@ -729,6 +740,7 @@ void set_long_double(long_double a, long_double b) { _imp_set_long_double(a, b); long_double long_double_from_int(int a) { return _imp_long_double_from_int(a); } long_double long_double_from_float(float a) { return _imp_long_double_from_float(a); } long_double long_double_from_double(double a) { return _imp_long_double_from_double(a); } +long_double long_double_from_intptr(uintptr_t a) { return _imp_long_double_from_intptr(a); } long_double long_double_from_uintptr(uintptr_t a) { return _imp_long_double_from_uintptr(a); } double double_from_long_double(long_double a) { return _imp_double_from_long_double(a); } diff --git a/racket/src/racket/src/longdouble/longdouble.h b/racket/src/racket/src/longdouble/longdouble.h index 798ea9eb02..f9eca1c3e2 100644 --- a/racket/src/racket/src/longdouble/longdouble.h +++ b/racket/src/racket/src/longdouble/longdouble.h @@ -57,6 +57,7 @@ XFORM_NONGCING LDBL_DLL_API void set_long_double(long_double a, long_double b); XFORM_NONGCING LDBL_DLL_API long_double long_double_from_int(int a); XFORM_NONGCING LDBL_DLL_API long_double long_double_from_float(float a); XFORM_NONGCING LDBL_DLL_API long_double long_double_from_double(double a); +XFORM_NONGCING LDBL_DLL_API long_double long_double_from_intptr(intptr_t a); XFORM_NONGCING LDBL_DLL_API long_double long_double_from_uintptr(uintptr_t a); XFORM_NONGCING LDBL_DLL_API double double_from_long_double(long_double a); @@ -142,6 +143,7 @@ XFORM_NONGCING int long_double_available(); # define long_double_from_int(a) ((long double)(a)) # define long_double_from_float(a) ((long double)(a)) # define long_double_from_double(a) ((long double)(a)) +# define long_double_from_intptr(a) ((long double)(a)) # define long_double_from_uintptr(a) ((long double)(a)) # define double_from_long_double(a) (a) diff --git a/racket/src/racket/src/number.c b/racket/src/racket/src/number.c index 3c76539149..7846287101 100644 --- a/racket/src/racket/src/number.c +++ b/racket/src/racket/src/number.c @@ -1814,7 +1814,7 @@ int scheme_long_minus_zero_p(long_double d) long_double scheme_real_to_long_double(Scheme_Object *r) { if (SCHEME_INTP(r)) - return long_double_from_int(SCHEME_INT_VAL(r)); + return long_double_from_intptr(SCHEME_INT_VAL(r)); else if (SCHEME_DBLP(r)) return long_double_from_double(SCHEME_DBL_VAL(r)); else if (SCHEME_LONG_DBLP(r)) @@ -3990,7 +3990,7 @@ static Scheme_Object *exact_to_extfl (int argc, Scheme_Object *argv[]) Scheme_Type t; if (SCHEME_INTP(o)) - return scheme_make_long_double(long_double_from_int(SCHEME_INT_VAL(o))); + return scheme_make_long_double(long_double_from_intptr(SCHEME_INT_VAL(o))); t = _SCHEME_TYPE(o); if (t == scheme_float_type) @@ -5118,7 +5118,7 @@ static Scheme_Object *fx_to_extfl (int argc, Scheme_Object *argv[]) WHEN_LONG_DOUBLE_UNSUPPORTED(unsupported("fx->extfl")); if (!SCHEME_INTP(argv[0])) scheme_wrong_contract("fx->extfl", "fixnum?", 0, argc, argv); v = SCHEME_INT_VAL(argv[0]); - return scheme_make_long_double(long_double_from_int(v)); + return scheme_make_long_double(long_double_from_intptr(v)); #else return unsupported("fx->extfl"); #endif @@ -5291,7 +5291,7 @@ static Scheme_Object *unsafe_fx_to_extfl (int argc, Scheme_Object *argv[]) intptr_t v; if (scheme_current_thread->constant_folding) return exact_to_extfl(argc, argv); v = SCHEME_INT_VAL(argv[0]); - return scheme_make_long_double(long_double_from_int(v)); + return scheme_make_long_double(long_double_from_intptr(v)); #else return fx_to_extfl(argc, argv); #endif diff --git a/racket/src/racket/src/ratfloat.inc b/racket/src/racket/src/ratfloat.inc index cf486bea7c..560b3eaaa4 100644 --- a/racket/src/racket/src/ratfloat.inc +++ b/racket/src/racket/src/ratfloat.inc @@ -31,7 +31,7 @@ FP_TYPE SCHEME_RATIONAL_TO_FLOAT(const Scheme_Object *o) #ifdef CONVERT_INT_TO_FLOAT n = CONVERT_INT_TO_FLOAT(SCHEME_INT_VAL(r->num)); #else - n = FP_TYPE_FROM_INT(SCHEME_INT_VAL(r->num)); + n = FP_TYPE_FROM_INTPTR(SCHEME_INT_VAL(r->num)); #endif ns = 0; } else { @@ -49,7 +49,7 @@ FP_TYPE SCHEME_RATIONAL_TO_FLOAT(const Scheme_Object *o) if (SCHEME_INTP(r->denom)) { if (FIXNUM_FITS_FP(r->denom)) { - d = FP_TYPE_FROM_INT(SCHEME_INT_VAL(r->denom)); + d = FP_TYPE_FROM_INTPTR(SCHEME_INT_VAL(r->denom)); ds = 0; } else { d = FP_ZEROx; @@ -130,11 +130,11 @@ FP_TYPE SCHEME_RATIONAL_TO_FLOAT(const Scheme_Object *o) } if (SCHEME_INTP(n)) - res = FP_TYPE_FROM_INT(SCHEME_INT_VAL(n)); + res = FP_TYPE_FROM_INTPTR(SCHEME_INT_VAL(n)); else res = SCHEME_BIGNUM_TO_FLOAT_INF_INFO(n, 0, NULL); - res = FP_MULT(res, FP_TYPE_FROM_INT(FP_POWx(2, p - shift))); + res = FP_MULT(res, FP_POWx(FP_TYPE_FROM_INT(2), FP_TYPE_FROM_INTPTR(p - shift))); if (SCHEME_INTP(r->num)) { if (SCHEME_INT_VAL(r->num) < 0) @@ -291,6 +291,7 @@ Scheme_Object *SCHEME_RATIONAL_FROM_FLOAT(FP_TYPE d) #undef FP_DIV #undef FP_NEG #undef FP_LESS +#undef FP_TYPE_FROM_INTPTR #undef FP_TYPE_FROM_INT #undef FP_LDEXP #undef FP_EQV diff --git a/racket/src/racket/src/rational.c b/racket/src/racket/src/rational.c index c6674f4032..ad03d11b87 100644 --- a/racket/src/racket/src/rational.c +++ b/racket/src/racket/src/rational.c @@ -526,7 +526,8 @@ Scheme_Object *scheme_rational_sqrt(const Scheme_Object *o) #define FP_EQV(x,y) x==y #define FP_LESS(x, y) x