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

make fl->fx truncate

Browse Source 
Change `fl->fx` to truncate as it converts, which is typically done
anyway by a machine instruction to convert from floating-point to
integer values. This makes `fl->fx` different from `inexact->exact`
or `fl->exact-integer`, but it brings BC and CS in line.
This commit is contained in:
Matthew Flatt 2020-06-10 18:55:33 -06:00
parent fd236d99ef
commit 42cb80bc70
23 changed files with 409 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "7.7.0.7")
(define version "7.7.0.8")
(define deps `("racket-lib"
["racket" #:version ,version]))

9
pkgs/racket-doc/scribblings/reference/extflonums.scrbl
View File

@ -110,13 +110,16 @@ Like @racket[flsin], @racket[flcos], @racket[fltan], @racket[flasin],
@defproc[(extfl->exact-integer [a extflonum?]) exact-integer?]
@defproc[(real->extfl [a real?]) extflonum?]
@defproc[(extfl->exact [a extflonum?]) (and/c real? exact?)]
@defproc[(extfl->fl [a extflonum?]) fixnum?]
@defproc[(extfl->inexact [a extflonum?]) flonum?]
)]{
The first four are like @racket[->fl], @racket[fl->exact],
@racket[fl->real], @racket[inexact->exact], but for @tech{extflonums}.
The first five are like @racket[->fl], @racket[fl->exact-integer],
@racket[real->fl], @racket[inexact->exact], and @racket[fl->fx], but for @tech{extflonums}.
The @racket[extfl->inexact] function converts a @tech{extflonum} to
its closest @tech{flonum} approximation.}
its closest @tech{flonum} approximation.
@history[#:changed "7.7.0.8" @elem{Changed @racket[extfl->fx] to truncate.}]}
@; ------------------------------------------------------------------------

15
pkgs/racket-doc/scribblings/reference/fixnums.scrbl
View File

@ -96,10 +96,21 @@ Safe versions of @racket[unsafe-fx=], @racket[unsafe-fx<],
@deftogether[(
@defproc[(fx->fl [a fixnum?]) flonum?]
@defproc[(fl->fx [a flonum?]) fixnum?]
@defproc[(fl->fx [fl flonum?]) fixnum?]
)]{
Safe versions of @racket[unsafe-fx->fl] and @racket[unsafe-fl->fx].}
Conversion between @tech{fixnums} and @tech{flonums} with truncation
in the case of converting a @tech{flonum} to a @tech{fixnum}.
The @racket[fx->fl] function is the same as @racket[exact->inexact] or
@racket[->fl] constrained to a fixnum argument.
The @racket[fl->fx] function is the same as @racket[truncate] followed
by @racket[inexact->exact] or @racket[fl->exact-integer] constrained
to returning a fixnum. If the truncated flonum does not fit into a
fixnum, the @exnraise[exn:fail:contract].
@history[#:changed "7.7.0.8" @elem{Changed @racket[fl->fx] to truncate.}]}
@defproc[(fixnum-for-every-system? [v any/c]) boolean?]{

15
pkgs/racket-doc/scribblings/reference/unsafe.scrbl
View File

@ -196,10 +196,10 @@ For @tech{flonums}: Unchecked versions of @racket[make-flrectangular],
@defproc[(unsafe-fx->fl [a fixnum?]) flonum?]
@defproc[(unsafe-fl->fx [a flonum?]) fixnum?]
)]{
Unchecked conversion of a fixnum to an integer flonum and vice versa.
These are similar to the safe bindings @racket[->fl] and @racket[fl->exact-integer],
but further constrained to consume or produce a fixnum.
}
Unchecked versions of @racket[fx->fl] and @racket[fl->fx].
@history[#:changed "7.7.0.8" @elem{Changed @racket[unsafe-fl->fx] to truncate.}]}
@defproc[(unsafe-flrandom [rand-gen pseudo-random-generator?]) (and flonum? (>/c 0) (</c 1))]{
@ -669,10 +669,9 @@ aliases for the corresponding safe bindings.}
@defproc[(unsafe-fx->extfl [a fixnum?]) extflonum?]
@defproc[(unsafe-extfl->fx [a extflonum?]) fixnum?]
)]{
Unchecked conversion of a @tech{fixnum} to an integer @tech{extflonum} and vice versa.
These are similar to the safe bindings @racket[->extfl] and @racket[extfl->exact-integer],
but further constrained to consume or produce a fixnum.
}
Unchecked (potentially) versions of @racket[fx->extfl] and @racket[extfl->fx].
@history[#:changed "7.7.0.8" @elem{Changed @racket[unsafe-fl->fx] to truncate.}]}
@deftogether[(
@defproc[(unsafe-extflvector-length [v extflvector?]) fixnum?]

55
pkgs/racket-test-core/tests/racket/extflonum.rktl
View File

@ -418,6 +418,61 @@
;; ----------------------------------------
(test 2 extfl->fx 2.0t0)
(test 2 extfl->fx 2.2t0)
(test -2 extfl->fx -2.0t0)
(test -2 extfl->fx -2.2t0)
(test 0 extfl->fx 0.0t0)
(test 0 extfl->fx -0.0t0)
(err/rt-test (extfl->fx +inf.t))
(err/rt-test (extfl->fx -inf.t))
(err/rt-test (extfl->fx +nan.t))
(if (fixnum? 536870911)
(begin
(test 536870911 extfl->fx 536870911.0t0)
(test 536870911 extfl->fx 536870911.5t0))
(begin
(err/rt-test (extfl->fx 536870911.0t0))
(err/rt-test (extfl->fx 536870911.5t0))))
(if (fixnum? -536870912)
(begin
(test -536870912 extfl->fx -536870912.0t0)
(test -536870912 extfl->fx -536870912.5t0))
(begin
(err/rt-test (extfl->fx -536870912.0t0))
(err/rt-test (extfl->fx -536870912.5t0))))
(if (fixnum? 1073741823)
(begin
(test 1073741823 extfl->fx 1073741823.0t0)
(test 1073741823 extfl->fx 1073741823.5t0))
(begin
(err/rt-test (extfl->fx 1073741823.0t0))
(err/rt-test (extfl->fx 1073741823.5t0))))
(if (fixnum? -1073741824)
(begin
(test -1073741824 extfl->fx -1073741824.0t0)
(test -1073741824 extfl->fx -1073741824.5t0))
(begin
(err/rt-test (extfl->fx -1073741824.0t0))
(err/rt-test (extfl->fx -1073741824.5t0))))
(if (fixnum? 4611686018427387903)
(test 4611686018427387903 extfl->fx 4611686018427387903.0t0)
(err/rt-test (extfl->fx 4611686018427387903.0t0)))
(if (fixnum? -4611686018427387904)
(test -4611686018427387904 extfl->fx -4611686018427387904.0t0)
(err/rt-test (extfl->fx -4611686018427387904.0t0)))
;; Too big for all current fixnum ranges:
(err/rt-test (extfl->fx 4611686018427387904.0t0))
(err/rt-test (extfl->fx -4611686018427387905.0t0))
)
(report-errs)

75
pkgs/racket-test-core/tests/racket/fixnum.rktl
View File

@ -269,4 +269,79 @@
;; ----------------------------------------
(test 2.0 fx->fl 2)
(test -2.0 fx->fl -2)
(test 2 fl->fx 2.0)
(test 2 fl->fx 2.2)
(test -2 fl->fx -2.0)
(test -2 fl->fx -2.2)
(test 0 fl->fx 0.0)
(test 0 fl->fx -0.0)
(err/rt-test (fl->fx +inf.0))
(err/rt-test (fl->fx -inf.0))
(err/rt-test (fl->fx +nan.0))
(if (fixnum? 536870911)
(begin
(test 536870911 fl->fx 536870911.0)
(test 536870911 fl->fx 536870911.5))
(begin
(err/rt-test (fl->fx 536870911.0))
(err/rt-test (fl->fx 536870911.5))))
(if (fixnum? -536870912)
(begin
(test -536870912 fl->fx -536870912.0)
(test -536870912 fl->fx -536870912.5))
(begin
(err/rt-test (fl->fx -536870912.0))
(err/rt-test (fl->fx -536870912.5))))
(if (fixnum? 1073741823)
(begin
(test 1073741823 fl->fx 1073741823.0)
(test 1073741823 fl->fx 1073741823.5))
(begin
(err/rt-test (fl->fx 1073741823.0))
(err/rt-test (fl->fx 1073741823.5))))
(if (fixnum? -1073741824)
(begin
(test -1073741824 fl->fx -1073741824.0)
(test -1073741824 fl->fx -1073741824.5))
(begin
(err/rt-test (fl->fx -1073741824.0))
(err/rt-test (fl->fx -1073741824.5))))
(if (fixnum? 1152921504606846975)
(test 1152921504606846848 fl->fx 1152921504606846800.0)
(err/rt-test (fl->fx 1152921504606846800.0)))
(if (fixnum? -1152921504606846976)
(test -1152921504606846976 fl->fx -1152921504606847000.0)
(err/rt-test (fl->fx -1152921504606847000.0)))
(if (fixnum? 1152921504606846976)
(test 1152921504606846976 fl->fx 1152921504606847000.0)
(err/rt-test (fl->fx 1152921504606847000.0)))
(if (fixnum? -1152921504606847232)
(test -1152921504606847232 fl->fx -1152921504606847200.0)
(err/rt-test (fl->fx -1152921504606847200.0)))
(if (fixnum? 4611686018427387903)
;; Note: 4611686018427387903 won't round-trip
;; if it's the biggest fixnum
(test 4611686018427387392 fl->fx 4.6116860184273874e+18)
(err/rt-test (fl->fx 4.6116860184273874e+18)))
(if (fixnum? -4611686018427387904)
;; Ditto (about round-trip)
(test -4611686018427387904 fl->fx -4.611686018427388e+18)
(err/rt-test (fl->fx -4.611686018427388e+18)))
;; Too big for all current fixnum ranges:
(err/rt-test (fl->fx 4.611686018427388e+18))
(err/rt-test (fl->fx -4.611686018427389e+18))
;; ----------------------------------------
(report-errs)

14
pkgs/racket-test-core/tests/racket/jitinline.rktl
View File

@ -547,7 +547,14 @@
(un-exact -1 'fl->exact-integer -1.0)
(un-exact (inexact->exact 5e200) 'fl->exact-integer 5e200)
(un-exact 11 'fl->fx 11.0 #t)
(un-exact 11 'fl->fx 11.5 #t)
(un-exact -11 'fl->fx -11.0)
(un-exact -11 'fl->fx -11.5)
(check-error-message 'fl->fx (eval `(lambda (x) (fl->fx x))) #:bad-value (exact->inexact (expt 2 100)))
(check-error-message 'fl->fx (eval `(lambda (x) (fl->fx x))) #:bad-value (exact->inexact (- (expt 2 100))))
(check-error-message 'fl->fx (eval `(lambda (x) (fl->fx x))) #:bad-value +inf.0)
(check-error-message 'fl->fx (eval `(lambda (x) (fl->fx x))) #:bad-value -inf.0)
(check-error-message 'fl->fx (eval `(lambda (x) (fl->fx x))) #:bad-value +nan.0)
(un 4 '+ 4)
(bin 11 '+ 4 7)
@ -910,7 +917,14 @@
(un-exact -1 'extfl->exact-integer -1.0t0)
(un-exact (inexact->exact 5e200) 'extfl->exact-integer (real->extfl 5e200))
(un-exact 11 'extfl->fx 11.0t0 #t)
(un-exact 11 'extfl->fx 11.5t0 #t)
(un-exact -11 'extfl->fx -11.0t0)
(un-exact -11 'extfl->fx -11.5t0)
(check-error-message 'extfl->fx (eval `(lambda (x) (extfl->fx x))) #:bad-value (->extfl (expt 2 100)))
(check-error-message 'extfl->fx (eval `(lambda (x) (extfl->fx x))) #:bad-value (->extfl (- (expt 2 100))))
(check-error-message 'extfl->fx (eval `(lambda (x) (extfl->fx x))) #:bad-value +inf.t)
(check-error-message 'extfl->fx (eval `(lambda (x) (extfl->fx x))) #:bad-value -inf.t)
(check-error-message 'extfl->fx (eval `(lambda (x) (extfl->fx x))) #:bad-value +nan.t)
(bin-exact -0.75t0 'extfl- 1.5t0 2.25t0 #t)

2
racket/src/cs/bootstrap/scheme-lang.rkt
View File

@ -3,6 +3,7 @@
racket/match)
(prefix-in r: racket/include)
racket/fixnum
racket/flonum
racket/vector
racket/splicing
racket/pretty
@ -140,6 +141,7 @@
[bitwise-and logand]
[bitwise-bit-set? fxbit-set?]
[integer-length bitwise-length]
[->fl fixnum->flonum]
[+ cfl+]
[- cfl-]
[* cfl*]

7
racket/src/racket/src/jit.h
View File

@ -1231,6 +1231,7 @@ static void emit_indentation(mz_jit_state *jitter)
#define jit_bantieqr_d_fppop(d, s1, s2) jit_bantieqr_d(d, s1, s2)
#define jit_extr_l_d_fppush(rd, rs) jit_extr_l_d(rd, rs)
#define jit_roundr_d_l_fppop(rd, rs) jit_roundr_d_l(rd, rs)
#define jit_truncr_d_l_fppop(rd, rs) jit_truncr_d_l(rd, rs)
#define jit_movr_d_rel(rd, rs) jit_movr_d(rd, rs)
#define jit_movr_d_fppush(rd, rs) jit_movr_d(rd, rs)
#define R0_FP_ADJUST(x) /* empty */
@ -1668,10 +1669,12 @@ Scheme_Object *scheme_jit_continuation_apply_install(Apply_LWC_Args *args);
/* flfloor, flceiling, flround, fltruncate, flsin, flcos, fltan, */
/* flasin, flacos, flatan, flexp, fllog */
#define ARITH_FLUNOP 14
/* inexact->exact, unsafe-fl->fx, fl->exact-integer, fl->fx */
/* inexact->exact, fl->exact-integer */
#define ARITH_INEX_EX 15
/* fl->fx, unsafe-fl->fx, extfl->fx, unsafe-extfl->fx */
#define ARITH_INEX_TRUNC_EX 16
/* flexpt */
#define ARITH_EXPT 16
#define ARITH_EXPT 17
/* Comparison codes. Used in jitarith.c and jitinline.c. */

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

@ -451,7 +451,8 @@ static int can_fast_double(int arith, int cmp, int two_args)
|| (arith == ARITH_EX_INEX)
|| (arith == ARITH_SQRT)
|| (arith == ARITH_FLUNOP)
|| (arith == ARITH_INEX_EX))
|| (arith == ARITH_INEX_EX)
|| (arith == ARITH_INEX_TRUNC_EX))
return 1;
#endif
#ifdef INLINE_FP_COMP
@ -596,7 +597,7 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator
If unboxed in push/pop mode, first arg is pushed before second.
If unboxed in direct mode, first arg is in JIT_FPR0+depth
and second is in JIT_FPR1+depth (which is backward).
Unboxed implies unsafe unless arith == ARITH_INEX_EX. */
Unboxed implies unsafe unless arith == ARITH_INEX_EX or arith == ARITH_INEX_TRUNC_EX. */
{
#if defined(INLINE_FP_OPS) || defined(INLINE_FP_COMP)
GC_CAN_IGNORE jit_insn *ref8, *ref9, *ref10, *refd, *refdt, *refs = NULL, *refs2 = NULL;
@ -660,6 +661,8 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator
/* exact->inexact needs no extra number */
} else if (arith == ARITH_INEX_EX) {
/* inexact->exact needs no extra number */
} else if (arith == ARITH_INEX_TRUNC_EX) {
/* fl->fx needs no extra number */
} else {
#ifdef MZ_LONG_DOUBLE
long_double d;
@ -825,6 +828,52 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator
jit_fixnum_l(dest, JIT_R1);
no_alloc = 1;
break;
case ARITH_INEX_TRUNC_EX: /* fl->fx */
if (!unsafe_fl) {
#ifdef DIRECT_FPR_ACCESS
if (unboxed && USES_DIRECT_FPR_ACCESS) {
JIT_ASSERT(jitter->unbox_depth == 0);
jit_FPSEL_movr_xd_fppush(extfl, JIT_FPR2, fpr0); /* for slow path */
}
#endif
#if !defined(DIRECT_FPR_ACCESS) || defined(MZ_LONG_DOUBLE)
if (!USES_DIRECT_FPR_ACCESS) {
jit_FPSEL_movr_xd_fppush(extfl, fpr0, fpr0); /* copy for comparison */
}
#endif
#ifdef MZ_LONG_DOUBLE
if (extfl) {
mz_fpu_movi_ld_fppush(fpr1, scheme_extfl_too_positive_for_fixnum, JIT_R1);
} else
#endif
{
mz_movi_d_fppush(fpr1, scheme_double_too_positive_for_fixnum, JIT_R1);
}
__START_TINY_JUMPS__(1);
refs = jit_FPSEL_bantigtr_xd_fppop(extfl, jit_forward(), fpr1, fpr0);
__END_TINY_JUMPS__(1);
#if !defined(DIRECT_FPR_ACCESS) || defined(MZ_LONG_DOUBLE)
if (!USES_DIRECT_FPR_ACCESS) {
jit_FPSEL_movr_xd_fppush(extfl, fpr0, fpr0); /* copy for comparison */
}
#endif
#ifdef MZ_LONG_DOUBLE
if (extfl) {
mz_fpu_movi_ld_fppush(fpr1, scheme_extfl_too_negative_for_fixnum, JIT_R1);
} else
#endif
{
mz_movi_d_fppush(fpr1, scheme_double_too_negative_for_fixnum, JIT_R1);
}
__START_TINY_JUMPS__(1);
refs2 = jit_FPSEL_bantiltr_xd_fppop(extfl, jit_forward(), fpr1, fpr0);
__END_TINY_JUMPS__(1);
}
jit_FPSEL_truncr_xd_l_fppop(extfl, JIT_R1, fpr0);
jit_fixnum_l(dest, JIT_R1);
no_alloc = 1;
break;
case ARITH_SQRT:
jit_FPSEL_sqrt_xd_fppop(extfl, fpr0, fpr0);
break;
@ -1166,7 +1215,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
int args_unboxed = (((arith != ARITH_MIN) && (arith != ARITH_MAX)) || rand);
int flonum_depth, fl_reversed = 0, can_direct1, can_direct2;
if (inlined_flonum1 && inlined_flonum2 && (arith != ARITH_INEX_EX))
if (inlined_flonum1 && inlined_flonum2 && (arith != ARITH_INEX_EX) && (arith != ARITH_INEX_TRUNC_EX))
/* safe can be implemented as unsafe */
unsafe_fl = 1;
@ -1278,19 +1327,20 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
if (!jitter->unbox && jitter->unbox_depth && rand)
scheme_signal_error("internal error: broken unbox depth");
if (for_branch
|| (arith == ARITH_INEX_EX)) /* has slow path */
|| (arith == ARITH_INEX_EX) /* has slow path */
|| (arith == ARITH_INEX_TRUNC_EX)) /* could have slow path */
mz_rs_sync(); /* needed if arguments were unboxed */
generate_float_point_arith(jitter, rator, arith, cmp, reversed, !!rand2, 0,
&refd, &refdt, for_branch, branch_short,
(arith == ARITH_INEX_EX) ? (unsafe_fl > 0) : 1,
((arith == ARITH_INEX_EX) || (arith == ARITH_INEX_TRUNC_EX)) ? (unsafe_fl > 0) : 1,
args_unboxed, jitter->unbox, dest, extfl);
CHECK_LIMIT();
ref3 = NULL;
ref = NULL;
ref4 = NULL;
if ((arith == ARITH_INEX_EX) && (unsafe_fl < 1)) {
if (((arith == ARITH_INEX_EX) || (arith == ARITH_INEX_TRUNC_EX)) && (unsafe_fl < 1)) {
/* need a slow path */
if (args_unboxed) {
MZ_FPUSEL_STMT(extfl,
@ -1618,7 +1668,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
if (arith == ARITH_DIV) {
GC_CAN_IGNORE jit_insn *refx, *refz;
__START_INNER_TINY__(branch_short);
/* watch out for negation of most negative fixnum,
/* watch out for negation of most neg<ative fixnum,
which is a positive number too big for a fixnum */
refz = jit_beqi_p(jit_forward(), JIT_R0, (void *)(((uintptr_t)1 << ((8 * JIT_WORD_SIZE) - 2))));
__END_INNER_TINY__(branch_short);

6
racket/src/racket/src/jitfpu.h
View File

@ -47,6 +47,9 @@
# define jit_FPSEL_roundr_xd_i(use_fpu, rd, rs) (use_fpu ? jit_fpu_roundr_ld_i(rd, rs) : jit_roundr_d_i(rd, rs))
# define jit_FPSEL_roundr_xd_l(use_fpu, rd, rs) (use_fpu ? jit_fpu_roundr_ld_l(rd, rs) : jit_roundr_d_l(rd, rs))
# define jit_FPSEL_roundr_xd_l_fppop(use_fpu, rd, rs) (use_fpu ? jit_fpu_roundr_ld_l_fppop(rd, rs) : jit_roundr_d_l_fppop(rd, rs))
# define jit_FPSEL_truncr_xd_i(use_fpu, rd, rs) (use_fpu ? jit_fpu_truncr_ld_i(rd, rs) : jit_truncr_d_i(rd, rs))
# define jit_FPSEL_truncr_xd_l(use_fpu, rd, rs) (use_fpu ? jit_fpu_truncr_ld_l(rd, rs) : jit_truncr_d_l(rd, rs))
# define jit_FPSEL_truncr_xd_l_fppop(use_fpu, rd, rs) (use_fpu ? jit_fpu_truncr_ld_l_fppop(rd, rs) : jit_truncr_d_l_fppop(rd, rs))
# define jit_FPSEL_bger_xd(use_fpu, d, s1, s2) (use_fpu ? jit_fpu_bger_ld(d, s1, s2) : jit_bger_d(d, s1, s2))
# define jit_FPSEL_bltr_xd(use_fpu, d, s1, s2) (use_fpu ? jit_fpu_bltr_ld(d, s1, s2) : jit_bltr_d(d, s1, s2))
# define jit_FPSEL_beqr_xd(use_fpu, d, s1, s2) (use_fpu ? jit_fpu_beqr_ld(d, s1, s2) : jit_beqr_d(d, s1, s2))
@ -107,6 +110,9 @@
# define jit_FPSEL_roundr_xd_i(use_fpu, rd, rs) jit_roundr_d_i(rd, rs)
# define jit_FPSEL_roundr_xd_l(use_fpu, rd, rs) jit_roundr_d_l(rd, rs)
# define jit_FPSEL_roundr_xd_l_fppop(use_fpu, rd, rs) jit_roundr_d_l_fppop(rd, rs)
# define jit_FPSEL_truncr_xd_i(use_fpu, rd, rs) jit_truncr_d_i(rd, rs)
# define jit_FPSEL_truncr_xd_l(use_fpu, rd, rs) jit_truncr_d_l(rd, rs)
# define jit_FPSEL_truncr_xd_l_fppop(use_fpu, rd, rs) jit_truncr_d_l_fppop(rd, rs)
# define jit_FPSEL_bger_xd(use_fpu, d, s1, s2) jit_bger_d(d, s1, s2)
# define jit_FPSEL_bltr_xd(use_fpu, d, s1, s2) jit_bltr_d(d, s1, s2)
# define jit_FPSEL_beqr_xd(use_fpu, d, s1, s2) jit_beqr_d(d, s1, s2)

16
racket/src/racket/src/jitinline.c
View File

@ -2240,12 +2240,14 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
scheme_generate_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_EX, 0, 0, NULL, 1, 0, 0, NULL, dest);
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-fl->fx")) {
scheme_generate_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_EX, 0, 0, NULL, 1, 0, 1, NULL, dest);
scheme_generate_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_TRUNC_EX, 0, 0, NULL, 1, 0, 1, NULL, dest);
return 1;
} else if (IS_NAMED_PRIM(rator, "fl->exact-integer")
|| IS_NAMED_PRIM(rator, "fl->fx")) {
} else if (IS_NAMED_PRIM(rator, "fl->exact-integer")) {
scheme_generate_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_EX, 0, 0, NULL, 1, 0, -1, NULL, dest);
return 1;
} else if (IS_NAMED_PRIM(rator, "fl->fx")) {
scheme_generate_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_TRUNC_EX, 0, 0, NULL, 1, 0, -1, NULL, dest);
return 1;
#ifdef MZ_LONG_DOUBLE
} else if (IS_NAMED_PRIM(rator, "unsafe-extflabs")) {
scheme_generate_extflonum_arith(jitter, rator, app->rand, NULL, 1, ARITH_ABS, 0, 0, NULL, 1, 0, 1, NULL, dest);
@ -2287,12 +2289,14 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
scheme_generate_extflonum_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_EX, 0, 0, NULL, 1, 0, 0, NULL, dest);
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-extfl->fx")) {
scheme_generate_extflonum_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_EX, 0, 0, NULL, 1, 0, 1, NULL, dest);
scheme_generate_extflonum_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_TRUNC_EX, 0, 0, NULL, 1, 0, 1, NULL, dest);
return 1;
} else if (IS_NAMED_PRIM(rator, "extfl->exact-integer")
|| IS_NAMED_PRIM(rator, "extfl->fx")) {
} else if (IS_NAMED_PRIM(rator, "extfl->exact-integer")) {
scheme_generate_extflonum_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_EX, 0, 0, NULL, 1, 0, -1, NULL, dest);
return 1;
} else if (IS_NAMED_PRIM(rator, "extfl->fx")) {
scheme_generate_extflonum_arith(jitter, rator, app->rand, NULL, 1, ARITH_INEX_TRUNC_EX, 0, 0, NULL, 1, 0, -1, NULL, dest);
return 1;
#endif
} else if (IS_NAMED_PRIM(rator, "bitwise-not")) {
scheme_generate_arith(jitter, rator, app->rand, NULL, 1, ARITH_NOT, 0, 9, NULL, 1, 0, 0, NULL, dest);

3
racket/src/racket/src/lightning/i386/asm.h
View File

@ -1185,6 +1185,7 @@ typedef _uc jit_insn;
#define FISTWm(D,B,I,S) ESCmi(D,B,I,S,072) /* fist m16int */
#define FSTPSm(D,B,I,S) ESCmi(D,B,I,S,013) /* fstp m32real */
#define FISTPLm(D,B,I,S) ESCmi(D,B,I,S,033) /* fistp m32int */
#define FISTTPLm(D,B,I,S) ESCmi(D,B,I,S,031) /* fisttp m32int */
#define FSTPLm(D,B,I,S) ESCmi(D,B,I,S,053) /* fstp m64real */
#define FISTPWm(D,B,I,S) ESCmi(D,B,I,S,073) /* fistp m16int */
#define FLDTm(D,B,I,S) ESCmi(D,B,I,S,035) /* fld m80real */
@ -1192,8 +1193,10 @@ typedef _uc jit_insn;
#define FSTPTm(D,B,I,S) ESCmi(D,B,I,S,037) /* fstp m80real */
#ifdef JIT_X86_64
# define FISTPQm(D,B,I,S) ESCmi(D,B,I,S,077) /* fistp m64int */
# define FISTTPQm(D,B,I,S) ESCmi(D,B,I,S,051) /* fisttp m64int */
#else
# define FISTPQm(D,B,I,S) FISTPLm(D,B,I,S)
# define FISTTPQm(D,B,I,S) FISTTPLm(D,B,I,S)
#endif
#define FADDrr(RS,RD) ESCrri(RS,RD,000)

76
racket/src/racket/src/lightning/i386/fp-extfpu.h
View File

@ -298,16 +298,36 @@ union jit_fpu_double_imm {
#define jit_fpu_extr_d_f(r1, r2) jit_fpu_movr_d(r1, r2)
#define jit_fpu_extr_f_d(r1, r2) jit_fpu_movr_d(r1, r2)
/* Assume round to near mode */
/* the easy one */
#define jit_fpu_roundr_d_i(rd, rs) \
(PUSHLr(_EAX), \
jit_fpu_fxch ((rs), FISTPLm(0, _ESP, 0, 0)), \
POPLr((rd)))
#define jit_fpu_roundr_ld_i(rd, rs) jit_fpu_roundr_d_i(rd, rs)
#define jit_fpu_roundr_d_l(rd, rs) \
(PUSHQr(_EAX), \
jit_fpu_fxch ((rs), FISTPQm(0, _ESP, 0, 0)), \
POPQr((rd)))
#define jit_fpu_roundr_ld_l(rd, rs) jit_fpu_roundr_d_l(rd, rs)
#define jit_fpu_roundr_d_l_fppop(rd, rs) \
(PUSHQr(_EAX), \
FISTPQm(0, _ESP, 0, 0), \
POPQr((rd)))
#define jit_fpu_roundr_ld_l_fppop(rd, rs) jit_fpu_roundr_d_l_fppop(rd, rs)
/* Other rounding modes assume round to near mode */
#define jit_fpu_floorr_d_i(rd, rs) \
(FLDr (rs), jit_fpu_floor2((rd), ((rd) == _EDX ? _EAX : _EDX)))
#define jit_fpu_ceilr_d_i(rd, rs) \
(FLDr (rs), jit_fpu_ceil2((rd), ((rd) == _EDX ? _EAX : _EDX)))
#define jit_fpu_truncr_d_i(rd, rs) \
(FLDr (rs), jit_fpu_trunc2((rd), ((rd) == _EDX ? _EAX : _EDX)))
#define jit_fpu_calc_diff(ofs) \
FISTLm(ofs, _ESP, 0, 0), \
FILDLm(ofs, _ESP, 0, 0), \
@ -337,11 +357,16 @@ union jit_fpu_double_imm {
ADCLir(0, rd), \
POPLr(aux))
#ifndef JIT_X86_64
/* 32-bit mode: FSTT is part of SSE3, so not necessarily available,
so use the same strategy as floor and ceiling */
/* a mingling of the two above */
#define jit_fpu_trunc2(rd, aux) \
#define jit_fpu_trunc2(rd, aux, store) \
(PUSHLr(aux), \
SUBLir(12, _ESP), \
FSTSm(0, _ESP, 0, 0), \
store(0, _ESP, 0, 0), \
jit_fpu_calc_diff(4), \
POPLr(aux), \
POPLr(rd), \
@ -357,27 +382,40 @@ union jit_fpu_double_imm {
ADCLir(0, rd), /* 3 */ \
POPLr(aux))
/* the easy one */
#define jit_fpu_roundr_d_i(rd, rs) \
(PUSHLr(_EAX), \
jit_fpu_fxch ((rs), FISTPLm(0, _ESP, 0, 0)), \
POPLr((rd)))
#define jit_fpu_truncr_d_i(rd, rs) \
(FLDr (rs), jit_fpu_trunc2((rd), ((rd) == _EDX ? _EAX : _EDX), FSTSm))
#define jit_fpu_roundr_ld_i(rd, rs) jit_fpu_roundr_d_i(rd, rs)
#define jit_fpu_truncr_d_i_fppop(rd, rs) \
(FLDr (rs), jit_fpu_trunc2((rd), ((rd) == _EDX ? _EAX : _EDX), FSTPSm))
#define jit_fpu_roundr_d_l(rd, rs) \
#define jit_fpu_truncr_ld_i(rd, rs) jit_fpu_truncr_d_i(rd, rs)
#define jit_fpu_truncr_ld_i_fppop(rd, rs) jit_fpu_truncr_d_i_fppop(rd, rs)
#define jit_fpu_truncr_d_l(rd, rs) jit_fpu_truncr_d_i(rd, rs)
#define jit_fpu_truncr_d_l_fppop(rd, rs) jit_fpu_truncr_d_i_fppop(rd, rs)
#define jit_fpu_truncr_ld_l(rd, rs) jit_fpu_truncr_d_l(rd, rs)
#define jit_fpu_truncr_ld_l_fppop(rd, rs) jit_fpu_truncr_d_l_fppop(rd, rs)
#else
/* 64-bit mode, so SSE3 must be available: use FSTT */
#define jit_fpu_truncr_d_l(rd, rs) \
(PUSHQr(_EAX), \
jit_fpu_fxch ((rs), FISTPQm(0, _ESP, 0, 0)), \
jit_fpu_fxch ((rs), FISTTPQm(0, _ESP, 0, 0)), \
POPQr((rd)))
#define jit_fpu_roundr_ld_l(rd, rs) jit_fpu_roundr_d_l(rd, rs)
#define jit_fpu_truncr_ld_l(rd, rs) jit_fpu_truncr_d_l(rd, rs)
#define jit_fpu_roundr_d_l_fppop(rd, rs) \
#define jit_fpu_truncr_d_l_fppop(rd, rs) \
(PUSHQr(_EAX), \
FISTPQm(0, _ESP, 0, 0), \
FISTTPQm(0, _ESP, 0, 0), \
POPQr((rd)))
#define jit_fpu_roundr_ld_l_fppop(rd, rs) jit_fpu_roundr_d_l_fppop(rd, rs)
#define jit_fpu_truncr_ld_l_fppop(rd, rs) jit_fpu_truncr_d_l_fppop(rd, rs)
#endif
#define jit_fpu_fp_test(d, s1, s2, n, _and, res) \
(((s1) == 0 ? FUCOMr((s2)) : (FLDr((s1)), FUCOMPr((s2) + 1))), \
@ -506,7 +544,7 @@ union jit_fpu_double_imm {
/* #define jit_fpu_bantiger_d_fppop(d, s1, s2) jit_fpu_fp_btest_fppop((d), 9, 0, 0, JCm) */
#define jit_fpu_bantiger_d_fppop(d, s1, s2) jit_fpu_fp_btest_fppop_2((d), JBm)
#define jit_fpu_bantiger_ld_fppop(d, s1, s2) jit_fpu_bantiger_d_fppop(d, s1, s2)
#define jit_fpu_bler_d_fppop(d, s1, s2) (FXCHr(1), jit_fpu_bger_d_fppop(d, s1, s2))
#define jit_fpu_bler_d_fppop(d, s1, s2) jit_fpu_fp_btest_fppop((d), 9, 0, 0, JNAm)
#define jit_fpu_bler_ld_fppop(d, s1, s2) jit_fpu_bler_d_fppop(d, s1, s2)
#define jit_fpu_bantiler_d_fppop(d, s1, s2) (FXCHr(1), jit_fpu_bantiger_d_fppop(d, s1, s2))
#define jit_fpu_bantiler_ld_fppop(d, s1, s2) jit_fpu_bantiler_d_fppop(d, s1, s2)

6
racket/src/racket/src/lightning/i386/fp-sse.h
View File

@ -170,8 +170,8 @@
jit_addi_l(JIT_SP, JIT_SP, sizeof(int) << 1))
#endif
/* Racket uses jit_roundr_l only for inexact->exact of fixnums,
so a truncate is good enough. */
/* Racket has used jit_roundr_l only for inexact->exact of fixnums,
where a truncate was good enough. */
#define jit_roundr_d_i(r0, f0) jit_truncr_d_i(r0, f0)
#define jit_roundr_d_l(r0, f0) jit_truncr_d_l(r0, f0)
@ -183,7 +183,7 @@
#endif
#define jit_bltr_d(label, f0, f1) (UCOMISDrr(f0, f1), JAEm(label,0,0,0), (_jit.x.pc))
#define jit_bler_d(label, f0, f1) (UCOMISDrr(f0, f1), JBEm(label,0,0,0), (_jit.x.pc))
#define jit_bler_d(label, f0, f1) (UCOMISDrr(f1, f0), JBEm(label,0,0,0), (_jit.x.pc))
#define jit_bgtr_d(label, f0, f1) (UCOMISDrr(f1, f0), JAm(label,0,0,0), (_jit.x.pc))
#define jit_bger_d(label, f0, f1) (UCOMISDrr(f1, f0), JAEm(label,0,0,0), (_jit.x.pc))
#define jit_beqr_d(label, f0, f1) \

7
racket/src/racket/src/lightning/i386/fp.h
View File

@ -134,13 +134,18 @@
# define jit_stxr_ld_fppop(d1, d2, rs) jit_fpu_stxr_ld_fppop(d1, d2, rs)
# define jit_floorr_d_i(rd, rs) jit_fpu_floorr_d_i(rd, rs)
# define jit_ceilr_d_i(rd, rs) jit_fpu_ceilr_d_i(rd, rs)
# define jit_truncr_d_i(rd, rs) jit_fpu_truncr_d_i(rd, rs)
# define jit_roundr_d_i(rd, rs) jit_fpu_roundr_d_i(rd, rs)
# define jit_roundr_ld_i(rd, rs) jit_fpu_roundr_ld_i(rd, rs)
# define jit_roundr_d_l(rd, rs) jit_fpu_roundr_d_l(rd, rs)
# define jit_roundr_ld_l(rd, rs) jit_fpu_roundr_ld_l(rd, rs)
# define jit_roundr_d_l_fppop(rd, rs) jit_fpu_roundr_d_l_fppop(rd, rs)
# define jit_roundr_ld_l_fppop(rd, rs) jit_fpu_roundr_ld_l_fppop(rd, rs)
# define jit_truncr_d_i(rd, rs) jit_fpu_truncr_d_i(rd, rs)
# define jit_truncr_ld_i(rd, rs) jit_fpu_truncr_ld_i(rd, rs)
# define jit_truncr_d_l(rd, rs) jit_fpu_truncr_d_l(rd, rs)
# define jit_truncr_ld_l(rd, rs) jit_fpu_truncr_ld_l(rd, rs)
# define jit_truncr_d_l_fppop(rd, rs) jit_fpu_truncr_d_l_fppop(rd, rs)
# define jit_truncr_ld_l_fppop(rd, rs) jit_fpu_truncr_ld_l_fppop(rd, rs)
# define jit_gtr_d(d, s1, s2) jit_fpu_gtr_d(d, s1, s2)
# define jit_ger_d(d, s1, s2) jit_fpu_ger_d(d, s1, s2)
# define jit_unler_d(d, s1, s2) jit_fpu_unler_d(d, s1, s2)

1
racket/src/racket/src/lightning/ppc/fp.h
View File

@ -221,6 +221,7 @@
MOVEIri(JIT_AUX,-4), \
STFIWXrrr(7,JIT_SP,JIT_AUX), \
LWZrm((rd),-4,JIT_SP))
#define jit_truncr_d_l(rd,rs) jit_truncr_d_i(rd,rs)
/* Uses JIT_FPR5 as scratch: */
#define jit_extr_i_d(rd, rs) (jit_movi_l(JIT_AUX, 0x43300000), \

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

@ -196,6 +196,7 @@ float float_from_long_double(long_double a)
{
return (float)a.val;
}
intptr_t int_from_long_double(long_double a)
{
return (intptr_t)a.val;

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

@ -150,7 +150,7 @@ XFORM_NONGCING int long_double_available();
# define double_from_long_double(a) (a)
# define float_from_long_double(a) (a)
# define int_from_long_double(a) ((int)(a))
# define int_from_long_double(a) ((intptr_t)(a))
# define uintptr_from_long_double(a) ((uintptr_t)(a))
# define long_double_plus(a,b) ((a)+(b))

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

@ -4065,19 +4065,16 @@ scheme_exact_to_inexact (int argc, Scheme_Object *argv[])
}
XFORM_NONGCING static int double_fits_fixnum(double d)
/* returns TRUE if the number definitely fits in an intptr_t
and might fit in a fixnum */
/* returns TRUE if the number is an integer that fits in a fixnum */
{
int exp;
if (MZ_IS_NAN(d)
|| MZ_IS_POS_INFINITY(d)
|| MZ_IS_NEG_INFINITY(d))
#ifdef NAN_EQUALS_ANYTHING
if (MZ_IS_NAN(d))
return 0;
#endif
(void)frexp(d, &exp);
return (exp < (8 * sizeof(intptr_t)) - 1);
return ((d < scheme_double_too_positive_for_fixnum)
&& (d > scheme_double_too_negative_for_fixnum)
&& ((double)((intptr_t)d) == d));
}
Scheme_Object *
@ -4091,36 +4088,20 @@ scheme_inexact_to_exact (int argc, Scheme_Object *argv[])
t = _SCHEME_TYPE(o);
if (t == scheme_double_type) {
double d = SCHEME_DBL_VAL(o);
Scheme_Object *i;
/* Try simple case: */
i = (double_fits_fixnum(d)
? scheme_make_integer((intptr_t)d)
: scheme_make_integer(0));
if ((double)SCHEME_INT_VAL(i) == d) {
#ifdef NAN_EQUALS_ANYTHING
if (!MZ_IS_NAN(d))
#endif
return i;
}
if (double_fits_fixnum(d))
return scheme_make_integer((intptr_t)d);
return scheme_rational_from_double(d);
}
#ifdef MZ_USE_SINGLE_FLOATS
if (t == scheme_float_type) {
float d = SCHEME_FLT_VAL(o);
Scheme_Object *i;
/* Try simple case: */
i = (double_fits_fixnum(d)
? scheme_make_integer((intptr_t)d)
: scheme_make_integer(0));
if ((double)SCHEME_INT_VAL(i) == d) {
# ifdef NAN_EQUALS_ANYTHING
if (!MZ_IS_NAN(d))
# endif
return i;
}
if (double_fits_fixnum(d))
return scheme_make_integer((intptr_t)d);
return scheme_rational_from_float(d);
}
@ -4179,6 +4160,7 @@ extfl_to_exact (int argc, Scheme_Object *argv[])
#ifdef MZ_LONG_DOUBLE
Scheme_Object *o = argv[0], *i;
long_double d;
intptr_t v;
CHECK_MZ_LONG_DOUBLE_UNSUPPORTED("extfl->exact");
@ -4188,7 +4170,8 @@ extfl_to_exact (int argc, Scheme_Object *argv[])
d = SCHEME_LONG_DBL_VAL(o);
/* Try simple case: */
i = scheme_make_integer((intptr_t)int_from_long_double(d));
v = int_from_long_double(d);
i = scheme_make_integer(v);
if (long_double_eqv_i(int_from_long_double(d), d)) {
# ifdef NAN_EQUALS_ANYTHING
if (!MZ_IS_LONG_NAN(d))
@ -5309,21 +5292,15 @@ static Scheme_Object *fx_to_fl (int argc, Scheme_Object *argv[])
static Scheme_Object *fl_to_fx (int argc, Scheme_Object *argv[])
{
double d;
intptr_t v;
Scheme_Object *o;
if (!SCHEME_DBLP(argv[0])
|| !scheme_is_integer(argv[0]))
scheme_wrong_contract("fl->fx", "(and/c flonum? integer?)", 0, argc, argv);
if (!SCHEME_DBLP(argv[0]))
scheme_wrong_contract("fl->fx", "flonum?", 0, argc, argv);
d = SCHEME_DBL_VAL(argv[0]);
if (double_fits_fixnum(d)) {
v = (intptr_t)d;
if ((double)v == d) {
o = scheme_make_integer_value(v);
if (SCHEME_INTP(o))
return o;
}
if ((d < scheme_double_too_positive_for_fixnum)
&& (d > scheme_double_too_negative_for_fixnum)) {
intptr_t v = (intptr_t)d;
return scheme_make_integer(v);
}
scheme_contract_error("fl->fx", "no fixnum representation",
@ -5383,20 +5360,18 @@ static Scheme_Object *extfl_to_fx (int argc, Scheme_Object *argv[])
{
#ifdef MZ_LONG_DOUBLE
long_double d;
intptr_t v;
Scheme_Object *o;
WHEN_LONG_DOUBLE_UNSUPPORTED(unsupported("extfl->fx"));
if (!SCHEME_LONG_DBLP(argv[0]))
scheme_wrong_contract("extfl->fx", "(and/c extflonum?)", 0, argc, argv);
scheme_wrong_contract("extfl->fx", "extflonum?", 0, argc, argv);
d = SCHEME_LONG_DBL_VAL(argv[0]);
v = (intptr_t)int_from_long_double(d);
if (long_double_eqv_i(v, d)) {
o = scheme_make_integer_value(v);
if (SCHEME_INTP(o))
return o;
if (long_double_less(d, scheme_extfl_too_positive_for_fixnum)
&& long_double_greater(d, scheme_extfl_too_negative_for_fixnum)) {
intptr_t v;
v = int_from_long_double(d);
return scheme_make_integer(v);
}
scheme_contract_error("extfl->fx", "no fixnum representation",
@ -5525,7 +5500,7 @@ static Scheme_Object *unsafe_fx_to_fl (int argc, Scheme_Object *argv[])
static Scheme_Object *unsafe_fl_to_fx (int argc, Scheme_Object *argv[])
{
intptr_t v;
if (scheme_current_thread->constant_folding) return scheme_inexact_to_exact(argc, argv);
if (scheme_current_thread->constant_folding) return fl_to_fx(argc, argv);
v = (intptr_t)(SCHEME_DBL_VAL(argv[0]));
return scheme_make_integer(v);
}
@ -5589,7 +5564,7 @@ static Scheme_Object *unsafe_extfl_to_fx (int argc, Scheme_Object *argv[])
{
#ifdef MZ_LONG_DOUBLE
intptr_t v;
if (scheme_current_thread->constant_folding) return extfl_to_exact(argc, argv);
if (scheme_current_thread->constant_folding) return extfl_to_fx(argc, argv);
v = (intptr_t)int_from_long_double(SCHEME_LONG_DBL_VAL(argv[0]));
return scheme_make_integer(v);
#else

52
racket/src/racket/src/numstr.c
View File

@ -39,6 +39,8 @@ static Scheme_Object *sch_check_pack(int argc, Scheme_Object *argv[]);
static char *number_to_allocated_string(int radix, Scheme_Object *obj, int alloc);
static void init_double_fixnum_extremes(void);
READ_ONLY static char *infinity_str = "+inf.0";
READ_ONLY static char *minus_infinity_str = "-inf.0";
READ_ONLY static char *not_a_number_str = "+nan.0";
@ -61,6 +63,11 @@ READ_ONLY static char *single_other_not_a_number_str = "-nan.f";
SHARED_OK static Scheme_Object *num_limits[3];
#endif
READ_ONLY double scheme_double_too_positive_for_fixnum, scheme_double_too_negative_for_fixnum;
#ifdef MZ_LONG_DOUBLE
READ_ONLY long_double scheme_extfl_too_positive_for_fixnum, scheme_extfl_too_negative_for_fixnum;
#endif
#ifdef SCHEME_BIG_ENDIAN
# define MZ_IS_BIG_ENDIAN 1
#else
@ -190,6 +197,8 @@ void scheme_init_numstr(Scheme_Startup_Env *env)
num_limits[MZ_S8LO] = v;
}
#endif
init_double_fixnum_extremes();
}
void scheme_init_extfl_numstr(Scheme_Startup_Env *env)
@ -3008,3 +3017,46 @@ static Scheme_Object *pseudo_random_generator_p(int argc, Scheme_Object **argv)
: scheme_false);
}
/* Just to make sure there are no C compiler number issues, we
record floting-point values just outside of the fixnum
range as little-endian byte sequences: */
#ifdef SIXTY_FOUR_BIT_INTEGERS
#if MZ_IS_BIG_ENDIAN
# define double_too_positive_for_fixnum_bytes "C\320\0\0\0\0\0\0" /* 4.611686018427388e+18 */
# define double_too_negative_for_fixnum_bytes "\303\320\0\0\0\0\0\1" /* -4.611686018427389e+18 */
#else
# define double_too_positive_for_fixnum_bytes "\0\0\0\0\0\0\320C" /* 4.611686018427388e+18 */
# define double_too_negative_for_fixnum_bytes "\1\0\0\0\0\0\320\303" /* -4.611686018427389e+18 */
#endif
/* always little-endian: */
#define extfl_too_positive_for_fixnum_bytes "\0\0\0\0\0\0\0\200=@" /* 4611686018427387904.0t0 */
#define extfl_too_negative_for_fixnum_bytes "\2\0\0\0\0\0\0\200=\300" /* -4611686018427387905.0t0 */
#else
#if MZ_IS_BIG_ENDIAN
# define double_too_positive_for_fixnum_bytes "A\320\0\0\0\0\0\0" /* 1073741824.0 */
# define double_too_negative_for_fixnum_bytes "\301\320\0\0\0@\0\0" /* -1073741825.0 */
#else
# define double_too_positive_for_fixnum_bytes "\0\0\0\0\0\0\320A" /* 1073741824.0 */
# define double_too_negative_for_fixnum_bytes "\0\0@\0\0\0\320\301" /* -1073741825.0 */
#endif
/* always little-endian: */
#define extfl_too_positive_for_fixnum_bytes "\0\0\0\0\0\0\0\200\35@" /* 1073741824.0 */
#define extfl_too_negative_for_fixnum_bytes "\0\0\0\0\2\0\0\200\35\300" /* -1073741825.0 */
#endif
static void init_double_fixnum_extremes(void)
{
memcpy(&scheme_double_too_positive_for_fixnum, double_too_positive_for_fixnum_bytes, sizeof(double));
memcpy(&scheme_double_too_negative_for_fixnum, double_too_negative_for_fixnum_bytes, sizeof(double));
#ifdef MZ_LONG_DOUBLE
memcpy(&scheme_extfl_too_positive_for_fixnum, extfl_too_positive_for_fixnum_bytes, 10);
memcpy(&scheme_extfl_too_negative_for_fixnum, extfl_too_negative_for_fixnum_bytes, 10);
#endif
}

5
racket/src/racket/src/schpriv.h
View File

@ -2155,6 +2155,11 @@ intptr_t scheme_get_semaphore_init(const char *who, int n, Scheme_Object **p);
void scheme_configure_floating_point(void);
extern double scheme_double_too_positive_for_fixnum, scheme_double_too_negative_for_fixnum;
#ifdef MZ_LONG_DOUBLE
extern long_double scheme_extfl_too_positive_for_fixnum, scheme_extfl_too_negative_for_fixnum;
#endif
/****** Bignums *******/
#ifdef USE_LONG_LONG_FOR_BIGDIG

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

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 7
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 7
#define MZSCHEME_VERSION_W 8
/* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x