suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

win64: fix fixnum-to-extfl conversion

Browse Source
This commit is contained in:
Matthew Flatt 2014-06-18 09:30:58 +01:00
parent 3e3cb71680
commit e1c735f66f
7 changed files with 32 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
native-pkgs

@ -1 +1 @@
Subproject commit a4521921cea66170c4b55373cda6191fb47730d5
Subproject commit 60c510ba85d702163b317423f3c20f6fd80278c0

2
racket/src/racket/src/jitarith.c
View File

@ -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 {

14
racket/src/racket/src/longdouble/longdouble.c
View File

@ -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); }

2
racket/src/racket/src/longdouble/longdouble.h
View File

@ -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)

8
racket/src/racket/src/number.c
View File

@ -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

9
racket/src/racket/src/ratfloat.inc
View File

@ -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

9
racket/src/racket/src/rational.c
View File

@ -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<y
#define FP_IS_ZERO(x) x==0.0
#define FP_TYPE_FROM_INT(x) (FP_TYPE)x
#define FP_TYPE_FROM_INT(x) ((FP_TYPE)(x))
#define FP_TYPE_FROM_INTPTR(x) ((FP_TYPE)(x))
#ifdef SIXTY_FOUR_BIT_INTEGERS
# define FIXNUM_FITS_FP(x) (!(SCHEME_INT_VAL(x) & ~(((intptr_t)1 << (FLOAT_M_BITS-1)) - 1)))
# define BIGNUM_FITS_FP(x) 0
@ -553,7 +554,8 @@ Scheme_Object *scheme_rational_sqrt(const Scheme_Object *o)
#define FP_NEG(x) -x
#define FP_EQV(x,y) x==y
#define FP_LESS(x, y) x<y
#define FP_TYPE_FROM_INT(x) (FP_TYPE)x
#define FP_TYPE_FROM_INT(x) ((FP_TYPE)(x))
#define FP_TYPE_FROM_INTPTR(x) ((FP_TYPE)(x))
#define FIXNUM_FITS_FP(x) (!(SCHEME_INT_VAL(x) & ~(((intptr_t)1 << (FLOAT_M_BITS-1)) - 1)))
#define FP_IS_ZERO(x) x==0.0
#define BIGNUM_FITS_FP(x) 0
@ -581,6 +583,7 @@ Scheme_Object *scheme_rational_sqrt(const Scheme_Object *o)
# define FP_EQV(x,y) long_double_eqv(x,y)
# define FP_LESS(x, y) long_double_less(x,y)
# define FP_TYPE_FROM_INT(x) long_double_from_int(x)
# define FP_TYPE_FROM_INTPTR(x) long_double_from_intptr(x)
# define FIXNUM_FITS_FP(x) 1
# define BIGNUM_FITS_FP(x) (scheme_integer_length(x) <= (FLOAT_M_BITS-1))
# define FP_IS_ZERO(x) long_double_is_zero(x)
@ -593,7 +596,7 @@ Scheme_Object *scheme_rational_sqrt(const Scheme_Object *o)
# define FLOAT_M_BITS 64
# define FLOAT_E_BITS 15
# define FP_ZEROx get_long_double_zero()
# define FP_POWx pow
# define FP_POWx long_double_pow
# define FP_MODFx long_double_modf
# define FP_FREXPx long_double_frexp
# define FP_LDEXP long_double_ldexp