ghc/lib/std/cbits/floatExtreme.c

   1 /*
   2  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
   3  *
   4  * $Id: floatExtreme.c,v 1.1 1998/04/10 10:54:28 simonm Exp $
   5  *
   6  * Stubs to check for extremities of (IEEE) floats,
   7  * the tests have been (artfully) lifted from the hbc-0.9999.3 (lib/fltcode.c)
   8  * source.
   9  */
  10
  11 /*
  12 ToDo:
  13   - avoid hard-wiring the fact that on an
  14     Alpha we repr. a StgFloat as a double.
  15     (introduce int equivalent of {ASSIGN,PK}_FLT? )
  16 */
  17
  18 #include "Rts.h"
  19 #include "ieee-flpt.h"
  20 #include "floatExtreme.h"
  21
  22 #ifdef BIGENDIAN
  23 #define L 1
  24 #define H 0
  25 #else
  26 #define L 0
  27 #define H 1
  28 #endif
  29
  30 #ifdef IEEE_FLOATING_POINT
  31
  32 StgInt
  33 isDoubleNaN(StgDouble d)
  34 {
  35     union { double d; int i[2]; } u;
  36     int hx,lx;
  37     int r;
  38
  39     u.d = d;
  40     hx = u.i[H];
  41     lx = u.i[L];
  42     hx &= 0x7fffffff;
  43     hx |= (unsigned int)(lx|(-lx))>>31;
  44     hx = 0x7ff00000 - hx;
  45     r = (int)((unsigned int)(hx))>>31;
  46     return (r);
  47 }
  48
  49 StgInt
  50 isDoubleInfinite(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(StgDouble d)
  66 {
  67     union { double d; int i[2]; } u;
  68     int high, iexp;
  69
  70     u.d = d;
  71     high = u.i[H];
  72     iexp = high & (0x7ff << 20);
  73     return (iexp == 0);
  74 }
  75
  76 StgInt
  77 isDoubleNegativeZero(StgDouble d)
  78 {
  79     union { double d; int i[2]; } u;
  80     int high, iexp;
  81
  82     u.d = d;
  83     return (u.i[H] == 0x80000000 && u.i[L] == 0);
  84 }
  85
  86 /* Same tests, this time for StgFloats. */
  87
  88 StgInt
  89 isFloatNaN(StgFloat f)
  90 {
  91 #if !defined(alpha_TARGET_OS)
  92     /* StgFloat = double on alphas */
  93     return (isDoubleNaN(f));
  94 #else
  95     union { StgFloat f; int i; } u;
  96     int r;
  97     u.f = f;
  98
  99     u.i &= 0x7fffffff;
 100     u.i = 0x7f800000 - u.i;
 101     r = (int)(((unsigned int)(u.i))>>31);
 102     return (r);
 103 #endif
 104 }
 105
 106 StgInt
 107 isFloatInfinite(StgFloat f)
 108 {
 109 #if !defined(alpha_TARGET_OS)
 110     /* StgFloat = double on alphas */
 111     return (isDoubleInfinite(f));
 112 #else
 113     int ix;
 114     union { StgFloat f; int i; } u;
 115     u.f = f;
 116
 117     u.i &= 0x7fffffff;
 118     u.i ^= 0x7f800000;
 119     return (u.i == 0);
 120 #endif
 121 }
 122
 123 StgInt
 124 isFloatDenormalized(StgFloat f)
 125 {
 126 #if !defined(alpha_TARGET_OS)
 127     /* StgFloat = double on alphas */
 128     return (isDoubleDenormalized(f));
 129 #else
 130     int iexp;
 131     union { StgFloat f; int i; } u;
 132     u.f = f;
 133
 134     iexp = u.i & (0xff << 23);
 135     return (iexp == 0);
 136 #endif
 137 }
 138
 139 StgInt
 140 isFloatNegativeZero(StgFloat f)
 141 {
 142 #if !defined(alpha_TARGET_OS)
 143     /* StgFloat = double on alphas */
 144     return (isDoubleNegativeZero(f));
 145 #else
 146     union { StgFloat f; int i; } u;
 147     u.f = f;
 148
 149     return (u.i  == (int)0x80000000);
 150 #endif
 151 }
 152
 153
 154 #else
 155
 156 StgInt isDoubleNaN(d) StgDouble d; { return 0; }
 157 StgInt isDoubleInfinite(d) StgDouble d; { return 0; }
 158 StgInt isDoubleDenormalized(d) StgDouble d; { return 0; }
 159 StgInt isDoubleNegativeZero(d) StgDouble d; { return 0; }
 160 StgInt isFloatNaN(f) StgFloat f; { return 0; }
 161 StgInt isFloatInfinite(f) StgFloat f; { return 0; }
 162 StgInt isFloatDenormalized(f) StgFloat f; { return 0; }
 163 StgInt isFloatNegativeZero(f) StgFloat f; { return 0; }
 164
 165 #endif