#include #include #include

void fpenab_(void); void hanfpe();

main() { float a,b,c,d; int ia,ib,ic; int i; signal(8,hanfpe); fpenab_(); a=1.; b=0.; c=a/b; d=(float)sqrt((double)-a); printf("Float: a=%f b=%f a/b=%f d=sqrt(-a)=%f\n",a,b,c,d); ia=1; ib=0; ic=ia/ib; printf("Integer: ia=%d ib=%d ia/ib=%d\n",ia,ib,ic); }

void hanfpe(void) { printf ("We have a floating point exception...\n"); printf ("Bye Bye...\n"); exit(1); } --------------------------------------------------------------------------- /*---------------------------------------------------------------------------+ | Floating-point environment | | | | | | Copyright (C) 1996, 1997 | | W. Metzenthen, 22 Parker St, Ormond, Vic 3163, | | Australia. E-mail billm@suburbia.net | | | | See the files "README" and "COPYING" for further copyright and warranty | | information. | | | +---------------------------------------------------------------------------*/ /*---------------------------------------------------------------------------+ | History: | | 29 Feb 1996: First version, based upon the definitions in | | WG14/N513 X3J11/95-114 (Draft 12/21/95) | | 14 May 1996: Let the sticky bit functions preform in a similar manner | | even if there are unmasked exceptions. | +---------------------------------------------------------------------------*/

#define _LOOSE_KERNEL_NAMES

#include

#define __SIGFPE_INTERNAL #define NON_PORTABLE_FENV /* #include */ /*---------------------------------------------------------------------------+ | Floating-point environment | | | | | | Copyright (C) 1996, 1997 | | W. Metzenthen, 22 Parker St, Ormond, Vic 3163, | | Australia. E-mail billm@suburbia.net | | | | See the files "README" and "COPYING" for further copyright and warranty | | information. | | | +---------------------------------------------------------------------------*/ /*---------------------------------------------------------------------------+ | History: | | 10 Sep 1993: First version, based upon early NCEG docs. | | 29 Feb 1996: Second version, minor modifications to satisfy | | WG14/N513 X3J11/95-114 (Draft 12/21/95) | +---------------------------------------------------------------------------*/

#ifndef _FENV_H #define _FENV_H

#define FE_INEXACT 0x20 #define FE_DIVBYZERO 0x04 #define FE_UNDERFLOW 0x10 #define FE_OVERFLOW 0x08 #define FE_INVALID 0x01 #define FE_ALL_EXCEPT ( FE_INEXACT | FE_DIVBYZERO | FE_UNDERFLOW | FE_OVERFLOW | FE_INVALID )

#define FE_TONEAREST 0x000 #define FE_UPWARD 0x800 #define FE_DOWNWARD 0x400 #define FE_TOWARDZERO 0xc00

#define FE_DFL_ENV (&__default_fp_env)

/* fenv_t: a type for representing the entire floating-point environment. */ /* fenv_t is not defined in detail by NCEG. For Linux, we use the FPU environment: */ struct __fenv { unsigned long control; unsigned long status; unsigned long tags; unsigned long ip_offset; unsigned long opcode; unsigned long data_offset; unsigned long op_sel; }; typedef struct __fenv fenv_t;

extern const fenv_t __default_fp_env;

/* fexcept_t: a type for representing the floating-point exception flags collectively, including any status associated with the flags. */ /* fexcept_t is not defined in detail by NCEG. For Linux, it might be something like this: */ struct __fexcept { int excepts; void *code_address; void *data_address; }; typedef struct __fexcept fexcept_t;

__BEGIN_DECLS void feclearexcept(int excepts); void feraiseexcept(int excepts); int fetestexcept(int excepts);

void fegetexceptflag(fexcept_t *flagp, int excepts); void fesetexceptflag(const fexcept_t *flagp, int excepts);

int fegetround(void); int fesetround(int round);

void fegetenv(fenv_t *envp); int feholdexcept(fenv_t *envp); void fesetenv(const fenv_t *envp); void feupdateenv(const fenv_t *envp); __END_DECLS

#ifdef NON_PORTABLE_FENV

#define FE_DENORM_OP 0x02 /* 80x87, Not mentioned by NCEG */ #define FE_STACK_FLT 0x40 /* 80x87, Not mentioned by NCEG */ #undef FE_ALL_EXCEPT #define FE_ALL_EXCEPT ( FE_INEXACT | FE_DIVBYZERO | FE_UNDERFLOW | FE_OVERFLOW | FE_INVALID | FE_DENORM_OP )

#define FE_FLTPREC 0x000 #define FE_INVALIDPREC 0x100 #define FE_DBLPREC 0x200 #define FE_LDBLPREC 0x300

/* These are non-standard functions. They will probably be removed in a future release. DO NOT USE if you require portability. */ #include #if defined(__cplusplus) /* My version of g++ doesn't like Linus' definition of asmlinkage */ #define _PERSONALITY_H #endif #include

/* Change this to "#if 1" if you get warning and/or error messages from gcc about sigcontext_struct. The name of the structure has changed in , grrrh!. */ #if 0 /* %% Change this line as needed. %% */ #define sigcontext_struct sigcontext #endif

__BEGIN_DECLS

typedef int (*ftrap_t)(struct sigcontext_struct *sig, struct i387_hard_struct *fpu );

int fegetprecision(void); int fesetprecision(int prec);

int fegetvector(ftrap_t *trap, int except); int fesetvector(ftrap_t *trap, int except); int fegettraps(void); int fedisabletraps(int excepts); int feenabletraps(int excepts);

void report_fpu_exception_stats(FILE *f);

#ifdef __SIGFPE_INTERNAL struct fptraps { ftrap_t invalid, stack_flt, denorm_op, divbyzero, overflow, underflow, inexact; int trap_invalid, trap_stack_flt; };

extern struct fptraps __trap_vectors; extern void __set_sticky(int bits); #endif /* __SIGFPE_INTERNAL */

__END_DECLS

#endif /* NON_PORTABLE_FENV */

#endif /* _FENV_H */

/* A place to keep the unmasked "sticky" bits. */ static int sticky;

/* Clears the supported exceptions represented by the argument. */ void feclearexcept(int excepts) { fenv_t env; asm volatile ("fnstenv %0"::"m" (env)); excepts &= FE_ALL_EXCEPT; sticky &= ~excepts; env.status &= ~excepts; if ( !(env.status & FE_ALL_EXCEPT) ) env.status &= 0xff00; /* No bits set, so clear summary as well. */ else if ( !(env.status & FE_INVALID) ) env.status &= ~FE_STACK_FLT; /* Invalid bit not set, so clear this. */ asm volatile ("fldenv %0":"=m" (env)); }

/* Raises the supported exceptions represented by the argument. */ void feraiseexcept(int excepts) { fenv_t env; asm volatile ("fnstenv %0"::"m" (env)); env.status |= excepts & FE_ALL_EXCEPT; sticky |= excepts & ~env.control & FE_ALL_EXCEPT; asm volatile ("fldenv %0":"=m" (env)); }

/* Store the exception flags indicated by excepts in *flagp. */ void fegetexceptflag(fexcept_t *flagp, int excepts) { }

/* Set the exception flags indicated by excepts from *flagp. */ void fesetexceptflag(const fexcept_t *flagp, int excepts) { }

void __set_sticky(int bits) { sticky |= bits & FE_ALL_EXCEPT; }

/* Returns the bitwise OR of the exception macros corresponding to the currently set exceptions included in excepts. */ int fetestexcept(int excepts) { unsigned sw; asm volatile ("fnstsw %0":"=m" (sw)); return (sw | sticky) & excepts & FE_ALL_EXCEPT; }

/* Return the rounding direction macro representing the current rounding direction. */ int fegetround(void) { unsigned short cw; asm volatile ("fnstcw %0":"=m" (cw)); return cw & FE_TOWARDZERO; }

/* Set rounding direction to round if it is a valid rounding direction macro. Returns 1 if rounding direction set, 0 otherwise. */ int fesetround(int round) { unsigned short cw;

asm volatile ("fnstcw %0":"=m" (cw)); if ( ! (round & ~FE_TOWARDZERO) ) { /* round matches a rounding direction macro. */ cw = (cw & ~FE_TOWARDZERO) | (round & FE_TOWARDZERO); asm volatile ("fldcw %0"::"m" (cw)); return 1; } else return 0; /* Invalid argument. */ }

/* Return the current floating point environment in *envp. */ void fegetenv(fenv_t *envp) { asm volatile ("fnstenv %0":"=m" (*envp)); }

/* Save current environment in *envp, clear exception flags, and install "non-stop" mode. */ int feholdexcept(fenv_t *envp) { fenv_t env; asm volatile ("fnstenv %0":"=m" (*envp)); /* Masks exceptions. */ asm volatile ("fnstenv %0":"=m" (env)); env.status &= 0xff00; /* Clear exception flags. */ asm volatile ("fldenv %0"::"m" (env)); return 1; /* Always succeeds. */ }

/* Set floating point environment. Don't raise exceptions. */ void fesetenv(const fenv_t *envp) { asm volatile ("fldenv %0"::"m" (*envp)); }

/* Install new environment with old exceptions. */ void feupdateenv(const fenv_t *envp) { fenv_t env = *envp; unsigned short sw; asm volatile ("fnstsw %0":"=m" (sw)); env.status = sw; asm volatile ("fldenv %0"::"m" (*envp)); }

/* Return the precision macro representing the current floating point precision. */ int fegetprecision(void) { unsigned short cw; asm volatile ("fnstcw %0":"=m" (cw)); return cw & FE_LDBLPREC; }

/* Set the precision to prec if it is a valid floating point precision macro. Returns 1 if precision set, 0 otherwise. */ int fesetprecision(int prec) { unsigned short cw; asm volatile ("fnstcw %0":"=m" (cw)); if ( !(prec & ~FE_LDBLPREC) && (prec != FE_INVALIDPREC) ) { cw = (cw & ~FE_LDBLPREC) | (prec & FE_LDBLPREC); asm volatile ("fldcw %0"::"m" (cw)); return 1; } else return 0; }

int __sigfpe_abort(char *s, void *p) { char line[81]; FILE *cmd; cmd = fopen("/proc/self/cmdline", "r"); if ( cmd ) fscanf(cmd, "%80s", line); else line[0] = 0; line[80] = 0; fprintf(stderr, "FATAL: %s %s at %p\n", line, s, p); exit(1); return 0; /* Keep gcc happy. */ }

int default_stack_flt_handler(struct sigcontext_struct *sig, struct i387_hard_struct *fpu) { return __sigfpe_abort("got FPU stack fault", (void *)fpu->fip); }

int default_invalid_handler(struct sigcontext_struct *sig, struct i387_hard_struct *fpu) { return __sigfpe_abort("attempted invalid FPU operation", (void *)fpu->fip); }

int default_divbyzero_handler(struct sigcontext_struct *sig, struct i387_hard_struct *fpu) { return __sigfpe_abort("attempted FPU divide-by-zero", (void *)fpu->fip); }

struct fptraps __trap_vectors = { default_invalid_handler, default_stack_flt_handler, 0, default_divbyzero_handler, 0, 0, 0, 0, 1 };

/* Return the exception trap macros representing the current enabled traps. */ int fegettraps(void) { unsigned short cw; asm volatile ("fnstcw %0":"=m" (cw)); cw = ~cw & FE_ALL_EXCEPT; if ( cw & FE_INVALID ) { if ( ! __trap_vectors.trap_invalid ) cw &= ~FE_INVALID; if ( __trap_vectors.trap_stack_flt ) cw |= FE_STACK_FLT; } return cw; }

/* Enable exception traps for the exceptions specified by traps. */ int feenabletraps(int traps) { unsigned short cw;

asm volatile ("fnstcw %0":"=m" (cw)); if ( ! (traps & ~(FE_ALL_EXCEPT | FE_STACK_FLT)) ) { if ( traps & (FE_INVALID | FE_STACK_FLT) ) { if ( traps & FE_INVALID ) __trap_vectors.trap_invalid = 1; if ( traps & FE_STACK_FLT ) __trap_vectors.trap_stack_flt = 1; traps |= FE_INVALID; } cw &= ~traps; asm volatile ("fldcw %0"::"m" (cw)); return 1; } else return 0; }

/* Disable exception traps for the exceptions specified by traps. */ int fedisabletraps(int traps) { unsigned short cw;

asm volatile ("fnstcw %0":"=m" (cw)); if ( ! (traps & ~(FE_ALL_EXCEPT | FE_STACK_FLT)) ) { if ( traps & (FE_INVALID | FE_STACK_FLT) ) { if ( traps & FE_INVALID ) __trap_vectors.trap_invalid = 0; if ( traps & FE_STACK_FLT ) __trap_vectors.trap_stack_flt = 0; if ( !(__trap_vectors.trap_invalid | __trap_vectors.trap_stack_flt) ) traps |= FE_INVALID; } cw |= (traps & FE_ALL_EXCEPT); asm volatile ("fldcw %0"::"m" (cw)); return 1; } else return 0; }

/* Get the trap vector for the specified exception. */ int fegetvector(ftrap_t *vector, int excep) { switch ( excep ) { case FE_STACK_FLT: *vector = __trap_vectors.stack_flt; break; case FE_INVALID: *vector = __trap_vectors.invalid; break; case FE_DIVBYZERO: *vector = __trap_vectors.divbyzero; break; case FE_OVERFLOW: *vector = __trap_vectors.overflow; break; case FE_INEXACT: *vector = __trap_vectors.inexact; break; case FE_UNDERFLOW: *vector = __trap_vectors.underflow; break; case FE_DENORM_OP: *vector = __trap_vectors.denorm_op; break; default: return 0; } return 1; }

/* Set the trap vector for the specified exception. */ int fesetvector(ftrap_t *vector, int excep) { switch ( excep ) { case FE_STACK_FLT: __trap_vectors.stack_flt = *vector; break; case FE_INVALID: __trap_vectors.invalid = *vector; break; case FE_DIVBYZERO: __trap_vectors.divbyzero = *vector; break; case FE_OVERFLOW: __trap_vectors.overflow = *vector; break; case FE_INEXACT: __trap_vectors.inexact = *vector; break; case FE_UNDERFLOW: __trap_vectors.underflow = *vector; break; case FE_DENORM_OP: __trap_vectors.denorm_op = *vector; break; default: return 0; } return 1; }

#define FE_REASONABLE_EXCEPT ( FE_INEXACT | FE_DIVBYZERO | FE_OVERFLOW | FE_INVALID )

void fpenab_ () { feenabletraps(FE_REASONABLE_EXCEPT); } --------------------------------------------------------------------------- This library can be also called from FORTRAN files as follow: --------------------------------------------------------------------------- program test external hanfpe call signal(8,hanfpe) call fpenab call mess3 end subroutine mess1 a=0. b=1/a end subroutine mess2 a=0. b=log(a) end subroutine mess3 a=-1 b=sqrt(a) end subroutine mess4 i=0 b=1/i end subroutine hanfpe print *, 'We have a floating point excp...' print *, 'Bye Bye....' stop end