~ubuntu-branches/ubuntu/trusty/libf2c2/trusty

« back to all changes in this revision

Viewing changes to uninit.c

  • Committer: Bazaar Package Importer
  • Author(s): Alan Bain
  • Date: 2008-05-19 22:50:54 UTC
  • mfrom: (2.1.4 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080519225054-jlymia0wdvvfq7dg
Tags: 20061008-4
Remove CVS directory left in source package

Show diffs side-by-side

added added

removed removed

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