* gfortran.h: Add bitmasks for different FPE traps. Add fpe
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 12 Oct 2005 20:21:31 +0000 (20:21 +0000)
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 12 Oct 2005 20:21:31 +0000 (20:21 +0000)
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

21 files changed:
gcc/fortran/ChangeLog
gcc/fortran/gfortran.h
gcc/fortran/invoke.texi
gcc/fortran/lang.opt
gcc/fortran/options.c
gcc/fortran/trans-decl.c
gcc/fortran/trans.h
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/config.h.in
libgfortran/config/fpu-387.h [new file with mode: 0644]
libgfortran/config/fpu-generic.h [new file with mode: 0644]
libgfortran/config/fpu-glibc.h [new file with mode: 0644]
libgfortran/configure
libgfortran/configure.ac
libgfortran/configure.host [new file with mode: 0644]
libgfortran/libgfortran.h
libgfortran/runtime/environ.c
libgfortran/runtime/fpu.c [new file with mode: 0644]
libgfortran/runtime/main.c

index a02586f..91acbf2 100644 (file)
@@ -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.
index 1923826..63b4b93 100644 (file)
@@ -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;
index 847ab29..88e8eef 100644 (file)
@@ -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.
index ee0d61f..053cc3d 100644 (file)
@@ -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
index 48df674..95720bf 100644 (file)
@@ -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;
index 3f656dd..70e8e82 100644 (file)
@@ -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)
     {
index e64640c..16d0a37 100644 (file)
@@ -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;
index 3407289..9433fda 100644 (file)
@@ -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
index cac343b..f5a1869 100644 (file)
@@ -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
 
index c4d3be6..5ed436f 100644 (file)
@@ -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)/$@
 
index 44c45c7..669bc15 100644 (file)
 /* 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 (file)
index 0000000..06c02ea
--- /dev/null
@@ -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 (file)
index 0000000..9e043d7
--- /dev/null
@@ -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 (file)
index 0000000..0a6c9df
--- /dev/null
@@ -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
+}
index 5b31d51..69ca7b7 100755 (executable)
@@ -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
index 65f6241..396deb5 100644 (file)
@@ -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 (file)
index 0000000..c7cc16e
--- /dev/null
@@ -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
index 174873b..bc23789 100644 (file)
@@ -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));
index fb5da20..09743a0 100644 (file)
@@ -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 (file)
index 0000000..f81a3b0
--- /dev/null
@@ -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 ();
+}
index 7720430..1186a30 100644 (file)
@@ -96,6 +96,7 @@ init (void)
   init_variables ();
 
   init_units ();
+  set_fpu ();
   init_compile_options ();
 
 #ifdef DEBUG