From dc1d4e80dda760e6b2d1bf54213e00277ec5c4e1 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 26 Feb 2012 03:55:08 +0000 Subject: [PATCH] fix incorrect GC decls hard-wired into xform Closes PR 12602 --- collects/compiler/private/xform.rkt | 3 --- collects/tests/racket/number.rktl | 14 ++++++++++ src/racket/src/nummacs.h | 40 +++++++++++++++++------------ src/racket/src/schemef.h | 14 +++++----- 4 files changed, 45 insertions(+), 26 deletions(-) diff --git a/collects/compiler/private/xform.rkt b/collects/compiler/private/xform.rkt index a7b131a535..8a32453d5a 100644 --- a/collects/compiler/private/xform.rkt +++ b/collects/compiler/private/xform.rkt @@ -886,9 +886,6 @@ __error __errno_location __toupper __tolower __attribute__ __mode__ ; not really functions in gcc __iob_func ; VC 8 - scheme_get_milliseconds scheme_get_process_milliseconds - scheme_rational_to_double scheme_bignum_to_double - scheme_rational_to_float scheme_bignum_to_float |GetStdHandle| |__CFStringMakeConstantString| _vswprintf_c diff --git a/collects/tests/racket/number.rktl b/collects/tests/racket/number.rktl index de08074e3b..9248472634 100644 --- a/collects/tests/racket/number.rktl +++ b/collects/tests/racket/number.rktl @@ -2827,6 +2827,20 @@ (err/rt-test (real->floating-point-bytes 1.0+2.0i 8)) (err/rt-test (real->floating-point-bytes 1.0 8 #f (make-bytes 7)) exn:application:mismatch?) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; This test once trigggered a crash due to an incorrect +;; hard-wired GC declaration for xform: + +(let () + (define (root n r) + (expt n (/ 1 r))) + + (define (n-digit-has-nth-root? n) + (not (= (floor (root (expt 10 (- n 1)) n)) + (floor (root (- (expt 10 n) 1) n))))) + + (test 240 length (filter n-digit-has-nth-root? (build-list 5000 (lambda (x) (+ x 1)))))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/src/racket/src/nummacs.h b/src/racket/src/nummacs.h index ae87d89af8..e3d0bbf4c4 100644 --- a/src/racket/src/nummacs.h +++ b/src/racket/src/nummacs.h @@ -144,21 +144,23 @@ static MZ_INLINE rettype name ## __int_comp(const Scheme_Object *n1, const Schem }) \ FLOATWRAP( \ static MZ_INLINE rettype name ## __flt_big(float d1, const Scheme_Object *n1, const Scheme_Object *n2) { \ - toi_or_toe(,Small_Rational sr2); \ + toi_or_toe(float tmp2, Small_Rational sr2); \ snanchk_more(d1); \ wrap(if (MZ_IS_POS_INFINITY(d1)) return combineinf(swaybigf, n2);) \ wrap(if (MZ_IS_NEG_INFINITY(d1)) return combineinf(swaysmallf, n2);) \ - return toi_or_toe(fsop(d1, scheme_bignum_to_float(n2)), \ + toi_or_toe(tmp2=scheme_bignum_to_float(n2),); \ + return toi_or_toe(fsop(d1, tmp2), \ rop(rat_from_float(d1, &sr2), scheme_integer_to_rational(n2))); \ }) \ FLOATWRAP( \ static MZ_INLINE rettype name ## __flt_rat(float d1, const Scheme_Object *n1, const Scheme_Object *n2) { \ - toi_or_toe(,Small_Rational sr3); \ + toi_or_toe(float tmp3, Small_Rational sr3); \ snanchk_more(d1); \ wrap(if (MZ_IS_POS_INFINITY(d1)) return combineinf(swaybigf, n2);) \ wrap(if (MZ_IS_NEG_INFINITY(d1)) return combineinf(swaysmallf, n2);) \ wrap(if (d1 == 0.0) return combinezero(sfirstzero, n2, d1);) \ - return toi_or_toe(fsop(d1, scheme_rational_to_float(n2)), \ + toi_or_toe(tmp3=scheme_rational_to_float(n2),); \ + return toi_or_toe(fsop(d1, tmp3), \ rop(rat_from_float(d1, &sr3), (n2))); \ })\ FLOATWRAP(complexwrap( \ @@ -169,20 +171,22 @@ static MZ_INLINE rettype name ## __flt_comp(float d1, const Scheme_Object *n1, c (n2)); \ })) \ static MZ_INLINE rettype name ## __dbl_big(double d1, const Scheme_Object *n1, const Scheme_Object *n2) { \ - toi_or_toe(,Small_Rational sr4); \ + toi_or_toe(double tmp4, Small_Rational sr4); \ nanchk_more(d1); \ wrap(if (MZ_IS_POS_INFINITY(d1)) return combineinf(waybigf, n2);) \ wrap(if (MZ_IS_NEG_INFINITY(d1)) return combineinf(waysmallf, n2);) \ - return toi_or_toe(fop(d1, scheme_bignum_to_double(n2)), \ + toi_or_toe(tmp4=scheme_bignum_to_double(n2),); \ + return toi_or_toe(fop(d1, tmp4), \ rop(rat_from_double(d1, &sr4), scheme_integer_to_rational(n2))); \ } \ static MZ_INLINE rettype name ## __dbl_rat(double d1, const Scheme_Object *n1, const Scheme_Object *n2) { \ - toi_or_toe(,Small_Rational sr5); \ + toi_or_toe(double tmp5, Small_Rational sr5); \ nanchk_more(d1); \ wrap(if (MZ_IS_POS_INFINITY(d1)) return combineinf(waybigf, n2);) \ wrap(if (MZ_IS_NEG_INFINITY(d1)) return combineinf(waysmallf, n2);) \ wrap(if (d1 == 0.0) return combinezero(firstzero, n2, d1);) \ - return toi_or_toe(fop(d1, scheme_rational_to_double(n2)), \ + toi_or_toe(tmp5=scheme_rational_to_double(n2),); \ + return toi_or_toe(fop(d1, tmp5), \ rop(rat_from_double(d1, &sr5), (n2))); \ } \ complexwrap( \ @@ -201,22 +205,24 @@ static MZ_INLINE rettype name ## __big_int(const Scheme_Object *n1, const Scheme FLOATWRAP( \ static MZ_INLINE rettype name ## __big_flt(const Scheme_Object *n1, const Scheme_Object *n2) { \ float d2; \ - toi_or_toe(,Small_Rational sr6); \ + toi_or_toe(float tmp6, Small_Rational sr6); \ d2 = SCHEME_FLT_VAL(n2); \ snanchk_more(d2); \ wrap(if (MZ_IS_POS_INFINITY(d2)) return combineinf(swaysmalls, n1);) \ wrap(if (MZ_IS_NEG_INFINITY(d2)) return combineinf(swaybigs, n1);) \ - return toi_or_toe(fsop(scheme_bignum_to_float(n1), d2), \ + toi_or_toe(tmp6=scheme_bignum_to_float(n1),); \ + return toi_or_toe(fsop(tmp6, d2), \ rop(scheme_integer_to_rational(n1), rat_from_float(d2, &sr6))); \ }) \ static MZ_INLINE rettype name ## __big_dbl(const Scheme_Object *n1, const Scheme_Object *n2) { \ double d2; \ - toi_or_toe(,Small_Rational sr7); \ + toi_or_toe(double tmp7, Small_Rational sr7); \ d2 = SCHEME_DBL_VAL(n2); \ nanchk_more(d2); \ wrap(if (MZ_IS_POS_INFINITY(d2)) return combineinf(waysmalls, n1);) \ wrap(if (MZ_IS_NEG_INFINITY(d2)) return combineinf(waybigs, n1);) \ - return toi_or_toe(fop(scheme_bignum_to_double(n1), d2), \ + toi_or_toe(tmp7=scheme_bignum_to_double(n1),); \ + return toi_or_toe(fop(tmp7, d2), \ rop(scheme_integer_to_rational(n1), rat_from_double(d2, &sr7))); \ } \ static MZ_INLINE rettype name ## __big_rat(const Scheme_Object *n1, const Scheme_Object *n2) { \ @@ -237,24 +243,26 @@ static MZ_INLINE rettype name ## __rat_int(const Scheme_Object *n1, const Scheme FLOATWRAP( \ static MZ_INLINE rettype name ## __rat_flt(const Scheme_Object *n1, const Scheme_Object *n2) { \ float d2; \ - toi_or_toe(,Small_Rational sr9); \ + toi_or_toe(float tmp9, Small_Rational sr9); \ d2 = SCHEME_FLT_VAL(n2); \ snanchk_more(d2); \ wrap(if (MZ_IS_POS_INFINITY(d2)) return combineinf(swaysmalls, n1);) \ wrap(if (MZ_IS_NEG_INFINITY(d2)) return combineinf(swaybigs, n1);) \ wrap(if (d2 == 0.0) return combinezero(ssecondzero, n1, d2);) \ - return toi_or_toe(fsop(scheme_rational_to_float(n1), d2), \ + toi_or_toe(tmp9=scheme_rational_to_float(n1),); \ + return toi_or_toe(fsop(tmp9, d2), \ rop((n1), rat_from_float(d2, &sr9))); \ }) \ static MZ_INLINE rettype name ## __rat_dbl(const Scheme_Object *n1, const Scheme_Object *n2) { \ double d2; \ - toi_or_toe(,Small_Rational sr10); \ + toi_or_toe(double tmp10, Small_Rational sr10); \ d2 = SCHEME_DBL_VAL(n2); \ nanchk_more(d2); \ wrap(if (MZ_IS_POS_INFINITY(d2)) return combineinf(waysmalls, n1);) \ wrap(if (MZ_IS_NEG_INFINITY(d2)) return combineinf(waybigs, n1);) \ wrap(if (d2 == 0.0) return combinezero(secondzero, n1, d2);) \ - return toi_or_toe(fop(scheme_rational_to_double(n1), d2), \ + toi_or_toe(tmp10=scheme_rational_to_double(n1),); \ + return toi_or_toe(fop(tmp10, d2), \ rop((n1), rat_from_double(d2, &sr10))); \ } \ static MZ_INLINE rettype name ## __rat_big(const Scheme_Object *n1, const Scheme_Object *n2) { \ diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index c3ad40c646..351f9599ec 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -617,7 +617,7 @@ XFORM_NONGCING MZ_EXTERN int scheme_get_unsigned_int_val(Scheme_Object *o, uintp XFORM_NONGCING MZ_EXTERN int scheme_get_long_long_val(Scheme_Object *o, mzlonglong *v); XFORM_NONGCING MZ_EXTERN int scheme_get_unsigned_long_long_val(Scheme_Object *o, umzlonglong *v); -XFORM_NONGCING MZ_EXTERN double scheme_real_to_double(Scheme_Object *r); +MZ_EXTERN double scheme_real_to_double(Scheme_Object *r); MZ_EXTERN Scheme_Object *scheme_make_cptr(void *cptr, Scheme_Object *typetag); MZ_EXTERN Scheme_Object *scheme_make_offset_cptr(void *cptr, intptr_t offset, Scheme_Object *typetag); @@ -677,10 +677,10 @@ MZ_EXTERN Scheme_Object *scheme_make_bignum(intptr_t v); MZ_EXTERN Scheme_Object *scheme_make_bignum_from_unsigned(uintptr_t v); MZ_EXTERN Scheme_Object *scheme_make_bignum_from_long_long(mzlonglong v); MZ_EXTERN Scheme_Object *scheme_make_bignum_from_unsigned_long_long(umzlonglong v); -MZ_EXTERN double scheme_bignum_to_double(const Scheme_Object *n); +XFORM_NONGCING MZ_EXTERN double scheme_bignum_to_double(const Scheme_Object *n); MZ_EXTERN Scheme_Object *scheme_bignum_from_double(double d); #ifdef MZ_USE_SINGLE_FLOATS -MZ_EXTERN float scheme_bignum_to_float(const Scheme_Object *n); +XFORM_NONGCING MZ_EXTERN float scheme_bignum_to_float(const Scheme_Object *n); MZ_EXTERN Scheme_Object *scheme_bignum_from_float(float d); #else # define scheme_bignum_to_float scheme_bignum_to_double @@ -1138,10 +1138,10 @@ MZ_EXTERN Scheme_Object *scheme_load_extension(const char *filename, Scheme_Env MZ_EXTERN void scheme_register_extension_global(void *ptr, intptr_t size); MZ_EXTERN intptr_t scheme_get_seconds(void); -MZ_EXTERN intptr_t scheme_get_milliseconds(void); -MZ_EXTERN double scheme_get_inexact_milliseconds(void); -MZ_EXTERN intptr_t scheme_get_process_milliseconds(void); -MZ_EXTERN intptr_t scheme_get_thread_milliseconds(Scheme_Object *thrd); +XFORM_NONGCING MZ_EXTERN intptr_t scheme_get_milliseconds(void); +XFORM_NONGCING MZ_EXTERN double scheme_get_inexact_milliseconds(void); +XFORM_NONGCING MZ_EXTERN intptr_t scheme_get_process_milliseconds(void); +XFORM_NONGCING MZ_EXTERN intptr_t scheme_get_thread_milliseconds(Scheme_Object *thrd); MZ_EXTERN char *scheme_banner(void); MZ_EXTERN char *scheme_version(void);