diff options
Diffstat (limited to 'gcc-4.9/libgfortran/config')
| -rw-r--r-- | gcc-4.9/libgfortran/config/fpu-387.h | 261 | ||||
| -rw-r--r-- | gcc-4.9/libgfortran/config/fpu-aix.h | 190 | ||||
| -rw-r--r-- | gcc-4.9/libgfortran/config/fpu-generic.h | 71 | ||||
| -rw-r--r-- | gcc-4.9/libgfortran/config/fpu-glibc.h | 201 | ||||
| -rw-r--r-- | gcc-4.9/libgfortran/config/fpu-sysv.h | 203 |
5 files changed, 926 insertions, 0 deletions
diff --git a/gcc-4.9/libgfortran/config/fpu-387.h b/gcc-4.9/libgfortran/config/fpu-387.h new file mode 100644 index 000000000..8ba3f4aab --- /dev/null +++ b/gcc-4.9/libgfortran/config/fpu-387.h @@ -0,0 +1,261 @@ +/* FPU-related code for x86 and x86_64 processors. + Copyright (C) 2005-2014 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#ifndef __SSE_MATH__ +#include "cpuid.h" +#endif + +#if defined(__sun__) && defined(__svr4__) +#include <signal.h> +#include <ucontext.h> + +static volatile sig_atomic_t sigill_caught; + +static void +sigill_hdlr (int sig __attribute((unused)), + siginfo_t *sip __attribute__((unused)), + ucontext_t *ucp) +{ + sigill_caught = 1; + /* Set PC to the instruction after the faulting one to skip over it, + otherwise we enter an infinite loop. 3 is the size of the movaps + instruction. */ + ucp->uc_mcontext.gregs[EIP] += 3; + setcontext (ucp); +} +#endif + +static int +has_sse (void) +{ +#ifndef __SSE_MATH__ + unsigned int eax, ebx, ecx, edx; + + if (!__get_cpuid (1, &eax, &ebx, &ecx, &edx)) + return 0; + +#if defined(__sun__) && defined(__svr4__) + /* Solaris 2 before Solaris 9 4/04 cannot execute SSE instructions even + if the CPU supports them. Programs receive SIGILL instead, so check + for that at runtime. */ + + if (edx & bit_SSE) + { + struct sigaction act, oact; + + act.sa_handler = sigill_hdlr; + sigemptyset (&act.sa_mask); + /* Need to set SA_SIGINFO so a ucontext_t * is passed to the handler. */ + act.sa_flags = SA_SIGINFO; + sigaction (SIGILL, &act, &oact); + + /* We need a single SSE instruction here so the handler can safely skip + over it. */ + __asm__ __volatile__ ("movaps\t%xmm0,%xmm0"); + + sigaction (SIGILL, &oact, NULL); + + if (sigill_caught) + return 0; + } +#endif /* __sun__ && __svr4__ */ + + return edx & bit_SSE; +#else + return 1; +#endif +} + +/* i387 exceptions -- see linux <fpu_control.h> header file for details. */ +#define _FPU_MASK_IM 0x01 +#define _FPU_MASK_DM 0x02 +#define _FPU_MASK_ZM 0x04 +#define _FPU_MASK_OM 0x08 +#define _FPU_MASK_UM 0x10 +#define _FPU_MASK_PM 0x20 +#define _FPU_MASK_ALL 0x3f + +#define _FPU_EX_ALL 0x3f + +/* i387 rounding modes. */ + +#define _FPU_RC_NEAREST 0x0 +#define _FPU_RC_DOWN 0x1 +#define _FPU_RC_UP 0x2 +#define _FPU_RC_ZERO 0x3 + +#define _FPU_RC_MASK 0x3 + + +void +set_fpu (void) +{ + int excepts = 0; + unsigned short cw; + + __asm__ __volatile__ ("fstcw\t%0" : "=m" (cw)); + + if (options.fpe & GFC_FPE_INVALID) excepts |= _FPU_MASK_IM; + if (options.fpe & GFC_FPE_DENORMAL) excepts |= _FPU_MASK_DM; + if (options.fpe & GFC_FPE_ZERO) excepts |= _FPU_MASK_ZM; + if (options.fpe & GFC_FPE_OVERFLOW) excepts |= _FPU_MASK_OM; + if (options.fpe & GFC_FPE_UNDERFLOW) excepts |= _FPU_MASK_UM; + if (options.fpe & GFC_FPE_INEXACT) excepts |= _FPU_MASK_PM; + + cw |= _FPU_MASK_ALL; + cw &= ~excepts; + + __asm__ __volatile__ ("fnclex\n\tfldcw\t%0" : : "m" (cw)); + + if (has_sse()) + { + unsigned int cw_sse; + + __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse)); + + /* The SSE exception masks are shifted by 7 bits. */ + cw_sse |= _FPU_MASK_ALL << 7; + cw_sse &= ~(excepts << 7); + + /* Clear stalled exception flags. */ + cw_sse &= ~_FPU_EX_ALL; + + __asm__ __volatile__ ("%vldmxcsr\t%0" : : "m" (cw_sse)); + } +} + +int +get_fpu_except_flags (void) +{ + unsigned short cw; + int excepts; + int result = 0; + + __asm__ __volatile__ ("fnstsw\t%0" : "=a" (cw)); + excepts = cw; + + if (has_sse()) + { + unsigned int cw_sse; + + __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse)); + excepts |= cw_sse; + } + + excepts &= _FPU_EX_ALL; + + if (excepts & _FPU_MASK_IM) result |= GFC_FPE_INVALID; + if (excepts & _FPU_MASK_DM) result |= GFC_FPE_DENORMAL; + if (excepts & _FPU_MASK_ZM) result |= GFC_FPE_ZERO; + if (excepts & _FPU_MASK_OM) result |= GFC_FPE_OVERFLOW; + if (excepts & _FPU_MASK_UM) result |= GFC_FPE_UNDERFLOW; + if (excepts & _FPU_MASK_PM) result |= GFC_FPE_INEXACT; + + return result; +} + +void +set_fpu_rounding_mode (int round) +{ + int round_mode; + unsigned short cw; + + switch (round) + { + case GFC_FPE_TONEAREST: + round_mode = _FPU_RC_NEAREST; + break; + case GFC_FPE_UPWARD: + round_mode = _FPU_RC_UP; + break; + case GFC_FPE_DOWNWARD: + round_mode = _FPU_RC_DOWN; + break; + case GFC_FPE_TOWARDZERO: + round_mode = _FPU_RC_ZERO; + break; + default: + return; /* Should be unreachable. */ + } + + __asm__ __volatile__ ("fnstcw\t%0" : "=m" (cw)); + + /* The x87 round control bits are shifted by 10 bits. */ + cw &= ~(_FPU_RC_MASK << 10); + cw |= round_mode << 10; + + __asm__ __volatile__ ("fldcw\t%0" : : "m" (cw)); + + if (has_sse()) + { + unsigned int cw_sse; + + __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse)); + + /* The SSE round control bits are shifted by 13 bits. */ + cw_sse &= ~(_FPU_RC_MASK << 13); + cw_sse |= round_mode << 13; + + __asm__ __volatile__ ("%vldmxcsr\t%0" : : "m" (cw_sse)); + } +} + +int +get_fpu_rounding_mode (void) +{ + int round_mode; + +#ifdef __SSE_MATH__ + unsigned int cw; + + __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw)); + + /* The SSE round control bits are shifted by 13 bits. */ + round_mode = cw >> 13; +#else + unsigned short cw; + + __asm__ __volatile__ ("fnstcw\t%0" : "=m" (cw)); + + /* The x87 round control bits are shifted by 10 bits. */ + round_mode = cw >> 10; +#endif + + round_mode &= _FPU_RC_MASK; + + switch (round_mode) + { + case _FPU_RC_NEAREST: + return GFC_FPE_TONEAREST; + case _FPU_RC_UP: + return GFC_FPE_UPWARD; + case _FPU_RC_DOWN: + return GFC_FPE_DOWNWARD; + case _FPU_RC_ZERO: + return GFC_FPE_TOWARDZERO; + default: + return GFC_FPE_INVALID; /* Should be unreachable. */ + } +} diff --git a/gcc-4.9/libgfortran/config/fpu-aix.h b/gcc-4.9/libgfortran/config/fpu-aix.h new file mode 100644 index 000000000..a05fab837 --- /dev/null +++ b/gcc-4.9/libgfortran/config/fpu-aix.h @@ -0,0 +1,190 @@ +/* AIX FPU-related code. + Copyright (C) 2005-2014 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + + +/* FPU-related code for AIX. */ +#ifdef HAVE_FPTRAP_H +#include <fptrap.h> +#endif + +#ifdef HAVE_FPXCP_H +#include <fpxcp.h> +#endif + +void +set_fpu (void) +{ + fptrap_t mode = 0; + + if (options.fpe & GFC_FPE_INVALID) +#ifdef TRP_INVALID + mode |= TRP_INVALID; +#else + estr_write ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_DENORMAL) + estr_write ("Fortran runtime warning: Floating point 'denormal operand' " + "exception not supported.\n"); + + if (options.fpe & GFC_FPE_ZERO) +#ifdef TRP_DIV_BY_ZERO + mode |= TRP_DIV_BY_ZERO; +#else + estr_write ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_OVERFLOW) +#ifdef TRP_OVERFLOW + mode |= TRP_OVERFLOW; +#else + estr_write ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_UNDERFLOW) +#ifdef TRP_UNDERFLOW + mode |= TRP_UNDERFLOW; +#else + estr_write ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_INEXACT) +#ifdef TRP_INEXACT + mode |= TRP_INEXACT; +#else + estr_write ("Fortran runtime warning: IEEE 'inexact' " + "exception not supported.\n"); +#endif + + fp_trap(FP_TRAP_SYNC); + fp_enable(mode); +} + + +int +get_fpu_except_flags (void) +{ + int result, set_excepts; + + result = 0; + +#ifdef HAVE_FPXCP_H + if (!fp_any_xcp ()) + return 0; + + if (fp_invalid_op ()) + result |= GFC_FPE_INVALID; + + if (fp_divbyzero ()) + result |= GFC_FPE_ZERO; + + if (fp_overflow ()) + result |= GFC_FPE_OVERFLOW; + + if (fp_underflow ()) + result |= GFC_FPE_UNDERFLOW; + + if (fp_inexact ()) + result |= GFC_FPE_INEXACT; +#endif + + return result; +} + + +int +get_fpu_rounding_mode (void) +{ + int rnd_mode; + + rnd_mode = fegetround (); + + switch (rnd_mode) + { +#ifdef FE_TONEAREST + case FE_TONEAREST: + return GFC_FPE_TONEAREST; +#endif + +#ifdef FE_UPWARD + case FE_UPWARD: + return GFC_FPE_UPWARD; +#endif + +#ifdef FE_DOWNWARD + case FE_DOWNWARD: + return GFC_FPE_DOWNWARD; +#endif + +#ifdef FE_TOWARDZERO + case FE_TOWARDZERO: + return GFC_FPE_TOWARDZERO; +#endif + default: + return GFC_FPE_INVALID; + } +} + + +void +set_fpu_rounding_mode (int mode) +{ + int rnd_mode; + + switch (mode) + { +#ifdef FE_TONEAREST + case GFC_FPE_TONEAREST: + rnd_mode = FE_TONEAREST; + break; +#endif + +#ifdef FE_UPWARD + case GFC_FPE_UPWARD: + rnd_mode = FE_UPWARD; + break; +#endif + +#ifdef FE_DOWNWARD + case GFC_FPE_DOWNWARD: + rnd_mode = FE_DOWNWARD; + break; +#endif + +#ifdef FE_TOWARDZERO + case GFC_FPE_TOWARDZERO: + rnd_mode = FE_TOWARDZERO; + break; +#endif + default: + return; + } + + fesetround (rnd_mode); +} diff --git a/gcc-4.9/libgfortran/config/fpu-generic.h b/gcc-4.9/libgfortran/config/fpu-generic.h new file mode 100644 index 000000000..d9be4d99b --- /dev/null +++ b/gcc-4.9/libgfortran/config/fpu-generic.h @@ -0,0 +1,71 @@ +/* Fallback FPU-related code (for systems not otherwise supported). + Copyright (C) 2005-2014 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + + +/* Fallback FPU-related code for systems not otherwise supported. This + is mainly telling the user that we will not be able to do what he + requested. */ + +void +set_fpu (void) +{ + if (options.fpe & GFC_FPE_INVALID) + estr_write ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_DENORMAL) + estr_write ("Fortran runtime warning: Floating point 'denormal operand' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_ZERO) + estr_write ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_OVERFLOW) + estr_write ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_UNDERFLOW) + estr_write ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_INEXACT) + estr_write ("Fortran runtime warning: IEEE 'inexact' " + "exception not supported.\n"); +} + +int +get_fpu_except_flags (void) +{ + return 0; +} + + +int +get_fpu_rounding_mode (void) +{ + return 0; +} + + +void +set_fpu_rounding_mode (int round __attribute__((unused))) +{ +} diff --git a/gcc-4.9/libgfortran/config/fpu-glibc.h b/gcc-4.9/libgfortran/config/fpu-glibc.h new file mode 100644 index 000000000..cf216847a --- /dev/null +++ b/gcc-4.9/libgfortran/config/fpu-glibc.h @@ -0,0 +1,201 @@ +/* FPU-related code for systems with GNU libc. + Copyright (C) 2005-2014 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +/* FPU-related code for systems with the GNU libc, providing the + feenableexcept function in fenv.h to set individual exceptions + (there's nothing to do that in C99). */ + +#ifdef HAVE_FENV_H +#include <fenv.h> +#endif + +void set_fpu (void) +{ + if (FE_ALL_EXCEPT != 0) + fedisableexcept (FE_ALL_EXCEPT); + + if (options.fpe & GFC_FPE_INVALID) +#ifdef FE_INVALID + feenableexcept (FE_INVALID); +#else + estr_write ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); +#endif + +/* glibc does never have a FE_DENORMAL. */ + if (options.fpe & GFC_FPE_DENORMAL) +#ifdef FE_DENORMAL + feenableexcept (FE_DENORMAL); +#else + estr_write ("Fortran runtime warning: Floating point 'denormal operand' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_ZERO) +#ifdef FE_DIVBYZERO + feenableexcept (FE_DIVBYZERO); +#else + estr_write ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_OVERFLOW) +#ifdef FE_OVERFLOW + feenableexcept (FE_OVERFLOW); +#else + estr_write ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_UNDERFLOW) +#ifdef FE_UNDERFLOW + feenableexcept (FE_UNDERFLOW); +#else + estr_write ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_INEXACT) +#ifdef FE_INEXACT + feenableexcept (FE_INEXACT); +#else + estr_write ("Fortran runtime warning: IEEE 'inexact' " + "exception not supported.\n"); +#endif +} + + +int +get_fpu_except_flags (void) +{ + int result, set_excepts; + + result = 0; + set_excepts = fetestexcept (FE_ALL_EXCEPT); + +#ifdef FE_INVALID + if (set_excepts & FE_INVALID) + result |= GFC_FPE_INVALID; +#endif + +#ifdef FE_DIVBYZERO + if (set_excepts & FE_DIVBYZERO) + result |= GFC_FPE_ZERO; +#endif + +#ifdef FE_OVERFLOW + if (set_excepts & FE_OVERFLOW) + result |= GFC_FPE_OVERFLOW; +#endif + +#ifdef FE_UNDERFLOW + if (set_excepts & FE_UNDERFLOW) + result |= GFC_FPE_UNDERFLOW; +#endif + +#ifdef FE_DENORMAL + if (set_excepts & FE_DENORMAL) + result |= GFC_FPE_DENORMAL; +#endif + +#ifdef FE_INEXACT + if (set_excepts & FE_INEXACT) + result |= GFC_FPE_INEXACT; +#endif + + return result; +} + + +int +get_fpu_rounding_mode (void) +{ + int rnd_mode; + + rnd_mode = fegetround (); + + switch (rnd_mode) + { +#ifdef FE_TONEAREST + case FE_TONEAREST: + return GFC_FPE_TONEAREST; +#endif + +#ifdef FE_UPWARD + case FE_UPWARD: + return GFC_FPE_UPWARD; +#endif + +#ifdef FE_DOWNWARD + case FE_DOWNWARD: + return GFC_FPE_DOWNWARD; +#endif + +#ifdef FE_TOWARDZERO + case FE_TOWARDZERO: + return GFC_FPE_TOWARDZERO; +#endif + default: + return GFC_FPE_INVALID; + } +} + + +void +set_fpu_rounding_mode (int mode) +{ + int rnd_mode; + + switch (mode) + { +#ifdef FE_TONEAREST + case GFC_FPE_TONEAREST: + rnd_mode = FE_TONEAREST; + break; +#endif + +#ifdef FE_UPWARD + case GFC_FPE_UPWARD: + rnd_mode = FE_UPWARD; + break; +#endif + +#ifdef FE_DOWNWARD + case GFC_FPE_DOWNWARD: + rnd_mode = FE_DOWNWARD; + break; +#endif + +#ifdef FE_TOWARDZERO + case GFC_FPE_TOWARDZERO: + rnd_mode = FE_TOWARDZERO; + break; +#endif + default: + return; + } + + fesetround (rnd_mode); +} diff --git a/gcc-4.9/libgfortran/config/fpu-sysv.h b/gcc-4.9/libgfortran/config/fpu-sysv.h new file mode 100644 index 000000000..e7ba88f4a --- /dev/null +++ b/gcc-4.9/libgfortran/config/fpu-sysv.h @@ -0,0 +1,203 @@ +/* SysV FPU-related code (for systems not otherwise supported). + Copyright (C) 2005-2014 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +/* FPU-related code for SysV platforms with fpsetmask(). */ + +void +set_fpu (void) +{ + int cw = 0; + + if (options.fpe & GFC_FPE_INVALID) +#ifdef FP_X_INV + cw |= FP_X_INV; +#else + estr_write ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_DENORMAL) +#ifdef FP_X_DNML + cw |= FP_X_DNML; +#else + estr_write ("Fortran runtime warning: Floating point 'denormal operand' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_ZERO) +#ifdef FP_X_DZ + cw |= FP_X_DZ; +#else + estr_write ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_OVERFLOW) +#ifdef FP_X_OFL + cw |= FP_X_OFL; +#else + estr_write ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_UNDERFLOW) +#ifdef FP_X_UFL + cw |= FP_X_UFL; +#else + estr_write ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_INEXACT) +#ifdef FP_X_IMP + cw |= FP_X_IMP; +#else + estr_write ("Fortran runtime warning: IEEE 'inexact' " + "exception not supported.\n"); +#endif + + fpsetmask(cw); +} + +int +get_fpu_except_flags (void) +{ + int result; +#if HAVE_FP_EXCEPT + fp_except set_excepts; +#elif HAVE_FP_EXCEPT_T + fp_except_t set_excepts; +#else + choke me +#endif + + result = 0; + set_excepts = fpgetsticky (); + +#ifdef FP_X_INV + if (set_excepts & FP_X_INV) + result |= GFC_FPE_INVALID; +#endif + +#ifdef FP_X_DZ + if (set_excepts & FP_X_DZ) + result |= GFC_FPE_ZERO; +#endif + +#ifdef FP_X_OFL + if (set_excepts & FP_X_OFL) + result |= GFC_FPE_OVERFLOW; +#endif + +#ifdef FP_X_UFL + if (set_excepts & FP_X_UFL) + result |= GFC_FPE_UNDERFLOW; +#endif + +#ifdef FP_X_DNML + if (set_excepts & FP_X_DNML) + result |= GFC_FPE_DENORMAL; +#endif + +#ifdef FP_X_IMP + if (set_excepts & FP_X_IMP) + result |= GFC_FPE_INEXACT; +#endif + + return result; +} + + +int +get_fpu_rounding_mode (void) +{ + switch (fpgetround ()) + { +#ifdef FP_RN + case FP_RN: + return GFC_FPE_TONEAREST; +#endif + +#ifdef FP_RP + case FP_RP: + return GFC_FPE_UPWARD; +#endif + +#ifdef FP_RM + case FP_RM: + return GFC_FPE_DOWNWARD; +#endif + +#ifdef FP_RZ + case FP_RZ: + return GFC_FPE_TOWARDZERO; +#endif + default: + return GFC_FPE_INVALID; + } +} + + +void +set_fpu_rounding_mode (int mode) +{ +#if HAVE_FP_RND + fp_rnd rnd_mode; +#elif HAVE_FP_RND_T + fp_rnd_t rnd_mode; +#else + choke me +#endif + + switch (mode) + { +#ifdef FP_RN + case GFC_FPE_TONEAREST: + rnd_mode = FP_RN; + break; +#endif + +#ifdef FP_RP + case GFC_FPE_UPWARD: + rnd_mode = FP_RP; + break; +#endif + +#ifdef FP_RM + case GFC_FPE_DOWNWARD: + rnd_mode = FP_RM; + break; +#endif + +#ifdef FP_RZ + case GFC_FPE_TOWARDZERO: + rnd_mode = FP_RZ; + break; +#endif + default: + return; + } + fpsetround (rnd_mode); +} |