Commit fa86f4f9 by Tobias Burnus Committed by Tobias Burnus

gfortran.h (gfc_option_t): Add fpe_summary.

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.

From-SVN: r200147
parent 7e55aae9
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-15 Mikael Morin <mikael@gcc.gnu.org> 2013-06-15 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/49074 PR fortran/49074
......
...@@ -2303,6 +2303,7 @@ typedef struct ...@@ -2303,6 +2303,7 @@ typedef struct
int flag_frontend_optimize; int flag_frontend_optimize;
int fpe; int fpe;
int fpe_summary;
int rtcheck; int rtcheck;
gfc_fcoarray coarray; gfc_fcoarray coarray;
......
...@@ -2846,7 +2846,7 @@ standard error. Default: @code{GFC_STD_F95_DEL | GFC_STD_LEGACY}. ...@@ -2846,7 +2846,7 @@ standard error. Default: @code{GFC_STD_F95_DEL | GFC_STD_LEGACY}.
Default: off. Default: off.
@item @var{option}[3] @tab Unused. @item @var{option}[3] @tab Unused.
@item @var{option}[4] @tab If non zero, enable backtracing on run-time @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 Note: Installs a signal handler and requires command-line
initialization using @code{_gfortran_set_args}. initialization using @code{_gfortran_set_args}.
@item @var{option}[5] @tab If non zero, supports signed zeros. @item @var{option}[5] @tab If non zero, supports signed zeros.
...@@ -2855,13 +2855,21 @@ Default: enabled. ...@@ -2855,13 +2855,21 @@ Default: enabled.
are (bitwise or-ed): GFC_RTCHECK_BOUNDS (1), GFC_RTCHECK_ARRAY_TEMPS (2), 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). GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO (16), GFC_RTCHECK_POINTER (32).
Default: disabled. 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 @end multitable
@item @emph{Example}: @item @emph{Example}:
@smallexample @smallexample
/* Use gfortran 4.8 default options. */ /* Use gfortran 4.9 default options. */
static int options[] = @{68, 511, 0, 0, 1, 1, 0@}; static int options[] = @{68, 511, 0, 0, 1, 1, 0, 0, 31@};
_gfortran_set_options (7, &options); _gfortran_set_options (9, &options);
@end smallexample @end smallexample
@end table @end table
......
...@@ -151,7 +151,7 @@ and warnings}. ...@@ -151,7 +151,7 @@ and warnings}.
@item Debugging Options @item Debugging Options
@xref{Debugging Options,,Options for debugging your program or GNU Fortran}. @xref{Debugging Options,,Options for debugging your program or GNU Fortran}.
@gccoptlist{-fbacktrace -fdump-fortran-optimized -fdump-fortran-original @gol @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 @item Directory Options
...@@ -1021,6 +1021,17 @@ be uninteresting in practice. ...@@ -1021,6 +1021,17 @@ be uninteresting in practice.
By default no exception traps are enabled. 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 @item -fno-backtrace
@opindex @code{fno-backtrace} @opindex @code{fno-backtrace}
@cindex backtrace @cindex backtrace
......
...@@ -441,6 +441,10 @@ ffpe-trap= ...@@ -441,6 +441,10 @@ ffpe-trap=
Fortran RejectNegative JoinedOrMissing Fortran RejectNegative JoinedOrMissing
-ffpe-trap=[...] Stop on following floating point exceptions -ffpe-trap=[...] Stop on following floating point exceptions
ffpe-summary=
Fortran RejectNegative JoinedOrMissing
-ffpe-summary=[...] Print summary of floating point exceptions
ffree-form ffree-form
Fortran RejectNegative Fortran RejectNegative
Assume that the source file is free form Assume that the source file is free form
......
...@@ -161,6 +161,10 @@ gfc_init_options (unsigned int decoded_options_count, ...@@ -161,6 +161,10 @@ gfc_init_options (unsigned int decoded_options_count,
gfc_option.flag_frontend_optimize = -1; gfc_option.flag_frontend_optimize = -1;
gfc_option.fpe = 0; 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.rtcheck = 0;
gfc_option.coarray = GFC_FCOARRAY_NONE; gfc_option.coarray = GFC_FCOARRAY_NONE;
...@@ -492,8 +496,10 @@ gfc_handle_module_path_options (const char *arg) ...@@ -492,8 +496,10 @@ gfc_handle_module_path_options (const char *arg)
} }
/* Handle options -ffpe-trap= and -ffpe-summary=. */
static void static void
gfc_handle_fpe_trap_option (const char *arg) gfc_handle_fpe_option (const char *arg, bool trap)
{ {
int result, pos = 0, n; int result, pos = 0, n;
/* precision is a backwards compatibility alias for inexact. */ /* precision is a backwards compatibility alias for inexact. */
...@@ -505,7 +511,11 @@ gfc_handle_fpe_trap_option (const char *arg) ...@@ -505,7 +511,11 @@ gfc_handle_fpe_trap_option (const char *arg)
GFC_FPE_UNDERFLOW, GFC_FPE_INEXACT, GFC_FPE_UNDERFLOW, GFC_FPE_INEXACT,
GFC_FPE_INEXACT, GFC_FPE_INEXACT,
0 }; 0 };
/* As the default for -ffpe-summary= is nonzero, set it to 0. */
if (!trap)
gfc_option.fpe_summary = 0;
while (*arg) while (*arg)
{ {
while (*arg == ',') while (*arg == ',')
...@@ -515,19 +525,42 @@ gfc_handle_fpe_trap_option (const char *arg) ...@@ -515,19 +525,42 @@ gfc_handle_fpe_trap_option (const char *arg)
pos++; pos++;
result = 0; 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) 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; arg += pos;
pos = 0; pos = 0;
result = 1; result = 1;
break; break;
} }
} }
if (!result) if (!result && !trap)
gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg); 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, ...@@ -981,7 +1014,11 @@ gfc_handle_option (size_t scode, const char *arg, int value,
break; break;
case OPT_ffpe_trap_: 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; break;
case OPT_std_f95: case OPT_std_f95:
......
...@@ -5203,14 +5203,15 @@ create_main_function (tree fndecl) ...@@ -5203,14 +5203,15 @@ create_main_function (tree fndecl)
/* TODO: This is the -frange-check option, which no longer affects /* TODO: This is the -frange-check option, which no longer affects
library behavior; when bumping the library ABI this slot can be library behavior; when bumping the library ABI this slot can be
reused for something else. As it is the last element in the 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, CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
build_int_cst (integer_type_node, build_int_cst (integer_type_node,
gfc_option.flag_range_check)); gfc_option.fpe_summary));
*/
array_type = build_array_type (integer_type_node, 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); array = build_constructor (array_type, v);
TREE_CONSTANT (array) = 1; TREE_CONSTANT (array) = 1;
TREE_STATIC (array) = 1; TREE_STATIC (array) = 1;
...@@ -5225,7 +5226,7 @@ create_main_function (tree fndecl) ...@@ -5225,7 +5226,7 @@ create_main_function (tree fndecl)
tmp = build_call_expr_loc (input_location, tmp = build_call_expr_loc (input_location,
gfor_fndecl_set_options, 2, 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); gfc_add_expr_to_block (&body, tmp);
} }
......
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> 2013-06-01 Tobias Burnus <burnus@net-b.de>
PR fortran/57496 PR fortran/57496
......
...@@ -399,6 +399,9 @@ ...@@ -399,6 +399,9 @@
/* Define to 1 if you have the <fptrap.h> header file. */ /* Define to 1 if you have the <fptrap.h> header file. */
#undef HAVE_FPTRAP_H #undef HAVE_FPTRAP_H
/* Define to 1 if you have the <fpxcp.h> header file. */
#undef HAVE_FPXCP_H
/* fp_enable is present */ /* fp_enable is present */
#undef HAVE_FP_ENABLE #undef HAVE_FP_ENABLE
......
...@@ -134,3 +134,40 @@ void set_fpu (void) ...@@ -134,3 +134,40 @@ void set_fpu (void)
asm volatile ("%vldmxcsr %0" : : "m" (cw_sse)); 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;
}
...@@ -29,6 +29,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ...@@ -29,6 +29,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <fptrap.h> #include <fptrap.h>
#endif #endif
#ifdef HAVE_FPXCP_H
#include <fpxcp.h>
#endif
void void
set_fpu (void) set_fpu (void)
{ {
...@@ -81,3 +85,34 @@ set_fpu (void) ...@@ -81,3 +85,34 @@ set_fpu (void)
fp_trap(FP_TRAP_SYNC); fp_trap(FP_TRAP_SYNC);
fp_enable(mode); 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;
}
...@@ -50,3 +50,9 @@ set_fpu (void) ...@@ -50,3 +50,9 @@ set_fpu (void)
estr_write ("Fortran runtime warning: IEEE 'inexact' " estr_write ("Fortran runtime warning: IEEE 'inexact' "
"exception not supported.\n"); "exception not supported.\n");
} }
int
get_fpu_except_flags (void)
{
return 0;
}
...@@ -85,3 +85,45 @@ void set_fpu (void) ...@@ -85,3 +85,45 @@ void set_fpu (void)
"exception not supported.\n"); "exception not supported.\n");
#endif #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;
}
...@@ -80,3 +80,45 @@ set_fpu (void) ...@@ -80,3 +80,45 @@ set_fpu (void)
fpsetmask(cw); 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;
}
...@@ -654,7 +654,6 @@ CPP ...@@ -654,7 +654,6 @@ CPP
am__fastdepCC_FALSE am__fastdepCC_FALSE
am__fastdepCC_TRUE am__fastdepCC_TRUE
CCDEPMODE CCDEPMODE
am__nodep
AMDEPBACKSLASH AMDEPBACKSLASH
AMDEP_FALSE AMDEP_FALSE
AMDEP_TRUE AMDEP_TRUE
...@@ -2543,6 +2542,7 @@ as_fn_append ac_header_list " floatingpoint.h" ...@@ -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 " ieeefp.h"
as_fn_append ac_header_list " fenv.h" as_fn_append ac_header_list " fenv.h"
as_fn_append ac_header_list " fptrap.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 " pwd.h"
as_fn_append ac_header_list " complex.h" as_fn_append ac_header_list " complex.h"
as_fn_append ac_func_list " getrusage" as_fn_append ac_func_list " getrusage"
...@@ -3386,11 +3386,11 @@ MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} ...@@ -3386,11 +3386,11 @@ MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"}
# We need awk for the "check" target. The system "awk" is bad on # We need awk for the "check" target. The system "awk" is bad on
# some platforms. # some platforms.
# Always define AMTAR for backward compatibility. Yes, it's still used # Always define AMTAR for backward compatibility.
# in the wild :-( We should find a proper way to deprecate it ...
AMTAR='$${TAR-tar}'
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 ...@@ -3523,7 +3523,6 @@ fi
if test "x$enable_dependency_tracking" != xno; then if test "x$enable_dependency_tracking" != xno; then
am_depcomp="$ac_aux_dir/depcomp" am_depcomp="$ac_aux_dir/depcomp"
AMDEPBACKSLASH='\' AMDEPBACKSLASH='\'
am__nodep='_no'
fi fi
if test "x$enable_dependency_tracking" != xno; then if test "x$enable_dependency_tracking" != xno; then
AMDEP_TRUE= AMDEP_TRUE=
...@@ -4341,7 +4340,6 @@ else ...@@ -4341,7 +4340,6 @@ else
# instance it was reported that on HP-UX the gcc test will end up # 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 # making a dummy file named `D' -- because `-MD' means `put the output
# in D'. # in D'.
rm -rf conftest.dir
mkdir conftest.dir mkdir conftest.dir
# Copy depcomp to subdir because otherwise we won't find it if we're # Copy depcomp to subdir because otherwise we won't find it if we're
# using a relative directory. # using a relative directory.
...@@ -4401,7 +4399,7 @@ else ...@@ -4401,7 +4399,7 @@ else
break break
fi fi
;; ;;
msvc7 | msvc7msys | msvisualcpp | msvcmsys) msvisualcpp | msvcmsys)
# This compiler won't grok `-c -o', but also, the minuso test has # 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 # not run yet. These depmodes are late enough in the game, and
# so weak that their functioning should not be impacted. # so weak that their functioning should not be impacted.
...@@ -5517,7 +5515,6 @@ else ...@@ -5517,7 +5515,6 @@ else
# instance it was reported that on HP-UX the gcc test will end up # 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 # making a dummy file named `D' -- because `-MD' means `put the output
# in D'. # in D'.
rm -rf conftest.dir
mkdir conftest.dir mkdir conftest.dir
# Copy depcomp to subdir because otherwise we won't find it if we're # Copy depcomp to subdir because otherwise we won't find it if we're
# using a relative directory. # using a relative directory.
...@@ -5577,7 +5574,7 @@ else ...@@ -5577,7 +5574,7 @@ else
break break
fi fi
;; ;;
msvc7 | msvc7msys | msvisualcpp | msvcmsys) msvisualcpp | msvcmsys)
# This compiler won't grok `-c -o', but also, the minuso test has # 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 # not run yet. These depmodes are late enough in the game, and
# so weak that their functioning should not be impacted. # so weak that their functioning should not be impacted.
...@@ -12334,7 +12331,7 @@ else ...@@ -12334,7 +12331,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF cat > conftest.$ac_ext <<_LT_EOF
#line 12337 "configure" #line 12334 "configure"
#include "confdefs.h" #include "confdefs.h"
#if HAVE_DLFCN_H #if HAVE_DLFCN_H
...@@ -12440,7 +12437,7 @@ else ...@@ -12440,7 +12437,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF cat > conftest.$ac_ext <<_LT_EOF
#line 12443 "configure" #line 12440 "configure"
#include "confdefs.h" #include "confdefs.h"
#if HAVE_DLFCN_H #if HAVE_DLFCN_H
...@@ -16001,6 +15998,8 @@ done ...@@ -16001,6 +15998,8 @@ done
inttype_headers=`echo inttypes.h sys/inttypes.h | sed -e 's/,/ /g'` inttype_headers=`echo inttypes.h sys/inttypes.h | sed -e 's/,/ /g'`
acx_cv_header_stdint=stddef.h acx_cv_header_stdint=stddef.h
......
...@@ -254,7 +254,7 @@ AC_CHECK_TYPES([ptrdiff_t]) ...@@ -254,7 +254,7 @@ AC_CHECK_TYPES([ptrdiff_t])
# check header files (we assume C89 is available, so don't check for that) # 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 \ 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 \ 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) GCC_HEADER_STDINT(gstdint.h)
......
...@@ -534,6 +534,7 @@ typedef struct ...@@ -534,6 +534,7 @@ typedef struct
size_t record_marker; size_t record_marker;
int max_subrecord_length; int max_subrecord_length;
int bounds_check; int bounds_check;
int fpe_summary;
} }
compile_options_t; compile_options_t;
...@@ -742,6 +743,8 @@ internal_proto(gf_strerror); ...@@ -742,6 +743,8 @@ internal_proto(gf_strerror);
extern void set_fpu (void); extern void set_fpu (void);
internal_proto(set_fpu); internal_proto(set_fpu);
extern int get_fpu_except_flags (void);
internal_proto(get_fpu_except_flags);
/* memory.c */ /* memory.c */
......
...@@ -173,6 +173,8 @@ set_options (int num, int options[]) ...@@ -173,6 +173,8 @@ set_options (int num, int options[])
the library behavior; range checking is now always done when the library behavior; range checking is now always done when
parsing integers. It's place in the options array is retained due parsing integers. It's place in the options array is retained due
to ABI compatibility. Remove when bumping the library ABI. */ 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 /* If backtrace is required, we set signal handlers on the POSIX
2001 signals with core action. */ 2001 signals with core action. */
...@@ -225,6 +227,7 @@ init_compile_options (void) ...@@ -225,6 +227,7 @@ init_compile_options (void)
compile_options.pedantic = 0; compile_options.pedantic = 0;
compile_options.backtrace = 0; compile_options.backtrace = 0;
compile_options.sign_zero = 1; compile_options.sign_zero = 1;
compile_options.fpe_summary = 0;
} }
/* Function called by the front-end to tell us the /* Function called by the front-end to tell us the
......
...@@ -32,6 +32,55 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ...@@ -32,6 +32,55 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#endif #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. */ /* A numeric STOP statement. */
extern void stop_numeric (GFC_INTEGER_4) extern void stop_numeric (GFC_INTEGER_4)
...@@ -41,6 +90,7 @@ export_proto(stop_numeric); ...@@ -41,6 +90,7 @@ export_proto(stop_numeric);
void void
stop_numeric (GFC_INTEGER_4 code) stop_numeric (GFC_INTEGER_4 code)
{ {
report_exception ();
if (code == -1) if (code == -1)
code = 0; code = 0;
else else
...@@ -59,6 +109,7 @@ export_proto(stop_numeric_f08); ...@@ -59,6 +109,7 @@ export_proto(stop_numeric_f08);
void void
stop_numeric_f08 (GFC_INTEGER_4 code) stop_numeric_f08 (GFC_INTEGER_4 code)
{ {
report_exception ();
st_printf ("STOP %d\n", (int)code); st_printf ("STOP %d\n", (int)code);
exit (code); exit (code);
} }
...@@ -69,6 +120,7 @@ stop_numeric_f08 (GFC_INTEGER_4 code) ...@@ -69,6 +120,7 @@ stop_numeric_f08 (GFC_INTEGER_4 code)
void void
stop_string (const char *string, GFC_INTEGER_4 len) stop_string (const char *string, GFC_INTEGER_4 len)
{ {
report_exception ();
if (string) if (string)
{ {
estr_write ("STOP "); estr_write ("STOP ");
...@@ -91,6 +143,7 @@ export_proto(error_stop_string); ...@@ -91,6 +143,7 @@ export_proto(error_stop_string);
void void
error_stop_string (const char *string, GFC_INTEGER_4 len) error_stop_string (const char *string, GFC_INTEGER_4 len)
{ {
report_exception ();
estr_write ("ERROR STOP "); estr_write ("ERROR STOP ");
(void) write (STDERR_FILENO, string, len); (void) write (STDERR_FILENO, string, len);
estr_write ("\n"); estr_write ("\n");
...@@ -108,6 +161,7 @@ export_proto(error_stop_numeric); ...@@ -108,6 +161,7 @@ export_proto(error_stop_numeric);
void void
error_stop_numeric (GFC_INTEGER_4 code) error_stop_numeric (GFC_INTEGER_4 code)
{ {
report_exception ();
st_printf ("ERROR STOP %d\n", (int) code); st_printf ("ERROR STOP %d\n", (int) code);
exit (code); exit (code);
} }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment