From: "Barak A. Pearlmutter" Date: Mon, 11 Jan 2016 20:45:51 +0000 Subject: C tweaks --- f2c.h0 | 24 +++++++- uninit.c | 202 +++++++++++++++++++++++++++++++++++++++++++++------------------ 2 files changed, 166 insertions(+), 60 deletions(-) diff --git a/f2c.h0 b/f2c.h0 index b94ee7c..d33e7bd 100644 --- a/f2c.h0 +++ b/f2c.h0 @@ -7,21 +7,35 @@ #ifndef F2C_INCLUDE #define F2C_INCLUDE +#if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__) +typedef int integer; +typedef unsigned int uinteger; +#else typedef long int integer; typedef unsigned long int uinteger; +#endif typedef char *address; typedef short int shortint; typedef float real; typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; +#if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__) +typedef int logical; +#else typedef long int logical; +#endif typedef short int shortlogical; typedef char logical1; typedef char integer1; #ifdef INTEGER_STAR_8 /* Adjust for integer*8. */ -typedef long long longint; /* system-dependent */ -typedef unsigned long long ulongint; /* system-dependent */ +#if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__) +typedef long longint; /* system-dependent */ +typedef unsigned long ulongint; /* system-dependent */ +#else +typedef long long longint; /* system-dependent - oh yeah*/ +typedef unsigned long long ulongint; /* system-dependent - oh yeah*/ +#endif #define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b))) #define qbit_set(a,b) ((a) | ((ulongint)1 << (b))) #endif @@ -42,10 +56,16 @@ typedef short flag; typedef short ftnlen; typedef short ftnint; #else +#if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__) +typedef int flag; +typedef int ftnlen; +typedef int ftnint; +#else typedef long int flag; typedef long int ftnlen; typedef long int ftnint; #endif +#endif /*external read, write*/ typedef struct diff --git a/uninit.c b/uninit.c index f15fe39..93c8be5 100644 --- a/uninit.c +++ b/uninit.c @@ -1,5 +1,6 @@ #include #include +#include #include "arith.h" #define TYSHORT 2 @@ -15,24 +16,24 @@ #endif #ifdef __mips -#define RNAN 0xffc00000 -#define DNAN0 0xfff80000 +#define RNAN 0xffc00000 /* Quiet NaN */ +#define DNAN0 0xfff80000 /* Signalling NaN double Big endian */ #define DNAN1 0 #endif #ifdef _PA_RISC1_1 -#define RNAN 0xffc00000 +#define RNAN 0xffc00000 /* Quiet Nan -- big endian */ #define DNAN0 0xfff80000 #define DNAN1 0 #endif #ifndef RNAN #define RNAN 0xff800001 -#ifdef IEEE_MC68k -#define DNAN0 0xfff00000 +#ifdef IEEE_MC68k /* set on PPC*/ +#define DNAN0 0xfff00000 /* Quiet NaN big endian */ #define DNAN1 1 #else -#define DNAN0 1 +#define DNAN0 1 /* LSB, MSB for little endian machines */ #define DNAN1 0xfff00000 #endif #endif /*RNAN*/ @@ -57,6 +58,15 @@ static unsigned Long rnan = RNAN, double _0 = 0.; +void unsupported_error() +{ + fprintf(stderr,"Runtime Error: Your Architecture is not supported by the" + " -trapuv option of f2c\n"); + exit(-1); +} + + + void #ifdef KR_headers _uninit_f2c(x, type, len) void *x; int type; long len; @@ -178,7 +188,8 @@ ieee0(Void) } #endif /* MSpc */ -#ifdef __mips /* must link with -lfpe */ +/* What follows is for SGI IRIX only */ +#if defined(__mips) && defined(__sgi) /* must link with -lfpe */ #define IEEE0_done /* code from Eric Grosse */ #include @@ -229,11 +240,65 @@ ieee0(Void) _EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID, ieeeuserhand,_ABORT_ON_ERROR,ieeeuserhand2); } -#endif /* mips */ +#endif /* IRIX mips */ + +/* + * The following is the preferred method but depends upon a GLIBC extension only + * to be found in GLIBC 2.2 or later. It is a GNU extension, not included in the + * C99 extensions which allow the FP status register to be examined in a platform + * independent way. It should be used if at all possible -- AFRB + */ + + +#if (defined(__GLIBC__)&& ( __GLIBC__>=2) && (__GLIBC_MINOR__>=2) ) +#define _GNU_SOURCE 1 +#define IEEE0_done +#include + static void + ieee0(Void) + +{ + /* Clear all exception flags */ + if (fedisableexcept(FE_ALL_EXCEPT)==-1) + unsupported_error(); + if (feenableexcept(FE_DIVBYZERO|FE_INVALID|FE_OVERFLOW)==-1) + unsupported_error(); +} + +#endif /* Glibc control */ + +/* Many linux cases will be treated through GLIBC. Note that modern + * linux runs on many non-i86 plaforms and as a result the following code + * must be processor dependent rather than simply OS specific */ -#ifdef __linux__ +#if (defined(__linux__)&&(!defined(IEEE0_done))) #define IEEE0_done -#include "fpu_control.h" +#include + + +#ifdef __alpha__ +#ifndef USE_setfpucw +#define __setfpucw(x) __fpu_control = (x) +#endif +#endif + +/* Not all versions of libc define _FPU_SETCW; + * * some only provide the __setfpucw() function. + * */ +#ifndef _FPU_SETCW +#define _FPU_SETCW(cw) __setfpucw(cw) +#endif + +/* The exact set of flags we want to set in the FPU control word + * depends on the architecture. + * Note also that whether an exception is enabled or disabled when + * the _FPU_MASK_nn bit is set is architecture dependent! + * Enabled-when-set: M68k, ARM, MIPS, PowerPC + * Disabled-when-set: x86, Alpha + * The state we are after is: + * exceptions on division by zero, overflow and invalid operation. + */ + #ifdef __alpha__ #ifndef USE_setfpucw @@ -241,67 +306,88 @@ ieee0(Void) #endif #endif + #ifndef _FPU_SETCW #undef Can_use__setfpucw #define Can_use__setfpucw #endif - static void -ieee0(Void) -{ +#undef RQD_FPU_MASK +#undef RQD_FPU_CLEAR_MASK + #if (defined(__mc68000__) || defined(__mc68020__) || defined(mc68020) || defined (__mc68k__)) /* Reported 20010705 by Alan Bain */ /* Note that IEEE 754 IOP (illegal operation) */ /* = Signaling NAN (SNAN) + operation error (OPERR). */ -#ifdef Can_use__setfpucw - __setfpucw(_FPU_IEEE + _FPU_DOUBLE + _FPU_MASK_OPERR + _FPU_MASK_DZ + _FPU_MASK_SNAN+_FPU_MASK_OVFL); -#else - __fpu_control = _FPU_IEEE + _FPU_DOUBLE + _FPU_MASK_OPERR + _FPU_MASK_DZ + _FPU_MASK_SNAN+_FPU_MASK_OVFL; - _FPU_SETCW(__fpu_control); -#endif +#define RQD_FPU_STATE (_FPU_IEEE + _FPU_DOUBLE + _FPU_MASK_OPERR + \ + _FPU_MASK_DZ + _FPU_MASK_SNAN+_FPU_MASK_OVFL) +#define RQD_FPU_MASK (_FPU_MASK_OPERR+_FPU_MASK_DZ+_FPU_MASK_SNAN+_FPU_MASK_OVFL) #elif (defined(__powerpc__)||defined(_ARCH_PPC)||defined(_ARCH_PWR)) /* !__mc68k__ */ -/* Reported 20011109 by Alan Bain */ - -#ifdef Can_use__setfpucw - -/* The following is NOT a mistake -- the author of the fpu_control.h -for the PPC has erroneously defined IEEE mode to turn on exceptions -other than Inexact! Start from default then and turn on only the ones -which we want*/ - - __setfpucw(_FPU_DEFAULT + _FPU_MASK_IM+_FPU_MASK_OM+_FPU_MASK_UM); - -#else /* PPC && !Can_use__setfpucw */ - - __fpu_control = _FPU_DEFAULT +_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_UM; - _FPU_SETCW(__fpu_control); - -#endif /*Can_use__setfpucw*/ - -#else /* !(mc68000||powerpc) */ - -#ifdef _FPU_IEEE -#ifndef _FPU_EXTENDED /* e.g., ARM processor under Linux */ -#define _FPU_EXTENDED 0 -#endif -#ifndef _FPU_DOUBLE -#define _FPU_DOUBLE 0 + /* The following is NOT a mistake -- the author of the fpu_control.h + * for the PPC has erroneously defined IEEE mode to turn on exceptions + * other than Inexact! Start from default then and turn on only the ones + * which we want*/ + + /* I have changed _FPU_MASK_UM here to _FPU_MASK_ZM, because that is + * in line with all the other architectures specified here. -- AFRB + */ +#define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) +#define RQD_FPU_MASK (_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) + +#elif (defined(__arm__)) + /* On ARM too, IEEE implies all exceptions enabled. + * -- Peter Maydell + * Unfortunately some version of ARMlinux don't include any + * flags in the fpu_control.h file + */ +#define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) +#define RQD_FPU_MASK (_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) + +#elif (defined(__mips__)) + /* And same again for MIPS; _FPU_IEEE => exceptions seems a common meme. + * * MIPS uses different MASK constant names, no idea why -- PMM + * */ +#define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_MASK_O+_FPU_MASK_V+_FPU_MASK_Z) +#define RQD_FPU_MASK (_FPU_MASK_O+_FPU_MASK_V+_FPU_MASK_Z) + +#elif (defined(__sparc__)) +#define RQD_FPU_STATE (_FPU_DEFAULT +_FPU_DOUBLE+_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) +#define RQD_FPU_MASK (_FPU_MASK_OM+_FPU_MASK_IM+_FPU_MASK_ZM) + +#elif (defined(__i386__) || defined(__alpha__)) + /* This case is for Intel, and also Alpha, because the Alpha header + * purposely emulates x86 flags and meanings for compatibility with + * stupid programs. + * We used to try this case for anything defining _FPU_IEEE, but I think + * that that's a bad idea because it isn't really likely to work. + * Instead for unknown architectures we just won't allow -trapuv to work. + * Trying this case was just getting us + * (a) compile errors on archs which didn't know all these constants + * (b) silent wrong behaviour on archs (like SPARC) which do know all + * constants but have different semantics for them + */ +#define RQD_FPU_STATE (_FPU_IEEE - _FPU_EXTENDED + _FPU_DOUBLE - _FPU_MASK_IM - _FPU_MASK_ZM - _FPU_MASK_OM) +#define RQD_FPU_CLEAR_MASK (_FPU_MASK_IM + _FPU_MASK_ZM + _FPU_MASK_OM) #endif -#ifdef Can_use__setfpucw /* pre-1997 (?) Linux */ - __setfpucw(_FPU_IEEE - _FPU_MASK_IM - _FPU_MASK_ZM - _FPU_MASK_OM); -#else -#ifdef UNINIT_F2C_PRECISION_53 /* 20051004 */ - /* unmask invalid, etc., and change rounding precision to double */ - __fpu_control = _FPU_IEEE - _FPU_EXTENDED + _FPU_DOUBLE - _FPU_MASK_IM - _FPU_MASK_ZM - _FPU_MASK_OM; - _FPU_SETCW(__fpu_control); -#else + +static void ieee0(Void) +{ +#ifdef RQD_FPU_STATE + +#ifndef UNINIT_F2C_PRECISION_53 /* 20051004 */ + __fpu_control = RQD_FPU_STATE; + _FPU_SETCW(__fpu_control); +#else /* unmask invalid, etc., and keep current rounding precision */ fpu_control_t cw; _FPU_GETCW(cw); - cw &= ~(_FPU_MASK_IM | _FPU_MASK_ZM | _FPU_MASK_OM); - _FPU_SETCW(cw); +#ifdef RQD_FPU_CLEAR_MASK + cw &= ~ RQD_FPU_CLEAR_MASK; +#else + cw |= RQD_FPU_MASK; #endif + _FPU_SETCW(cw); #endif #else /* !_FPU_IEEE */ @@ -314,11 +400,11 @@ which we want*/ fflush(stderr); #endif /* _FPU_IEEE */ -#endif /* __mc68k__ */ } #endif /* __linux__ */ -#ifdef __alpha +/* Specific to OSF/1 */ +#if (defined(__alpha)&&defined(__osf__)) #ifndef IEEE0_done #define IEEE0_done #include @@ -328,7 +414,7 @@ ieee0(Void) ieee_set_fp_control(IEEE_TRAP_ENABLE_INV); } #endif /*IEEE0_done*/ -#endif /*__alpha*/ +#endif /*__alpha OSF/1*/ #ifdef __hpux #define IEEE0_done