From 428b6c66cd56f0a56fa118d3ac4ca3eacbf73320 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Sat, 1 Aug 2009 22:07:43 +0000 Subject: [PATCH] Updates to follow the RTS tidyup C functions like isDoubleNaN moved here (primFloat.c) --- GHC/TopHandler.lhs | 2 +- base.cabal | 1 + cbits/PrelIOUtils.c | 1 - cbits/primFloat.c | 261 +++++++++++++++++++++++++++++++++++++++++++++++++++ include/HsBase.h | 50 ---------- include/ieee-flpt.h | 35 +++++++ 6 files changed, 298 insertions(+), 52 deletions(-) create mode 100644 cbits/primFloat.c create mode 100644 include/ieee-flpt.h diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs index 2836111..0f55b38 100644 --- a/GHC/TopHandler.lhs +++ b/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/base.cabal b/base.cabal index 01fad68..c17d351 100644 --- a/base.cabal +++ b/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/cbits/PrelIOUtils.c b/cbits/PrelIOUtils.c index 6444bd0..b910c28 100644 --- a/cbits/PrelIOUtils.c +++ b/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/cbits/primFloat.c b/cbits/primFloat.c new file mode 100644 index 0000000..3fa39d3 --- /dev/null +++ b/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/include/HsBase.h b/include/HsBase.h index e052918..56a660e 100644 --- a/include/HsBase.h +++ b/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/include/ieee-flpt.h b/include/ieee-flpt.h new file mode 100644 index 0000000..a1fce3a --- /dev/null +++ b/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 -- 1.7.10.4