From 553e7cefa6034f54ee588e22cd96e64e343d500a Mon Sep 17 00:00:00 2001 From: burnus Date: Mon, 17 Jun 2013 07:48:21 +0000 Subject: [PATCH] 2013-06-17 Tobias Burnus * 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 * 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 --- gcc/fortran/ChangeLog | 12 ++++++++ gcc/fortran/gfortran.h | 1 + gcc/fortran/gfortran.texi | 16 ++++++++--- gcc/fortran/invoke.texi | 13 ++++++++- gcc/fortran/lang.opt | 4 +++ gcc/fortran/options.c | 51 ++++++++++++++++++++++++++++----- gcc/fortran/trans-decl.c | 11 +++---- libgfortran/ChangeLog | 18 ++++++++++++ libgfortran/config.h.in | 3 ++ libgfortran/config/fpu-387.h | 37 ++++++++++++++++++++++++ libgfortran/config/fpu-aix.h | 35 +++++++++++++++++++++++ libgfortran/config/fpu-generic.h | 6 ++++ libgfortran/config/fpu-glibc.h | 42 +++++++++++++++++++++++++++ libgfortran/config/fpu-sysv.h | 42 +++++++++++++++++++++++++++ libgfortran/configure | 23 +++++++-------- libgfortran/configure.ac | 2 +- libgfortran/libgfortran.h | 3 ++ libgfortran/runtime/compile_options.c | 3 ++ libgfortran/runtime/stop.c | 54 +++++++++++++++++++++++++++++++++++ 19 files changed, 346 insertions(+), 30 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b003bac..686a8e9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2013-06-17 Tobias Burnus + + * 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-15 Mikael Morin PR fortran/49074 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 14da0af..c11ffdd 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2303,6 +2303,7 @@ typedef struct int flag_frontend_optimize; int fpe; + int fpe_summary; int rtcheck; gfc_fcoarray coarray; diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 4a31a77..ad8cacc 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -2846,7 +2846,7 @@ standard error. Default: @code{GFC_STD_F95_DEL | GFC_STD_LEGACY}. Default: off. @item @var{option}[3] @tab Unused. @item @var{option}[4] @tab If non zero, enable backtracing on run-time -errors. Default: off. +errors. Default: off. (Default in the compiler: on.) Note: Installs a signal handler and requires command-line initialization using @code{_gfortran_set_args}. @item @var{option}[5] @tab If non zero, supports signed zeros. @@ -2855,13 +2855,21 @@ 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 exception occurred. Possible values +are (bitwise or-ed) @code{GFC_FPE_INVALID} (1), @code{GFC_FPE_DENORMAL} (2), +@code{GFC_FPE_ZERO} (4), @code{GFC_FPE_OVERFLOW} (8), +@code{GFC_FPE_UNDERFLOW} (16), @code{GFC_FPE_INEXACT} (32). Default: None (0). +(Default in the compiler: @code{GFC_FPE_INVALID | GFC_FPE_DENORMAL | +GFC_FPE_ZERO | GFC_FPE_OVERFLOW | GFC_FPE_UNDERFLOW}.) @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, 31@}; + _gfortran_set_options (9, &options); @end smallexample @end table diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 12c200e..3af57a3 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -151,7 +151,7 @@ and warnings}. @item Debugging Options @xref{Debugging Options,,Options for debugging your program or GNU Fortran}. @gccoptlist{-fbacktrace -fdump-fortran-optimized -fdump-fortran-original @gol --fdump-parse-tree -ffpe-trap=@var{list} +-fdump-parse-tree -ffpe-trap=@var{list} -ffpe-summary=@var{list} } @item Directory Options @@ -1021,6 +1021,17 @@ be uninteresting in practice. By default no exception traps are enabled. +@item -ffpe-summary=@var{list} +@opindex @code{ffpe-summary=}@var{list} +Specify a list of floating-point exceptions, whose flag status is printed +to @code{ERROR_UNIT} when invoking @code{STOP} and @code{ERROR STOP}. +@var{list} can be either @samp{none}, @samp{all} or a comma-separated list +of the following exceptions: @samp{invalid}, @samp{zero}, @samp{overflow}, +@samp{underflow}, @samp{inexact} and @samp{denormal}. (See +@option{-ffpe-trap} for a description of the exceptions.) + +By default, a summary for all exceptions but @samp{inexact} is shown. + @item -fno-backtrace @opindex @code{fno-backtrace} @cindex backtrace diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index dbc3f6b..61f77b4 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -441,6 +441,10 @@ ffpe-trap= Fortran RejectNegative JoinedOrMissing -ffpe-trap=[...] Stop on following floating point exceptions +ffpe-summary= +Fortran RejectNegative JoinedOrMissing +-ffpe-summary=[...] Print summary of floating point exceptions + ffree-form Fortran RejectNegative Assume that the source file is free form diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 3f5de03..908b47e 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -161,6 +161,10 @@ gfc_init_options (unsigned int decoded_options_count, gfc_option.flag_frontend_optimize = -1; gfc_option.fpe = 0; + /* All except GFC_FPE_INEXACT. */ + gfc_option.fpe_summary = GFC_FPE_INVALID | GFC_FPE_DENORMAL + | GFC_FPE_ZERO | GFC_FPE_OVERFLOW + | GFC_FPE_UNDERFLOW; gfc_option.rtcheck = 0; gfc_option.coarray = GFC_FCOARRAY_NONE; @@ -492,8 +496,10 @@ gfc_handle_module_path_options (const char *arg) } +/* Handle options -ffpe-trap= and -ffpe-summary=. */ + static void -gfc_handle_fpe_trap_option (const char *arg) +gfc_handle_fpe_option (const char *arg, bool trap) { int result, pos = 0, n; /* precision is a backwards compatibility alias for inexact. */ @@ -505,7 +511,11 @@ gfc_handle_fpe_trap_option (const char *arg) GFC_FPE_UNDERFLOW, GFC_FPE_INEXACT, GFC_FPE_INEXACT, 0 }; - + + /* As the default for -ffpe-summary= is nonzero, set it to 0. */ + if (!trap) + gfc_option.fpe_summary = 0; + while (*arg) { while (*arg == ',') @@ -515,19 +525,42 @@ gfc_handle_fpe_trap_option (const char *arg) pos++; result = 0; - for (n = 0; exception[n] != NULL; n++) + if (!trap && strncmp ("none", arg, pos) == 0) { + gfc_option.fpe_summary = 0; + arg += pos; + pos = 0; + continue; + } + else if (!trap && strncmp ("all", arg, pos) == 0) + { + gfc_option.fpe_summary = GFC_FPE_INVALID | GFC_FPE_DENORMAL + | GFC_FPE_ZERO | GFC_FPE_OVERFLOW + | GFC_FPE_UNDERFLOW | GFC_FPE_INEXACT; + arg += pos; + pos = 0; + continue; + } + else + for (n = 0; exception[n] != NULL; n++) + { if (exception[n] && strncmp (exception[n], arg, pos) == 0) { - gfc_option.fpe |= opt_exception[n]; + if (trap) + gfc_option.fpe |= opt_exception[n]; + else + gfc_option.fpe_summary |= opt_exception[n]; arg += pos; pos = 0; result = 1; break; } - } - if (!result) + } + if (!result && !trap) gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg); + else if (!result) + gfc_fatal_error ("Argument to -ffpe-summary is not valid: %s", arg); + } } @@ -981,7 +1014,11 @@ gfc_handle_option (size_t scode, const char *arg, int value, break; case OPT_ffpe_trap_: - gfc_handle_fpe_trap_option (arg); + gfc_handle_fpe_option (arg, true); + break; + + case OPT_ffpe_summary_: + gfc_handle_fpe_option (arg, false); break; case OPT_std_f95: diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index f04ebdc..4e3bf48 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -5203,14 +5203,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.fpe_summary)); 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; @@ -5225,7 +5226,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/ChangeLog b/libgfortran/ChangeLog index 38a5319..de5cfdd 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,21 @@ +2013-06-17 Tobias Burnus + + * 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 PR fortran/57496 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 header file. */ #undef HAVE_FPTRAP_H +/* Define to 1 if you have the 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 913eb60..608354d 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 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 #endif +#ifdef HAVE_FPXCP_H +#include +#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..e0d1019 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 b32702b..8fc52d5 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 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 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..f22da21 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 a49514c..1416d66 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 4805412..1091245 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); } -- 2.7.4