repairs for MinGW builds

The changes make extflonums work when compiling with SSE arithmetic
for `double's.

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
+The Windows build using MSVC enables extflonum support through a
-"longdouble.dll", since MSVC does not support `long double' as
+MinGW-compiled "longdouble.dll", since MSVC does not support `long
-extended-precision floating point.
+double' as extended-precision floating point.
 
 Configuration Options
 ---------------------

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)

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

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];

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
+    extended-precision arithmetic. This definition is turned off if
-    if the C compiler and JIT use SSE, and ASM_EXTPREC_CONTROL_87
+    C_COMPILER_USES_SSE, and ASM_EXTPREC_CONTROL_87 is turned on
-    is turned on instead if extflonums are enabled. */
+    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

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

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
 

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

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

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)
+#if defined(_MSC_VER)
-/* aligning */
+# define MZ_LONG_DOUBLE_API_IS_EXTERNAL
-# if defined(_X86_64) || defined(_M_X64) || defined(_WIN64)
+#endif
-#  define SIZEOF_LONGDOUBLE 16
-# else
-#  define SIZEOF_LONGDOUBLE 16
-# 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)
+#if defined(MZ_LONG_DOUBLE_API_IS_EXTERNAL) || defined(IMPLEMENTING_MSC_LONGDOUBLE)
-
-#define MZ_LONG_DOUBLE_API_IS_EXTERNAL
 
 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)
+# ifdef LONG_DOUBLE_STRING_OP_API_IS_EXTERNAL
-
+XFORM_NONGCING LDBL_DLL_API long_double long_double_from_string(char* buff, char** p);
-# define long_double_sprint(buffer,digits,d) sprintf(buffer, "%.*Lg", digits, d)
+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
 

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