00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031 #include <stdio.h>
00032 #include <string.h>
00033
00034
00035 #define TYSHORT 2
00036 #define TYLONG 3
00037 #define TYREAL 4
00038 #define TYDREAL 5
00039 #define TYCOMPLEX 6
00040 #define TYDCOMPLEX 7
00041 #define TYINT1 11
00042 #define TYQUAD 14
00043 #ifndef Long
00044 #define Long long
00045 #endif
00046
00047 #ifdef __mips
00048 #define RNAN 0xffc00000
00049 #define DNAN0 0xfff80000
00050 #define DNAN1 0
00051 #endif
00052
00053 #ifdef _PA_RISC1_1
00054 #define RNAN 0xffc00000
00055 #define DNAN0 0xfff80000
00056 #define DNAN1 0
00057 #endif
00058
00059 #ifndef RNAN
00060 #define RNAN 0xff800001
00061 #ifdef IEEE_MC68k
00062 #define DNAN0 0xfff00000
00063 #define DNAN1 1
00064 #else
00065 #define DNAN0 1
00066 #define DNAN1 0xfff00000
00067 #endif
00068 #endif
00069
00070 #ifdef KR_headers
00071 #define Void
00072 #define FA7UL (unsigned Long) 0xfa7a7a7aL
00073 #else
00074 #define Void void
00075 #define FA7UL 0xfa7a7a7aUL
00076 #endif
00077
00078 #ifdef __cplusplus
00079 extern "C" {
00080 #endif
00081
00082 static void ieee0(Void);
00083
00084 static unsigned Long rnan = RNAN,
00085 dnan0 = DNAN0,
00086 dnan1 = DNAN1;
00087
00088 double _0 = 0.;
00089
00090 void
00091 #ifdef KR_headers
00092 _uninit_f2c(x, type, len) void *x; int type; long len;
00093 #else
00094 _uninit_f2c(void *x, int type, long len)
00095 #endif
00096 {
00097 static int first = 1;
00098
00099 unsigned Long *lx, *lxe;
00100
00101 if (first) {
00102 first = 0;
00103 ieee0();
00104 }
00105 if (len == 1)
00106 switch(type) {
00107 case TYINT1:
00108 *(char*)x = 'Z';
00109 return;
00110 case TYSHORT:
00111 *(short*)x = 0xfa7a;
00112 break;
00113 case TYLONG:
00114 *(unsigned Long*)x = FA7UL;
00115 return;
00116 case TYQUAD:
00117 case TYCOMPLEX:
00118 case TYDCOMPLEX:
00119 break;
00120 case TYREAL:
00121 *(unsigned Long*)x = rnan;
00122 return;
00123 case TYDREAL:
00124 lx = (unsigned Long*)x;
00125 lx[0] = dnan0;
00126 lx[1] = dnan1;
00127 return;
00128 default:
00129 printf("Surprise type %d in _uninit_f2c\n", type);
00130 }
00131 switch(type) {
00132 case TYINT1:
00133 memset(x, 'Z', len);
00134 break;
00135 case TYSHORT:
00136 *(short*)x = 0xfa7a;
00137 break;
00138 case TYQUAD:
00139 len *= 2;
00140
00141 case TYLONG:
00142 lx = (unsigned Long*)x;
00143 lxe = lx + len;
00144 while(lx < lxe)
00145 *lx++ = FA7UL;
00146 break;
00147 case TYCOMPLEX:
00148 len *= 2;
00149
00150 case TYREAL:
00151 lx = (unsigned Long*)x;
00152 lxe = lx + len;
00153 while(lx < lxe)
00154 *lx++ = rnan;
00155 break;
00156 case TYDCOMPLEX:
00157 len *= 2;
00158
00159 case TYDREAL:
00160 lx = (unsigned Long*)x;
00161 for(lxe = lx + 2*len; lx < lxe; lx += 2) {
00162 lx[0] = dnan0;
00163 lx[1] = dnan1;
00164 }
00165 }
00166 }
00167 #ifdef __cplusplus
00168 }
00169 #endif
00170
00171 #ifndef MSpc
00172 #ifdef MSDOS
00173 #define MSpc
00174 #else
00175 #ifdef _WIN32
00176 #define MSpc
00177 #endif
00178 #endif
00179 #endif
00180
00181 #ifdef MSpc
00182 #define IEEE0_done
00183 #include "float.h"
00184 #include "signal.h"
00185
00186 static void
00187 ieee0(Void)
00188 {
00189 #ifndef __alpha
00190 _control87(EM_DENORMAL | EM_UNDERFLOW | EM_INEXACT, MCW_EM);
00191 #endif
00192
00193
00194
00195 signal(SIGFPE, SIG_DFL);
00196 }
00197 #endif
00198
00199 #ifdef __mips
00200 #define IEEE0_done
00201
00202 #include <stdlib.h>
00203 #include <stdio.h>
00204 #include "/usr/include/sigfpe.h"
00205 #include "/usr/include/sys/fpu.h"
00206
00207 static void
00208 #ifdef KR_headers
00209 ieeeuserhand(exception, val) unsigned exception[5]; int val[2];
00210 #else
00211 ieeeuserhand(unsigned exception[5], int val[2])
00212 #endif
00213 {
00214 fflush(stdout);
00215 fprintf(stderr,"ieee0() aborting because of ");
00216 if(exception[0]==_OVERFL) fprintf(stderr,"overflow\n");
00217 else if(exception[0]==_UNDERFL) fprintf(stderr,"underflow\n");
00218 else if(exception[0]==_DIVZERO) fprintf(stderr,"divide by 0\n");
00219 else if(exception[0]==_INVALID) fprintf(stderr,"invalid operation\n");
00220 else fprintf(stderr,"\tunknown reason\n");
00221 fflush(stderr);
00222 abort();
00223 }
00224
00225 static void
00226 #ifdef KR_headers
00227 ieeeuserhand2(j) unsigned int **j;
00228 #else
00229 ieeeuserhand2(unsigned int **j)
00230 #endif
00231 {
00232 fprintf(stderr,"ieee0() aborting because of confusion\n");
00233 abort();
00234 }
00235
00236 static void
00237 ieee0(Void)
00238 {
00239 int i;
00240 for(i=1; i<=4; i++){
00241 sigfpe_[i].count = 1000;
00242 sigfpe_[i].trace = 1;
00243 sigfpe_[i].repls = _USER_DETERMINED;
00244 }
00245 sigfpe_[1].repls = _ZERO;
00246 handle_sigfpes( _ON,
00247 _EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,
00248 ieeeuserhand,_ABORT_ON_ERROR,ieeeuserhand2);
00249 }
00250 #endif
00251
00252 #ifdef __linux__
00253 #define IEEE0_done
00254 #include "fpu_control.h"
00255
00256 #ifdef __alpha__
00257 #ifndef USE_setfpucw
00258 #define __setfpucw(x) __fpu_control = (x)
00259 #endif
00260 #endif
00261
00262 #ifndef _FPU_SETCW
00263 #undef Can_use__setfpucw
00264 #define Can_use__setfpucw
00265 #endif
00266
00267 static void
00268 ieee0(Void)
00269 {
00270 #if (defined(__mc68000__) || defined(__mc68020__) || defined(mc68020) || defined (__mc68k__))
00271
00272
00273
00274 #ifdef Can_use__setfpucw
00275 __setfpucw(_FPU_IEEE + _FPU_DOUBLE + _FPU_MASK_OPERR + _FPU_MASK_DZ + _FPU_MASK_SNAN+_FPU_MASK_OVFL);
00276 #else
00277 __fpu_control = _FPU_IEEE + _FPU_DOUBLE + _FPU_MASK_OPERR + _FPU_MASK_DZ + _FPU_MASK_SNAN+_FPU_MASK_OVFL;
00278 _FPU_SETCW(__fpu_control);
00279 #endif
00280
00281 #elif (defined(__powerpc__)||defined(_ARCH_PPC)||defined(_ARCH_PWR))
00282
00283
00284 #ifdef Can_use__setfpucw
00285
00286
00287
00288
00289
00290
00291 __setfpucw(_FPU_DEFAULT + _FPU_MASK_IM+_FPU_MASK_OM+_FPU_MASK_UM);
00292
00293 #else
00294
00295 __fpu_control = _FPU_DEFAULT +_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_UM;
00296 _FPU_SETCW(__fpu_control);
00297
00298 #endif
00299
00300 #else
00301
00302 #ifdef _FPU_IEEE
00303 #ifndef _FPU_EXTENDED
00304 #define _FPU_EXTENDED 0
00305 #endif
00306 #ifndef _FPU_DOUBLE
00307 #define _FPU_DOUBLE 0
00308 #endif
00309 #ifdef Can_use__setfpucw
00310 __setfpucw(_FPU_IEEE - _FPU_EXTENDED + _FPU_DOUBLE - _FPU_MASK_IM - _FPU_MASK_ZM - _FPU_MASK_OM);
00311 #else
00312 __fpu_control = _FPU_IEEE - _FPU_EXTENDED + _FPU_DOUBLE - _FPU_MASK_IM - _FPU_MASK_ZM - _FPU_MASK_OM;
00313 _FPU_SETCW(__fpu_control);
00314 #endif
00315
00316 #else
00317
00318 fprintf(stderr, "\n%s\n%s\n%s\n%s\n",
00319 "WARNING: _uninit_f2c in libf2c does not know how",
00320 "to enable trapping on this system, so f2c's -trapuv",
00321 "option will not detect uninitialized variables unless",
00322 "you can enable trapping manually.");
00323 fflush(stderr);
00324
00325 #endif
00326 #endif
00327 }
00328 #endif
00329
00330 #ifdef __alpha
00331 #ifndef IEEE0_done
00332 #define IEEE0_done
00333 #include <machine/fpu.h>
00334 static void
00335 ieee0(Void)
00336 {
00337 ieee_set_fp_control(IEEE_TRAP_ENABLE_INV);
00338 }
00339 #endif
00340 #endif
00341
00342 #ifdef __hpux
00343 #define IEEE0_done
00344 #define _INCLUDE_HPUX_SOURCE
00345 #include <math.h>
00346
00347 #ifndef FP_X_INV
00348 #include <fenv.h>
00349 #define fpsetmask fesettrapenable
00350 #define FP_X_INV FE_INVALID
00351 #endif
00352
00353 static void
00354 ieee0(Void)
00355 {
00356 fpsetmask(FP_X_INV);
00357 }
00358 #endif
00359
00360 #ifdef _AIX
00361 #define IEEE0_done
00362 #include <fptrap.h>
00363
00364 static void
00365 ieee0(Void)
00366 {
00367 fp_enable(TRP_INVALID);
00368 fp_trap(FP_TRAP_SYNC);
00369 }
00370 #endif
00371
00372 #ifdef __sun
00373 #define IEEE0_done
00374 #include <ieeefp.h>
00375
00376 static void
00377 ieee0(Void)
00378 {
00379 fpsetmask(FP_X_INV);
00380 }
00381 #endif
00382
00383 #ifndef IEEE0_done
00384 static void
00385 ieee0(Void) {}
00386 #endif