From 8c84a5de8ea015ec2e463b480ec81f03671b1e43 Mon Sep 17 00:00:00 2001
From: fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Wed, 12 Oct 2005 20:21:31 +0000
Subject: [PATCH] * gfortran.h: Add bitmasks for different FPE traps.
Add fpe member to options_t. * invoke.texi: Document the new
-ffpe-trap option. * lang.opt: Add -ffpe-trap option. * options.c
(gfc_init_options): Initialize the FPE option.
(gfc_handle_fpe_trap_option): New function to parse the argument of the
-ffpe-trap option. (gfc_handle_option): Add case for -ffpe-trap. *
trans-decl.c: Declare a tree for the set_fpe library function.
(gfc_build_builtin_function_decls): Build this tree.
(gfc_generate_function_code): Generate a call to set_fpe at the beginning
of the main program. * trans.h: New tree for the set_fpe library function.
* Makefile.am: Add fpu.c to the build process, and
target-dependent code as fpu-target.h.
* Makefile.in: Regenerate.
* configure.ac: Add call to configure.host to set
FPU_HOST_HEADER.
* configure: Regenerate.
* config.h.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.host: New script to determine which host-dependent
code should go in.
* libgfortran.h: Add fpe option, remove previous fpu_ options.
Add bitmasks for different FPE traps. Add prototype for set_fpu.
* runtime/environ.c: Remove environment variables to control
fpu behaviour.
* runtime/fpu.c (set_fpe): New function for the front-end.
* runtime/main.c (init): Set FPU state.
* config: New directory to store host-dependent code.
* config/fpu-387.h: New file with code handling the i387 FPU.
* config/fpu-glibc.h: New file with code for glibc systems.
* config/fpu-generic.h: Fallback for the most generic host. Issue
warnings.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@105328 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/fortran/ChangeLog | 18 +++++-
gcc/fortran/gfortran.h | 11 ++++
gcc/fortran/invoke.texi | 18 +++++-
gcc/fortran/lang.opt | 4 ++
gcc/fortran/options.c | 41 ++++++++++++
gcc/fortran/trans-decl.c | 21 +++++++
gcc/fortran/trans.h | 1 +
libgfortran/ChangeLog | 22 +++++++
libgfortran/Makefile.am | 8 ++-
libgfortran/Makefile.in | 13 +++-
libgfortran/config.h.in | 6 ++
libgfortran/config/fpu-387.h | 103 +++++++++++++++++++++++++++++++
libgfortran/config/fpu-generic.h | 57 +++++++++++++++++
libgfortran/config/fpu-glibc.h | 93 ++++++++++++++++++++++++++++
libgfortran/configure | 94 +++++++++++++++++++++++++++-
libgfortran/configure.ac | 13 +++-
libgfortran/configure.host | 32 ++++++++++
libgfortran/libgfortran.h | 16 ++++-
libgfortran/runtime/environ.c | 24 -------
libgfortran/runtime/fpu.c | 16 +++++
libgfortran/runtime/main.c | 1 +
21 files changed, 575 insertions(+), 37 deletions(-)
create mode 100644 libgfortran/config/fpu-387.h
create mode 100644 libgfortran/config/fpu-generic.h
create mode 100644 libgfortran/config/fpu-glibc.h
create mode 100644 libgfortran/configure.host
create mode 100644 libgfortran/runtime/fpu.c
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a02586f1758a..91acbf2e5a95 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2005-10-12 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ * gfortran.h: Add bitmasks for different FPE traps. Add fpe
+ member to options_t.
+ * invoke.texi: Document the new -ffpe-trap option.
+ * lang.opt: Add -ffpe-trap option.
+ * options.c (gfc_init_options): Initialize the FPE option.
+ (gfc_handle_fpe_trap_option): New function to parse the argument
+ of the -ffpe-trap option.
+ (gfc_handle_option): Add case for -ffpe-trap.
+ * trans-decl.c: Declare a tree for the set_fpe library function.
+ (gfc_build_builtin_function_decls): Build this tree.
+ (gfc_generate_function_code): Generate a call to set_fpe at
+ the beginning of the main program.
+ * trans.h: New tree for the set_fpe library function.
+
2005-10-12 Paul Thomas <pault@gcc.gnu.org>
PR fortran/20847
@@ -34,7 +50,7 @@
2005-10-07 Erik Edelmann <erik.edelmann@iki.fi>
- PR 18568
+ PR 18568
* resolve.c (find_array_spec): Search through the list of
components in the symbol of the type instead of the symbol of the
variable.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 1923826d7bd3..63b4b931c3c5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -103,6 +103,15 @@ mstring;
#define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */
#define GFC_STD_F77 (1<<0) /* Up to and including F77. */
+/* Bitmasks for the various FPE that can be enabled. */
+#define GFC_FPE_INVALID (1<<0)
+#define GFC_FPE_DENORMAL (1<<1)
+#define GFC_FPE_ZERO (1<<2)
+#define GFC_FPE_OVERFLOW (1<<3)
+#define GFC_FPE_UNDERFLOW (1<<4)
+#define GFC_FPE_PRECISION (1<<5)
+
+
/*************************** Enums *****************************/
/* The author remains confused to this day about the convention of
@@ -1453,6 +1462,8 @@ typedef struct
int q_kind;
+ int fpe;
+
int warn_std;
int allow_std;
int warn_nonstd_intrinsics;
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 847ab29f7010..88e8eefe9696 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -133,7 +133,7 @@ by type. Explanations are in the following sections.
@item Debugging Options
@xref{Debugging Options,,Options for Debugging Your Program or GCC}.
@gccoptlist{
--fdump-parse-tree}
+-fdump-parse-tree -ffpe-trap=@var{list}}
@item Directory Options
@xref{Directory Options,,Options for Directory Search}.
@@ -464,6 +464,22 @@ Output the internal parse tree before starting code generation. Only
really useful for debugging gfortran itself.
@end table
+@table @gcctabopt
+@cindex -ffpe-trap=@var{list} option
+@cindex option, -ffpe-trap=@var{list}
+@item -ffpe-trap=@var{list}
+Specify a list of IEEE exceptions when a Floating Point Exception
+(FPE) should be raised. On most systems, this will result in a SIGFPE
+signal being sent and the program being interrupted, producing a core
+file useful for debugging. @var{list} is a (possibly empty) comma-separated
+list of the following IEEE exceptions: @samp{invalid} (invalid floating
+point operation, such as @code{sqrt(-1.0)}), @samp{zero} (division by
+zero), @samp{overflow} (overflow in a floating point operation),
+@samp{underflow} (underflow in a floating point operation),
+@samp{precision} (loss of precision during operation) and @samp{denormal}
+(operation produced a denormal denormal value).
+@end table
+
@xref{Debugging Options,,Options for Debugging Your Program or GCC,
gcc,Using the GNU Compiler Collection (GCC)}, for more information on
debugging options.
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index ee0d61fe506c..053cc3dbf70c 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -165,6 +165,10 @@ qkind=
Fortran RejectNegative Joined UInteger
-qkind=<n> Set the kind for a real with the 'q' exponent to 'n'
+ffpe-trap=
+Fortran RejectNegative JoinedOrMissing
+-ffpe-trap=[..] Stop on following floating point exceptions
+
std=f95
Fortran
Conform to the ISO Fortran 95 standard
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 48df6746d2d8..95720bf51057 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -76,6 +76,8 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
gfc_option.q_kind = gfc_default_double_kind;
+ gfc_option.fpe = 0;
+
flag_argument_noalias = 2;
flag_errno_math = 0;
@@ -278,6 +280,41 @@ gfc_handle_module_path_options (const char *arg)
strcat (gfc_option.module_dir, "/");
}
+static void
+gfc_handle_fpe_trap_option (const char *arg)
+{
+ int result, pos = 0, n;
+ static const char * const exception[] = { "invalid", "denormal", "zero",
+ "overflow", "underflow",
+ "precision", NULL };
+ static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL,
+ GFC_FPE_ZERO, GFC_FPE_OVERFLOW,
+ GFC_FPE_UNDERFLOW, GFC_FPE_PRECISION,
+ 0 };
+
+ while (*arg)
+ {
+ while (*arg == ',')
+ arg++;
+ while (arg[pos] && arg[pos] != ',')
+ pos++;
+ result = 0;
+ for (n = 0; exception[n] != NULL; n++)
+ {
+ if (exception[n] && strncmp (exception[n], arg, pos) == 0)
+ {
+ gfc_option.fpe |= opt_exception[n];
+ arg += pos;
+ pos = 0;
+ result = 1;
+ break;
+ }
+ }
+ if (! result)
+ gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg);
+ }
+}
+
/* Handle command-line options. Returns 0 if unrecognized, 1 if
recognized and handled. */
int
@@ -440,6 +477,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
gfc_handle_module_path_options (arg);
break;
+ case OPT_ffpe_trap_:
+ gfc_handle_fpe_trap_option (arg);
+ break;
+
case OPT_std_f95:
gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77;
gfc_option.warn_std = GFC_STD_F95_OBS;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 3f656ddc01fc..70e8e82856a9 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -85,6 +85,7 @@ tree gfor_fndecl_stop_numeric;
tree gfor_fndecl_stop_string;
tree gfor_fndecl_select_string;
tree gfor_fndecl_runtime_error;
+tree gfor_fndecl_set_fpe;
tree gfor_fndecl_set_std;
tree gfor_fndecl_in_pack;
tree gfor_fndecl_in_unpack;
@@ -1934,6 +1935,7 @@ gfc_build_intrinsic_function_decls (void)
void
gfc_build_builtin_function_decls (void)
{
+ tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
tree gfc_int4_type_node = gfc_get_int_type (4);
tree gfc_int8_type_node = gfc_get_int_type (8);
tree gfc_logical4_type_node = gfc_get_logical_type (4);
@@ -2018,6 +2020,10 @@ gfc_build_builtin_function_decls (void)
/* The runtime_error function does not return. */
TREE_THIS_VOLATILE (gfor_fndecl_runtime_error) = 1;
+ gfor_fndecl_set_fpe =
+ gfc_build_library_function_decl (get_identifier (PREFIX("set_fpe")),
+ void_type_node, 1, gfc_c_int_type_node);
+
gfor_fndecl_set_std =
gfc_build_library_function_decl (get_identifier (PREFIX("set_std")),
void_type_node,
@@ -2455,6 +2461,21 @@ gfc_generate_function_code (gfc_namespace * ns)
gfc_add_expr_to_block (&body, tmp);
}
+ /* If this is the main program and a -ffpe-trap option was provided,
+ add a call to set_fpe so that the library will raise a FPE when
+ needed. */
+ if (sym->attr.is_main_program && gfc_option.fpe != 0)
+ {
+ tree arglist, gfc_c_int_type_node;
+
+ gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
+ arglist = gfc_chainon_list (NULL_TREE,
+ build_int_cst (gfc_c_int_type_node,
+ gfc_option.fpe));
+ tmp = gfc_build_function_call (gfor_fndecl_set_fpe, arglist);
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
&& sym->attr.subroutine)
{
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e64640cfd0c4..16d0a37ed3fa 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -455,6 +455,7 @@ extern GTY(()) tree gfor_fndecl_stop_numeric;
extern GTY(()) tree gfor_fndecl_stop_string;
extern GTY(()) tree gfor_fndecl_select_string;
extern GTY(()) tree gfor_fndecl_runtime_error;
+extern GTY(()) tree gfor_fndecl_set_fpe;
extern GTY(()) tree gfor_fndecl_set_std;
extern GTY(()) tree gfor_fndecl_in_pack;
extern GTY(()) tree gfor_fndecl_in_unpack;
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 34072892ff3c..9433fda08b94 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,25 @@
+2005-10-12 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ * Makefile.am: Add fpu.c to the build process, and
+ target-dependent code as fpu-target.h.
+ * Makefile.in: Regenerate.
+ * configure.ac: Add call to configure.host to set
+ FPU_HOST_HEADER.
+ * configure: Regenerate.
+ * configure.host: New script to determine which host-dependent
+ code should go in.
+ * libgfortran.h: Add fpe option, remove previous fpu_ options.
+ Add bitmasks for different FPE traps. Add prototype for set_fpu.
+ * runtime/environ.c: Remove environment variables to control
+ fpu behaviour.
+ * runtime/fpu.c (set_fpe): New function for the front-end.
+ * runtime/main.c (init): Set FPU state.
+ * config: New directory to store host-dependent code.
+ * config/fpu-387.h: New file with code handling the i387 FPU.
+ * config/fpu-glibc.h: New file with code for glibc systems.
+ * config/fpu-generic.h: Fallback for the most generic host. Issue
+ warnings.
+
2005-10-12 Janne Blomqvist <jblomqvi@cc.hut.fi>
* io/unix.c: Remove parts of patch of 2005/10/07 that cause
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index cac343b1da63..f5a1869baa36 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -18,8 +18,6 @@ libgfortranbegin_la_LDFLAGS = -static
## use -iquote
AM_CPPFLAGS = -iquote$(srcdir)/io
-libgfortranincludedir = $(includedir)/gforio
-
gfor_io_src= \
io/close.c \
io/file_pos.c \
@@ -97,6 +95,7 @@ gfor_src= \
runtime/compile_options.c \
runtime/environ.c \
runtime/error.c \
+runtime/fpu.c \
runtime/main.c \
runtime/memory.c \
runtime/pause.c \
@@ -433,7 +432,7 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
$(i_pow_c) \
selected_int_kind.inc selected_real_kind.inc kinds.h \
- kinds.inc c99_protos.inc
+ kinds.inc c99_protos.inc fpu-target.h
# Machine generated specifics
gfor_built_specific_src= \
@@ -592,6 +591,9 @@ selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh
$(SHELL) $(srcdir)/mk-srk-inc.sh '$(FCCOMPILE)' > $@
+fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
+ cp $(srcdir)/$(FPU_HOST_HEADER) $@
+
## A 'normal' build shouldn't need to regenerate these
## so we only include them in maintainer mode
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index c4d3be6ef113..5ed436f41aef 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -66,7 +66,7 @@ am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
toolexeclibLTLIBRARIES_INSTALL = $(INSTALL)
LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
libgfortran_la_LIBADD =
-am__objects_1 = compile_options.lo environ.lo error.lo main.lo \
+am__objects_1 = compile_options.lo environ.lo error.lo fpu.lo main.lo \
memory.lo pause.lo stop.lo string.lo select.lo
am__objects_2 = all_l4.lo all_l8.lo all_l16.lo
am__objects_3 = any_l4.lo any_l8.lo any_l16.lo
@@ -276,6 +276,7 @@ EGREP = @EGREP@
EXEEXT = @EXEEXT@
FC = @FC@
FCFLAGS = @FCFLAGS@
+FPU_HOST_HEADER = @FPU_HOST_HEADER@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
@@ -357,7 +358,6 @@ libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version`
libgfortranbegin_la_SOURCES = fmain.c
libgfortranbegin_la_LDFLAGS = -static
AM_CPPFLAGS = -iquote$(srcdir)/io
-libgfortranincludedir = $(includedir)/gforio
gfor_io_src = \
io/close.c \
io/file_pos.c \
@@ -435,6 +435,7 @@ gfor_src = \
runtime/compile_options.c \
runtime/environ.c \
runtime/error.c \
+runtime/fpu.c \
runtime/main.c \
runtime/memory.c \
runtime/pause.c \
@@ -771,7 +772,7 @@ gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
$(i_pow_c) \
selected_int_kind.inc selected_real_kind.inc kinds.h \
- kinds.inc c99_protos.inc
+ kinds.inc c99_protos.inc fpu-target.h
# Machine generated specifics
@@ -1394,6 +1395,9 @@ environ.lo: runtime/environ.c
error.lo: runtime/error.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o error.lo `test -f 'runtime/error.c' || echo '$(srcdir)/'`runtime/error.c
+fpu.lo: runtime/fpu.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fpu.lo `test -f 'runtime/fpu.c' || echo '$(srcdir)/'`runtime/fpu.c
+
main.lo: runtime/main.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o main.lo `test -f 'runtime/main.c' || echo '$(srcdir)/'`runtime/main.c
@@ -2699,6 +2703,9 @@ selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh
$(SHELL) $(srcdir)/mk-srk-inc.sh '$(FCCOMPILE)' > $@
+fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
+ cp $(srcdir)/$(FPU_HOST_HEADER) $@
+
@MAINTAINER_MODE_TRUE@$(i_all_c): m4/all.m4 $(I_M4_DEPS1)
@MAINTAINER_MODE_TRUE@ m4 -Dfile=$@ -I$(srcdir)/m4 all.m4 > $(srcdir)/$@
diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
index 44c45c7767bc..669bc1531665 100644
--- a/libgfortran/config.h.in
+++ b/libgfortran/config.h.in
@@ -285,6 +285,12 @@
/* libm includes fabsl */
#undef HAVE_FABSL
+/* libm includes feenableexcept */
+#undef HAVE_FEENABLEEXCEPT
+
+/* Define to 1 if you have the <fenv.h> header file. */
+#undef HAVE_FENV_H
+
/* libm includes finite */
#undef HAVE_FINITE
diff --git a/libgfortran/config/fpu-387.h b/libgfortran/config/fpu-387.h
new file mode 100644
index 000000000000..06c02eaf8538
--- /dev/null
+++ b/libgfortran/config/fpu-387.h
@@ -0,0 +1,103 @@
+/* FPU-related code for x86 and x86_64 processors.
+ Copyright 2005 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 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+
+static int
+has_sse (void)
+{
+#ifdef __x86_64__
+ return 1;
+#else
+ unsigned int eax, ebx, ecx, edx;
+
+ /* See if we can use cpuid. */
+ asm volatile ("pushfl; pushfl; popl %0; movl %0,%1; xorl %2,%0;"
+ "pushl %0; popfl; pushfl; popl %0; popfl"
+ : "=&r" (eax), "=&r" (ebx)
+ : "i" (0x00200000));
+
+ if (((eax ^ ebx) & 0x00200000) == 0)
+ return 0;
+
+ /* Check the highest input value for eax. */
+ asm volatile ("xchgl %%ebx, %1; cpuid; xchgl %%ebx, %1"
+ : "=a" (eax), "=r" (ebx), "=c" (ecx), "=d" (edx)
+ : "0" (0));
+
+ if (eax == 0)
+ return 0;
+
+ asm volatile ("xchgl %%ebx, %1; cpuid; xchgl %%ebx, %1"
+ : "=a" (eax), "=r" (ebx), "=c" (ecx), "=d" (edx)
+ : "0" (1));
+
+ if (edx & (1 << 25))
+ return 1;
+
+ return 0;
+#endif
+}
+
+void set_fpu (void)
+{
+ short cw;
+ int cw_sse;
+
+ /* i387 -- 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
+ asm volatile ("fnstcw %0" : "=m" (cw));
+ cw |= _FPU_MASK_IM | _FPU_MASK_DM | _FPU_MASK_ZM | _FPU_MASK_OM | _FPU_MASK_UM | _FPU_MASK_PM;
+ if (options.fpe & GFC_FPE_INVALID) cw &= ~_FPU_MASK_IM;
+ if (options.fpe & GFC_FPE_DENORMAL) cw &= ~_FPU_MASK_DM;
+ if (options.fpe & GFC_FPE_ZERO) cw &= ~_FPU_MASK_ZM;
+ if (options.fpe & GFC_FPE_OVERFLOW) cw &= ~_FPU_MASK_OM;
+ if (options.fpe & GFC_FPE_UNDERFLOW) cw &= ~_FPU_MASK_UM;
+ if (options.fpe & GFC_FPE_PRECISION) cw &= ~_FPU_MASK_PM;
+ asm volatile ("fldcw %0" : : "m" (cw));
+
+ if (has_sse())
+ {
+ /* SSE */
+ asm volatile ("stmxcsr %0" : : "m" (cw_sse));
+ cw_sse &= 0xFFFF0000;
+ if (options.fpe & GFC_FPE_INVALID) cw_sse |= 1 << 7;
+ if (options.fpe & GFC_FPE_DENORMAL) cw_sse |= 1 << 8;
+ if (options.fpe & GFC_FPE_ZERO) cw_sse |= 1 << 9;
+ if (options.fpe & GFC_FPE_OVERFLOW) cw_sse |= 1 << 10;
+ if (options.fpe & GFC_FPE_UNDERFLOW) cw_sse |= 1 << 11;
+ if (options.fpe & GFC_FPE_PRECISION) cw_sse |= 1 << 12;
+ asm volatile ("ldmxcsr %0" : : "m" (cw_sse));
+ }
+}
diff --git a/libgfortran/config/fpu-generic.h b/libgfortran/config/fpu-generic.h
new file mode 100644
index 000000000000..9e043d74895f
--- /dev/null
+++ b/libgfortran/config/fpu-generic.h
@@ -0,0 +1,57 @@
+/* Fallback FPU-related code (for systems not otherwise supported).
+ Copyright 2005 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 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+
+/* 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)
+ st_printf ("Fortran runtime warning: IEEE 'invalid operation' "
+ "exception not supported.\n");
+ if (options.fpe & GFC_FPE_DENORMAL)
+ st_printf ("Fortran runtime warning: IEEE 'denormal number' "
+ "exception not supported.\n");
+ if (options.fpe & GFC_FPE_ZERO)
+ st_printf ("Fortran runtime warning: IEEE 'division by zero' "
+ "exception not supported.\n");
+ if (options.fpe & GFC_FPE_OVERFLOW)
+ st_printf ("Fortran runtime warning: IEEE 'overflow' "
+ "exception not supported.\n");
+ if (options.fpe & GFC_FPE_UNDERFLOW)
+ st_printf ("Fortran runtime warning: IEEE 'underflow' "
+ "exception not supported.\n");
+ if (options.fpe & GFC_FPE_PRECISION)
+ st_printf ("Fortran runtime warning: IEEE 'loss of precision' "
+ "exception not supported.\n");
+}
diff --git a/libgfortran/config/fpu-glibc.h b/libgfortran/config/fpu-glibc.h
new file mode 100644
index 000000000000..0a6c9df1cc1c
--- /dev/null
+++ b/libgfortran/config/fpu-glibc.h
@@ -0,0 +1,93 @@
+/* FPU-related code for systems with GNU libc.
+ Copyright 2005 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 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+
+/* 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). */
+
+#define __USE_GNU
+#ifdef HAVE_FENV_H
+#include <fenv.h>
+#endif
+
+void set_fpu (void)
+{
+ fedisableexcept (FE_ALL_EXCEPT);
+
+ if (options.fpe & GFC_FPE_INVALID)
+#ifdef FE_INVALID
+ feenableexcept (FE_INVALID);
+#else
+ st_printf ("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
+ st_printf ("Fortran runtime warning: IEEE 'denormal number' "
+ "exception not supported.\n");
+#endif
+
+ if (options.fpe & GFC_FPE_ZERO)
+#ifdef FE_DIVBYZERO
+ feenableexcept (FE_DIVBYZERO);
+#else
+ st_printf ("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
+ st_printf ("Fortran runtime warning: IEEE 'overflow' "
+ "exception not supported.\n");
+#endif
+
+ if (options.fpe & GFC_FPE_UNDERFLOW)
+#ifdef FE_UNDERFLOW
+ feenableexcept (FE_UNDERFLOW);
+#else
+ st_printf ("Fortran runtime warning: IEEE 'underflow' "
+ "exception not supported.\n");
+#endif
+
+ if (options.fpe & GFC_FPE_PRECISION)
+#ifdef FE_INEXACT
+ feenableexcept (FE_INEXACT);
+#else
+ st_printf ("Fortran runtime warning: IEEE 'loss of precision' "
+ "exception not supported.\n");
+#endif
+}
diff --git a/libgfortran/configure b/libgfortran/configure
index 5b31d51a6477..69ca7b75bc44 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -308,7 +308,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar MAINTAINER_MODE_TRUE MAINTAINER_MODE_FALSE MAINT multi_basedir toolexecdir toolexeclibdir CC ac_ct_CC EXEEXT OBJEXT AM_FCFLAGS AM_CFLAGS AS ac_ct_AS AR ac_ct_AR RANLIB ac_ct_RANLIB LN_S LIBTOOL enable_shared enable_static FC FCFLAGS LDFLAGS ac_ct_FC extra_ldflags_libgfortran CPP CPPFLAGS EGREP LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar MAINTAINER_MODE_TRUE MAINTAINER_MODE_FALSE MAINT multi_basedir toolexecdir toolexeclibdir CC ac_ct_CC EXEEXT OBJEXT AM_FCFLAGS AM_CFLAGS AS ac_ct_AS AR ac_ct_AR RANLIB ac_ct_RANLIB LN_S LIBTOOL enable_shared enable_static FC FCFLAGS LDFLAGS ac_ct_FC extra_ldflags_libgfortran CPP CPPFLAGS EGREP FPU_HOST_HEADER LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@@ -6507,7 +6507,8 @@ done
-for ac_header in sys/mman.h sys/types.h sys/stat.h ieeefp.h
+
+for ac_header in sys/mman.h sys/types.h sys/stat.h ieeefp.h fenv.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if eval "test \"\${$as_ac_Header+set}\" = set"; then
@@ -19431,6 +19432,94 @@ _ACEOF
fi
+# Check for GNU libc feenableexcept
+echo "$as_me:$LINENO: checking for feenableexcept in -lm" >&5
+echo $ECHO_N "checking for feenableexcept in -lm... $ECHO_C" >&6
+if test "${ac_cv_lib_m_feenableexcept+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm $LIBS"
+if test x$gcc_no_link = xyes; then
+ { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char feenableexcept ();
+int
+main ()
+{
+feenableexcept ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_lib_m_feenableexcept=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_m_feenableexcept=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_m_feenableexcept" >&5
+echo "${ECHO_T}$ac_cv_lib_m_feenableexcept" >&6
+if test $ac_cv_lib_m_feenableexcept = yes; then
+ have_feenableexcept=yes
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_FEENABLEEXCEPT 1
+_ACEOF
+
+fi
+
+
+# Runs configure.host to set up necessary host-dependent shell variables.
+# We then display a message about it, and propagate them through the
+# build chain.
+. ${srcdir}/configure.host
+{ echo "$as_me:$LINENO: FPU dependent file will be ${fpu_host}.h" >&5
+echo "$as_me: FPU dependent file will be ${fpu_host}.h" >&6;}
+FPU_HOST_HEADER=config/${fpu_host}.h
+
+
# The standard autoconf HAVE_STRUCT_TIMEZONE doesn't actually check
# for struct timezone, as you might think. We also need to check how
# to call gettimeofday if we have it.
@@ -21031,6 +21120,7 @@ s,@extra_ldflags_libgfortran@,$extra_ldflags_libgfortran,;t t
s,@CPP@,$CPP,;t t
s,@CPPFLAGS@,$CPPFLAGS,;t t
s,@EGREP@,$EGREP,;t t
+s,@FPU_HOST_HEADER@,$FPU_HOST_HEADER,;t t
s,@LIBOBJS@,$LIBOBJS,;t t
s,@LTLIBOBJS@,$LTLIBOBJS,;t t
CEOF
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index 65f624163744..396deb5fe6a0 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -158,7 +158,7 @@ AC_TYPE_OFF_T
AC_STDC_HEADERS
AC_HAVE_HEADERS(stdlib.h stdio.h string.h stddef.h math.h unistd.h signal.h)
AC_CHECK_HEADERS(time.h sys/params.h sys/time.h sys/times.h sys/resource.h)
-AC_CHECK_HEADERS(sys/mman.h sys/types.h sys/stat.h ieeefp.h)
+AC_CHECK_HEADERS(sys/mman.h sys/types.h sys/stat.h ieeefp.h fenv.h)
AC_CHECK_HEADER([complex.h],[AC_DEFINE([HAVE_COMPLEX_H], [1], [complex.h exists])])
AC_CHECK_MEMBERS([struct stat.st_blksize])
@@ -340,6 +340,17 @@ LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY
# Fallback in case isfinite is not available.
AC_CHECK_LIB([m],[finite],[AC_DEFINE([HAVE_FINITE],[1],[libm includes finite])])
+# Check for GNU libc feenableexcept
+AC_CHECK_LIB([m],[feenableexcept],[have_feenableexcept=yes AC_DEFINE([HAVE_FEENABLEEXCEPT],[1],[libm includes feenableexcept])])
+
+# Runs configure.host to set up necessary host-dependent shell variables.
+# We then display a message about it, and propagate them through the
+# build chain.
+. ${srcdir}/configure.host
+AC_MSG_NOTICE([FPU dependent file will be ${fpu_host}.h])
+FPU_HOST_HEADER=config/${fpu_host}.h
+AC_SUBST(FPU_HOST_HEADER)
+
# The standard autoconf HAVE_STRUCT_TIMEZONE doesn't actually check
# for struct timezone, as you might think. We also need to check how
# to call gettimeofday if we have it.
diff --git a/libgfortran/configure.host b/libgfortran/configure.host
new file mode 100644
index 000000000000..c7cc16e17d2d
--- /dev/null
+++ b/libgfortran/configure.host
@@ -0,0 +1,32 @@
+# configure.host
+#
+# This shell script handles all host based configuration for libgfortran.
+# It sets various shell variables based on the the host triplet.
+# You can modify this shell script without rerunning autoconf/aclocal/etc.
+# This file is "sourced", not executed.
+#
+#
+# It uses the following shell variables as set by config.guess:
+# host The configuration host (full CPU-vendor-OS triplet)
+# host_cpu The configuration host CPU
+# host_os The configuration host OS
+#
+#
+# It sets the following shell variables:
+#
+# fpu_host FPU-specific code file, defaults to fpu-generic.
+
+
+# DEFAULTS
+fpu_host=fpu-generic
+
+# HOST-SPECIFIC OVERRIDES
+case "${host_cpu}" in
+ i?86 | x86_64)
+ fpu_host='fpu-387' ;;
+esac
+
+# CONFIGURATION-SPECIFIC OVERRIDES
+if test "x${have_feenableexcept}" = "xyes"; then
+ fpu_host='fpu-glibc'
+fi
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 174873b67a33..bc23789f7d61 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -337,8 +337,7 @@ typedef struct
int mem_check;
int use_stderr, all_unbuffered, default_recl;
- int fpu_round, fpu_precision, fpu_invalid, fpu_denormal, fpu_zerodiv,
- fpu_overflow, fpu_underflow, fpu_precision_loss;
+ int fpu_round, fpu_precision, fpe;
int sighup, sigint;
}
@@ -410,6 +409,14 @@ error_codes;
#define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */
#define GFC_STD_F77 (1<<0) /* Up to and including F77. */
+/* Bitmasks for the various FPE that can be enabled.
+ Keep them in sync with their counterparts in gcc/fortran/gfortran.h. */
+#define GFC_FPE_INVALID (1<<0)
+#define GFC_FPE_DENORMAL (1<<1)
+#define GFC_FPE_ZERO (1<<2)
+#define GFC_FPE_OVERFLOW (1<<3)
+#define GFC_FPE_UNDERFLOW (1<<4)
+#define GFC_FPE_PRECISION (1<<5)
/* The filename and line number don't go inside the globals structure.
They are set by the rest of the program and must be linked to. */
@@ -485,6 +492,11 @@ internal_proto(translate_error);
extern void generate_error (int, const char *);
internal_proto(generate_error);
+/* fpu.c */
+
+extern void set_fpu (void);
+internal_proto(set_fpu);
+
/* memory.c */
extern void *get_mem (size_t) __attribute__ ((malloc));
diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c
index fb5da2012ad9..09743a0eb95a 100644
--- a/libgfortran/runtime/environ.c
+++ b/libgfortran/runtime/environ.c
@@ -533,30 +533,6 @@ static variable variable_table[] = {
show_precision,
"Precision of intermediate results. Values are 24, 53 and 64.", 0},
- {"GFORTRAN_FPU_INVALID", 1, &options.fpu_invalid, init_boolean,
- show_boolean,
- "Raise a floating point exception on invalid FP operation.", 0},
-
- {"GFORTRAN_FPU_DENORMAL", 1, &options.fpu_denormal, init_boolean,
- show_boolean,
- "Raise a floating point exception when denormal numbers are encountered.",
- 0},
-
- {"GFORTRAN_FPU_ZERO", 0, &options.fpu_zerodiv, init_boolean, show_boolean,
- "Raise a floating point exception when dividing by zero.", 0},
-
- {"GFORTRAN_FPU_OVERFLOW", 0, &options.fpu_overflow, init_boolean,
- show_boolean,
- "Raise a floating point exception on overflow.", 0},
-
- {"GFORTRAN_FPU_UNDERFLOW", 0, &options.fpu_underflow, init_boolean,
- show_boolean,
- "Raise a floating point exception on underflow.", 0},
-
- {"GFORTRAN_FPU_PRECISION", 0, &options.fpu_precision_loss, init_boolean,
- show_boolean,
- "Raise a floating point exception on precision loss.", 0},
-
{NULL, 0, NULL, NULL, NULL, NULL, 0}
};
diff --git a/libgfortran/runtime/fpu.c b/libgfortran/runtime/fpu.c
new file mode 100644
index 000000000000..f81a3b05a421
--- /dev/null
+++ b/libgfortran/runtime/fpu.c
@@ -0,0 +1,16 @@
+#include "libgfortran.h"
+
+/* We include the platform-dependent code. */
+#include "fpu-target.h"
+
+/* Function called by the front-end to tell us
+ when a FPE should be raised. */
+extern void set_fpe (int);
+export_proto(set_fpe);
+
+void
+set_fpe (int exceptions)
+{
+ options.fpe = exceptions;
+ set_fpu ();
+}
diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index 77204309aaed..1186a304930f 100644
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -96,6 +96,7 @@ init (void)
init_variables ();
init_units ();
+ set_fpu ();
init_compile_options ();
#ifdef DEBUG
--
GitLab