summaryrefslogtreecommitdiff
path: root/libgfortran
diff options
context:
space:
mode:
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>2013-06-17 07:48:21 +0000
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>2013-06-17 07:48:21 +0000
commit553e7cefa6034f54ee588e22cd96e64e343d500a (patch)
treef0f53ca508f0a7d7947323827651db99fab185cc /libgfortran
parent5530d2ddc939f410566f957ad5296fe17ab2297c (diff)
downloadgcc-553e7cefa6034f54ee588e22cd96e64e343d500a.tar.gz
2013-06-17 Tobias Burnus <burnus@net-b.de>
* gfortran.h (gfc_option_t): Add fpe_summary. * gfortran.texi (_gfortran_set_options): Update. * invoke.texi (-ffpe-summary): Add doc. * lang.opt (ffpe-summary): Add flag. * options.c (gfc_init_options, gfc_handle_option): Handle it. (gfc_handle_fpe_option): Renamed from gfc_handle_fpe_trap_option, also handle fpe_summary. * trans-decl.c (create_main_function): Update _gfortran_set_options call. 2013-06-17 Tobias Burnus <burnus@net-b.de> * libgfortran.h (compile_options_t) Add fpe_summary. (get_fpu_except_flags): New prototype. * runtime/compile_options.c (set_options, init_compile_options): Handle fpe_summary. * runtime/stop.c (report_exception): New function. (stop_numeric, stop_numeric_f08, stop_string, error_stop_string, error_stop_numeric): Call it. * config/fpu-387.h (get_fpu_except_flags): New function. * config/fpu-aix.h (get_fpu_except_flags): New function. * config/fpu-generic.h (get_fpu_except_flags): New function. * config/fpu-glibc.h (get_fpu_except_flags): New function. * config/fpu-glibc.h (get_fpu_except_flags): New function. * configure.ac: Check for fpxcp.h. * configure: Regenerate. * config.h.in: Regenerate. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@200147 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/ChangeLog18
-rw-r--r--libgfortran/config.h.in3
-rw-r--r--libgfortran/config/fpu-387.h37
-rw-r--r--libgfortran/config/fpu-aix.h35
-rw-r--r--libgfortran/config/fpu-generic.h6
-rw-r--r--libgfortran/config/fpu-glibc.h42
-rw-r--r--libgfortran/config/fpu-sysv.h42
-rwxr-xr-xlibgfortran/configure23
-rw-r--r--libgfortran/configure.ac2
-rw-r--r--libgfortran/libgfortran.h3
-rw-r--r--libgfortran/runtime/compile_options.c3
-rw-r--r--libgfortran/runtime/stop.c54
12 files changed, 255 insertions, 13 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 38a53190179..de5cfdd1ed9 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,21 @@
+2013-06-17 Tobias Burnus <burnus@net-b.de>
+
+ * libgfortran.h (compile_options_t) Add fpe_summary.
+ (get_fpu_except_flags): New prototype.
+ * runtime/compile_options.c (set_options, init_compile_options):
+ Handle fpe_summary.
+ * runtime/stop.c (report_exception): New function.
+ (stop_numeric, stop_numeric_f08, stop_string, error_stop_string,
+ error_stop_numeric): Call it.
+ * config/fpu-387.h (get_fpu_except_flags): New function.
+ * config/fpu-aix.h (get_fpu_except_flags): New function.
+ * config/fpu-generic.h (get_fpu_except_flags): New function.
+ * config/fpu-glibc.h (get_fpu_except_flags): New function.
+ * config/fpu-glibc.h (get_fpu_except_flags): New function.
+ * configure.ac: Check for fpxcp.h.
+ * configure: Regenerate.
+ * config.h.in: Regenerate.
+
2013-06-01 Tobias Burnus <burnus@net-b.de>
PR fortran/57496
diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
index fb5026fc0da..0d5d56ccb1c 100644
--- a/libgfortran/config.h.in
+++ b/libgfortran/config.h.in
@@ -399,6 +399,9 @@
/* Define to 1 if you have the <fptrap.h> header file. */
#undef HAVE_FPTRAP_H
+/* Define to 1 if you have the <fpxcp.h> header file. */
+#undef HAVE_FPXCP_H
+
/* fp_enable is present */
#undef HAVE_FP_ENABLE
diff --git a/libgfortran/config/fpu-387.h b/libgfortran/config/fpu-387.h
index 913eb60b1d9..608354d975a 100644
--- a/libgfortran/config/fpu-387.h
+++ b/libgfortran/config/fpu-387.h
@@ -134,3 +134,40 @@ void set_fpu (void)
asm volatile ("%vldmxcsr %0" : : "m" (cw_sse));
}
}
+
+
+int
+get_fpu_except_flags (void)
+{
+ int result;
+ unsigned short cw;
+
+ __asm__ __volatile__ ("fnstsw\t%0" : "=a" (cw));
+
+ if (has_sse())
+ {
+ unsigned int cw_sse;
+ __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse));
+ cw |= cw_sse;
+ }
+
+ if (cw & _FPU_MASK_IM)
+ result |= GFC_FPE_INVALID;
+
+ if (cw & _FPU_MASK_ZM)
+ result |= GFC_FPE_ZERO;
+
+ if (cw & _FPU_MASK_OM)
+ result |= GFC_FPE_OVERFLOW;
+
+ if (cw & _FPU_MASK_UM)
+ result |= GFC_FPE_UNDERFLOW;
+
+ if (cw & _FPU_MASK_DM)
+ result |= GFC_FPE_DENORMAL;
+
+ if (cw & _FPU_MASK_PM)
+ result |= GFC_FPE_INEXACT;
+
+ return result;
+}
diff --git a/libgfortran/config/fpu-aix.h b/libgfortran/config/fpu-aix.h
index bcb5500c657..1ba9d4cfb22 100644
--- a/libgfortran/config/fpu-aix.h
+++ b/libgfortran/config/fpu-aix.h
@@ -29,6 +29,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <fptrap.h>
#endif
+#ifdef HAVE_FPXCP_H
+#include <fpxcp.h>
+#endif
+
void
set_fpu (void)
{
@@ -81,3 +85,34 @@ set_fpu (void)
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;
+}
diff --git a/libgfortran/config/fpu-generic.h b/libgfortran/config/fpu-generic.h
index 23212f8fb3c..4223f2e27d4 100644
--- a/libgfortran/config/fpu-generic.h
+++ b/libgfortran/config/fpu-generic.h
@@ -50,3 +50,9 @@ set_fpu (void)
estr_write ("Fortran runtime warning: IEEE 'inexact' "
"exception not supported.\n");
}
+
+int
+get_fpu_except_flags (void)
+{
+ return 0;
+}
diff --git a/libgfortran/config/fpu-glibc.h b/libgfortran/config/fpu-glibc.h
index 5c7ad84ff39..e0d1019b919 100644
--- a/libgfortran/config/fpu-glibc.h
+++ b/libgfortran/config/fpu-glibc.h
@@ -85,3 +85,45 @@ void set_fpu (void)
"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;
+}
diff --git a/libgfortran/config/fpu-sysv.h b/libgfortran/config/fpu-sysv.h
index b32702b3ce9..8fc52d5eade 100644
--- a/libgfortran/config/fpu-sysv.h
+++ b/libgfortran/config/fpu-sysv.h
@@ -80,3 +80,45 @@ set_fpu (void)
fpsetmask(cw);
}
+
+int
+get_fpu_except_flags (void)
+{
+ int result;
+ fp_except_t set_excepts;
+
+ 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;
+}
diff --git a/libgfortran/configure b/libgfortran/configure
index 8601d8440fa..c049cdcfebe 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -654,7 +654,6 @@ CPP
am__fastdepCC_FALSE
am__fastdepCC_TRUE
CCDEPMODE
-am__nodep
AMDEPBACKSLASH
AMDEP_FALSE
AMDEP_TRUE
@@ -2543,6 +2542,7 @@ as_fn_append ac_header_list " floatingpoint.h"
as_fn_append ac_header_list " ieeefp.h"
as_fn_append ac_header_list " fenv.h"
as_fn_append ac_header_list " fptrap.h"
+as_fn_append ac_header_list " fpxcp.h"
as_fn_append ac_header_list " pwd.h"
as_fn_append ac_header_list " complex.h"
as_fn_append ac_func_list " getrusage"
@@ -3386,11 +3386,11 @@ MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"}
# We need awk for the "check" target. The system "awk" is bad on
# some platforms.
-# Always define AMTAR for backward compatibility. Yes, it's still used
-# in the wild :-( We should find a proper way to deprecate it ...
-AMTAR='$${TAR-tar}'
+# Always define AMTAR for backward compatibility.
-am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'
+AMTAR=${AMTAR-"${am_missing_run}tar"}
+
+am__tar='${AMTAR} chof - "$$tardir"'; am__untar='${AMTAR} xf -'
@@ -3523,7 +3523,6 @@ fi
if test "x$enable_dependency_tracking" != xno; then
am_depcomp="$ac_aux_dir/depcomp"
AMDEPBACKSLASH='\'
- am__nodep='_no'
fi
if test "x$enable_dependency_tracking" != xno; then
AMDEP_TRUE=
@@ -4341,7 +4340,6 @@ else
# instance it was reported that on HP-UX the gcc test will end up
# making a dummy file named `D' -- because `-MD' means `put the output
# in D'.
- rm -rf conftest.dir
mkdir conftest.dir
# Copy depcomp to subdir because otherwise we won't find it if we're
# using a relative directory.
@@ -4401,7 +4399,7 @@ else
break
fi
;;
- msvc7 | msvc7msys | msvisualcpp | msvcmsys)
+ msvisualcpp | msvcmsys)
# This compiler won't grok `-c -o', but also, the minuso test has
# not run yet. These depmodes are late enough in the game, and
# so weak that their functioning should not be impacted.
@@ -5517,7 +5515,6 @@ else
# instance it was reported that on HP-UX the gcc test will end up
# making a dummy file named `D' -- because `-MD' means `put the output
# in D'.
- rm -rf conftest.dir
mkdir conftest.dir
# Copy depcomp to subdir because otherwise we won't find it if we're
# using a relative directory.
@@ -5577,7 +5574,7 @@ else
break
fi
;;
- msvc7 | msvc7msys | msvisualcpp | msvcmsys)
+ msvisualcpp | msvcmsys)
# This compiler won't grok `-c -o', but also, the minuso test has
# not run yet. These depmodes are late enough in the game, and
# so weak that their functioning should not be impacted.
@@ -12334,7 +12331,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
-#line 12337 "configure"
+#line 12334 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -12440,7 +12437,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
-#line 12443 "configure"
+#line 12440 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -16001,6 +15998,8 @@ done
+
+
inttype_headers=`echo inttypes.h sys/inttypes.h | sed -e 's/,/ /g'`
acx_cv_header_stdint=stddef.h
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index 7d97fed1b0b..ba14f1f30b7 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -254,7 +254,7 @@ AC_CHECK_TYPES([ptrdiff_t])
# check header files (we assume C89 is available, so don't check for that)
AC_CHECK_HEADERS_ONCE(unistd.h sys/time.h sys/times.h sys/resource.h \
sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h fenv.h fptrap.h \
-pwd.h complex.h)
+fpxcp.h pwd.h complex.h)
GCC_HEADER_STDINT(gstdint.h)
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 56c98715feb..f22da21c4c6 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -534,6 +534,7 @@ typedef struct
size_t record_marker;
int max_subrecord_length;
int bounds_check;
+ int fpe_summary;
}
compile_options_t;
@@ -742,6 +743,8 @@ internal_proto(gf_strerror);
extern void set_fpu (void);
internal_proto(set_fpu);
+extern int get_fpu_except_flags (void);
+internal_proto(get_fpu_except_flags);
/* memory.c */
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
index a49514c0aa9..1416d6634f4 100644
--- a/libgfortran/runtime/compile_options.c
+++ b/libgfortran/runtime/compile_options.c
@@ -173,6 +173,8 @@ set_options (int num, int options[])
the library behavior; range checking is now always done when
parsing integers. It's place in the options array is retained due
to ABI compatibility. Remove when bumping the library ABI. */
+ if (num >= 9)
+ compile_options.fpe_summary = options[8];
/* If backtrace is required, we set signal handlers on the POSIX
2001 signals with core action. */
@@ -225,6 +227,7 @@ init_compile_options (void)
compile_options.pedantic = 0;
compile_options.backtrace = 0;
compile_options.sign_zero = 1;
+ compile_options.fpe_summary = 0;
}
/* Function called by the front-end to tell us the
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 4805412e761..1091245241a 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -32,6 +32,55 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#endif
+/* Fortran 2008 demands: If any exception (14) is signaling on that image, the
+ processor shall issue a warning indicating which exceptions are signaling;
+ this warning shall be on the unit identified by the named constant
+ ERROR_UNIT (13.8.2.8). In line with other compilers, we do not report
+ inexact - and we optionally ignore underflow, cf. thread starting at
+ http://mailman.j3-fortran.org/pipermail/j3/2013-June/006452.html. */
+
+static void
+report_exception (void)
+{
+ int set_excepts;
+
+ if (!compile_options.fpe_summary)
+ return;
+
+ set_excepts = get_fpu_except_flags ();
+ if ((set_excepts & compile_options.fpe_summary) == 0)
+ return;
+
+ estr_write ("Note: The following floating-point exceptions are signalling:");
+
+ if ((compile_options.fpe_summary & GFC_FPE_INVALID)
+ && (set_excepts & GFC_FPE_INVALID))
+ estr_write (" IEEE_INVALID_FLAG");
+
+ if ((compile_options.fpe_summary & GFC_FPE_ZERO)
+ && (set_excepts & GFC_FPE_ZERO))
+ estr_write (" IEEE_DIVIDE_BY_ZERO");
+
+ if ((compile_options.fpe_summary & GFC_FPE_OVERFLOW)
+ && (set_excepts & GFC_FPE_OVERFLOW))
+ estr_write (" IEEE_OVERFLOW_FLAG");
+
+ if ((compile_options.fpe_summary & GFC_FPE_UNDERFLOW)
+ && (set_excepts & GFC_FPE_UNDERFLOW))
+ estr_write (" IEEE_UNDERFLOW_FLAG");
+
+ if ((compile_options.fpe_summary & GFC_FPE_DENORMAL)
+ && (set_excepts & GFC_FPE_DENORMAL))
+ estr_write (" IEEE_DENORMAL");
+
+ if ((compile_options.fpe_summary & GFC_FPE_INEXACT)
+ && (set_excepts & GFC_FPE_INEXACT))
+ estr_write (" IEEE_INEXACT_FLAG");
+
+ estr_write ("\n");
+}
+
+
/* A numeric STOP statement. */
extern void stop_numeric (GFC_INTEGER_4)
@@ -41,6 +90,7 @@ export_proto(stop_numeric);
void
stop_numeric (GFC_INTEGER_4 code)
{
+ report_exception ();
if (code == -1)
code = 0;
else
@@ -59,6 +109,7 @@ export_proto(stop_numeric_f08);
void
stop_numeric_f08 (GFC_INTEGER_4 code)
{
+ report_exception ();
st_printf ("STOP %d\n", (int)code);
exit (code);
}
@@ -69,6 +120,7 @@ stop_numeric_f08 (GFC_INTEGER_4 code)
void
stop_string (const char *string, GFC_INTEGER_4 len)
{
+ report_exception ();
if (string)
{
estr_write ("STOP ");
@@ -91,6 +143,7 @@ export_proto(error_stop_string);
void
error_stop_string (const char *string, GFC_INTEGER_4 len)
{
+ report_exception ();
estr_write ("ERROR STOP ");
(void) write (STDERR_FILENO, string, len);
estr_write ("\n");
@@ -108,6 +161,7 @@ export_proto(error_stop_numeric);
void
error_stop_numeric (GFC_INTEGER_4 code)
{
+ report_exception ();
st_printf ("ERROR STOP %d\n", (int) code);
exit (code);
}