ghc/lib/std/cbits/floatExtreme.lc

   1 %
   2 %
   3 %
   4
   5 Stubs to check for extremities of (IEEE) floats,
   6 the tests have been (artfully) lifted from the hbc-0.9999.3 (lib/fltcode.c)
   7 source.
   8
   9 All tests return non-zero values to indicate success.
  10
  11 (SOF 95/98 - Bugfixed and tidied up.)
  12
  13 ToDo:
  14   - avoid hard-wiring the fact that on an
  15     Alpha we repr. a StgFloat as a double.
  16     (introduce int equivalent of {ASSIGN,PK}_FLT? )
  17
  18 \begin{code}
  19
  20 #include "rtsdefs.h"
  21 #include "ieee-flpt.h"
  22 #include "floatExtreme.h"
  23
  24 #ifdef BIGENDIAN
  25 #define L 1
  26 #define H 0
  27 #else
  28 #define L 0
  29 #define H 1
  30 #endif
  31
  32 #ifdef IEEE_FLOATING_POINT
  33
  34 /*
  35
  36  To recap, here's the representation of a double precision
  37  IEEE floating point number:
  38
  39  sign         63           sign bit (0==positive, 1==negative)
  40  exponent     62-52        exponent (biased by 1023)
  41  fraction     51-0         fraction (bits to right of binary point)
  42 */
  43
  44 StgInt
  45 isDoubleNaN(d)
  46 StgDouble d;
  47 {
  48     union { double d; int i[2]; } u;
  49     int hx,lx;
  50     int r;
  51
  52     u.d = d;
  53
  54     /* Spelt out for clarity */
  55     hx = u.i[H];
  56     lx = u.i[L];
  57     return ( ( (hx & 0x7ff00000) == 0x7ff00000 ) && /* Is the exponent all ones? */
  58              ( (hx & 0xfffff )   != 0 ||            /* and the mantissa non-zero? */
  59                ((unsigned int)lx != 0) )
  60            );
  61
  62 /* Old definition:
  63     hx &= 0x7fffffff;
  64     hx |= (unsigned int)(lx|(-lx))>>31;
  65     hx = 0x7ff00000 - hx;
  66     r = (int)((unsigned int)(hx))>>31;
  67     return (r);
  68 */
  69
  70 }
  71
  72 StgInt
  73 isDoubleInfinite(d)
  74 StgDouble d;
  75 {
  76     union { double d; int i[2]; } u;
  77     int high,low;
  78
  79     u.d = d;
  80     high = u.i[H];
  81     low  = u.i[L];
  82
  83     /* Inf iff exponent is all ones, mantissa all zeros */
  84     high &= 0x7fffffff; /* mask out sign bit */
  85     high ^= 0x7ff00000; /* flip the exponent bits */
  86     high |= low;
  87     return (high == 0);
  88 }
  89
  90 StgInt
  91 isDoubleDenormalized(d)
  92 StgDouble d;
  93 {
  94     union { double d; int i[2]; } u;
  95     int high, low, iexp;
  96
  97     u.d = d;
  98
  99     /* A (single/double/quad) precision floating point number
 100        is denormalised iff:
 101         - exponent is zero
 102         - mantissa is non-zero.
 103         - (don't care about setting of sign bit.)
 104
 105     */
 106
 107     high = u.i[H];
 108     low  = u.i[L];
 109     iexp = high & (0x7ff << 20);           /* Get at the exponent */
 110
 111     return (  (iexp == 0)    &&            /* exponent all zero?  */
 112              ( (high & 0xfffff )  != 0 ||  /* and the mantissa non-zero? */
 113                ((unsigned int)low != 0) )
 114            );
 115
 116 }
 117
 118 StgInt
 119 isDoubleNegativeZero(d)
 120 StgDouble d;
 121 {
 122     union { double d; int i[2]; } u;
 123     int high, iexp;
 124
 125     u.d = d;
 126     /* sign (bit 63) set (only) => negative zero */
 127     return (u.i[H] == 0x80000000 && u.i[L] == 0);
 128 }
 129
 130 /* Same tests, this time for StgFloats. */
 131
 132 /*
 133
 134  To recap, here's the representation of a single precision
 135  IEEE floating point number:
 136
 137  sign         31           sign bit (0 == positive, 1 == negative)
 138  exponent     30-23        exponent (biased by 127)
 139  fraction     22-0         fraction (bits to right of binary point)
 140 */
 141
 142
 143 StgInt
 144 isFloatNaN(f)
 145 StgFloat f;
 146 {
 147 #if defined(alpha_TARGET_OS)
 148     /* StgFloat = double on alphas */
 149     return (isDoubleNaN(f));
 150 #else
 151     int r;
 152     union { StgFloat f; int i; } u;
 153     u.f = f;
 154
 155    /* Floating point NaN iff exponent is all ones, mantissa is
 156       non-zero (but see below.) */
 157
 158     u.i &= 0x7fffffff;        /* mask out sign bit */
 159     u.i  = 0x7f800000 - u.i;  /* <0 if exponent is max and mantissa non-zero. */
 160     r = (int)(((unsigned int)(u.i))>>31);  /* Get at the sign.. */
 161     return (r);
 162
 163    /* In case we should ever want to distinguish.. */
 164 #if 0 && WE_JUST_WANT_QUIET_NAN
 165     int iexp;
 166     iexp  = u.i & (0xff << 23);         /* Get at the exponent part.. */
 167     /* Quiet NaN */
 168     return ( ( iexp == (int)0x7f800000 ) &&  /* exponent all ones. */
 169              (u.i & (0x80 << 22) )           /* MSB of mantissa is set */
 170            );
 171 #endif
 172 #if 0 && WE_WANT_SIGNALLING_NAN
 173     /* Signalling/trapping NaN */
 174     int iexp;
 175     iexp  = u.i & (0xff << 23);               /* Get at the exponent part.. */
 176     return ( ( iexp == (int)0x7f800000 ) &&   /* ..it's all ones. */
 177              ((u.i & (0x80 << 22)) == 0) &&   /* MSB of mantissa is clear */
 178              ((u.i & 0x7fffff) != 0)          /* rest of mantissa is non-zero */
 179            );
 180 #endif
 181
 182 #endif
 183 }
 184
 185 StgInt
 186 isFloatInfinite(f)
 187 StgFloat f;
 188 {
 189 #if defined(alpha_TARGET_OS)
 190     /* StgFloat = double on alphas */
 191     return (isDoubleInfinite(f));
 192 #else
 193     union { StgFloat f; int i; } u;
 194     u.f = f;
 195
 196     /* A float is Inf iff exponent is max (all ones),
 197        and mantissa is min(all zeros.) */
 198
 199     u.i &= 0x7fffffff;    /* mask out sign bit    */
 200     u.i ^= 0x7f800000;    /* invert exponent bits */
 201     return (u.i == 0);
 202 #endif
 203 }
 204
 205 StgInt
 206 isFloatDenormalized(f)
 207 StgFloat f;
 208 {
 209 #if defined(alpha_TARGET_OS)
 210     /* StgFloat = double on alphas */
 211     return (isDoubleDenormalized(f));
 212 #else
 213     int iexp, imant;
 214     union { StgFloat f; int i; } u;
 215     u.f = f;
 216
 217     iexp  = u.i & (0xff << 23); /* Get at the exponent part */
 218     imant = u.i & 0x3fffff;     /* ditto, mantissa */
 219     /* A (single/double/quad) precision floating point number
 220        is denormalised iff:
 221         - exponent is zero
 222         - mantissa is non-zero.
 223         - (don't care about setting of sign bit.)
 224
 225     */
 226     return ( (iexp == 0) &&  (imant != 0 ) );
 227 #endif
 228 }
 229
 230 StgInt
 231 isFloatNegativeZero(f)
 232 StgFloat f;
 233 {
 234 #if defined(alpha_TARGET_OS)
 235     /* StgFloat = double on alphas */
 236     return (isDoubleNegativeZero(f));
 237 #else
 238     union { StgFloat f; int i; } u;
 239     u.f = f;
 240
 241     /* sign (bit 31) set (only) => negative zero */
 242     return (u.i  == (int)0x80000000);
 243 #endif
 244 }
 245
 246
 247 #else
 248
 249 StgInt isDoubleNaN(d) StgDouble d; { return 0; }
 250 StgInt isDoubleInfinite(d) StgDouble d; { return 0; }
 251 StgInt isDoubleDenormalized(d) StgDouble d; { return 0; }
 252 StgInt isDoubleNegativeZero(d) StgDouble d; { return 0; }
 253 StgInt isFloatNaN(f) StgFloat f; { return 0; }
 254 StgInt isFloatInfinite(f) StgFloat f; { return 0; }
 255 StgInt isFloatDenormalized(f) StgFloat f; { return 0; }
 256 StgInt isFloatNegativeZero(f) StgFloat f; { return 0; }
 257
 258 #endif
 259
 260
 261 \end{code}