[project @ 1998-02-02 17:27:26 by simonm]

[ghc-hetmet.git] / ghc / lib / cbits / floatExtreme.lc

diff --git a/ghc/lib/cbits/floatExtreme.lc b/ghc/lib/cbits/floatExtreme.lc
deleted file mode 100644 (file)
index 3dbecde..0000000
--- a/ghc/lib/cbits/floatExtreme.lc
+++ /dev/null
@@ -1,174 +0,0 @@
-%
-%
-%
-
-Stubs to check for extremities of (IEEE) floats, 
-the tests have been (artfully) lifted from the hbc-0.9999.3 (lib/fltcode.c)
-source.
-
-ToDo:
-  - avoid hard-wiring the fact that on an
-    Alpha we repr. a StgFloat as a double.
-    (introduce int equivalent of {ASSIGN,PK}_FLT? )
-
-\begin{code}
-
-#include "rtsdefs.h"
-#include "ieee-flpt.h"
-#include "floatExtreme.h"
-
-#ifdef BIGENDIAN
-#define L 1
-#define H 0
-#else
-#define L 0
-#define H 1
-#endif
-
-#ifdef IEEE_FLOATING_POINT
-
-StgInt
-isDoubleNaN(d)
-StgDouble d;
-{
-    union { double d; int i[2]; } u;
-    int hx,lx;
-    int r;
-
-    u.d = d;
-    hx = u.i[H];
-    lx = u.i[L];
-    hx &= 0x7fffffff;
-    hx |= (unsigned int)(lx|(-lx))>>31;        
-    hx = 0x7ff00000 - hx;
-    r = (int)((unsigned int)(hx))>>31;
-    return (r);
-}
-
-StgInt
-isDoubleInfinite(d)
-StgDouble d;
-{
-    union { double d; int i[2]; } u;
-    int hx,lx;
-
-    u.d = d;
-    hx = u.i[H];
-    lx = u.i[L];
-    hx &= 0x7fffffff;
-    hx ^= 0x7ff00000;
-    hx |= lx;
-    return (hx == 0);
-}
-
-StgInt
-isDoubleDenormalized(d) 
-StgDouble d;
-{
-    union { double d; int i[2]; } u;
-    int high, iexp;
-
-    u.d = d;
-    high = u.i[H];
-    iexp = high & (0x7ff << 20);
-    return (iexp == 0);
-}
-
-StgInt
-isDoubleNegativeZero(d) 
-StgDouble d;
-{
-    union { double d; int i[2]; } u;
-    int high, iexp;
-
-    u.d = d;
-    return (u.i[H] == 0x80000000 && u.i[L] == 0);
-}
-
-/* Same tests, this time for StgFloats. */
-
-StgInt
-isFloatNaN(f) 
-StgFloat f;
-{
-#if !defined(alpha_TARGET_OS)
-    /* StgFloat = double on alphas */
-    return (isDoubleNaN(f));
-#else
-    union { StgFloat f; int i; } u;
-    int r;
-    u.f = f;
-
-    u.i &= 0x7fffffff;
-    u.i = 0x7f800000 - u.i;
-    r = (int)(((unsigned int)(u.i))>>31);
-    return (r);
-#endif
-}
-
-StgInt
-isFloatInfinite(f) 
-StgFloat f;
-{
-#if !defined(alpha_TARGET_OS)
-    /* StgFloat = double on alphas */
-    return (isDoubleInfinite(f));
-#else
-    int ix;
-    union { StgFloat f; int i; } u;
-    u.f = f;
-
-    u.i &= 0x7fffffff;
-    u.i ^= 0x7f800000;
-    return (u.i == 0);
-#endif
-}
-
-StgInt
-isFloatDenormalized(f) 
-StgFloat f;
-{
-#if !defined(alpha_TARGET_OS)
-    /* StgFloat = double on alphas */
-    return (isDoubleDenormalized(f));
-#else
-    int iexp;
-    union { StgFloat f; int i; } u;
-    u.f = f;
-
-    iexp = u.i & (0xff << 23);
-    return (iexp == 0);
-#endif
-}
-
-StgInt
-isFloatNegativeZero(f) 
-StgFloat f;
-{
-#if !defined(alpha_TARGET_OS)
-    /* StgFloat = double on alphas */
-    return (isDoubleNegativeZero(f));
-#else
-    union { StgFloat f; int i; } u;
-    u.f = f;
-
-    return (u.i  == (int)0x80000000);
-#endif
-}
-
-
-#else
-
-StgInt isDoubleNaN(d) StgDouble d; { return 0; }
-StgInt isDoubleInfinite(d) StgDouble d; { return 0; }
-StgInt isDoubleDenormalized(d) StgDouble d; { return 0; }
-StgInt isDoubleNegativeZero(d) StgDouble d; { return 0; }
-StgInt isFloatNaN(f) StgFloat f; { return 0; }
-StgInt isFloatInfinite(f) StgFloat f; { return 0; }
-StgInt isFloatDenormalized(f) StgFloat f; { return 0; }
-StgInt isFloatNegativeZero(f) StgFloat f; { return 0; }
-
-#endif
-
-
-\end{code}