cbits/primFloat.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) Lennart Augustsson
   4  * (c) The GHC Team, 1998-2000
   5  *
   6  * Miscellaneous support for floating-point primitives
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "HsFFI.h"
  11 #include "Rts.h" // XXX wrong (for IEEE_FLOATING_POINT and WORDS_BIGENDIAN)
  12
  13 #define IEEE_FLOATING_POINT 1
  14
  15 union stg_ieee754_flt
  16 {
  17    float f;
  18    struct {
  19
  20 #if WORDS_BIGENDIAN
  21         unsigned int negative:1;
  22         unsigned int exponent:8;
  23         unsigned int mantissa:23;
  24 #else
  25         unsigned int mantissa:23;
  26         unsigned int exponent:8;
  27         unsigned int negative:1;
  28 #endif
  29    } ieee;
  30    struct {
  31
  32 #if WORDS_BIGENDIAN
  33         unsigned int negative:1;
  34         unsigned int exponent:8;
  35         unsigned int quiet_nan:1;
  36         unsigned int mantissa:22;
  37 #else
  38         unsigned int mantissa:22;
  39         unsigned int quiet_nan:1;
  40         unsigned int exponent:8;
  41         unsigned int negative:1;
  42 #endif
  43    } ieee_nan;
  44 };
  45
  46 /*
  47
  48  To recap, here's the representation of a double precision
  49  IEEE floating point number:
  50
  51  sign         63           sign bit (0==positive, 1==negative)
  52  exponent     62-52        exponent (biased by 1023)
  53  fraction     51-0         fraction (bits to right of binary point)
  54 */
  55
  56 union stg_ieee754_dbl
  57 {
  58    double d;
  59    struct {
  60
  61 #if WORDS_BIGENDIAN
  62         unsigned int negative:1;
  63         unsigned int exponent:11;
  64         unsigned int mantissa0:20;
  65         unsigned int mantissa1:32;
  66 #else
  67 #if FLOAT_WORDS_BIGENDIAN
  68         unsigned int mantissa0:20;
  69         unsigned int exponent:11;
  70         unsigned int negative:1;
  71         unsigned int mantissa1:32;
  72 #else
  73         unsigned int mantissa1:32;
  74         unsigned int mantissa0:20;
  75         unsigned int exponent:11;
  76         unsigned int negative:1;
  77 #endif
  78 #endif
  79    } ieee;
  80     /* This format makes it easier to see if a NaN is a signalling NaN.  */
  81    struct {
  82
  83 #if WORDS_BIGENDIAN
  84         unsigned int negative:1;
  85         unsigned int exponent:11;
  86         unsigned int quiet_nan:1;
  87         unsigned int mantissa0:19;
  88         unsigned int mantissa1:32;
  89 #else
  90 #if FLOAT_WORDS_BIGENDIAN
  91         unsigned int mantissa0:19;
  92         unsigned int quiet_nan:1;
  93         unsigned int exponent:11;
  94         unsigned int negative:1;
  95         unsigned int mantissa1:32;
  96 #else
  97         unsigned int mantissa1:32;
  98         unsigned int mantissa0:19;
  99         unsigned int quiet_nan:1;
 100         unsigned int exponent:11;
 101         unsigned int negative:1;
 102 #endif
 103 #endif
 104    } ieee_nan;
 105 };
 106
 107 /*
 108  * Predicates for testing for extreme IEEE fp values.
 109  */
 110
 111 /* In case you don't suppport IEEE, you'll just get dummy defs.. */
 112 #ifdef IEEE_FLOATING_POINT
 113
 114 HsInt
 115 isDoubleNaN(HsDouble d)
 116 {
 117   union stg_ieee754_dbl u;
 118
 119   u.d = d;
 120
 121   return (
 122     u.ieee.exponent  == 2047 /* 2^11 - 1 */ &&  /* Is the exponent all ones? */
 123     (u.ieee.mantissa0 != 0 || u.ieee.mantissa1 != 0)
 124         /* and the mantissa non-zero? */
 125     );
 126 }
 127
 128 HsInt
 129 isDoubleInfinite(HsDouble d)
 130 {
 131     union stg_ieee754_dbl u;
 132
 133     u.d = d;
 134
 135     /* Inf iff exponent is all ones, mantissa all zeros */
 136     return (
 137         u.ieee.exponent  == 2047 /* 2^11 - 1 */ &&
 138         u.ieee.mantissa0 == 0                   &&
 139         u.ieee.mantissa1 == 0
 140       );
 141 }
 142
 143 HsInt
 144 isDoubleDenormalized(HsDouble d)
 145 {
 146     union stg_ieee754_dbl u;
 147
 148     u.d = d;
 149
 150     /* A (single/double/quad) precision floating point number
 151        is denormalised iff:
 152         - exponent is zero
 153         - mantissa is non-zero.
 154         - (don't care about setting of sign bit.)
 155
 156     */
 157     return (
 158         u.ieee.exponent  == 0 &&
 159         (u.ieee.mantissa0 != 0 ||
 160          u.ieee.mantissa1 != 0)
 161       );
 162
 163 }
 164
 165 HsInt
 166 isDoubleNegativeZero(HsDouble d)
 167 {
 168     union stg_ieee754_dbl u;
 169
 170     u.d = d;
 171     /* sign (bit 63) set (only) => negative zero */
 172
 173     return (
 174         u.ieee.negative  == 1 &&
 175         u.ieee.exponent  == 0 &&
 176         u.ieee.mantissa0 == 0 &&
 177         u.ieee.mantissa1 == 0);
 178 }
 179
 180 /* Same tests, this time for HsFloats. */
 181
 182 /*
 183  To recap, here's the representation of a single precision
 184  IEEE floating point number:
 185
 186  sign         31           sign bit (0 == positive, 1 == negative)
 187  exponent     30-23        exponent (biased by 127)
 188  fraction     22-0         fraction (bits to right of binary point)
 189 */
 190
 191
 192 HsInt
 193 isFloatNaN(HsFloat f)
 194 {
 195     union stg_ieee754_flt u;
 196     u.f = f;
 197
 198    /* Floating point NaN iff exponent is all ones, mantissa is
 199       non-zero (but see below.) */
 200    return (
 201         u.ieee.exponent == 255 /* 2^8 - 1 */ &&
 202         u.ieee.mantissa != 0);
 203 }
 204
 205 HsInt
 206 isFloatInfinite(HsFloat f)
 207 {
 208     union stg_ieee754_flt u;
 209     u.f = f;
 210
 211     /* A float is Inf iff exponent is max (all ones),
 212        and mantissa is min(all zeros.) */
 213     return (
 214         u.ieee.exponent == 255 /* 2^8 - 1 */ &&
 215         u.ieee.mantissa == 0);
 216 }
 217
 218 HsInt
 219 isFloatDenormalized(HsFloat f)
 220 {
 221     union stg_ieee754_flt u;
 222     u.f = f;
 223
 224     /* A (single/double/quad) precision floating point number
 225        is denormalised iff:
 226         - exponent is zero
 227         - mantissa is non-zero.
 228         - (don't care about setting of sign bit.)
 229
 230     */
 231     return (
 232         u.ieee.exponent == 0 &&
 233         u.ieee.mantissa != 0);
 234 }
 235
 236 HsInt
 237 isFloatNegativeZero(HsFloat f)
 238 {
 239     union stg_ieee754_flt u;
 240     u.f = f;
 241
 242     /* sign (bit 31) set (only) => negative zero */
 243     return (
 244         u.ieee.negative      &&
 245         u.ieee.exponent == 0 &&
 246         u.ieee.mantissa == 0);
 247 }
 248
 249 #else /* ! IEEE_FLOATING_POINT */
 250
 251 /* Dummy definitions of predicates - they all return false */
 252 HsInt isDoubleNaN(d) HsDouble d; { return 0; }
 253 HsInt isDoubleInfinite(d) HsDouble d; { return 0; }
 254 HsInt isDoubleDenormalized(d) HsDouble d; { return 0; }
 255 HsInt isDoubleNegativeZero(d) HsDouble d; { return 0; }
 256 HsInt isFloatNaN(f) HsFloat f; { return 0; }
 257 HsInt isFloatInfinite(f) HsFloat f; { return 0; }
 258 HsInt isFloatDenormalized(f) HsFloat f; { return 0; }
 259 HsInt isFloatNegativeZero(f) HsFloat f; { return 0; }
 260
 261 #endif /* ! IEEE_FLOATING_POINT */