1
2 /* Defining _GNU_SOURCE enables the GNU extensions fedisableexcept() and feenableexcept()
3 * when using glibc. It must be defined before any standard headers are included. */
4 #define _GNU_SOURCE 1
5 #include <fenv.h>
6 #include <stdio.h>
7 #include <string.h>
8 #include <stdlib.h>
9 #include "arith.h"
10
11 #define TYSHORT 2
12 #define TYLONG 3
13 #define TYREAL 4
14 #define TYDREAL 5
15 #define TYCOMPLEX 6
16 #define TYDCOMPLEX 7
17 #define TYINT1 11
18 #define TYQUAD 14
19 #ifndef Long
20 #define Long long
21 #endif
22
23 #ifdef __mips
24 #define RNAN 0xffc00000 /* Quiet NaN */
25 #define DNAN0 0xfff80000 /* Signalling NaN double Big endian */
26 #define DNAN1 0
27 #endif
28
29 #ifdef _PA_RISC1_1
30 #define RNAN 0xffc00000 /* Quiet Nan -- big endian */
31 #define DNAN0 0xfff80000
32 #define DNAN1 0
33 #endif
34
35 #ifndef RNAN
36 #define RNAN 0xff800001
37 #ifdef IEEE_MC68k /* set on PPC*/
38 #define DNAN0 0xfff00000 /* Quiet NaN big endian */
39 #define DNAN1 1
40 #else
41 #define DNAN0 1 /* LSB, MSB for little endian machines */
42 #define DNAN1 0xfff00000
43 #endif
44 #endif /*RNAN*/
45
46 #ifdef KR_headers
47 #define Void /*void*/
48 #define FA7UL (unsigned Long) 0xfa7a7a7aL
49 #else
50 #define Void void
51 #define FA7UL 0xfa7a7a7aUL
52 #endif
53
54 #ifdef __cplusplus
55 extern "C" {
56 #endif
57
58 static void ieee0(Void);
59
60 static unsigned Long rnan = RNAN,
61 dnan0 = DNAN0,
62 dnan1 = DNAN1;
63
64 double _0 = 0.;
65
unsupported_error()66 void unsupported_error()
67 {
68 fprintf(stderr,"Runtime Error: Your Architecture is not supported by the"
69 " -trapuv option of f2c\n");
70 exit(-1);
71 }
72
73
74
75 void
76 #ifdef KR_headers
_uninit_f2c(x,type,len)77 _uninit_f2c(x, type, len) void *x; int type; long len;
78 #else
79 _uninit_f2c(void *x, int type, long len)
80 #endif
81 {
82 static int first = 1;
83
84 unsigned Long *lx, *lxe;
85
86 if (first) {
87 first = 0;
88 ieee0();
89 }
90 if (len == 1)
91 switch(type) {
92 case TYINT1:
93 *(char*)x = 'Z';
94 return;
95 case TYSHORT:
96 *(short*)x = 0xfa7a;
97 break;
98 case TYLONG:
99 *(unsigned Long*)x = FA7UL;
100 return;
101 case TYQUAD:
102 case TYCOMPLEX:
103 case TYDCOMPLEX:
104 break;
105 case TYREAL:
106 *(unsigned Long*)x = rnan;
107 return;
108 case TYDREAL:
109 lx = (unsigned Long*)x;
110 lx[0] = dnan0;
111 lx[1] = dnan1;
112 return;
113 default:
114 printf("Surprise type %d in _uninit_f2c\n", type);
115 }
116 switch(type) {
117 case TYINT1:
118 memset(x, 'Z', len);
119 break;
120 case TYSHORT:
121 *(short*)x = 0xfa7a;
122 break;
123 case TYQUAD:
124 len *= 2;
125 /* no break */
126 case TYLONG:
127 lx = (unsigned Long*)x;
128 lxe = lx + len;
129 while(lx < lxe)
130 *lx++ = FA7UL;
131 break;
132 case TYCOMPLEX:
133 len *= 2;
134 /* no break */
135 case TYREAL:
136 lx = (unsigned Long*)x;
137 lxe = lx + len;
138 while(lx < lxe)
139 *lx++ = rnan;
140 break;
141 case TYDCOMPLEX:
142 len *= 2;
143 /* no break */
144 case TYDREAL:
145 lx = (unsigned Long*)x;
146 for(lxe = lx + 2*len; lx < lxe; lx += 2) {
147 lx[0] = dnan0;
148 lx[1] = dnan1;
149 }
150 }
151 }
152 #ifdef __cplusplus
153 }
154 #endif
155
156 #ifndef MSpc
157 #ifdef MSDOS
158 #define MSpc
159 #else
160 #ifdef _WIN32
161 #define MSpc
162 #endif
163 #endif
164 #endif
165
166 #ifdef MSpc
167 #define IEEE0_done
168 #include "float.h"
169 #include "signal.h"
170
171 static void
ieee0(Void)172 ieee0(Void)
173 {
174 #ifndef __alpha
175 #ifndef EM_DENORMAL
176 #define EM_DENORMAL _EM_DENORMAL
177 #endif
178 #ifndef EM_UNDERFLOW
179 #define EM_UNDERFLOW _EM_UNDERFLOW
180 #endif
181 #ifndef EM_INEXACT
182 #define EM_INEXACT _EM_INEXACT
183 #endif
184 #ifndef MCW_EM
185 #define MCW_EM _MCW_EM
186 #endif
187 _control87(EM_DENORMAL | EM_UNDERFLOW | EM_INEXACT, MCW_EM);
188 #endif
189 /* With MS VC++, compiling and linking with -Zi will permit */
190 /* clicking to invoke the MS C++ debugger, which will show */
191 /* the point of error -- provided SIGFPE is SIG_DFL. */
192 signal(SIGFPE, SIG_DFL);
193 }
194 #endif /* MSpc */
195
196 /* What follows is for SGI IRIX only */
197 #if defined(__mips) && defined(__sgi) /* must link with -lfpe */
198 #define IEEE0_done
199 /* code from Eric Grosse */
200 #include <stdlib.h>
201 #include <stdio.h>
202 #include "/usr/include/sigfpe.h" /* full pathname for lcc -N */
203 #include "/usr/include/sys/fpu.h"
204
205 static void
206 #ifdef KR_headers
ieeeuserhand(exception,val)207 ieeeuserhand(exception, val) unsigned exception[5]; int val[2];
208 #else
209 ieeeuserhand(unsigned exception[5], int val[2])
210 #endif
211 {
212 fflush(stdout);
213 fprintf(stderr,"ieee0() aborting because of ");
214 if(exception[0]==_OVERFL) fprintf(stderr,"overflow\n");
215 else if(exception[0]==_UNDERFL) fprintf(stderr,"underflow\n");
216 else if(exception[0]==_DIVZERO) fprintf(stderr,"divide by 0\n");
217 else if(exception[0]==_INVALID) fprintf(stderr,"invalid operation\n");
218 else fprintf(stderr,"\tunknown reason\n");
219 fflush(stderr);
220 abort();
221 }
222
223 static void
224 #ifdef KR_headers
ieeeuserhand2(j)225 ieeeuserhand2(j) unsigned int **j;
226 #else
227 ieeeuserhand2(unsigned int **j)
228 #endif
229 {
230 fprintf(stderr,"ieee0() aborting because of confusion\n");
231 abort();
232 }
233
234 static void
ieee0(Void)235 ieee0(Void)
236 {
237 int i;
238 for(i=1; i<=4; i++){
239 sigfpe_[i].count = 1000;
240 sigfpe_[i].trace = 1;
241 sigfpe_[i].repls = _USER_DETERMINED;
242 }
243 sigfpe_[1].repls = _ZERO; /* underflow */
244 handle_sigfpes( _ON,
245 _EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,
246 ieeeuserhand,_ABORT_ON_ERROR,ieeeuserhand2);
247 }
248 #endif /* IRIX mips */
249
250 /*
251 * The following is the preferred method but depends upon a GLIBC extension only
252 * to be found in GLIBC 2.2 or later. It is a GNU extension, not included in the
253 * C99 extensions which allow the FP status register to be examined in a platform
254 * independent way. It should be used if at all possible -- AFRB
255 */
256
257
258 #ifdef __GLIBC__
259 #define IEEE0_done
260
261 #if ((__GLIBC__ > 2) || ((__GLIBC__ == 2) && (__GLIBC_MINOR__ >= 2)))
262 static void
ieee0(Void)263 ieee0(Void)
264
265 {
266 /* Clear all exception flags */
267 if (fedisableexcept(FE_ALL_EXCEPT)==-1)
268 unsupported_error();
269 if (feenableexcept(FE_DIVBYZERO|FE_INVALID|FE_OVERFLOW)==-1)
270 unsupported_error();
271 }
272
273 /* Many linux cases will be treated through GLIBC. Note that modern
274 * linux runs on many non-i86 plaforms and as a result the following code
275 * must be processor dependent rather than simply OS specific */
276
277 #else /* __GLIBC__<2.2 */
278 #include <fpu_control.h>
279
280
281 #ifdef __alpha__
282 #ifndef USE_setfpucw
283 #define __setfpucw(x) __fpu_control = (x)
284 #endif
285 #endif
286
287 /* Not all versions of libc define _FPU_SETCW;
288 * * some only provide the __setfpucw() function.
289 * */
290 #ifndef _FPU_SETCW
291 #define _FPU_SETCW(cw) __setfpucw(cw)
292 #endif
293
294 /* The exact set of flags we want to set in the FPU control word
295 * depends on the architecture.
296 * Note also that whether an exception is enabled or disabled when
297 * the _FPU_MASK_nn bit is set is architecture dependent!
298 * Enabled-when-set: M68k, ARM, MIPS, PowerPC
299 * Disabled-when-set: x86, Alpha
300 * The state we are after is:
301 * exceptions on division by zero, overflow and invalid operation.
302 */
303
304
305 #ifdef __alpha__
306 #ifndef USE_setfpucw
307 #define __setfpucw(x) __fpu_control = (x)
308 #endif
309 #endif
310
311
312 #ifndef _FPU_SETCW
313 #undef Can_use__setfpucw
314 #define Can_use__setfpucw
315 #endif
316
317 #undef RQD_FPU_MASK
318 #undef RQD_FPU_CLEAR_MASK
319
320 #if (defined(__mc68000__) || defined(__mc68020__) || defined(mc68020) || defined (__mc68k__))
321 /* Reported 20010705 by Alan Bain <alanb@chiark.greenend.org.uk> */
322 /* Note that IEEE 754 IOP (illegal operation) */
323 /* = Signaling NAN (SNAN) + operation error (OPERR). */
324 #define RQD_FPU_STATE (_FPU_IEEE + _FPU_DOUBLE + _FPU_MASK_OPERR + \
325 _FPU_MASK_DZ + _FPU_MASK_SNAN+_FPU_MASK_OVFL)
326 #define RQD_FPU_MASK (_FPU_MASK_OPERR+_FPU_MASK_DZ+_FPU_MASK_SNAN+_FPU_MASK_OVFL)
327
328 #elif (defined(__powerpc__)||defined(_ARCH_PPC)||defined(_ARCH_PWR)) /* !__mc68k__ */
329 /* The following is NOT a mistake -- the author of the fpu_control.h
330 * for the PPC has erroneously defined IEEE mode to turn on exceptions
331 * other than Inexact! Start from default then and turn on only the ones
332 * which we want*/
333
334 /* I have changed _FPU_MASK_UM here to _FPU_MASK_ZM, because that is
335 * in line with all the other architectures specified here. -- AFRB
336 */
337 #define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM)
338 #define RQD_FPU_MASK (_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM)
339
340 #elif (defined(__arm__))
341 /* On ARM too, IEEE implies all exceptions enabled.
342 * -- Peter Maydell <pmaydell@chiark.greenend.org.uk>
343 * Unfortunately some version of ARMlinux don't include any
344 * flags in the fpu_control.h file
345 */
346 #define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM)
347 #define RQD_FPU_MASK (_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM)
348
349 #elif (defined(__mips__))
350 /* And same again for MIPS; _FPU_IEEE => exceptions seems a common meme.
351 * * MIPS uses different MASK constant names, no idea why -- PMM
352 * */
353 #define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_MASK_O+_FPU_MASK_V+_FPU_MASK_Z)
354 #define RQD_FPU_MASK (_FPU_MASK_O+_FPU_MASK_V+_FPU_MASK_Z)
355
356 #elif (defined(__sparc__))
357 #define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_DOUBLE+_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM)
358 #define RQD_FPU_MASK (_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM)
359
360 #elif (defined(__i386__) || defined(__alpha__))
361 /* This case is for Intel, and also Alpha, because the Alpha header
362 * purposely emulates x86 flags and meanings for compatibility with
363 * stupid programs.
364 * We used to try this case for anything defining _FPU_IEEE, but I think
365 * that that's a bad idea because it isn't really likely to work.
366 * Instead for unknown architectures we just won't allow -trapuv to work.
367 * Trying this case was just getting us
368 * (a) compile errors on archs which didn't know all these constants
369 * (b) silent wrong behaviour on archs (like SPARC) which do know all
370 * constants but have different semantics for them
371 */
372 #define RQD_FPU_STATE (_FPU_IEEE - _FPU_EXTENDED + _FPU_DOUBLE - _FPU_MASK_IM - _FPU_MASK_ZM - _FPU_MASK_OM)
373 #define RQD_FPU_CLEAR_MASK (_FPU_MASK_IM + _FPU_MASK_ZM + _FPU_MASK_OM)
374 #endif
375
ieee0(Void)376 static void ieee0(Void)
377 {
378 #ifdef RQD_FPU_STATE
379
380 #ifndef UNINIT_F2C_PRECISION_53 /* 20051004 */
381 __fpu_control = RQD_FPU_STATE;
382 _FPU_SETCW(__fpu_control);
383 #else
384 /* unmask invalid, etc., and keep current rounding precision */
385 fpu_control_t cw;
386 _FPU_GETCW(cw);
387 #ifdef RQD_FPU_CLEAR_MASK
388 cw &= ~ RQD_FPU_CLEAR_MASK;
389 #else
390 cw |= RQD_FPU_MASK;
391 #endif
392 _FPU_SETCW(cw);
393 #endif
394
395 #else /* !_FPU_IEEE */
396
397 fprintf(stderr, "\n%s\n%s\n%s\n%s\n",
398 "WARNING: _uninit_f2c in libf2c does not know how",
399 "to enable trapping on this system, so f2c's -trapuv",
400 "option will not detect uninitialized variables unless",
401 "you can enable trapping manually.");
402 fflush(stderr);
403
404 #endif /* _FPU_IEEE */
405 }
406 #endif /* __GLIBC__>2.2 */
407 #endif /* __GLIBC__ */
408
409 /* Specific to OSF/1 */
410 #if (defined(__alpha)&&defined(__osf__))
411 #ifndef IEEE0_done
412 #define IEEE0_done
413 #include <machine/fpu.h>
414 static void
ieee0(Void)415 ieee0(Void)
416 {
417 ieee_set_fp_control(IEEE_TRAP_ENABLE_INV);
418 }
419 #endif /*IEEE0_done*/
420 #endif /*__alpha OSF/1*/
421
422 #ifdef __hpux
423 #define IEEE0_done
424 #define _INCLUDE_HPUX_SOURCE
425 #include <math.h>
426
427 #ifndef FP_X_INV
428 #include <fenv.h>
429 #define fpsetmask fesettrapenable
430 #define FP_X_INV FE_INVALID
431 #endif
432
433 static void
ieee0(Void)434 ieee0(Void)
435 {
436 fpsetmask(FP_X_INV);
437 }
438 #endif /*__hpux*/
439
440 #ifdef _AIX
441 #define IEEE0_done
442 #include <fptrap.h>
443
444 static void
ieee0(Void)445 ieee0(Void)
446 {
447 fp_enable(TRP_INVALID);
448 fp_trap(FP_TRAP_SYNC);
449 }
450 #endif /*_AIX*/
451
452 #ifdef __sun
453 #define IEEE0_done
454 #include <ieeefp.h>
455
456 static void
ieee0(Void)457 ieee0(Void)
458 {
459 fpsetmask(FP_X_INV);
460 }
461 #endif /*__sparc*/
462
463 #ifndef IEEE0_done
464 static void
ieee0(Void)465 ieee0(Void) {}
466 #endif
467