This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, Fortran] Print floating-point exception status after STOP/ERROR STOP
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc patches <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>, David Edelsohn <dje dot gcc at gmail dot com>, Uros Bizjak <ubizjak at gmail dot com>
- Date: Wed, 12 Jun 2013 15:05:30 +0200
- Subject: [Patch, Fortran] Print floating-point exception status after STOP/ERROR STOP
David: Can you have a look at libgfortran/config/fpu-aix.h - Thanks!
Uros: Can you have a look at libgfortran/config/fpu-387.h - Thanks!
The attached patch causes gfortran-compiled programs to print warnings like
Note: The following floating-point status flag is signalling:
IEEE_DIVIDE_BY_ZERO
when STOP / ERROR STOP is invoked. That's required by Fortran 2008 (8.4
STOP and ERROR STOP statements):
"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)."
From the J3 discussion at
http://mailman.j3-fortran.org/pipermail/j3/2013-June/006452.html
* sunf77 shows this message - and user complained - even if it didn't
report inexact exceptions
* Intel: There is an option to dis-/enable this option (-assume
[no]fpe_summary; default: no warning)
* NAG: Never reports inexact. Only underflow handling has a compiler
option (as users complained; -no_underflow_warning
* PGI reports all (denorm, underflow, inexact) by default (and seemingly
no compiler option exists)
* Cray: I couldn't find a compiler option to turn the warning on.
The patch below follows NAG by always printing the warning, but the
underflow warning can be disabled. (It also always ignores denormalized
status flags.)
One surely could extend it to allow to completely disable the warning -
or to make it more fine grained like "none", "all" plus all single flags
(including underflow, denormal and inexact, where by default one leaves
out inexact).
Comments?
Test case:
real, volatile :: r
! Divide by zero:
r = 0
r = 1.0/r
! Underflow:
!r = tiny(r)
!r = r/100.
stop
end
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
2013-06-12 Tobias Burnus <burnus@net-b.de>
* gfortran.h (gfc_option_t): Add flag_underflow_warning.
* gfortran.texi (_gfortran_set_options): Update.
* invoke.texi (-funderflow-warning): Add doc.
* lang.opt (fno-underflow-warning): Add flag.
* options.c (gfc_init_options, gfc_handle_option): Handle it.
* trans-decl.c (create_main_function): Update
_gfortran_set_options call.
2013-06-12 Tobias Burnus <burnus@net-b.de>
* libgfortran.h (compile_options_t) Add underflow_warning.
(get_fpu_except_flags): New prototype.
* runtime/compile_options.c (set_options, init_compile_options):
Handle underflow_warning.
* 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.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 14da0af..28b47ac 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2299,6 +2299,7 @@ typedef struct
int flag_align_commons;
int flag_protect_parens;
int flag_realloc_lhs;
+ int flag_underflow_warning;
int flag_aggressive_function_elimination;
int flag_frontend_optimize;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 4a31a77..d8ed562 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2855,13 +2855,16 @@ Default: enabled.
are (bitwise or-ed): GFC_RTCHECK_BOUNDS (1), GFC_RTCHECK_ARRAY_TEMPS (2),
GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO (16), GFC_RTCHECK_POINTER (32).
Default: disabled.
+@item @var{option}[7] @tab Unused.
+@item @var{option}[8] @tab Show a warning when invoking @code{STOP} and
+@code{ERROR STOP} if a floating-point underflow occurred.
@end multitable
@item @emph{Example}:
@smallexample
- /* Use gfortran 4.8 default options. */
- static int options[] = @{68, 511, 0, 0, 1, 1, 0@};
- _gfortran_set_options (7, &options);
+ /* Use gfortran 4.9 default options. */
+ static int options[] = @{68, 511, 0, 0, 1, 1, 0, 0, 1@};
+ _gfortran_set_options (9, &options);
@end smallexample
@end table
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 12c200e..63a1ffb 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -1157,8 +1157,17 @@ negative in the @code{SIGN} intrinsic. @option{-fno-sign-zero} does not
print the negative sign of zero values (or values rounded to zero for I/O)
and regards zero as positive number in the @code{SIGN} intrinsic for
compatibility with Fortran 77. The default is @option{-fsign-zero}.
+
+@item -fno-underflow-warning
+@opindex @code{funderflow-warning}
+When @code{STOP} and @code{ERROR STOP} is invoked, a warning is printed to
+@code{ERROR_UNIT} if a floating-point status flag is set (other than inexact).
+When @option{-fno-underflow-warning} is set, no warning is shown if a
+floating-point underflow occurred. The default is
+@option{-funderflow-warning}.
@end table
+
@node Code Gen Options
@section Options for code generation conventions
@cindex code generation, conventions
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index dbc3f6b..e0e71b4 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -585,6 +585,10 @@ fshort-enums
Fortran Var(flag_short_enums)
; Documented in C
+funderflow-warning
+Fortran
+On run-time exit, show a warning if an underflow occurred
+
fsign-zero
Fortran
Apply negative sign to zero values
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 3f5de03..34d066d 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -157,6 +157,7 @@ gfc_init_options (unsigned int decoded_options_count,
gfc_option.flag_align_commons = 1;
gfc_option.flag_protect_parens = -1;
gfc_option.flag_realloc_lhs = -1;
+ gfc_option.flag_underflow_warning = 1;
gfc_option.flag_aggressive_function_elimination = 0;
gfc_option.flag_frontend_optimize = -1;
@@ -980,6 +981,10 @@ gfc_handle_option (size_t scode, const char *arg, int value,
gfc_option.flag_sign_zero = value;
break;
+ case OPT_funderflow_warning:
+ gfc_option.flag_underflow_warning = value;
+ break;
+
case OPT_ffpe_trap_:
gfc_handle_fpe_trap_option (arg);
break;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 87652ba..06a299f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -5171,14 +5239,15 @@ create_main_function (tree fndecl)
/* TODO: This is the -frange-check option, which no longer affects
library behavior; when bumping the library ABI this slot can be
reused for something else. As it is the last element in the
- array, we can instead leave it out altogether.
+ array, we can instead leave it out altogether. */
+ CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+ build_int_cst (integer_type_node, 0));
CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
build_int_cst (integer_type_node,
- gfc_option.flag_range_check));
- */
+ gfc_option.flag_underflow_warning));
array_type = build_array_type (integer_type_node,
- build_index_type (size_int (6)));
+ build_index_type (size_int (8)));
array = build_constructor (array_type, v);
TREE_CONSTANT (array) = 1;
TREE_STATIC (array) = 1;
@@ -5193,7 +5262,7 @@ create_main_function (tree fndecl)
tmp = build_call_expr_loc (input_location,
gfor_fndecl_set_options, 2,
- build_int_cst (integer_type_node, 7), var);
+ build_int_cst (integer_type_node, 9), var);
gfc_add_expr_to_block (&body, tmp);
}
diff --git a/libgfortran/config/fpu-387.h b/libgfortran/config/fpu-387.h
index 913eb60..7492127 100644
--- a/libgfortran/config/fpu-387.h
+++ b/libgfortran/config/fpu-387.h
@@ -134,3 +134,37 @@ void set_fpu (void)
asm volatile ("%vldmxcsr %0" : : "m" (cw_sse));
}
}
+
+
+int
+get_fpu_except_flags (void)
+{
+ int result;
+ unsigned short cw;
+
+ __asm__ ("fnstsw %0" : "=a" (cw));
+
+ if (has_sse())
+ {
+ unsigned int cw_sse;
+ __asm__ ("stmxcsr %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_PM)
+ result |= GFC_FPE_INEXACT;
+
+ return result;
+}
diff --git a/libgfortran/config/fpu-aix.h b/libgfortran/config/fpu-aix.h
index bcb5500..1ba9d4c 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 23212f8..4223f2e 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 5c7ad84..b300372 100644
--- a/libgfortran/config/fpu-glibc.h
+++ b/libgfortran/config/fpu-glibc.h
@@ -85,3 +85,40 @@ 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_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 b32702b..160c4b5 100644
--- a/libgfortran/config/fpu-sysv.h
+++ b/libgfortran/config/fpu-sysv.h
@@ -80,3 +80,40 @@ 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_IMP
+ if (set_excepts & FP_X_IMP)
+ result |= GFC_FPE_INEXACT;
+#endif
+
+ return result;
+}
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index 7d97fed..ba14f1f 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 56c9871..cc759ac 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 underflow_warning;
}
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 a49514c..8246606 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.underflow_warning = 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.underflow_warning = 1;
}
/* Function called by the front-end to tell us the
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 4805412..00cd717 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -32,6 +32,37 @@ 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 = get_fpu_except_flags ();
+ if (!set_excepts)
+ return;
+
+ estr_write ("Note: The following floating-point status flag is signalling:");
+
+ if (set_excepts & GFC_FPE_INVALID)
+ estr_write (" IEEE INVALID FLAG");
+ if (set_excepts & GFC_FPE_ZERO)
+ estr_write (" IEEE_DIVIDE_BY_ZERO");
+ if (set_excepts & GFC_FPE_OVERFLOW)
+ estr_write (" IEEE_OVERFLOW_FLAG");
+ if (compile_options.underflow_warning && (set_excepts & GFC_FPE_UNDERFLOW))
+ estr_write (" IEEE_UNDERFLOW_FLAG");
+ /* if (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 +72,7 @@ export_proto(stop_numeric);
void
stop_numeric (GFC_INTEGER_4 code)
{
+ report_exception ();
if (code == -1)
code = 0;
else
@@ -59,6 +91,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 +102,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 +125,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 +143,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);
}
diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
index fb5026f..0d5d56c 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/configure b/libgfortran/configure
index 8601d84..c049cdc 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