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 ToDo:
  10   - avoid hard-wiring the fact that on an
  11     Alpha we repr. a StgFloat as a double.
  12     (introduce int equivalent of {ASSIGN,PK}_FLT? )
  13
  14 \begin{code}
  15
  16 #include "rtsdefs.h"
  17 #include "ieee-flpt.h"
  18 #include "floatExtreme.h"
  19
  20 #ifdef BIGENDIAN
  21 #define L 1
  22 #define H 0
  23 #else
  24 #define L 0
  25 #define H 1
  26 #endif
  27
  28 #ifdef IEEE_FLOATING_POINT
  29
  30 StgInt
  31 isDoubleNaN(d)
  32 StgDouble d;
  33 {
  34     union { double d; int i[2]; } u;
  35     int hx,lx;
  36     int r;
  37
  38     u.d = d;
  39     hx = u.i[H];
  40     lx = u.i[L];
  41     hx &= 0x7fffffff;
  42     hx |= (unsigned int)(lx|(-lx))>>31;
  43     hx = 0x7ff00000 - hx;
  44     r = (int)((unsigned int)(hx))>>31;
  45     return (r);
  46 }
  47
  48 StgInt
  49 isDoubleInfinite(d)
  50 StgDouble d;
  51 {
  52     union { double d; int i[2]; } u;
  53     int hx,lx;
  54
  55     u.d = d;
  56     hx = u.i[H];
  57     lx = u.i[L];
  58     hx &= 0x7fffffff;
  59     hx ^= 0x7ff00000;
  60     hx |= lx;
  61     return (hx == 0);
  62 }
  63
  64 StgInt
  65 isDoubleDenormalized(d)
  66 StgDouble d;
  67 {
  68     union { double d; int i[2]; } u;
  69     int high, iexp;
  70
  71     u.d = d;
  72     high = u.i[H];
  73     iexp = high & (0x7ff << 20);
  74     return (iexp == 0);
  75 }
  76
  77 StgInt
  78 isDoubleNegativeZero(d)
  79 StgDouble d;
  80 {
  81     union { double d; int i[2]; } u;
  82     int high, iexp;
  83
  84     u.d = d;
  85     return (u.i[H] == 0x80000000 && u.i[L] == 0);
  86 }
  87
  88 /* Same tests, this time for StgFloats. */
  89
  90 StgInt
  91 isFloatNaN(f)
  92 StgFloat f;
  93 {
  94 #if !defined(alpha_TARGET_OS)
  95     /* StgFloat = double on alphas */
  96     return (isDoubleNaN(f));
  97 #else
  98     union { StgFloat f; int i; } u;
  99     int r;
 100     u.f = f;
 101
 102     u.i &= 0x7fffffff;
 103     u.i = 0x7f800000 - u.i;
 104     r = (int)(((unsigned int)(u.i))>>31);
 105     return (r);
 106 #endif
 107 }
 108
 109 StgInt
 110 isFloatInfinite(f)
 111 StgFloat f;
 112 {
 113 #if !defined(alpha_TARGET_OS)
 114     /* StgFloat = double on alphas */
 115     return (isDoubleInfinite(f));
 116 #else
 117     int ix;
 118     union { StgFloat f; int i; } u;
 119     u.f = f;
 120
 121     u.i &= 0x7fffffff;
 122     u.i ^= 0x7f800000;
 123     return (u.i == 0);
 124 #endif
 125 }
 126
 127 StgInt
 128 isFloatDenormalized(f)
 129 StgFloat f;
 130 {
 131 #if !defined(alpha_TARGET_OS)
 132     /* StgFloat = double on alphas */
 133     return (isDoubleDenormalized(f));
 134 #else
 135     int iexp;
 136     union { StgFloat f; int i; } u;
 137     u.f = f;
 138
 139     iexp = u.i & (0xff << 23);
 140     return (iexp == 0);
 141 #endif
 142 }
 143
 144 StgInt
 145 isFloatNegativeZero(f)
 146 StgFloat f;
 147 {
 148 #if !defined(alpha_TARGET_OS)
 149     /* StgFloat = double on alphas */
 150     return (isDoubleNegativeZero(f));
 151 #else
 152     union { StgFloat f; int i; } u;
 153     u.f = f;
 154
 155     return (u.i  == (int)0x80000000);
 156 #endif
 157 }
 158
 159
 160 #else
 161
 162 StgInt isDoubleNaN(d) StgDouble d; { return 0; }
 163 StgInt isDoubleInfinite(d) StgDouble d; { return 0; }
 164 StgInt isDoubleDenormalized(d) StgDouble d; { return 0; }
 165 StgInt isDoubleNegativeZero(d) StgDouble d; { return 0; }
 166 StgInt isFloatNaN(f) StgFloat f; { return 0; }
 167 StgInt isFloatInfinite(f) StgFloat f; { return 0; }
 168 StgInt isFloatDenormalized(f) StgFloat f; { return 0; }
 169 StgInt isFloatNegativeZero(f) StgFloat f; { return 0; }
 170
 171 #endif
 172
 173
 174 \end{code}