[project @ 1998-01-29 13:48:00 by sof]
[ghc-hetmet.git] / ghc / lib / 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}