From: sof <unknown>
Date: Thu, 20 Mar 1997 21:54:56 +0000 (+0000)
Subject: [project @ 1997-03-20 21:54:55 by sof]
X-Git-Tag: Approximately_1000_patches_recorded~762
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a841eb7d6ce77dc819b7768d6ab2ae4debc8ca2f;p=ghc-hetmet.git

[project @ 1997-03-20 21:54:55 by sof]
Stubs for catching IEEE float extremities
---

diff --git a/ghc/lib/cbits/floatExtreme.h b/ghc/lib/cbits/floatExtreme.h
new file mode 100644
index 0000000..e073985
--- /dev/null
+++ b/ghc/lib/cbits/floatExtreme.h
@@ -0,0 +1,13 @@
+#ifndef FLOATEXTREME_H
+#define FLOATEXTREME_H
+
+StgInt isDoubleNaN            PROTO((StgDouble));
+StgInt isDoubleInfinite       PROTO((StgDouble));
+StgInt isDoubleDenormalized   PROTO((StgDouble));
+StgInt isDoubleNegativeZero   PROTO((StgDouble));
+StgInt isFloatNaN             PROTO((StgFloat));
+StgInt isFloatInfinite        PROTO((StgFloat));
+StgInt isFloatDenormalized    PROTO((StgFloat));
+StgInt isFloatNegativeZero    PROTO((StgFloat));
+
+#endif /* FLOATEXTREME_H */
diff --git a/ghc/lib/cbits/floatExtreme.lc b/ghc/lib/cbits/floatExtreme.lc
new file mode 100644
index 0000000..d77ab73
--- /dev/null
+++ b/ghc/lib/cbits/floatExtreme.lc
@@ -0,0 +1,147 @@
+%
+%
+%
+
+Stubs to check for extremities of (IEEE) floats, 
+the tests have been (artfully) lifted from the hbc-0.9999.3 (lib/fltcode.c)
+source.
+
+\begin{code}
+
+#if (defined (sun) && !defined(i386)) || defined(hp300) || defined(_IBMR2) || defined(sgi) || defined(hppa)
+#define BIGENDIAN
+#endif
+
+#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);
+}
+
+StgInt
+isFloatNaN(f) 
+StgFloat f;
+{
+    int ix;
+    int r;
+
+    ix = (int)f;
+    ix &= 0x7fffffff;
+    ix = 0x7f800000 - ix;
+    r = (int)(((unsigned int)(ix))>>31);
+    return (r);
+}
+
+StgInt
+isFloatInfinite(f) 
+StgFloat f;
+{
+    int ix;
+
+    ix = (int)f;
+    ix &= 0x7fffffff;
+    ix ^= 0x7f800000;
+    return (ix == 0);
+}
+
+StgInt
+isFloatDenormalized(f) 
+StgFloat f;
+{
+    int high, iexp;
+
+    high = (int)f;
+    iexp = high & (0xff << 23);
+    return (iexp == 0);
+}
+
+StgInt
+isFloatNegativeZero(f) 
+StgFloat f;
+{
+    int high = (int)f;
+    return (high == 0x80000000);
+}
+
+
+#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}