diff --git a/src/README b/src/README index 6e4195439a..d433a30f32 100644 --- a/src/README +++ b/src/README @@ -39,6 +39,13 @@ build, not a Windows-style build (e.g., Racket's `system-type' procedure returns 'unix, not 'windows, and `racket/gui' uses Gtk instead of Win32). +Beware that MinGW/Cygwin builds different from the MSVC build when +SSE-based floating-point math is enabled in the C compiler. In that +case, Racket includes sets the floating-point mode to extended +precision to support extflonums, and changing precision may affect +other libraries. To avoid the floating-point mode change, disable +extflonum support with `--disable-extflonum'. + ======================================================================== Compiling for Mac OS X ======================================================================== @@ -382,9 +389,9 @@ is compiling floating-point operations as SSE, so be sure to include flags like "-mfpmath=sse" or "-mfpmath=387" in CPPFLAGS, and not just CFLAGS. See related configuration options below. -The Windows build enables extflonum support through a MinGW-compiled -"longdouble.dll", since MSVC does not support `long double' as -extended-precision floating point. +The Windows build using MSVC enables extflonum support through a +MinGW-compiled "longdouble.dll", since MSVC does not support `long +double' as extended-precision floating point. Configuration Options --------------------- diff --git a/src/download-libs.rkt b/src/download-libs.rkt index 2cd8bcc4dc..776cda133c 100644 --- a/src/download-libs.rkt +++ b/src/download-libs.rkt @@ -21,7 +21,7 @@ (define url-host "download.racket-lang.org") -(define url-path "/libs/12/") +(define url-path "/libs/13/") (define url-base (string-append "http://" url-host url-path)) (define architecture #f) ;; set in `do-download' @@ -30,7 +30,20 @@ (parameterize ([current-directory path]) (for-each delete-path (directory-list))) (delete-directory path)] - [(or (file-exists? path) (link-exists? path)) (delete-file path)])) + [(or (file-exists? path) (link-exists? path)) + (if (eq? (system-type) 'windows) + ;; Use a rename-and-delete dance that lets us replace + ;; a DLL that might be in use by the Racket process + ;; that is running the download: + (let ([new-path (path-add-suffix path #".del")]) + (when (file-exists? new-path) + (delete-file new-path)) + (rename-file-or-directory path new-path) + (with-handlers ([exn:fail:filesystem? + (lambda (exn) + (log-error (exn-message exn)))]) + (delete-file new-path))) + (delete-file path))])) (define (purify-port port) (let ([m (regexp-match-peek-positions #rx#"^HTTP/.*?(?:\r\n\r\n|\n\n|\r\r)" @@ -74,6 +87,7 @@ (when (> n 3) (raise-user-error 'download "could not retrieve ~a" file)) (when (zero? n) (printf " timeout,")) (loop (add1 n)))) + (when (file-exists? file) (delete-path file)) (rename-file-or-directory tmp file #t) (define sz (file-size file)) (unless (= size sz) diff --git a/src/get-libs.rkt b/src/get-libs.rkt index ee0fd69321..496bcb9f60 100644 --- a/src/get-libs.rkt +++ b/src/get-libs.rkt @@ -17,12 +17,12 @@ ["iconv.dll" 892928] ["libeay32.dll" 1099776] ["ssleay32.dll" 239104] - ["longdouble.dll" 113285]] + ["longdouble.dll" 114786]] [win32/x86_64 ["libiconv-2.dll" 1378028] ["libeay32.dll" 1503232] ["ssleay32.dll" 309760] - ["longdouble.dll" 123031]]] + ["longdouble.dll" 125176]]] ;; Math Libraries '[math [i386-macosx diff --git a/src/racket/include/scheme.h b/src/racket/include/scheme.h index 39aaccb783..c78800468b 100644 --- a/src/racket/include/scheme.h +++ b/src/racket/include/scheme.h @@ -85,7 +85,6 @@ #ifdef MZ_LONG_DOUBLE # if defined(_MSC_VER) -# define MZ_NEED_SET_EXTFL_MODE 1 # define BYTES_RESERVED_FOR_LONG_DOUBLE 16 typedef struct { char bytes[BYTES_RESERVED_FOR_LONG_DOUBLE]; diff --git a/src/racket/sconfig.h b/src/racket/sconfig.h index f0bba06980..4792b83495 100644 --- a/src/racket/sconfig.h +++ b/src/racket/sconfig.h @@ -627,7 +627,9 @@ #endif #if defined(_MSC_VER) +# define MZ_LONG_DOUBLE # define IGNORE_BY_MS_CONTROL_87 +# define MZ_NEED_SET_EXTFL_MODE #endif #if defined(__MINGW32__) # define MZ_TRY_EXTFLONUMS @@ -640,7 +642,6 @@ # define USE_ICONV_DLL # define NO_MBTOWC_FUNCTIONS -# define MZ_LONG_DOUBLE # ifdef _WIN64 # define MZ_USE_JIT_X86_64 # else @@ -1351,11 +1352,31 @@ converts (a == a) to TRUE, even if `a' is floating-point. Used only when USE_[SCO_]IEEE_FP_PREDS is not defined. */ + /* C_COMPILER_USES_SSE indicates that the C compiler generates SSE + instructions for `double' arithmetic. This flag is turned on + automatically if __SSE_MATH__ is defined (usually by gcc). */ + + /* MZ_LONG_DOUBLE enables extflonum support. */ + + /* MZ_TRY_EXTFLONUMS turns on MZ_LONG_DOUBLE if C_COMPILER_USES_SSE. */ + /* ASM_DBLPREC_CONTROL_87 uses inline assembly to set Intel '387 floating-point operations to double-precision instead of - extended-precision arithmetic. This definition is turned off - if the C compiler and JIT use SSE, and ASM_EXTPREC_CONTROL_87 - is turned on instead if extflonums are enabled. */ + extended-precision arithmetic. This definition is turned off if + C_COMPILER_USES_SSE, and ASM_EXTPREC_CONTROL_87 is turned on + instead if C_COMPILER_USES_SSE and MZ_LONG_DOUBLE. */ + + /* ASM_EXTPREC_CONTROL_87 uses inline assembly to set Intel '387 + floating-point operations to double-precision instead of + extended-precision arithmetic. */ + + /* MZ_NEED_SET_EXTFL_MODE causes JIT-generated extflonum instructions + to set the x87 control word to extended precision just before an + extflonum operation, and then set if back to double precision just + after. This is needed or Windows (where the default mode is double + precision, something about the x64 environment switches the mode + back if you try to change it permanently, and "longdouble.dll" + does the same switch for non-JITted operations). */ /* IGNORE_BY_BORLAND_CONTROL_87 turns off floating-point error for Intel '387 with Borlad-style _control87. DONT_IGNORE_PIPE_SIGNAL diff --git a/src/racket/src/Makefile.in b/src/racket/src/Makefile.in index c30ff3b13c..a857662b09 100644 --- a/src/racket/src/Makefile.in +++ b/src/racket/src/Makefile.in @@ -201,7 +201,8 @@ fun.@LTO@: $(srcdir)/fun.c $(CC) $(CFLAGS) -c $(srcdir)/fun.c -o fun.@LTO@ future.@LTO@: $(srcdir)/future.c $(CC) $(CFLAGS) -c $(srcdir)/future.c -o future.@LTO@ -gmp.@LTO@: $(srcdir)/gmp/gmp.c $(srcdir)/gmp/gmplonglong.h $(srcdir)/../include/schthread.h +gmp.@LTO@: $(srcdir)/gmp/gmp.c $(srcdir)/gmp/gmplonglong.h \ + $(srcdir)/../include/schthread.h $(srcdir)/../sconfig.h $(CC) $(CFLAGS) -c $(srcdir)/gmp/gmp.c -o gmp.@LTO@ hash.@LTO@: $(srcdir)/hash.c $(CC) $(CFLAGS) -c $(srcdir)/hash.c -o hash.@LTO@ @@ -365,7 +366,8 @@ network.@LTO@: $(COMMON_HEADERS) \ numarith.@LTO@: $(COMMON_HEADERS) \ $(srcdir)/stypes.h $(srcdir)/nummacs.h number.@LTO@: $(COMMON_HEADERS) \ - $(srcdir)/stypes.h $(srcdir)/nummacs.h + $(srcdir)/stypes.h $(srcdir)/nummacs.h \ + $(srcdir)/longdouble/longdouble.c numcomp.@LTO@: $(COMMON_HEADERS) \ $(srcdir)/stypes.h $(srcdir)/nummacs.h numstr.@LTO@: $(COMMON_HEADERS) \ diff --git a/src/racket/src/env.c b/src/racket/src/env.c index 2bd620ed66..30fc969f58 100644 --- a/src/racket/src/env.c +++ b/src/racket/src/env.c @@ -239,7 +239,7 @@ Scheme_Env *scheme_engine_instance_init() printf("#if 0\nengine_instance_init @ %" PRIdPTR "\n", scheme_get_process_milliseconds()); #endif -#ifdef MZ_LONG_DOUBLE_API_IS_EXTERNAL +#if defined(MZ_LONG_DOUBLE_API_IS_EXTERNAL) || defined(LONG_DOUBLE_STRING_OP_API_IS_EXTERNAL) scheme_load_long_double_dll(); #endif diff --git a/src/racket/src/jitarith.c b/src/racket/src/jitarith.c index 8ed3bb9cdf..d8d3d38ce7 100644 --- a/src/racket/src/jitarith.c +++ b/src/racket/src/jitarith.c @@ -701,7 +701,7 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator #endif if (arith) { -#ifdef MZ_NEED_SET_EXTFL_MODE +#if defined(MZ_LONG_DOUBLE) && defined(MZ_NEED_SET_EXTFL_MODE) int need_control_reset = 0; if (extfl) { switch (arith) { @@ -954,7 +954,7 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator } #endif } -#ifdef MZ_NEED_SET_EXTFL_MODE +#if defined(MZ_LONG_DOUBLE) && defined(MZ_NEED_SET_EXTFL_MODE) if (extfl && need_control_reset) { jit_set_fp_control(0x27f); } diff --git a/src/racket/src/longdouble/longdouble.c b/src/racket/src/longdouble/longdouble.c index f8e51cafb3..fc88e5a93a 100644 --- a/src/racket/src/longdouble/longdouble.c +++ b/src/racket/src/longdouble/longdouble.c @@ -1,3 +1,11 @@ + +/* This file is really three implementations: the external API, glue + for the external API, and glue for just the string external API. */ + +/**********************************************************************/ +/* External long_double implementation */ +/**********************************************************************/ + #ifdef IMPLEMENTING_MSC_LONGDOUBLE /* Implement the `long_double' API. @@ -25,118 +33,120 @@ LDBL_DLL_API int get_x87_control() return v; } -static void ext_mode() +static int ext_mode() { + int m = get_x87_control(); set_x87_control(0x37F); + return m; } -static void default_mode() +static void restore_mode(int m) { - set_x87_control(0x27F); + set_x87_control(m); } long_double get_long_double_infinity_val() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = 1.0L / get_long_double_zero().val; - default_mode(); + restore_mode(m); return result; } long_double get_long_double_minus_infinity_val() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = -get_long_double_infinity_val().val; - default_mode(); + restore_mode(m); return result; } long_double get_long_double_zero() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = 0.0L; - default_mode(); + restore_mode(m); return result; } long_double get_long_double_nzero() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = -1.0L / get_long_double_infinity_val().val; - default_mode(); + restore_mode(m); return result; } long_double get_long_double_nan() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = get_long_double_infinity_val().val + get_long_double_minus_infinity_val().val; - default_mode(); + restore_mode(m); return result; } long_double get_long_double_1() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = 1.0L; - default_mode(); + restore_mode(m); return result; } long_double get_long_double_minus_1() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = -1.0L; - default_mode(); + restore_mode(m); return result; } long_double get_long_double_2() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = 2.0L; - default_mode(); + restore_mode(m); return result; } long_double get_long_double_one_half() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = 0.5L; - default_mode(); + restore_mode(m); return result; } long_double get_long_double_pi() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = atan2l(0.0L, -1.0L); - default_mode(); + restore_mode(m); return result; } long_double get_long_double_half_pi() { long_double result; - ext_mode(); + int m = ext_mode(); result.val = atan2l(0.0L, -1.0L)/2.0L; - default_mode(); + restore_mode(m); return result; } long_double long_double_from_int(int a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = (long double) a; - default_mode(); + restore_mode(m); return result; } @@ -144,27 +154,27 @@ long_double long_double_from_int(int a) long_double long_double_from_float(float a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = (long double) a; - default_mode(); + restore_mode(m); return result; } long_double long_double_from_double(double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = (long double) a; - default_mode(); + restore_mode(m); return result; } long_double long_double_from_uintptr(uintptr_t a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = a; - default_mode(); + restore_mode(m); return result; } @@ -185,62 +195,62 @@ intptr_t int_from_long_double(long_double a) long_double long_double_plus(long_double a, long_double b) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = a.val + b.val; - default_mode(); + restore_mode(m); return result; } long_double long_double_minus(long_double a, long_double b) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = a.val - b.val; - default_mode(); + restore_mode(m); return result; } long_double long_double_mult(long_double a, long_double b) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = a.val * b.val; - default_mode(); + restore_mode(m); return result; } long_double long_double_mult_i(long_double a, int b) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = a.val * b; - default_mode(); + restore_mode(m); return result; } uintptr_t uintptr_from_long_double(long_double a) { uintptr_t result; - ext_mode(); + int m = ext_mode(); result = a.val; - default_mode(); + restore_mode(m); return result; } long_double long_double_div(long_double a, long_double b) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = a.val / b.val; - default_mode(); + restore_mode(m); return result; } long_double long_double_neg(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = -a.val; - default_mode(); + restore_mode(m); return result; } @@ -283,9 +293,9 @@ int long_double_is_1(long_double a) int long_double_minus_zero_p(long_double a) { int v; - ext_mode(); + int m = ext_mode(); v = ((1.0L / a.val) < 0.0L); - default_mode(); + restore_mode(m); return v; } int long_double_is_nan(long_double a) @@ -310,160 +320,160 @@ int long_double_is_infinity(long_double a) long_double long_double_fabs(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = fabsl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_modf(long_double a, long_double *b) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = modfl(a.val, &b->val); - default_mode(); + restore_mode(m); return result; } long_double long_double_fmod(long_double a, long_double b) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = fmodl(a.val, b.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_trunc(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = truncl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_floor(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = floorl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_ceil(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = ceill(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_sin(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = sinl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_cos(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = cosl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_tan(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = tanl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_asin(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = asinl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_acos(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = acosl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_atan(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = atanl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_log(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = logl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_exp(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = expl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_ldexp(long_double a, int i) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = ldexpl(a.val, i); - default_mode(); + restore_mode(m); return result; } long_double long_double_pow(long_double a, long_double b) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = powl(a.val, b.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_sqrt(long_double a) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = sqrtl(a.val); - default_mode(); + restore_mode(m); return result; } long_double long_double_frexp(long_double a, int* i) { long_double result; - ext_mode(); + int m = ext_mode(); result.val = frexpl(a.val, i); - default_mode(); + restore_mode(m); return result; } void long_double_sprint(char* buffer, int digits, long_double d) { - ext_mode(); + int m = ext_mode(); __mingw_sprintf(buffer, "%.*Lg", digits, d.val); - default_mode(); + restore_mode(m); } long_double long_double_array_ref(void *pointer, int index) @@ -484,9 +494,9 @@ long_double long_double_from_string(char* buff, char** p) long_double result; char* ptr, one_char; int n; - ext_mode(); + int m = ext_mode(); n = __mingw_sscanf(buff, "%Lf%c", &result.val, &one_char); - default_mode(); + restore_mode(m); if (n == 1) { /* all characters consumed for the number */ *p = &buff[strlen(buff)]; @@ -498,9 +508,18 @@ long_double long_double_from_string(char* buff, char** p) return result; } -#else +void long_double_from_string_indirect(char* buff, char** p, long_double *_ld) +{ + *_ld = long_double_from_string(buff, p); +} -/* Glue code */ +#endif + +/**********************************************************************/ +/* Glue for external long_double implementation */ +/**********************************************************************/ + +#ifdef MZ_LONG_DOUBLE_API_IS_EXTERNAL #ifdef MZ_PRECISE_GC START_XFORM_SKIP; @@ -597,7 +616,7 @@ static long_double fail_from_string(char* buff, char** p) double d; long_double ld; - d = strtod(buff, p, 0); + d = strtod(buff, p); memcpy(&ld, &d, sizeof(double)); return ld; @@ -779,3 +798,89 @@ END_XFORM_SKIP; #endif #endif + +/**********************************************************************/ +/* Glue for external long_double string-op implementation */ +/**********************************************************************/ + +#ifdef LONG_DOUBLE_STRING_OP_API_IS_EXTERNAL + +/* Like regular glue mode, but only for the string operations. + + It may seem strage to resort to a MinGW-compiled DLL to implement + functionality when compiling with MinGW, but the MinGW version has + to be recent enough to get __mingw_sscanf, so we do things this + way to allow building with older MinGWs (such as the default MinGW + release at the time of writing). */ + +#ifdef MZ_PRECISE_GC +START_XFORM_SKIP; +#endif + +static int long_double_dll_available; + +typedef union dll_long_double +{ + char bytes[SIZEOF_LONGDOUBLE]; + long double val; +} dll_long_double; + +/* pointers to dynamically loaded functions */ +#define DECLARE_LDBL(res, name, args) \ + typedef res (* name ## _t)args; \ + static name ## _t _imp_ ## name; +DECLARE_LDBL(void, long_double_sprint, (char* buffer, int digits, dll_long_double ld)) +DECLARE_LDBL(void, long_double_from_string_indirect, (char* buff, char** p, dll_long_double *_ld)) + +static void fail_from_string_indirect(char* buff, char** p, dll_long_double *_ld) +{ + double d; + + d = strtod(buff, p); + memcpy(_ld, &d, sizeof(double)); +} + +static void fail_sprint(char* buffer, int digits, dll_long_double ld) +{ + double d; + memcpy(&d, &ld, sizeof(double)); + sprintf(buffer, "%.*Lg", digits, d); +} + +/* initialization */ +void scheme_load_long_double_dll() +{ + HANDLE m; + m = LoadLibraryW(scheme_get_dll_path(L"longdouble.dll")); + + if (m) long_double_dll_available = 1; + +# define EXTRACT_LDBL(name, fail) \ + _imp_ ## name = (name ##_t)(m ? GetProcAddress(m, # name) : NULL); \ + if (!(_imp_ ## name)) _imp_ ## name = (name ##_t)fail; + + EXTRACT_LDBL(long_double_sprint, fail_sprint); + EXTRACT_LDBL(long_double_from_string_indirect, fail_from_string_indirect); +} + +int long_double_available() { + return long_double_dll_available; +} + +void long_double_sprint(char* buffer, int digits, long double d) { + dll_long_double ld; + ld.val = d; + _imp_long_double_sprint(buffer, digits, ld); +} + +long double long_double_from_string(char* buff, char** p) { + dll_long_double ld; + _imp_long_double_from_string_indirect(buff, p, &ld); + return ld.val; +} + +#ifdef MZ_PRECISE_GC +END_XFORM_SKIP; +#endif + +#endif diff --git a/src/racket/src/longdouble/longdouble.h b/src/racket/src/longdouble/longdouble.h index c455ee5433..798ea9eb02 100644 --- a/src/racket/src/longdouble/longdouble.h +++ b/src/racket/src/longdouble/longdouble.h @@ -1,45 +1,41 @@ #ifndef MZ_LONGDOUBLE_H #define MZ_LONGDOUBLE_H -#if defined(_MSC_VER) || defined(IMPLEMENTING_MSC_LONGDOUBLE) -/* aligning */ -# if defined(_X86_64) || defined(_M_X64) || defined(_WIN64) -# define SIZEOF_LONGDOUBLE 16 -# else -# define SIZEOF_LONGDOUBLE 16 -# endif +#if defined(_MSC_VER) +# define MZ_LONG_DOUBLE_API_IS_EXTERNAL +#endif -# ifdef BYTES_RESERVED_FOR_LONG_DOUBLE +#if defined(__MINGW32__) && defined(MZ_LONG_DOUBLE) +# define LONG_DOUBLE_STRING_OP_API_IS_EXTERNAL +#endif + +#if defined(MZ_LONG_DOUBLE_API_IS_EXTERNAL) \ + || defined(LONG_DOUBLE_STRING_OP_API_IS_EXTERNAL) \ + || defined(IMPLEMENTING_MSC_LONGDOUBLE) +# define SIZEOF_LONGDOUBLE 16 +#endif + +#ifdef BYTES_RESERVED_FOR_LONG_DOUBLE /* check "scheme.h" versus "longdouble.h": */ -# if BYTES_RESERVED_FOR_LONG_DOUBLE != SIZEOF_LONGDOUBLE +# if BYTES_RESERVED_FOR_LONG_DOUBLE != SIZEOF_LONGDOUBLE !! mismatch in mz_long_double size !! -# endif # endif +#endif -# ifdef IMPLEMENTING_MSC_LONGDOUBLE +#ifdef IMPLEMENTING_MSC_LONGDOUBLE typedef union long_double { char bytes[SIZEOF_LONGDOUBLE]; long double val; } long_double; -# else -# define long_double mz_long_double -# endif - -#else -# define long_double mz_long_double -#endif - -#ifdef IMPLEMENTING_MSC_LONGDOUBLE # define LDBL_DLL_API __declspec(dllexport) # define XFORM_NONGCING /* empty */ #else +# define long_double mz_long_double # define LDBL_DLL_API /* empty */ #endif -#if defined(_MSC_VER) || defined(IMPLEMENTING_MSC_LONGDOUBLE) - -#define MZ_LONG_DOUBLE_API_IS_EXTERNAL +#if defined(MZ_LONG_DOUBLE_API_IS_EXTERNAL) || defined(IMPLEMENTING_MSC_LONGDOUBLE) void scheme_load_long_double_dll(); @@ -121,6 +117,7 @@ XFORM_NONGCING LDBL_DLL_API long_double long_double_array_ref(void *pointer, int XFORM_NONGCING LDBL_DLL_API void long_double_array_set(void *pointer, int index, long_double value); XFORM_NONGCING LDBL_DLL_API long_double long_double_from_string(char* buff, char** p); +XFORM_NONGCING LDBL_DLL_API void long_double_from_string_indirect(char* buff, char** p, long_double *_ld); XFORM_NONGCING void to_double_prec(); XFORM_NONGCING void to_extended_prec(); @@ -199,14 +196,23 @@ XFORM_NONGCING int long_double_available(); # define long_double_frexp(a, i) frexpl(a, i) -# define long_double_from_string(x,y) strtold(x, y) - -# define long_double_sprint(buffer,digits,d) sprintf(buffer, "%.*Lg", digits, d) +# ifdef LONG_DOUBLE_STRING_OP_API_IS_EXTERNAL +XFORM_NONGCING LDBL_DLL_API long_double long_double_from_string(char* buff, char** p); +XFORM_NONGCING LDBL_DLL_API void long_double_sprint(char* buffer, int digits, long_double d); +# else +# define long_double_from_string(x,y) strtold(x, y) +# define long_double_sprint(buffer,digits,d) sprintf(buffer, "%.*Lg", digits, d) +# endif # define long_double_array_ref(pointer,index) ((long_double *)(pointer))[index] # define long_double_array_set(pointer,index,value) ((long_double *)(pointer))[index] = (value) -# define long_double_available() 1 +# ifdef LONG_DOUBLE_STRING_OP_API_IS_EXTERNAL +XFORM_NONGCING void scheme_load_long_double_dll(); +XFORM_NONGCING int long_double_available(); +# else +# define long_double_available() 1 +# endif #endif diff --git a/src/racket/src/number.c b/src/racket/src/number.c index c49e0e0f9d..95439259ce 100644 --- a/src/racket/src/number.c +++ b/src/racket/src/number.c @@ -5457,6 +5457,6 @@ static Scheme_Object *extfl_to_integer (int argc, Scheme_Object *argv[]) #endif } -#ifdef MZ_LONG_DOUBLE_API_IS_EXTERNAL +#if defined(MZ_LONG_DOUBLE_API_IS_EXTERNAL) || defined(LONG_DOUBLE_STRING_OP_API_IS_EXTERNAL) # include "longdouble/longdouble.c" #endif