Updates to follow the RTS tidyup

C functions like isDoubleNaN moved here (primFloat.c)

6 files changed, 298 insertions, 52 deletions

diff --git a/libraries/base/GHC/TopHandler.lhs b/libraries/base/GHC/TopHandler.lhs
index 2836111475..0f55b38ba3 100644
--- a/libraries/base/GHC/TopHandler.lhs
+++ b/libraries/base/GHC/TopHandler.lhs
@@ -78,7 +78,7 @@ install_interrupt_handler handler = do
            _ -> return ()
   return ()
 #else
-#include "Signals.h"
+#include "rts/Signals.h"
 -- specialised version of System.Posix.Signals.installHandler, which
 -- isn't available here.
 install_interrupt_handler handler = do
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 01fad6838d..c17d351615 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -198,6 +198,7 @@ Library {
         cbits/iconv.c
         cbits/inputReady.c
         cbits/selectUtils.c
+        cbits/primFloat.c
     include-dirs: include
     includes:    HsBase.h
     install-includes:    HsBase.h HsBaseConfig.h WCsubst.h consUtils.h Typeable.h
diff --git a/libraries/base/cbits/PrelIOUtils.c b/libraries/base/cbits/PrelIOUtils.c
index 6444bd04e6..b910c28de2 100644
--- a/libraries/base/cbits/PrelIOUtils.c
+++ b/libraries/base/cbits/PrelIOUtils.c
@@ -13,7 +13,6 @@
 #include "HsBase.h"
 
 #ifdef __GLASGOW_HASKELL__
-# include "RtsMessages.h"
 
 void errorBelch2(const char*s, char *t)
 {
diff --git a/libraries/base/cbits/primFloat.c b/libraries/base/cbits/primFloat.c
new file mode 100644
index 0000000000..3fa39d3c59
--- /dev/null
+++ b/libraries/base/cbits/primFloat.c
@@ -0,0 +1,261 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) Lennart Augustsson
+ * (c) The GHC Team, 1998-2000
+ *
+ * Miscellaneous support for floating-point primitives
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "HsFFI.h"
+#include "Rts.h" // XXX wrong (for IEEE_FLOATING_POINT and WORDS_BIGENDIAN)
+
+#define IEEE_FLOATING_POINT 1
+
+union stg_ieee754_flt
+{
+   float f;
+   struct {
+
+#if WORDS_BIGENDIAN
+	unsigned int negative:1;
+	unsigned int exponent:8;
+	unsigned int mantissa:23;
+#else
+	unsigned int mantissa:23;
+	unsigned int exponent:8;
+	unsigned int negative:1;
+#endif
+   } ieee;
+   struct {
+
+#if WORDS_BIGENDIAN
+	unsigned int negative:1;
+	unsigned int exponent:8;
+	unsigned int quiet_nan:1;
+	unsigned int mantissa:22;
+#else
+	unsigned int mantissa:22;
+	unsigned int quiet_nan:1;
+	unsigned int exponent:8;
+	unsigned int negative:1;
+#endif
+   } ieee_nan;
+};
+
+/*
+ 
+ To recap, here's the representation of a double precision
+ IEEE floating point number:
+
+ sign         63           sign bit (0==positive, 1==negative)
+ exponent     62-52        exponent (biased by 1023)
+ fraction     51-0         fraction (bits to right of binary point)
+*/
+
+union stg_ieee754_dbl
+{
+   double d;
+   struct {
+
+#if WORDS_BIGENDIAN
+	unsigned int negative:1;
+	unsigned int exponent:11;
+	unsigned int mantissa0:20;
+	unsigned int mantissa1:32;
+#else
+#if FLOAT_WORDS_BIGENDIAN
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+	unsigned int mantissa1:32;
+#else
+	unsigned int mantissa1:32;
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+#endif
+#endif
+   } ieee;
+    /* This format makes it easier to see if a NaN is a signalling NaN.  */
+   struct {
+
+#if WORDS_BIGENDIAN
+	unsigned int negative:1;
+	unsigned int exponent:11;
+	unsigned int quiet_nan:1;
+	unsigned int mantissa0:19;
+	unsigned int mantissa1:32;
+#else
+#if FLOAT_WORDS_BIGENDIAN
+	unsigned int mantissa0:19;
+	unsigned int quiet_nan:1;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+	unsigned int mantissa1:32;
+#else
+	unsigned int mantissa1:32;
+	unsigned int mantissa0:19;
+	unsigned int quiet_nan:1;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+#endif
+#endif
+   } ieee_nan;
+};
+
+/*
+ * Predicates for testing for extreme IEEE fp values.
+ */ 
+
+/* In case you don't suppport IEEE, you'll just get dummy defs.. */
+#ifdef IEEE_FLOATING_POINT
+
+HsInt
+isDoubleNaN(HsDouble d)
+{
+  union stg_ieee754_dbl u;
+  
+  u.d = d;
+
+  return (
+    u.ieee.exponent  == 2047 /* 2^11 - 1 */ &&  /* Is the exponent all ones? */
+    (u.ieee.mantissa0 != 0 || u.ieee.mantissa1 != 0)
+    	/* and the mantissa non-zero? */
+    );
+}
+
+HsInt
+isDoubleInfinite(HsDouble d)
+{
+    union stg_ieee754_dbl u;
+
+    u.d = d;
+
+    /* Inf iff exponent is all ones, mantissa all zeros */
+    return (
+        u.ieee.exponent  == 2047 /* 2^11 - 1 */ &&
+	u.ieee.mantissa0 == 0 		        &&
+	u.ieee.mantissa1 == 0
+      );
+}
+
+HsInt
+isDoubleDenormalized(HsDouble d) 
+{
+    union stg_ieee754_dbl u;
+
+    u.d = d;
+
+    /* A (single/double/quad) precision floating point number
+       is denormalised iff:
+        - exponent is zero
+	- mantissa is non-zero.
+        - (don't care about setting of sign bit.)
+
+    */
+    return (  
+	u.ieee.exponent  == 0 &&
+	(u.ieee.mantissa0 != 0 ||
+	 u.ieee.mantissa1 != 0)
+      );
+	 
+}
+
+HsInt
+isDoubleNegativeZero(HsDouble d) 
+{
+    union stg_ieee754_dbl u;
+
+    u.d = d;
+    /* sign (bit 63) set (only) => negative zero */
+
+    return (
+    	u.ieee.negative  == 1 &&
+	u.ieee.exponent  == 0 &&
+	u.ieee.mantissa0 == 0 &&
+	u.ieee.mantissa1 == 0);
+}
+
+/* Same tests, this time for HsFloats. */
+
+/*
+ To recap, here's the representation of a single precision
+ IEEE floating point number:
+
+ sign         31           sign bit (0 == positive, 1 == negative)
+ exponent     30-23        exponent (biased by 127)
+ fraction     22-0         fraction (bits to right of binary point)
+*/
+
+
+HsInt
+isFloatNaN(HsFloat f)
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+
+   /* Floating point NaN iff exponent is all ones, mantissa is
+      non-zero (but see below.) */
+   return (
+   	u.ieee.exponent == 255 /* 2^8 - 1 */ &&
+	u.ieee.mantissa != 0);
+}
+
+HsInt
+isFloatInfinite(HsFloat f)
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+  
+    /* A float is Inf iff exponent is max (all ones),
+       and mantissa is min(all zeros.) */
+    return (
+    	u.ieee.exponent == 255 /* 2^8 - 1 */ &&
+	u.ieee.mantissa == 0);
+}
+
+HsInt
+isFloatDenormalized(HsFloat f)
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+
+    /* A (single/double/quad) precision floating point number
+       is denormalised iff:
+        - exponent is zero
+	- mantissa is non-zero.
+        - (don't care about setting of sign bit.)
+
+    */
+    return (
+    	u.ieee.exponent == 0 &&
+	u.ieee.mantissa != 0);
+}
+
+HsInt
+isFloatNegativeZero(HsFloat f) 
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+
+    /* sign (bit 31) set (only) => negative zero */
+    return (
+	u.ieee.negative      &&
+	u.ieee.exponent == 0 &&
+	u.ieee.mantissa == 0);
+}
+
+#else /* ! IEEE_FLOATING_POINT */
+
+/* Dummy definitions of predicates - they all return false */
+HsInt isDoubleNaN(d) HsDouble d; { return 0; }
+HsInt isDoubleInfinite(d) HsDouble d; { return 0; }
+HsInt isDoubleDenormalized(d) HsDouble d; { return 0; }
+HsInt isDoubleNegativeZero(d) HsDouble d; { return 0; }
+HsInt isFloatNaN(f) HsFloat f; { return 0; }
+HsInt isFloatInfinite(f) HsFloat f; { return 0; }
+HsInt isFloatDenormalized(f) HsFloat f; { return 0; }
+HsInt isFloatNegativeZero(f) HsFloat f; { return 0; }
+
+#endif /* ! IEEE_FLOATING_POINT */
diff --git a/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h
index e052918c00..56a660e40c 100644
--- a/libraries/base/include/HsBase.h
+++ b/libraries/base/include/HsBase.h
@@ -152,56 +152,6 @@ extern int fdReady(int fd, int write, int msecs, int isSock);
 extern HsInt nocldstop;
 
 /* -----------------------------------------------------------------------------
-   64-bit operations, defined in longlong.c
-   -------------------------------------------------------------------------- */
-
-#ifdef SUPPORT_LONG_LONGS
-
-HsBool hs_gtWord64 (HsWord64, HsWord64);
-HsBool hs_geWord64 (HsWord64, HsWord64);
-HsBool hs_eqWord64 (HsWord64, HsWord64);
-HsBool hs_neWord64 (HsWord64, HsWord64);
-HsBool hs_ltWord64 (HsWord64, HsWord64);
-HsBool hs_leWord64 (HsWord64, HsWord64);
-
-HsBool hs_gtInt64 (HsInt64, HsInt64);
-HsBool hs_geInt64 (HsInt64, HsInt64);
-HsBool hs_eqInt64 (HsInt64, HsInt64);
-HsBool hs_neInt64 (HsInt64, HsInt64);
-HsBool hs_ltInt64 (HsInt64, HsInt64);
-HsBool hs_leInt64 (HsInt64, HsInt64);
-
-HsWord64 hs_remWord64  (HsWord64, HsWord64);
-HsWord64 hs_quotWord64 (HsWord64, HsWord64);
-
-HsInt64 hs_remInt64    (HsInt64, HsInt64);
-HsInt64 hs_quotInt64   (HsInt64, HsInt64);
-HsInt64 hs_negateInt64 (HsInt64);
-HsInt64 hs_plusInt64   (HsInt64, HsInt64);
-HsInt64 hs_minusInt64  (HsInt64, HsInt64);
-HsInt64 hs_timesInt64  (HsInt64, HsInt64);
-
-HsWord64 hs_and64  (HsWord64, HsWord64);
-HsWord64 hs_or64   (HsWord64, HsWord64);
-HsWord64 hs_xor64  (HsWord64, HsWord64);
-HsWord64 hs_not64  (HsWord64);
-
-HsWord64 hs_uncheckedShiftL64   (HsWord64, HsInt);
-HsWord64 hs_uncheckedShiftRL64  (HsWord64, HsInt);
-HsInt64  hs_uncheckedIShiftL64  (HsInt64, HsInt);
-HsInt64  hs_uncheckedIShiftRA64 (HsInt64, HsInt);
-HsInt64  hs_uncheckedIShiftRL64 (HsInt64, HsInt);
-
-HsInt64  hs_intToInt64    (HsInt);
-HsInt    hs_int64ToInt    (HsInt64);
-HsWord64 hs_int64ToWord64 (HsInt64);
-HsWord64 hs_wordToWord64  (HsWord);
-HsWord   hs_word64ToWord  (HsWord64);
-HsInt64  hs_word64ToInt64 (HsWord64);
-
-#endif /* SUPPORT_LONG_LONGS */
-
-/* -----------------------------------------------------------------------------
    INLINE functions.
 
    These functions are given as inlines here for when compiling via C,
diff --git a/libraries/base/include/ieee-flpt.h b/libraries/base/include/ieee-flpt.h
new file mode 100644
index 0000000000..a1fce3a8da
--- /dev/null
+++ b/libraries/base/include/ieee-flpt.h
@@ -0,0 +1,35 @@
+/* this file is #included into both C (.c and .hc) and Haskell files */
+
+    /* IEEE format floating-point */
+#define IEEE_FLOATING_POINT 1
+
+   /* Radix of exponent representation */
+#ifndef FLT_RADIX
+# define FLT_RADIX 2
+#endif
+
+   /* Number of base-FLT_RADIX digits in the significand of a float */
+#ifndef FLT_MANT_DIG
+# define FLT_MANT_DIG 24
+#endif
+   /* Minimum int x such that FLT_RADIX**(x-1) is a normalised float */
+#ifndef FLT_MIN_EXP
+#  define FLT_MIN_EXP (-125)
+#endif
+   /* Maximum int x such that FLT_RADIX**(x-1) is a representable float */
+#ifndef FLT_MAX_EXP
+# define FLT_MAX_EXP 128
+#endif
+
+   /* Number of base-FLT_RADIX digits in the significand of a double */
+#ifndef DBL_MANT_DIG
+# define DBL_MANT_DIG 53
+#endif
+   /* Minimum int x such that FLT_RADIX**(x-1) is a normalised double */
+#ifndef DBL_MIN_EXP
+#  define DBL_MIN_EXP (-1021)
+#endif
+   /* Maximum int x such that FLT_RADIX**(x-1) is a representable double */
+#ifndef DBL_MAX_EXP
+# define DBL_MAX_EXP 1024
+#endif