[MLton-commit] r6693

[Wesley Terpstra]

The MinGW feget/setround are broken on win64. Use the MLton version.
Added assembler to control the SSE rounding mode along with the FPU.
This patch marks the point of every regression passing on Win64. :-)


----------------------------------------------------------------------

U   mlton/trunk/runtime/basis/Real/IEEEReal.c
U   mlton/trunk/runtime/platform/mingw.h

----------------------------------------------------------------------

Modified: mlton/trunk/runtime/basis/Real/IEEEReal.c
===================================================================
--- mlton/trunk/runtime/basis/Real/IEEEReal.c	2008-08-07 19:06:09 UTC (rev 6692)
+++ mlton/trunk/runtime/basis/Real/IEEEReal.c	2008-08-08 12:00:51 UTC (rev 6693)
@@ -2,29 +2,44 @@
 
 #if !HAS_FEROUND
 
-#if (defined __i386__)
+#if (defined __i386__) || (defined __x86_64__)
 
 /* Macros for accessing the hardware control word. */
-#define _FPU_GETCW(cw) __asm__ ("fnstcw %0" : "=m" (*&cw))
-#define _FPU_SETCW(cw) __asm__ ("fldcw %0" : : "m" (*&cw))
+#define _FPU_GETCW(cw)   __asm__ ("fnstcw %0" : "=m" (*&cw))
+#define _FPU_SETCW(cw)   __asm__ ("fldcw %0" : : "m" (*&cw))
+#define _SSE_GETCSR(csr) __asm__ ("stmxcsr %0" : "=m" (*&csr))
+#define _SSE_SETCSR(csr) __asm__ ("ldmxcsr %0" : : "m" (*&csr))
 
-#define ROUNDING_CONTROL_MASK 0x0C00
-#define ROUNDING_CONTROL_SHIFT 10
+#define FPU_ROUNDING_CONTROL_MASK 0x0C00
+#define FPU_ROUNDING_CONTROL_SHIFT 10
+#define SSE_ROUNDING_CONTROL_MASK 0x00006000
+#define SSE_ROUNDING_CONTROL_SHIFT 13
 
 static inline C_Int_t fegetround (void) {
-        unsigned short controlWord;
-
-        _FPU_GETCW (controlWord);
-        return (controlWord & ROUNDING_CONTROL_MASK) >> ROUNDING_CONTROL_SHIFT;
+        uint16_t fpuControl;
+        
+        _FPU_GETCW (fpuControl);
+        return (fpuControl & FPU_ROUNDING_CONTROL_MASK) 
+               >> FPU_ROUNDING_CONTROL_SHIFT;
 }
 
 static inline void fesetround (C_Int_t mode) {
-        unsigned short controlWord;
+        uint16_t fpuControl;
+#ifdef __x86_64__
+        uint32_t sseControl;
+#endif
 
-        _FPU_GETCW (controlWord);
-        controlWord &= ~ROUNDING_CONTROL_MASK;
-        controlWord |= mode << ROUNDING_CONTROL_SHIFT;
-        _FPU_SETCW (controlWord);
+        _FPU_GETCW (fpuControl);
+        fpuControl &= ~FPU_ROUNDING_CONTROL_MASK;
+        fpuControl |= mode << FPU_ROUNDING_CONTROL_SHIFT;
+        _FPU_SETCW (fpuControl);
+
+#ifdef __x86_64__
+        _SSE_GETCSR (sseControl);
+        sseControl &= ~SSE_ROUNDING_CONTROL_MASK;
+        sseControl |= mode << SSE_ROUNDING_CONTROL_SHIFT;
+        _SSE_SETCSR (sseControl);
+#endif
 }
 
 #else

Modified: mlton/trunk/runtime/platform/mingw.h
===================================================================
--- mlton/trunk/runtime/platform/mingw.h	2008-08-07 19:06:09 UTC (rev 6692)
+++ mlton/trunk/runtime/platform/mingw.h	2008-08-08 12:00:51 UTC (rev 6693)
@@ -1,4 +1,3 @@
-#include <fenv.h>
 #include <inttypes.h>
 #include <stdint.h>
 
@@ -25,7 +24,8 @@
 
 #undef max
 
-#define HAS_FEROUND TRUE
+// As of 20080807, MinGW has a broken fesetround. Use the runtime's.
+#define HAS_FEROUND FALSE
 // As of 20051104, MinGW has fpclassify, but it is broken.  In particular, it
 // classifies subnormals as normals.  So, we disable it here, which causes the
 // runtime to use our own version.