re PR fortran/29383 (Fortran 2003/F95[TR15580:1999]: Floating point exception (IEEE) support)

PR fortran/29383 gcc/fortran/ * gfortran.h (gfc_simplify_ieee_selected_real_kind): New prototype. * libgfortran.h (GFC_FPE_*): Use simple integer values, valid in both C and Fortran. * expr.c (gfc_check_init_expr): Simplify IEEE_SELECTED_REAL_KIND. * simplify.c (gfc_simplify_ieee_selected_real_kind): New function. * module.c (mio_symbol): Keep track of symbols which came from intrinsic modules. (gfc_use_module): Keep track of the IEEE modules. * trans-decl.c (gfc_get_symbol_decl): Adjust code since we have new intrinsic modules. (gfc_build_builtin_function_decls): Build decls for ieee_procedure_entry and ieee_procedure_exit. (is_from_ieee_module, is_ieee_module_used, save_fp_state, restore_fp_state): New functions. (gfc_generate_function_code): Save and restore floating-point state on procedure entry/exit, when IEEE modules are used. * intrinsic.texi: Document the IEEE modules. libgfortran/ * configure.host: Add checks for IEEE support, rework priorities. * configure.ac: Define IEEE_SUPPORT, check for fpsetsticky and fpresetsticky. * configure: Regenerate. * Makefile.am: Build new ieee files, install IEEE_* modules. * Makefile.in: Regenerate. * gfortran.map (GFORTRAN_1.6): Add new symbols. * libgfortran.h (get_fpu_trap_exceptions, set_fpu_trap_exceptions, support_fpu_trap, set_fpu_except_flags, support_fpu_flag, support_fpu_rounding_mode, get_fpu_state, set_fpu_state): New prototypes. * config/fpu-*.h (get_fpu_trap_exceptions, set_fpu_trap_exceptions, support_fpu_trap, set_fpu_except_flags, support_fpu_flag, support_fpu_rounding_mode, get_fpu_state, set_fpu_state): New functions. * ieee/ieee_features.F90: New file. * ieee/ieee_exceptions.F90: New file. * ieee/ieee_arithmetic.F90: New file. * ieee/ieee_helper.c: New file. gcc/testsuite/ * lib/target-supports.exp (check_effective_target_fortran_ieee): New function. * gfortran.dg/ieee/ieee.exp: New file. * gfortran.dg/ieee/ieee_1.F90: New file. * gfortran.dg/ieee/ieee_2.f90: New file. * gfortran.dg/ieee/ieee_3.f90: New file. * gfortran.dg/ieee/ieee_4.f90: New file. * gfortran.dg/ieee/ieee_5.f90: New file. * gfortran.dg/ieee/ieee_6.f90: New file. * gfortran.dg/ieee/ieee_7.f90: New file. * gfortran.dg/ieee/ieee_rounding_1.f90: New file. From-SVN: r212102
author: Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 2014-06-28 14:17:41 +0000
committer: François-Xavier Coudert <fxcoudert@gcc.gnu.org> 2014-06-28 14:17:41 +0000
commit: 8b198102220210ef6a61477d9a45564c206ee6b5 (patch)
tree: e7bff5fef45c93b6d9ac36021ec9edaa569bf861 /libgfortran
parent: a86471635f38376128e6cea8d6856f025a57b4c2 (diff)
17 files changed, 2924 insertions, 190 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 26825ca8714..c4e9949c9d7 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,26 @@
+2014-06-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/29383
+	* configure.host: Add checks for IEEE support, rework priorities.
+	* configure.ac: Define IEEE_SUPPORT, check for fpsetsticky and
+	fpresetsticky.
+	* configure: Regenerate.
+	* Makefile.am: Build new ieee files, install IEEE_* modules.
+	* Makefile.in: Regenerate.
+	* gfortran.map (GFORTRAN_1.6): Add new symbols.
+	* libgfortran.h (get_fpu_trap_exceptions, set_fpu_trap_exceptions,
+	support_fpu_trap, set_fpu_except_flags, support_fpu_flag,
+	support_fpu_rounding_mode, get_fpu_state, set_fpu_state): New
+	prototypes.
+	* config/fpu-*.h (get_fpu_trap_exceptions,
+	set_fpu_trap_exceptions, support_fpu_trap, set_fpu_except_flags,
+	support_fpu_flag, support_fpu_rounding_mode, get_fpu_state,
+	set_fpu_state): New functions.
+	* ieee/ieee_features.F90: New file.
+	* ieee/ieee_exceptions.F90: New file.
+	* ieee/ieee_arithmetic.F90: New file.
+	* ieee/ieee_helper.c: New file.
+
 2014-06-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/61499
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index abc23cd1eda..a058a016039 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -54,6 +54,11 @@ libcaf_single_la_LDFLAGS = -static
 libcaf_single_la_DEPENDENCIES = caf/libcaf.h
 libcaf_single_la_LINK = $(LINK) $(libcaf_single_la_LDFLAGS)
 
+if IEEE_SUPPORT
+fincludedir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR)/finclude
+nodist_finclude_HEADERS = ieee_arithmetic.mod ieee_exceptions.mod ieee_features.mod
+endif
+
 ## io.h conflicts with a system header on some platforms, so
 ## use -iquote
 AM_CPPFLAGS = -iquote$(srcdir)/io -I$(srcdir)/$(MULTISRCTOP)../gcc \
@@ -70,6 +75,7 @@ AM_CFLAGS += $(SECTION_FLAGS)
 
 # Some targets require additional compiler options for IEEE compatibility.
 AM_CFLAGS += $(IEEE_FLAGS)
+AM_FCFLAGS += $(IEEE_FLAGS)
 
 gfor_io_src= \
 io/close.c \
@@ -160,6 +166,21 @@ intrinsics/unpack_generic.c \
 runtime/in_pack_generic.c \
 runtime/in_unpack_generic.c
 
+if IEEE_SUPPORT
+
+gfor_helper_src+=ieee/ieee_helper.c
+
+gfor_ieee_src= \
+ieee/ieee_arithmetic.F90 \
+ieee/ieee_exceptions.F90 \
+ieee/ieee_features.F90
+
+else
+
+gfor_ieee_src=
+
+endif
+
 gfor_src= \
 runtime/backtrace.c \
 runtime/bounds.c \
@@ -650,7 +671,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) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \
     $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \
-    $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h
+    $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc
 
 # Machine generated specifics
 gfor_built_specific_src= \
@@ -811,11 +832,27 @@ $(patsubst %.c,%.lo,$(notdir $(i_matmull_c))): AM_CFLAGS += -funroll-loops
 $(patsubst %.F90,%.lo,$(patsubst %.f90,%.lo,$(notdir $(gfor_specific_src)))): AM_FCFLAGS += -fallow-leading-underscore
 selected_real_kind.lo selected_int_kind.lo: AM_FCFLAGS += -fallow-leading-underscore
 
+if IEEE_SUPPORT
+# Add flags for IEEE modules
+$(patsubst %.F90,%.lo,$(notdir $(gfor_ieee_src))): AM_FCFLAGS += -Wno-unused-dummy-argument -Wno-c-binding-type -ffree-line-length-0 -fallow-leading-underscore
+endif
+
+# Dependencies between IEEE_ARITHMETIC and IEEE_EXCEPTIONS
+ieee_arithmetic.lo: ieee/ieee_arithmetic.F90 ieee_exceptions.lo
+	$(LTPPFCCOMPILE) -c -o $@ $<
+
+ieee_features.mod: ieee_features.lo
+	:
+ieee_exceptions.mod: ieee_exceptions.lo
+	:
+ieee_arithmetic.mod: ieee_arithmetic.lo
+	:
+
 BUILT_SOURCES=$(gfor_built_src) $(gfor_built_specific_src) \
     $(gfor_built_specific2_src) $(gfor_misc_specifics)
 
 prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \
-    $(gfor_helper_src) $(gfor_io_headers) $(gfor_specific_src)
+    $(gfor_helper_src) $(gfor_ieee_src) $(gfor_io_headers) $(gfor_specific_src)
 
 if onestep
 # dummy sources for libtool
@@ -871,6 +908,10 @@ selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh
 fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
 	cp $(srcdir)/$(FPU_HOST_HEADER) $@
 
+fpu-target.inc: fpu-target.h $(srcdir)/libgfortran.h
+	grep '^#define GFC_FPE_' < $(top_srcdir)/../gcc/fortran/libgfortran.h > $@ || true
+	grep '^#define GFC_FPE_' < $(srcdir)/libgfortran.h >> $@ || true
+
 ## 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 62b9f7abffa..5a3c24a55ec 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -16,6 +16,7 @@
 @SET_MAKE@
 
 
+
 VPATH = @srcdir@
 pkgdatadir = $(datadir)/@PACKAGE@
 pkgincludedir = $(includedir)/@PACKAGE@
@@ -36,9 +37,10 @@ POST_UNINSTALL = :
 build_triplet = @build@
 host_triplet = @host@
 target_triplet = @target@
+@IEEE_SUPPORT_TRUE@am__append_1 = ieee/ieee_helper.c
 
 # dummy sources for libtool
-@onestep_TRUE@am__append_1 = libgfortran_c.c libgfortran_f.f90
+@onestep_TRUE@am__append_2 = libgfortran_c.c libgfortran_f.f90
 subdir = .
 DIST_COMMON = ChangeLog $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
 	$(top_srcdir)/configure $(am__configure_deps) \
@@ -95,7 +97,7 @@ am__uninstall_files_from_dir = { \
   }
 am__installdirs = "$(DESTDIR)$(cafexeclibdir)" \
 	"$(DESTDIR)$(myexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" \
-	"$(DESTDIR)$(toolexeclibdir)"
+	"$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(fincludedir)"
 LTLIBRARIES = $(cafexeclib_LTLIBRARIES) $(myexeclib_LTLIBRARIES) \
 	$(toolexeclib_LTLIBRARIES)
 libcaf_single_la_LIBADD =
@@ -245,7 +247,8 @@ am__objects_41 = close.lo file_pos.lo format.lo inquire.lo \
 	intrinsics.lo list_read.lo lock.lo open.lo read.lo \
 	size_from_kind.lo transfer.lo transfer128.lo unit.lo unix.lo \
 	write.lo fbuf.lo
-am__objects_42 = associated.lo abort.lo access.lo args.lo \
+@IEEE_SUPPORT_TRUE@am__objects_42 = ieee_helper.lo
+am__objects_43 = associated.lo abort.lo access.lo args.lo \
 	bit_intrinsics.lo c99_functions.lo chdir.lo chmod.lo clock.lo \
 	cpu_time.lo cshift0.lo ctime.lo date_and_time.lo dtime.lo \
 	env.lo eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo \
@@ -259,9 +262,11 @@ am__objects_42 = associated.lo abort.lo access.lo args.lo \
 	selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \
 	system_clock.lo time.lo transpose_generic.lo umask.lo \
 	unlink.lo unpack_generic.lo in_pack_generic.lo \
-	in_unpack_generic.lo
-am__objects_43 =
-am__objects_44 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
+	in_unpack_generic.lo $(am__objects_42)
+@IEEE_SUPPORT_TRUE@am__objects_44 = ieee_arithmetic.lo \
+@IEEE_SUPPORT_TRUE@	ieee_exceptions.lo ieee_features.lo
+am__objects_45 =
+am__objects_46 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
 	_abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
 	_abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \
 	_aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \
@@ -285,18 +290,19 @@ am__objects_44 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
 	_conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \
 	_aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
 	_anint_r8.lo _anint_r10.lo _anint_r16.lo
-am__objects_45 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
+am__objects_47 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
 	_sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \
 	_dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \
 	_atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \
 	_mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \
 	_mod_r10.lo _mod_r16.lo
-am__objects_46 = misc_specifics.lo
-am__objects_47 = $(am__objects_44) $(am__objects_45) $(am__objects_46) \
+am__objects_48 = misc_specifics.lo
+am__objects_49 = $(am__objects_46) $(am__objects_47) $(am__objects_48) \
 	dprod_r8.lo f2c_specifics.lo
-am__objects_48 = $(am__objects_1) $(am__objects_40) $(am__objects_41) \
-	$(am__objects_42) $(am__objects_43) $(am__objects_47)
-@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_48)
+am__objects_50 = $(am__objects_1) $(am__objects_40) $(am__objects_41) \
+	$(am__objects_43) $(am__objects_44) $(am__objects_45) \
+	$(am__objects_49)
+@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_50)
 @onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo
 libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
 libgfortranbegin_la_LIBADD =
@@ -336,6 +342,7 @@ MULTISUBDIR =
 MULTIDO = true
 MULTICLEAN = true
 DATA = $(toolexeclib_DATA)
+HEADERS = $(nodist_finclude_HEADERS)
 ETAGS = etags
 CTAGS = ctags
 ACLOCAL = @ACLOCAL@
@@ -348,7 +355,7 @@ AMTAR = @AMTAR@
 # Some targets require additional compiler options for IEEE compatibility.
 AM_CFLAGS = @AM_CFLAGS@ -fcx-fortran-rules $(SECTION_FLAGS) \
 	$(IEEE_FLAGS)
-AM_FCFLAGS = @AM_FCFLAGS@
+AM_FCFLAGS = @AM_FCFLAGS@ $(IEEE_FLAGS)
 AR = @AR@
 AS = @AS@
 AUTOCONF = @AUTOCONF@
@@ -376,6 +383,7 @@ FGREP = @FGREP@
 FPU_HOST_HEADER = @FPU_HOST_HEADER@
 GREP = @GREP@
 IEEE_FLAGS = @IEEE_FLAGS@
+IEEE_SUPPORT = @IEEE_SUPPORT@
 INSTALL = @INSTALL@
 INSTALL_DATA = @INSTALL_DATA@
 INSTALL_PROGRAM = @INSTALL_PROGRAM@
@@ -516,6 +524,8 @@ libcaf_single_la_SOURCES = caf/single.c
 libcaf_single_la_LDFLAGS = -static
 libcaf_single_la_DEPENDENCIES = caf/libcaf.h
 libcaf_single_la_LINK = $(LINK) $(libcaf_single_la_LDFLAGS)
+@IEEE_SUPPORT_TRUE@fincludedir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR)/finclude
+@IEEE_SUPPORT_TRUE@nodist_finclude_HEADERS = ieee_arithmetic.mod ieee_exceptions.mod ieee_features.mod
 AM_CPPFLAGS = -iquote$(srcdir)/io -I$(srcdir)/$(MULTISRCTOP)../gcc \
 	      -I$(srcdir)/$(MULTISRCTOP)../gcc/config $(LIBQUADINCLUDE) \
 	      -I$(MULTIBUILDTOP)../../$(host_subdir)/gcc \
@@ -546,70 +556,39 @@ io/fbuf.h \
 io/format.h \
 io/unix.h
 
-gfor_helper_src = \
-intrinsics/associated.c \
-intrinsics/abort.c \
-intrinsics/access.c \
-intrinsics/args.c \
-intrinsics/bit_intrinsics.c \
-intrinsics/c99_functions.c \
-intrinsics/chdir.c \
-intrinsics/chmod.c \
-intrinsics/clock.c \
-intrinsics/cpu_time.c \
-intrinsics/cshift0.c \
-intrinsics/ctime.c \
-intrinsics/date_and_time.c \
-intrinsics/dtime.c \
-intrinsics/env.c \
-intrinsics/eoshift0.c \
-intrinsics/eoshift2.c \
-intrinsics/erfc_scaled.c \
-intrinsics/etime.c \
-intrinsics/execute_command_line.c \
-intrinsics/exit.c \
-intrinsics/extends_type_of.c \
-intrinsics/fnum.c \
-intrinsics/gerror.c \
-intrinsics/getcwd.c \
-intrinsics/getlog.c \
-intrinsics/getXid.c \
-intrinsics/hostnm.c \
-intrinsics/ierrno.c \
-intrinsics/ishftc.c \
-intrinsics/iso_c_generated_procs.c \
-intrinsics/iso_c_binding.c \
-intrinsics/kill.c \
-intrinsics/link.c \
-intrinsics/malloc.c \
-intrinsics/mvbits.c \
-intrinsics/move_alloc.c \
-intrinsics/pack_generic.c \
-intrinsics/perror.c \
-intrinsics/selected_char_kind.c \
-intrinsics/signal.c \
-intrinsics/size.c \
-intrinsics/sleep.c \
-intrinsics/spread_generic.c \
-intrinsics/string_intrinsics.c \
-intrinsics/system.c \
-intrinsics/rand.c \
-intrinsics/random.c \
-intrinsics/rename.c \
-intrinsics/reshape_generic.c \
-intrinsics/reshape_packed.c \
-intrinsics/selected_int_kind.f90 \
-intrinsics/selected_real_kind.f90 \
-intrinsics/stat.c \
-intrinsics/symlnk.c \
-intrinsics/system_clock.c \
-intrinsics/time.c \
-intrinsics/transpose_generic.c \
-intrinsics/umask.c \
-intrinsics/unlink.c \
-intrinsics/unpack_generic.c \
-runtime/in_pack_generic.c \
-runtime/in_unpack_generic.c
+gfor_helper_src = intrinsics/associated.c intrinsics/abort.c \
+	intrinsics/access.c intrinsics/args.c \
+	intrinsics/bit_intrinsics.c intrinsics/c99_functions.c \
+	intrinsics/chdir.c intrinsics/chmod.c intrinsics/clock.c \
+	intrinsics/cpu_time.c intrinsics/cshift0.c intrinsics/ctime.c \
+	intrinsics/date_and_time.c intrinsics/dtime.c intrinsics/env.c \
+	intrinsics/eoshift0.c intrinsics/eoshift2.c \
+	intrinsics/erfc_scaled.c intrinsics/etime.c \
+	intrinsics/execute_command_line.c intrinsics/exit.c \
+	intrinsics/extends_type_of.c intrinsics/fnum.c \
+	intrinsics/gerror.c intrinsics/getcwd.c intrinsics/getlog.c \
+	intrinsics/getXid.c intrinsics/hostnm.c intrinsics/ierrno.c \
+	intrinsics/ishftc.c intrinsics/iso_c_generated_procs.c \
+	intrinsics/iso_c_binding.c intrinsics/kill.c intrinsics/link.c \
+	intrinsics/malloc.c intrinsics/mvbits.c \
+	intrinsics/move_alloc.c intrinsics/pack_generic.c \
+	intrinsics/perror.c intrinsics/selected_char_kind.c \
+	intrinsics/signal.c intrinsics/size.c intrinsics/sleep.c \
+	intrinsics/spread_generic.c intrinsics/string_intrinsics.c \
+	intrinsics/system.c intrinsics/rand.c intrinsics/random.c \
+	intrinsics/rename.c intrinsics/reshape_generic.c \
+	intrinsics/reshape_packed.c intrinsics/selected_int_kind.f90 \
+	intrinsics/selected_real_kind.f90 intrinsics/stat.c \
+	intrinsics/symlnk.c intrinsics/system_clock.c \
+	intrinsics/time.c intrinsics/transpose_generic.c \
+	intrinsics/umask.c intrinsics/unlink.c \
+	intrinsics/unpack_generic.c runtime/in_pack_generic.c \
+	runtime/in_unpack_generic.c $(am__append_1)
+@IEEE_SUPPORT_FALSE@gfor_ieee_src = 
+@IEEE_SUPPORT_TRUE@gfor_ieee_src = \
+@IEEE_SUPPORT_TRUE@ieee/ieee_arithmetic.F90 \
+@IEEE_SUPPORT_TRUE@ieee/ieee_exceptions.F90 \
+@IEEE_SUPPORT_TRUE@ieee/ieee_features.F90
 
 gfor_src = \
 runtime/backtrace.c \
@@ -1100,7 +1079,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) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \
     $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \
-    $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h
+    $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc
 
 
 # Machine generated specifics
@@ -1254,9 +1233,9 @@ intrinsics/f2c_specifics.F90
 
 BUILT_SOURCES = $(gfor_built_src) $(gfor_built_specific_src) \
 	$(gfor_built_specific2_src) $(gfor_misc_specifics) \
-	$(am__append_1)
+	$(am__append_2)
 prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \
-    $(gfor_helper_src) $(gfor_io_headers) $(gfor_specific_src)
+    $(gfor_helper_src) $(gfor_ieee_src) $(gfor_io_headers) $(gfor_specific_src)
 
 @onestep_FALSE@libgfortran_la_SOURCES = $(prereq_SRC)
 
@@ -1538,6 +1517,7 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i2.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i4.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ieee_helper.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ierrno.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c10.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c16.Plo@am__quote@
@@ -1919,6 +1899,12 @@ distclean-compile:
 .F90.lo:
 	$(LTPPFCCOMPILE) -c -o $@ $<
 
+ieee_exceptions.lo: ieee/ieee_exceptions.F90
+	$(LIBTOOL)  --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o ieee_exceptions.lo `test -f 'ieee/ieee_exceptions.F90' || echo '$(srcdir)/'`ieee/ieee_exceptions.F90
+
+ieee_features.lo: ieee/ieee_features.F90
+	$(LIBTOOL)  --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o ieee_features.lo `test -f 'ieee/ieee_features.F90' || echo '$(srcdir)/'`ieee/ieee_features.F90
+
 _abs_c4.lo: $(srcdir)/generated/_abs_c4.F90
 	$(LIBTOOL)  --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c4.lo `test -f '$(srcdir)/generated/_abs_c4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_c4.F90
 
@@ -5630,6 +5616,13 @@ in_unpack_generic.lo: runtime/in_unpack_generic.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@	$(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_generic.lo `test -f 'runtime/in_unpack_generic.c' || echo '$(srcdir)/'`runtime/in_unpack_generic.c
 
+ieee_helper.lo: ieee/ieee_helper.c
+@am__fastdepCC_TRUE@	$(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT ieee_helper.lo -MD -MP -MF $(DEPDIR)/ieee_helper.Tpo -c -o ieee_helper.lo `test -f 'ieee/ieee_helper.c' || echo '$(srcdir)/'`ieee/ieee_helper.c
+@am__fastdepCC_TRUE@	$(am__mv) $(DEPDIR)/ieee_helper.Tpo $(DEPDIR)/ieee_helper.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	source='ieee/ieee_helper.c' object='ieee_helper.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ieee_helper.lo `test -f 'ieee/ieee_helper.c' || echo '$(srcdir)/'`ieee/ieee_helper.c
+
 .f90.o:
 	$(FCCOMPILE) -c -o $@ $<
 
@@ -5691,6 +5684,24 @@ uninstall-toolexeclibDATA:
 	@list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \
 	files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
 	dir='$(DESTDIR)$(toolexeclibdir)'; $(am__uninstall_files_from_dir)
+install-nodist_fincludeHEADERS: $(nodist_finclude_HEADERS)
+	@$(NORMAL_INSTALL)
+	test -z "$(fincludedir)" || $(MKDIR_P) "$(DESTDIR)$(fincludedir)"
+	@list='$(nodist_finclude_HEADERS)'; test -n "$(fincludedir)" || list=; \
+	for p in $$list; do \
+	  if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+	  echo "$$d$$p"; \
+	done | $(am__base_list) | \
+	while read files; do \
+	  echo " $(INSTALL_HEADER) $$files '$(DESTDIR)$(fincludedir)'"; \
+	  $(INSTALL_HEADER) $$files "$(DESTDIR)$(fincludedir)" || exit $$?; \
+	done
+
+uninstall-nodist_fincludeHEADERS:
+	@$(NORMAL_UNINSTALL)
+	@list='$(nodist_finclude_HEADERS)'; test -n "$(fincludedir)" || list=; \
+	files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
+	dir='$(DESTDIR)$(fincludedir)'; $(am__uninstall_files_from_dir)
 
 ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
 	list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
@@ -5746,9 +5757,9 @@ distclean-tags:
 check-am: all-am
 check: $(BUILT_SOURCES)
 	$(MAKE) $(AM_MAKEFLAGS) check-am
-all-am: Makefile $(LTLIBRARIES) all-multi $(DATA) config.h
+all-am: Makefile $(LTLIBRARIES) all-multi $(DATA) $(HEADERS) config.h
 installdirs:
-	for dir in "$(DESTDIR)$(cafexeclibdir)" "$(DESTDIR)$(myexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)"; do \
+	for dir in "$(DESTDIR)$(cafexeclibdir)" "$(DESTDIR)$(myexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(fincludedir)"; do \
 	  test -z "$$dir" || $(MKDIR_P) "$$dir"; \
 	done
 install: $(BUILT_SOURCES)
@@ -5808,7 +5819,7 @@ info: info-am
 
 info-am:
 
-install-data-am:
+install-data-am: install-nodist_fincludeHEADERS
 
 install-dvi: install-dvi-am
 
@@ -5859,7 +5870,8 @@ ps: ps-am
 ps-am:
 
 uninstall-am: uninstall-cafexeclibLTLIBRARIES \
-	uninstall-myexeclibLTLIBRARIES uninstall-toolexeclibDATA \
+	uninstall-myexeclibLTLIBRARIES \
+	uninstall-nodist_fincludeHEADERS uninstall-toolexeclibDATA \
 	uninstall-toolexeclibLTLIBRARIES
 
 .MAKE: all all-multi check clean-multi distclean-multi install \
@@ -5876,15 +5888,17 @@ uninstall-am: uninstall-cafexeclibLTLIBRARIES \
 	install-data install-data-am install-dvi install-dvi-am \
 	install-exec install-exec-am install-html install-html-am \
 	install-info install-info-am install-man install-multi \
-	install-myexeclibLTLIBRARIES install-pdf install-pdf-am \
-	install-ps install-ps-am install-strip install-toolexeclibDATA \
+	install-myexeclibLTLIBRARIES install-nodist_fincludeHEADERS \
+	install-pdf install-pdf-am install-ps install-ps-am \
+	install-strip install-toolexeclibDATA \
 	install-toolexeclibLTLIBRARIES installcheck installcheck-am \
 	installdirs maintainer-clean maintainer-clean-generic \
 	maintainer-clean-multi mostlyclean mostlyclean-compile \
 	mostlyclean-generic mostlyclean-libtool mostlyclean-multi pdf \
 	pdf-am ps ps-am tags uninstall uninstall-am \
 	uninstall-cafexeclibLTLIBRARIES uninstall-myexeclibLTLIBRARIES \
-	uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES
+	uninstall-nodist_fincludeHEADERS uninstall-toolexeclibDATA \
+	uninstall-toolexeclibLTLIBRARIES
 
 @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@gfortran.map-sun : $(srcdir)/gfortran.map \
 @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@		$(top_srcdir)/../contrib/make_sunver.pl \
@@ -5904,6 +5918,20 @@ $(patsubst %.c,%.lo,$(notdir $(i_matmull_c))): AM_CFLAGS += -funroll-loops
 # Add the -fallow-leading-underscore option when needed
 $(patsubst %.F90,%.lo,$(patsubst %.f90,%.lo,$(notdir $(gfor_specific_src)))): AM_FCFLAGS += -fallow-leading-underscore
 selected_real_kind.lo selected_int_kind.lo: AM_FCFLAGS += -fallow-leading-underscore
+
+# Add flags for IEEE modules
+@IEEE_SUPPORT_TRUE@$(patsubst %.F90,%.lo,$(notdir $(gfor_ieee_src))): AM_FCFLAGS += -Wno-unused-dummy-argument -Wno-c-binding-type -ffree-line-length-0 -fallow-leading-underscore
+
+# Dependencies between IEEE_ARITHMETIC and IEEE_EXCEPTIONS
+ieee_arithmetic.lo: ieee/ieee_arithmetic.F90 ieee_exceptions.lo
+	$(LTPPFCCOMPILE) -c -o $@ $<
+
+ieee_features.mod: ieee_features.lo
+	:
+ieee_exceptions.mod: ieee_exceptions.lo
+	:
+ieee_arithmetic.mod: ieee_arithmetic.lo
+	:
 @onestep_TRUE@libgfortran_c.c libgfortran_f.f90 libgfortran_F.F90:
 @onestep_TRUE@	echo > $@
 # overrides for libtool perusing the dummy sources
@@ -5931,6 +5959,10 @@ selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh
 fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
 	cp $(srcdir)/$(FPU_HOST_HEADER) $@
 
+fpu-target.inc: fpu-target.h $(srcdir)/libgfortran.h
+	grep '^#define GFC_FPE_' < $(top_srcdir)/../gcc/fortran/libgfortran.h > $@ || true
+	grep '^#define GFC_FPE_' < $(srcdir)/libgfortran.h >> $@ || true
+
 @MAINTAINER_MODE_TRUE@$(i_all_c): m4/all.m4 $(I_M4_DEPS2)
 @MAINTAINER_MODE_TRUE@	$(M4) -Dfile=$@ -I$(srcdir)/m4 all.m4 > $@
 
diff --git a/libgfortran/config/fpu-387.h b/libgfortran/config/fpu-387.h
index 7b562930731..46720b20e8d 100644
--- a/libgfortran/config/fpu-387.h
+++ b/libgfortran/config/fpu-387.h
@@ -23,6 +23,8 @@ a copy of the GCC Runtime Library Exception along with this program;
 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 <http://www.gnu.org/licenses/>.  */
 
+#include <assert.h>
+
 #ifndef __SSE_MATH__
 #include "cpuid.h"
 #endif
@@ -62,24 +64,122 @@ has_sse (void)
 
 #define _FPU_RC_MASK    0x3
 
+/* This structure corresponds to the layout of the block
+   written by FSTENV.  */
+typedef struct
+{
+  unsigned short int __control_word;
+  unsigned short int __unused1;
+  unsigned short int __status_word;
+  unsigned short int __unused2;
+  unsigned short int __tags;
+  unsigned short int __unused3;
+  unsigned int __eip;
+  unsigned short int __cs_selector;
+  unsigned int __opcode:11;
+  unsigned int __unused4:5;
+  unsigned int __data_offset;
+  unsigned short int __data_selector;
+  unsigned short int __unused5;
+  unsigned int __mxcsr;
+}
+my_fenv_t;
+
+
+/* Raise the supported floating-point exceptions from EXCEPTS.  Other
+   bits in EXCEPTS are ignored.  Code originally borrowed from
+   libatomic/config/x86/fenv.c.  */
+
+static void
+local_feraiseexcept (int excepts)
+{
+  if (excepts & _FPU_MASK_IM)
+    {
+      float f = 0.0f;
+#ifdef __SSE_MATH__
+      volatile float r __attribute__ ((unused));
+      __asm__ __volatile__ ("%vdivss\t{%0, %d0|%d0, %0}" : "+x" (f));
+      r = f; /* Needed to trigger exception.   */
+#else
+      __asm__ __volatile__ ("fdiv\t{%y0, %0|%0, %y0}" : "+t" (f));
+      /* No need for fwait, exception is triggered by emitted fstp.  */
+#endif
+    }
+  if (excepts & _FPU_MASK_DM)
+    {
+      my_fenv_t temp;
+      __asm__ __volatile__ ("fnstenv\t%0" : "=m" (temp));
+      temp.__status_word |= _FPU_MASK_DM;
+      __asm__ __volatile__ ("fldenv\t%0" : : "m" (temp));
+      __asm__ __volatile__ ("fwait");
+    }
+  if (excepts & _FPU_MASK_ZM)
+    {
+      float f = 1.0f, g = 0.0f;
+#ifdef __SSE_MATH__
+      volatile float r __attribute__ ((unused));
+      __asm__ __volatile__ ("%vdivss\t{%1, %d0|%d0, %1}" : "+x" (f) : "xm" (g));
+      r = f; /* Needed to trigger exception.   */
+#else
+      __asm__ __volatile__ ("fdivs\t%1" : "+t" (f) : "m" (g));
+      /* No need for fwait, exception is triggered by emitted fstp.  */
+#endif
+    }
+  if (excepts & _FPU_MASK_OM)
+    {
+      my_fenv_t temp;
+      __asm__ __volatile__ ("fnstenv\t%0" : "=m" (temp));
+      temp.__status_word |= _FPU_MASK_OM;
+      __asm__ __volatile__ ("fldenv\t%0" : : "m" (temp));
+      __asm__ __volatile__ ("fwait");
+    }
+  if (excepts & _FPU_MASK_UM)
+    {
+      my_fenv_t temp;
+      __asm__ __volatile__ ("fnstenv\t%0" : "=m" (temp));
+      temp.__status_word |= _FPU_MASK_UM;
+      __asm__ __volatile__ ("fldenv\t%0" : : "m" (temp));
+      __asm__ __volatile__ ("fwait");
+    }
+  if (excepts & _FPU_MASK_PM)
+    {
+      float f = 1.0f, g = 3.0f;
+#ifdef __SSE_MATH__
+      volatile float r __attribute__ ((unused));
+      __asm__ __volatile__ ("%vdivss\t{%1, %d0|%d0, %1}" : "+x" (f) : "xm" (g));
+      r = f; /* Needed to trigger exception.   */
+#else
+      __asm__ __volatile__ ("fdivs\t%1" : "+t" (f) : "m" (g));
+      /* No need for fwait, exception is triggered by emitted fstp.  */
+#endif
+    }
+}
+
 
 void
-set_fpu (void)
+set_fpu_trap_exceptions (int trap, int notrap)
 {
-  int excepts = 0;
+  int exc_set = 0, exc_clr = 0;
   unsigned short cw;
 
-  __asm__ __volatile__ ("fstcw\t%0" : "=m" (cw));
+  if (trap & GFC_FPE_INVALID) exc_set |= _FPU_MASK_IM;
+  if (trap & GFC_FPE_DENORMAL) exc_set |= _FPU_MASK_DM;
+  if (trap & GFC_FPE_ZERO) exc_set |= _FPU_MASK_ZM;
+  if (trap & GFC_FPE_OVERFLOW) exc_set |= _FPU_MASK_OM;
+  if (trap & GFC_FPE_UNDERFLOW) exc_set |= _FPU_MASK_UM;
+  if (trap & GFC_FPE_INEXACT) exc_set |= _FPU_MASK_PM;
+
+  if (notrap & GFC_FPE_INVALID) exc_clr |= _FPU_MASK_IM;
+  if (notrap & GFC_FPE_DENORMAL) exc_clr |= _FPU_MASK_DM;
+  if (notrap & GFC_FPE_ZERO) exc_clr |= _FPU_MASK_ZM;
+  if (notrap & GFC_FPE_OVERFLOW) exc_clr |= _FPU_MASK_OM;
+  if (notrap & GFC_FPE_UNDERFLOW) exc_clr |= _FPU_MASK_UM;
+  if (notrap & GFC_FPE_INEXACT) exc_clr |= _FPU_MASK_PM;
 
-  if (options.fpe & GFC_FPE_INVALID) excepts |= _FPU_MASK_IM;
-  if (options.fpe & GFC_FPE_DENORMAL) excepts |= _FPU_MASK_DM;
-  if (options.fpe & GFC_FPE_ZERO) excepts |= _FPU_MASK_ZM;
-  if (options.fpe & GFC_FPE_OVERFLOW) excepts |= _FPU_MASK_OM;
-  if (options.fpe & GFC_FPE_UNDERFLOW) excepts |= _FPU_MASK_UM;
-  if (options.fpe & GFC_FPE_INEXACT) excepts |= _FPU_MASK_PM;
+  __asm__ __volatile__ ("fstcw\t%0" : "=m" (cw));
 
-  cw |= _FPU_MASK_ALL;
-  cw &= ~excepts;
+  cw |= exc_clr;
+  cw &= ~exc_set;
 
   __asm__ __volatile__ ("fnclex\n\tfldcw\t%0" : : "m" (cw));
 
@@ -90,8 +190,8 @@ set_fpu (void)
       __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse));
 
       /* The SSE exception masks are shifted by 7 bits.  */
-      cw_sse |= _FPU_MASK_ALL << 7;
-      cw_sse &= ~(excepts << 7);
+      cw_sse |= (exc_clr << 7);
+      cw_sse &= ~(exc_set << 7);
 
       /* Clear stalled exception flags.  */
       cw_sse &= ~_FPU_EX_ALL;
@@ -100,6 +200,47 @@ set_fpu (void)
     }
 }
 
+void
+set_fpu (void)
+{
+  set_fpu_trap_exceptions (options.fpe, 0);
+}
+
+int
+get_fpu_trap_exceptions (void)
+{
+  int res = 0;
+  unsigned short cw;
+
+  __asm__ __volatile__ ("fstcw\t%0" : "=m" (cw));
+  cw &= _FPU_MASK_ALL;
+
+  if (has_sse())
+    {
+      unsigned int cw_sse;
+
+      __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse));
+
+      /* The SSE exception masks are shifted by 7 bits.  */
+      cw = cw | ((cw_sse >> 7) & _FPU_MASK_ALL);
+    }
+
+  if (~cw & _FPU_MASK_IM) res |= GFC_FPE_INVALID;
+  if (~cw & _FPU_MASK_DM) res |= GFC_FPE_DENORMAL;
+  if (~cw & _FPU_MASK_ZM) res |= GFC_FPE_ZERO;
+  if (~cw & _FPU_MASK_OM) res |= GFC_FPE_OVERFLOW;
+  if (~cw & _FPU_MASK_UM) res |= GFC_FPE_UNDERFLOW;
+  if (~cw & _FPU_MASK_PM) res |= GFC_FPE_INEXACT;
+
+  return res;
+}
+
+int
+support_fpu_trap (int flag __attribute__((unused)))
+{
+  return 1;
+}
+
 int
 get_fpu_except_flags (void)
 {
@@ -107,7 +248,7 @@ get_fpu_except_flags (void)
   int excepts;
   int result = 0;
 
-  __asm__ __volatile__ ("fnstsw\t%0" : "=a" (cw));
+  __asm__ __volatile__ ("fnstsw\t%0" : "=am" (cw));
   excepts = cw;
 
   if (has_sse())
@@ -131,6 +272,70 @@ get_fpu_except_flags (void)
 }
 
 void
+set_fpu_except_flags (int set, int clear)
+{
+  my_fenv_t temp;
+  int exc_set = 0, exc_clr = 0;
+
+  /* Translate from GFC_PE_* values to _FPU_MASK_* values.  */
+  if (set & GFC_FPE_INVALID)
+    exc_set |= _FPU_MASK_IM;
+  if (clear & GFC_FPE_INVALID)
+    exc_clr |= _FPU_MASK_IM;
+
+  if (set & GFC_FPE_DENORMAL)
+    exc_set |= _FPU_MASK_DM;
+  if (clear & GFC_FPE_DENORMAL)
+    exc_clr |= _FPU_MASK_DM;
+
+  if (set & GFC_FPE_ZERO)
+    exc_set |= _FPU_MASK_ZM;
+  if (clear & GFC_FPE_ZERO)
+    exc_clr |= _FPU_MASK_ZM;
+
+  if (set & GFC_FPE_OVERFLOW)
+    exc_set |= _FPU_MASK_OM;
+  if (clear & GFC_FPE_OVERFLOW)
+    exc_clr |= _FPU_MASK_OM;
+
+  if (set & GFC_FPE_UNDERFLOW)
+    exc_set |= _FPU_MASK_UM;
+  if (clear & GFC_FPE_UNDERFLOW)
+    exc_clr |= _FPU_MASK_UM;
+
+  if (set & GFC_FPE_INEXACT)
+    exc_set |= _FPU_MASK_PM;
+  if (clear & GFC_FPE_INEXACT)
+    exc_clr |= _FPU_MASK_PM;
+
+
+  /* Change the flags. This is tricky on 387 (unlike SSE), because we have
+     FNSTSW but no FLDSW instruction.  */
+  __asm__ __volatile__ ("fnstenv\t%0" : "=m" (temp));
+  temp.__status_word &= ~exc_clr;
+  __asm__ __volatile__ ("fldenv\t%0" : : "m" (temp));
+
+  /* Change the flags on SSE.  */
+
+  if (has_sse())
+  {
+    unsigned int cw_sse;
+
+    __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse));
+    cw_sse &= ~exc_clr;
+    __asm__ __volatile__ ("%vldmxcsr\t%0" : : "m" (cw_sse));
+  }
+
+  local_feraiseexcept (exc_set);
+}
+
+int
+support_fpu_flag (int flag __attribute__((unused)))
+{
+  return 1;
+}
+
+void
 set_fpu_rounding_mode (int round)
 {
   int round_mode;
@@ -213,3 +418,44 @@ get_fpu_rounding_mode (void)
       return GFC_FPE_INVALID; /* Should be unreachable.  */
     }
 }
+
+int
+support_fpu_rounding_mode (int mode __attribute__((unused)))
+{
+  return 1;
+}
+
+void
+get_fpu_state (void *state)
+{
+  my_fenv_t *envp = state;
+
+  /* Check we can actually store the FPU state in the allocated size.  */
+  assert (sizeof(my_fenv_t) <= (size_t) GFC_FPE_STATE_BUFFER_SIZE);
+
+  __asm__ __volatile__ ("fnstenv\t%0" : "=m" (*envp));
+
+  /* fnstenv has the side effect of masking all exceptions, so we need
+     to restore the control word after that.  */
+  __asm__ __volatile__ ("fldcw\t%0" : : "m" (envp->__control_word));
+
+  if (has_sse())
+    __asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (envp->__mxcsr));
+}
+
+void
+set_fpu_state (void *state)
+{
+  my_fenv_t *envp = state;
+
+  /* Check we can actually store the FPU state in the allocated size.  */
+  assert (sizeof(my_fenv_t) <= (size_t) GFC_FPE_STATE_BUFFER_SIZE);
+
+  /* glibc sources (sysdeps/x86_64/fpu/fesetenv.c) do something more
+     complex than this, but I think it suffices in our case.  */
+  __asm__ __volatile__ ("fldenv\t%0" : : "m" (*envp));
+
+  if (has_sse())
+    __asm__ __volatile__ ("%vldmxcsr\t%0" : : "m" (envp->__mxcsr));
+}
+
diff --git a/libgfortran/config/fpu-aix.h b/libgfortran/config/fpu-aix.h
index a05fab83737..6b44ab7c850 100644
--- a/libgfortran/config/fpu-aix.h
+++ b/libgfortran/config/fpu-aix.h
@@ -33,15 +33,103 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <fpxcp.h>
 #endif
 
+#ifdef HAVE_FENV_H
+#include <fenv.h>
+#endif
+
+
 void
-set_fpu (void)
+set_fpu_trap_exceptions (int trap, int notrap)
 {
-  fptrap_t mode = 0;
+  fptrap_t mode_set = 0, mode_clr = 0;
 
-  if (options.fpe & GFC_FPE_INVALID)
 #ifdef TRP_INVALID
-    mode |= TRP_INVALID;
-#else
+  if (trap & GFC_FPE_INVALID)
+    mode_set |= TRP_INVALID;
+  if (notrap & GFC_FPE_INVALID)
+    mode_clr |= TRP_INVALID;
+#endif
+
+#ifdef TRP_DIV_BY_ZERO
+  if (trap & GFC_FPE_ZERO)
+    mode_set |= TRP_DIV_BY_ZERO;
+  if (notrap & GFC_FPE_ZERO)
+    mode_clr |= TRP_DIV_BY_ZERO;
+#endif
+
+#ifdef TRP_OVERFLOW
+  if (trap & GFC_FPE_OVERFLOW)
+    mode_set |= TRP_OVERFLOW;
+  if (notrap & GFC_FPE_OVERFLOW)
+    mode_clr |= TRP_OVERFLOW;
+#endif
+
+#ifdef TRP_UNDERFLOW
+  if (trap & GFC_FPE_UNDERFLOW)
+    mode_set |= TRP_UNDERFLOW;
+  if (notrap & GFC_FPE_UNDERFLOW)
+    mode_clr |= TRP_UNDERFLOW;
+#endif
+
+#ifdef TRP_INEXACT
+  if (trap & GFC_FPE_INEXACT)
+    mode_set |= TRP_INEXACT;
+  if (notrap & GFC_FPE_INEXACT)
+    mode_clr |= TRP_INEXACT;
+#endif
+
+  fp_trap (FP_TRAP_SYNC);
+  fp_enable (mode_set);
+  fp_disable (mode_clr);
+}
+
+
+int
+get_fpu_trap_exceptions (void)
+{
+  int res = 0;
+
+#ifdef TRP_INVALID
+  if (fp_is_enabled (TRP_INVALID))
+    res |= GFC_FPE_INVALID;
+#endif
+
+#ifdef TRP_DIV_BY_ZERO
+  if (fp_is_enabled (TRP_DIV_BY_ZERO))
+    res |= GFC_FPE_ZERO;
+#endif
+
+#ifdef TRP_OVERFLOW
+  if (fp_is_enabled (TRP_OVERFLOW))
+    res |= GFC_FPE_OVERFLOW;
+#endif
+
+#ifdef TRP_UNDERFLOW
+  if (fp_is_enabled (TRP_UNDERFLOW))
+    res |= GFC_FPE_UNDERFLOW;
+#endif
+
+#ifdef TRP_INEXACT
+  if (fp_is_enabled (TRP_INEXACT))
+    res |= GFC_FPE_INEXACT;
+#endif
+
+  return res;
+}
+
+
+int
+support_fpu_trap (int flag)
+{
+  return support_fpu_flag (flag);
+}
+
+
+void
+set_fpu (void)
+{
+#ifndef TRP_INVALID
+  if (options.fpe & GFC_FPE_INVALID)
     estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
 	        "exception not supported.\n");
 #endif
@@ -50,43 +138,33 @@ set_fpu (void)
     estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
 	        "exception not supported.\n");
 
+#ifndef TRP_DIV_BY_ZERO
   if (options.fpe & GFC_FPE_ZERO)
-#ifdef TRP_DIV_BY_ZERO
-    mode |= TRP_DIV_BY_ZERO;
-#else
     estr_write ("Fortran runtime warning: IEEE 'division by zero' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef TRP_OVERFLOW
   if (options.fpe & GFC_FPE_OVERFLOW)
-#ifdef TRP_OVERFLOW
-    mode |= TRP_OVERFLOW;
-#else
     estr_write ("Fortran runtime warning: IEEE 'overflow' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef TRP_UNDERFLOW
   if (options.fpe & GFC_FPE_UNDERFLOW)
-#ifdef TRP_UNDERFLOW
-    mode |= TRP_UNDERFLOW;
-#else
     estr_write ("Fortran runtime warning: IEEE 'underflow' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef TRP_INEXACT
   if (options.fpe & GFC_FPE_INEXACT)
-#ifdef TRP_INEXACT
-    mode |= TRP_INEXACT;
-#else
     estr_write ("Fortran runtime warning: IEEE 'inexact' "
 	        "exception not supported.\n");
 #endif
 
-  fp_trap(FP_TRAP_SYNC);
-  fp_enable(mode);
+  set_fpu_trap_exceptions (options.fpe, 0);
 }
 
-
 int
 get_fpu_except_flags (void)
 {
@@ -118,6 +196,98 @@ get_fpu_except_flags (void)
 }
 
 
+void
+set_fpu_except_flags (int set, int clear)
+{
+  int exc_set = 0, exc_clr = 0;
+
+#ifdef FP_INVALID
+  if (set & GFC_FPE_INVALID)
+    exc_set |= FP_INVALID;
+  else if (clear & GFC_FPE_INVALID)
+    exc_clr |= FP_INVALID;
+#endif
+
+#ifdef FP_DIV_BY_ZERO
+  if (set & GFC_FPE_ZERO)
+    exc_set |= FP_DIV_BY_ZERO;
+  else if (clear & GFC_FPE_ZERO)
+    exc_clr |= FP_DIV_BY_ZERO;
+#endif
+
+#ifdef FP_OVERFLOW
+  if (set & GFC_FPE_OVERFLOW)
+    exc_set |= FP_OVERFLOW;
+  else if (clear & GFC_FPE_OVERFLOW)
+    exc_clr |= FP_OVERFLOW;
+#endif
+
+#ifdef FP_UNDERFLOW
+  if (set & GFC_FPE_UNDERFLOW)
+    exc_set |= FP_UNDERFLOW;
+  else if (clear & GFC_FPE_UNDERFLOW)
+    exc_clr |= FP_UNDERFLOW;
+#endif
+
+/* AIX does not have FP_DENORMAL.  */
+
+#ifdef FP_INEXACT
+  if (set & GFC_FPE_INEXACT)
+    exc_set |= FP_INEXACT;
+  else if (clear & GFC_FPE_INEXACT)
+    exc_clr |= FP_INEXACT;
+#endif
+
+  fp_clr_flag (exc_clr);
+  fp_set_flag (exc_set);
+}
+
+
+int
+support_fpu_flag (int flag)
+{
+  if (flag & GFC_FPE_INVALID)
+  {
+#ifndef FP_INVALID
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_ZERO)
+  {
+#ifndef FP_DIV_BY_ZERO
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_OVERFLOW)
+  {
+#ifndef FP_OVERFLOW
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_UNDERFLOW)
+  {
+#ifndef FP_UNDERFLOW
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_DENORMAL)
+  {
+    /* AIX does not support denormal flag.  */
+    return 0;
+  }
+  else if (flag & GFC_FPE_INEXACT)
+  {
+#ifndef FP_INEXACT
+    return 0;
+#endif
+  }
+
+  return 1;
+}
+
+
+
+
 int
 get_fpu_rounding_mode (void)
 {
@@ -188,3 +358,60 @@ set_fpu_rounding_mode (int mode)
 
   fesetround (rnd_mode);
 }
+
+
+int
+support_fpu_rounding_mode (int mode)
+{
+  switch (mode)
+    {
+      case GFC_FPE_TONEAREST:
+#ifdef FE_TONEAREST
+	return 1;
+#else
+	return 0;
+#endif
+
+#ifdef FE_UPWARD
+	return 1;
+#else
+	return 0;
+#endif
+
+#ifdef FE_DOWNWARD
+	return 1;
+#else
+	return 0;
+#endif
+
+#ifdef FE_TOWARDZERO
+	return 1;
+#else
+	return 0;
+#endif
+
+      default:
+	return 0;
+    }
+}
+
+
+
+void
+get_fpu_state (void *state)
+{
+  /* Check we can actually store the FPU state in the allocated size.  */
+  assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
+
+  fegetenv (state);
+}
+
+void
+set_fpu_state (void *state)
+{
+  /* Check we can actually store the FPU state in the allocated size.  */
+  assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
+
+  fesetenv (state);
+}
+
diff --git a/libgfortran/config/fpu-generic.h b/libgfortran/config/fpu-generic.h
index d9be4d99bd3..bbad875f40e 100644
--- a/libgfortran/config/fpu-generic.h
+++ b/libgfortran/config/fpu-generic.h
@@ -51,6 +51,12 @@ set_fpu (void)
 	        "exception not supported.\n");
 }
 
+void
+set_fpu_trap_exceptions (int trap __attribute__((unused)),
+			 int notrap __attribute__((unused)))
+{
+}
+
 int
 get_fpu_except_flags (void)
 {
diff --git a/libgfortran/config/fpu-glibc.h b/libgfortran/config/fpu-glibc.h
index cf216847a83..695b9d3fbb0 100644
--- a/libgfortran/config/fpu-glibc.h
+++ b/libgfortran/config/fpu-glibc.h
@@ -27,63 +27,141 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
    feenableexcept function in fenv.h to set individual exceptions
    (there's nothing to do that in C99).  */
 
+#include <assert.h>
+
 #ifdef HAVE_FENV_H
 #include <fenv.h>
 #endif
 
-void set_fpu (void)
-{
-  if (FE_ALL_EXCEPT != 0)
-    fedisableexcept (FE_ALL_EXCEPT);
 
-  if (options.fpe & GFC_FPE_INVALID)
+void set_fpu_trap_exceptions (int trap, int notrap)
+{
 #ifdef FE_INVALID
+  if (trap & GFC_FPE_INVALID)
     feenableexcept (FE_INVALID);
-#else
+  if (notrap & GFC_FPE_INVALID)
+    fedisableexcept (FE_INVALID);
+#endif
+
+/* glibc does never have a FE_DENORMAL.  */
+#ifdef FE_DENORMAL
+  if (trap & GFC_FPE_DENORMAL)
+    feenableexcept (FE_DENORMAL);
+  if (notrap & GFC_FPE_DENORMAL)
+    fedisableexcept (FE_DENORMAL);
+#endif
+
+#ifdef FE_DIVBYZERO
+  if (trap & GFC_FPE_ZERO)
+    feenableexcept (FE_DIVBYZERO);
+  if (notrap & GFC_FPE_ZERO)
+    fedisableexcept (FE_DIVBYZERO);
+#endif
+
+#ifdef FE_OVERFLOW
+  if (trap & GFC_FPE_OVERFLOW)
+    feenableexcept (FE_OVERFLOW);
+  if (notrap & GFC_FPE_OVERFLOW)
+    fedisableexcept (FE_OVERFLOW);
+#endif
+
+#ifdef FE_UNDERFLOW
+  if (trap & GFC_FPE_UNDERFLOW)
+    feenableexcept (FE_UNDERFLOW);
+  if (notrap & GFC_FPE_UNDERFLOW)
+    fedisableexcept (FE_UNDERFLOW);
+#endif
+
+#ifdef FE_INEXACT
+  if (trap & GFC_FPE_INEXACT)
+    feenableexcept (FE_INEXACT);
+  if (notrap & GFC_FPE_INEXACT)
+    fedisableexcept (FE_INEXACT);
+#endif
+}
+
+
+int
+get_fpu_trap_exceptions (void)
+{
+  int exceptions = fegetexcept ();
+  int res = 0;
+
+#ifdef FE_INVALID
+  if (exceptions & FE_INVALID) res |= GFC_FPE_INVALID;
+#endif
+
+#ifdef FE_DENORMAL
+  if (exceptions & FE_DENORMAL) res |= GFC_FPE_DENORMAL;
+#endif
+
+#ifdef FE_DIVBYZERO
+  if (exceptions & FE_DIVBYZERO) res |= GFC_FPE_ZERO;
+#endif
+
+#ifdef FE_OVERFLOW
+  if (exceptions & FE_OVERFLOW) res |= GFC_FPE_OVERFLOW;
+#endif
+
+#ifdef FE_UNDERFLOW
+  if (exceptions & FE_UNDERFLOW) res |= GFC_FPE_UNDERFLOW;
+#endif
+
+#ifdef FE_INEXACT
+  if (exceptions & FE_INEXACT) res |= GFC_FPE_INEXACT;
+#endif
+
+  return res;
+}
+
+
+int
+support_fpu_trap (int flag)
+{
+  return support_fpu_flag (flag);
+}
+
+
+void set_fpu (void)
+{
+#ifndef FE_INVALID
+  if (options.fpe & GFC_FPE_INVALID)
     estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
 	        "exception not supported.\n");
 #endif
 
 /* glibc does never have a FE_DENORMAL.  */
+#ifndef FE_DENORMAL
   if (options.fpe & GFC_FPE_DENORMAL)
-#ifdef FE_DENORMAL
-    feenableexcept (FE_DENORMAL);
-#else
     estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef FE_DIVBYZERO
   if (options.fpe & GFC_FPE_ZERO)
-#ifdef FE_DIVBYZERO
-    feenableexcept (FE_DIVBYZERO);
-#else
     estr_write ("Fortran runtime warning: IEEE 'division by zero' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef FE_OVERFLOW
   if (options.fpe & GFC_FPE_OVERFLOW)
-#ifdef FE_OVERFLOW
-    feenableexcept (FE_OVERFLOW);
-#else
     estr_write ("Fortran runtime warning: IEEE 'overflow' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef FE_UNDERFLOW
   if (options.fpe & GFC_FPE_UNDERFLOW)
-#ifdef FE_UNDERFLOW
-    feenableexcept (FE_UNDERFLOW);
-#else
     estr_write ("Fortran runtime warning: IEEE 'underflow' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef FE_INEXACT
   if (options.fpe & GFC_FPE_INEXACT)
-#ifdef FE_INEXACT
-    feenableexcept (FE_INEXACT);
-#else
     estr_write ("Fortran runtime warning: IEEE 'inexact' "
 	        "exception not supported.\n");
 #endif
+
+  set_fpu_trap_exceptions (options.fpe, 0);
 }
 
 
@@ -129,6 +207,102 @@ get_fpu_except_flags (void)
 }
 
 
+void
+set_fpu_except_flags (int set, int clear)
+{
+  int exc_set = 0, exc_clr = 0;
+
+#ifdef FE_INVALID
+  if (set & GFC_FPE_INVALID)
+    exc_set |= FE_INVALID;
+  else if (clear & GFC_FPE_INVALID)
+    exc_clr |= FE_INVALID;
+#endif
+
+#ifdef FE_DIVBYZERO
+  if (set & GFC_FPE_ZERO)
+    exc_set |= FE_DIVBYZERO;
+  else if (clear & GFC_FPE_ZERO)
+    exc_clr |= FE_DIVBYZERO;
+#endif
+
+#ifdef FE_OVERFLOW
+  if (set & GFC_FPE_OVERFLOW)
+    exc_set |= FE_OVERFLOW;
+  else if (clear & GFC_FPE_OVERFLOW)
+    exc_clr |= FE_OVERFLOW;
+#endif
+
+#ifdef FE_UNDERFLOW
+  if (set & GFC_FPE_UNDERFLOW)
+    exc_set |= FE_UNDERFLOW;
+  else if (clear & GFC_FPE_UNDERFLOW)
+    exc_clr |= FE_UNDERFLOW;
+#endif
+
+#ifdef FE_DENORMAL
+  if (set & GFC_FPE_DENORMAL)
+    exc_set |= FE_DENORMAL;
+  else if (clear & GFC_FPE_DENORMAL)
+    exc_clr |= FE_DENORMAL;
+#endif
+
+#ifdef FE_INEXACT
+  if (set & GFC_FPE_INEXACT)
+    exc_set |= FE_INEXACT;
+  else if (clear & GFC_FPE_INEXACT)
+    exc_clr |= FE_INEXACT;
+#endif
+
+  feclearexcept (exc_clr);
+  feraiseexcept (exc_set);
+}
+
+
+int
+support_fpu_flag (int flag)
+{
+  if (flag & GFC_FPE_INVALID)
+  {
+#ifndef FE_INVALID
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_ZERO)
+  {
+#ifndef FE_DIVBYZERO
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_OVERFLOW)
+  {
+#ifndef FE_OVERFLOW
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_UNDERFLOW)
+  {
+#ifndef FE_UNDERFLOW
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_DENORMAL)
+  {
+#ifndef FE_DENORMAL
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_INEXACT)
+  {
+#ifndef FE_INEXACT
+    return 0;
+#endif
+  }
+
+  return 1;
+}
+
+
 int
 get_fpu_rounding_mode (void)
 {
@@ -199,3 +373,60 @@ set_fpu_rounding_mode (int mode)
 
   fesetround (rnd_mode);
 }
+
+
+int
+support_fpu_rounding_mode (int mode)
+{
+  switch (mode)
+    {
+      case GFC_FPE_TONEAREST:
+#ifdef FE_TONEAREST
+	return 1;
+#else
+	return 0;
+#endif
+
+#ifdef FE_UPWARD
+	return 1;
+#else
+	return 0;
+#endif
+
+#ifdef FE_DOWNWARD
+	return 1;
+#else
+	return 0;
+#endif
+
+#ifdef FE_TOWARDZERO
+	return 1;
+#else
+	return 0;
+#endif
+
+      default:
+	return 0;
+    }
+}
+
+
+void
+get_fpu_state (void *state)
+{
+  /* Check we can actually store the FPU state in the allocated size.  */
+  assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
+
+  fegetenv (state);
+}
+
+
+void
+set_fpu_state (void *state)
+{
+  /* Check we can actually store the FPU state in the allocated size.  */
+  assert (sizeof(fenv_t) <= GFC_FPE_STATE_BUFFER_SIZE);
+
+  fesetenv (state);
+}
+
diff --git a/libgfortran/config/fpu-sysv.h b/libgfortran/config/fpu-sysv.h
index e7ba88f4a94..0105cf74b8b 100644
--- a/libgfortran/config/fpu-sysv.h
+++ b/libgfortran/config/fpu-sysv.h
@@ -25,73 +25,174 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 /* FPU-related code for SysV platforms with fpsetmask().  */
 
+/* BSD and Solaris systems have slightly different types and functions
+   naming.  We deal with these here, to simplify the code below.  */
+
+#if HAVE_FP_EXCEPT
+# define FP_EXCEPT_TYPE fp_except
+#elif HAVE_FP_EXCEPT_T
+# define FP_EXCEPT_TYPE fp_except_t
+#else
+  choke me
+#endif
+
+#if HAVE_FP_RND
+# define FP_RND_TYPE fp_rnd
+#elif HAVE_FP_RND_T
+# define FP_RND_TYPE fp_rnd_t
+#else
+  choke me
+#endif
+
+#if HAVE_FPSETSTICKY
+# define FPSETSTICKY fpsetsticky
+#elif HAVE_FPRESETSTICKY
+# define FPSETSTICKY fpresetsticky
+#else
+  choke me
+#endif
+
+
 void
-set_fpu (void)
+set_fpu_trap_exceptions (int trap, int notrap)
 {
-  int cw = 0;
+  FP_EXCEPT_TYPE cw = fpgetmask();
 
-  if (options.fpe & GFC_FPE_INVALID)
 #ifdef FP_X_INV
+  if (trap & GFC_FPE_INVALID)
     cw |= FP_X_INV;
-#else
+  if (notrap & GFC_FPE_INVALID)
+    cw &= ~FP_X_INV;
+#endif
+
+#ifdef FP_X_DNML
+  if (trap & GFC_FPE_DENORMAL)
+    cw |= FP_X_DNML;
+  if (notrap & GFC_FPE_DENORMAL)
+    cw &= ~FP_X_DNML;
+#endif
+
+#ifdef FP_X_DZ
+  if (trap & GFC_FPE_ZERO)
+    cw |= FP_X_DZ;
+  if (notrap & GFC_FPE_ZERO)
+    cw &= ~FP_X_DZ;
+#endif
+
+#ifdef FP_X_OFL
+  if (trap & GFC_FPE_OVERFLOW)
+    cw |= FP_X_OFL;
+  if (notrap & GFC_FPE_OVERFLOW)
+    cw &= ~FP_X_OFL;
+#endif
+
+#ifdef FP_X_UFL
+  if (trap & GFC_FPE_UNDERFLOW)
+    cw |= FP_X_UFL;
+  if (notrap & GFC_FPE_UNDERFLOW)
+    cw &= ~FP_X_UFL;
+#endif
+
+#ifdef FP_X_IMP
+  if (trap & GFC_FPE_INEXACT)
+    cw |= FP_X_IMP;
+  if (notrap & GFC_FPE_INEXACT)
+    cw &= ~FP_X_IMP;
+#endif
+
+  fpsetmask(cw);
+}
+
+
+int
+get_fpu_trap_exceptions (void)
+{
+  int res = 0;
+  FP_EXCEPT_TYPE cw = fpgetmask();
+
+#ifdef FP_X_INV
+  if (cw & FP_X_INV) res |= GFC_FPE_INVALID;
+#endif
+
+#ifdef FP_X_DNML
+  if (cw & FP_X_DNML) res |= GFC_FPE_DENORMAL;
+#endif
+
+#ifdef FP_X_DZ
+  if (cw & FP_X_DZ) res |= GFC_FPE_ZERO;
+#endif
+
+#ifdef FP_X_OFL
+  if (cw & FP_X_OFL) res |= GFC_FPE_OVERFLOW;
+#endif
+
+#ifdef FP_X_UFL
+  if (cw & FP_X_UFL) res |= GFC_FPE_UNDERFLOW;
+#endif
+
+#ifdef FP_X_IMP
+  if (cw & FP_X_IMP) res |= GFC_FPE_INEXACT;
+#endif
+
+  return res;
+}
+
+
+int
+support_fpu_trap (int flag)
+{
+  return support_fpu_flag (flag);
+}
+
+
+void
+set_fpu (void)
+{
+#ifndef FP_X_INV
+  if (options.fpe & GFC_FPE_INVALID)
     estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef FP_X_DNML
   if (options.fpe & GFC_FPE_DENORMAL)
-#ifdef FP_X_DNML
-    cw |= FP_X_DNML;
-#else
     estr_write ("Fortran runtime warning: Floating point 'denormal operand' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef FP_X_DZ
   if (options.fpe & GFC_FPE_ZERO)
-#ifdef FP_X_DZ
-    cw |= FP_X_DZ;
-#else
     estr_write ("Fortran runtime warning: IEEE 'division by zero' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef FP_X_OFL
   if (options.fpe & GFC_FPE_OVERFLOW)
-#ifdef FP_X_OFL
-    cw |= FP_X_OFL;
-#else
     estr_write ("Fortran runtime warning: IEEE 'overflow' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef FP_X_UFL
   if (options.fpe & GFC_FPE_UNDERFLOW)
-#ifdef FP_X_UFL
-    cw |= FP_X_UFL;
-#else
     estr_write ("Fortran runtime warning: IEEE 'underflow' "
 	        "exception not supported.\n");
 #endif
 
+#ifndef FP_X_IMP
   if (options.fpe & GFC_FPE_INEXACT)
-#ifdef FP_X_IMP
-    cw |= FP_X_IMP;
-#else
     estr_write ("Fortran runtime warning: IEEE 'inexact' "
 	        "exception not supported.\n");
 #endif
 
-  fpsetmask(cw);
+  set_fpu_trap_exceptions (options.fpe, 0);
 }
 
+
 int
 get_fpu_except_flags (void)
 {
   int result;
-#if HAVE_FP_EXCEPT
-  fp_except set_excepts;
-#elif HAVE_FP_EXCEPT_T
-  fp_except_t set_excepts;
-#else
-  choke me
-#endif
+  FP_EXCEPT_TYPE set_excepts;
 
   result = 0;
   set_excepts = fpgetsticky ();
@@ -130,6 +231,103 @@ get_fpu_except_flags (void)
 }
 
 
+void
+set_fpu_except_flags (int set, int clear)
+{
+  FP_EXCEPT_TYPE flags;
+
+  flags = fpgetsticky ();
+
+#ifdef FP_X_INV
+  if (set & GFC_FPE_INVALID)
+    flags |= FP_X_INV;
+  if (clear & GFC_FPE_INVALID)
+    flags &= ~FP_X_INV;
+#endif
+
+#ifdef FP_X_DZ
+  if (set & GFC_FPE_ZERO)
+    flags |= FP_X_DZ;
+  if (clear & GFC_FPE_ZERO)
+    flags &= ~FP_X_DZ;
+#endif
+
+#ifdef FP_X_OFL
+  if (set & GFC_FPE_OVERFLOW)
+    flags |= FP_X_OFL;
+  if (clear & GFC_FPE_OVERFLOW)
+    flags &= ~FP_X_OFL;
+#endif
+
+#ifdef FP_X_UFL
+  if (set & GFC_FPE_UNDERFLOW)
+    flags |= FP_X_UFL;
+  if (clear & GFC_FPE_UNDERFLOW)
+    flags &= ~FP_X_UFL;
+#endif
+
+#ifdef FP_X_DNML
+  if (set & GFC_FPE_DENORMAL)
+    flags |= FP_X_DNML;
+  if (clear & GFC_FPE_DENORMAL)
+    flags &= ~FP_X_DNML;
+#endif
+
+#ifdef FP_X_IMP
+  if (set & GFC_FPE_INEXACT)
+    flags |= FP_X_IMP;
+  if (clear & GFC_FPE_INEXACT)
+    flags &= ~FP_X_IMP;
+#endif
+
+  FPSETSTICKY (flags);
+}
+
+
+int
+support_fpu_flag (int flag)
+{
+  if (flag & GFC_FPE_INVALID)
+  {
+#ifndef FP_X_INV
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_ZERO)
+  {
+#ifndef FP_X_DZ
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_OVERFLOW)
+  {
+#ifndef FP_X_OFL
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_UNDERFLOW)
+  {
+#ifndef FP_X_UFL
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_DENORMAL)
+  {
+#ifndef FP_X_DNML
+    return 0;
+#endif
+  }
+  else if (flag & GFC_FPE_INEXACT)
+  {
+#ifndef FP_X_IMP
+    return 0;
+#endif
+  }
+
+  return 1;
+}
+
+
 int
 get_fpu_rounding_mode (void)
 {
@@ -163,13 +361,7 @@ get_fpu_rounding_mode (void)
 void
 set_fpu_rounding_mode (int mode)
 {
-#if HAVE_FP_RND
-  fp_rnd rnd_mode;
-#elif HAVE_FP_RND_T
-  fp_rnd_t rnd_mode;
-#else
-  choke me
-#endif
+  FP_RND_TYPE rnd_mode;
 
   switch (mode)
     {
@@ -201,3 +393,78 @@ set_fpu_rounding_mode (int mode)
     }
   fpsetround (rnd_mode);
 }
+
+
+int
+support_fpu_rounding_mode (int mode)
+{
+  switch (mode)
+    {
+      case GFC_FPE_TONEAREST:
+#ifdef FP_RN
+	return 1;
+#else
+	return 0;
+#endif
+
+      case GFC_FPE_UPWARD:
+#ifdef FP_RP
+	return 1;
+#else
+	return 0;
+#endif
+
+      case GFC_FPE_DOWNWARD:
+#ifdef FP_RM
+	return 1;
+#else
+	return 0;
+#endif
+
+      case GFC_FPE_TOWARDZERO:
+#ifdef FP_RZ
+	return 1;
+#else
+	return 0;
+#endif
+
+      default:
+	return 0;
+    }
+}
+
+
+typedef struct
+{
+  FP_EXCEPT_TYPE mask;
+  FP_EXCEPT_TYPE sticky;
+  FP_RND_TYPE round;
+} fpu_state_t;
+
+
+void
+get_fpu_state (void *s)
+{
+  fpu_state_t *state = s;
+
+  /* Check we can actually store the FPU state in the allocated size.  */
+  assert (sizeof(fpu_state_t) <= GFC_FPE_STATE_BUFFER_SIZE);
+
+  state->mask = fpgetmask ();
+  state->sticky = fpgetsticky ();
+  state->round = fpgetround ();
+}
+
+void
+set_fpu_state (void *s)
+{
+  fpu_state_t *state = s;
+
+  /* Check we can actually store the FPU state in the allocated size.  */
+  assert (sizeof(fpu_state_t) <= GFC_FPE_STATE_BUFFER_SIZE);
+
+  fpsetmask (state->mask);
+  FPSETSTICKY (state->sticky);
+  fpsetround (state->round);
+}
+
diff --git a/libgfortran/configure b/libgfortran/configure
index 05ab1683e02..f123c48dba2 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -606,6 +606,9 @@ am__EXEEXT_TRUE
 LTLIBOBJS
 LIBOBJS
 IEEE_FLAGS
+IEEE_SUPPORT
+IEEE_SUPPORT_FALSE
+IEEE_SUPPORT_TRUE
 FPU_HOST_HEADER
 LIBGFOR_BUILD_QUAD_FALSE
 LIBGFOR_BUILD_QUAD_TRUE
@@ -12346,7 +12349,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 12349 "configure"
+#line 12352 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -12452,7 +12455,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 12455 "configure"
+#line 12458 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -26119,9 +26122,22 @@ fi
 . ${srcdir}/configure.host
 { $as_echo "$as_me:${as_lineno-$LINENO}: FPU dependent file will be ${fpu_host}.h" >&5
 $as_echo "$as_me: FPU dependent file will be ${fpu_host}.h" >&6;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: Support for IEEE modules: ${ieee_support}" >&5
+$as_echo "$as_me: Support for IEEE modules: ${ieee_support}" >&6;}
 FPU_HOST_HEADER=config/${fpu_host}.h
 
 
+# Whether we will build the IEEE modules
+ if test x${ieee_support} = xyes; then
+  IEEE_SUPPORT_TRUE=
+  IEEE_SUPPORT_FALSE='#'
+else
+  IEEE_SUPPORT_TRUE='#'
+  IEEE_SUPPORT_FALSE=
+fi
+
+
+
 # Some targets require additional compiler options for IEEE compatibility.
 IEEE_FLAGS="${ieee_flags}"
 
@@ -26765,6 +26781,10 @@ if test -z "${LIBGFOR_BUILD_QUAD_TRUE}" && test -z "${LIBGFOR_BUILD_QUAD_FALSE}"
   as_fn_error "conditional \"LIBGFOR_BUILD_QUAD\" was never defined.
 Usually this means the macro was only invoked conditionally." "$LINENO" 5
 fi
+if test -z "${IEEE_SUPPORT_TRUE}" && test -z "${IEEE_SUPPORT_FALSE}"; then
+  as_fn_error "conditional \"IEEE_SUPPORT\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
 
 : ${CONFIG_STATUS=./config.status}
 ac_write_fail=0
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index 57e26ce9e48..be4b7beba04 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -530,6 +530,10 @@ AC_CHECK_TYPES([fp_rnd,fp_rnd_t], [], [], [[
 #include <math.h>
 ]])
 
+# Check whether we have fpsetsticky or fpresetsticky
+AC_CHECK_FUNC([fpsetsticky],[have_fpsetsticky=yes AC_DEFINE([HAVE_FPSETSTICKY],[1],[fpsetsticky is present])])
+AC_CHECK_FUNC([fpresetsticky],[have_fpresetsticky=yes AC_DEFINE([HAVE_FPRESETSTICKY],[1],[fpresetsticky is present])])
+
 # Check for AIX fp_trap and fp_enable
 AC_CHECK_FUNC([fp_trap],[have_fp_trap=yes AC_DEFINE([HAVE_FP_TRAP],[1],[fp_trap is present])])
 AC_CHECK_FUNC([fp_enable],[have_fp_enable=yes AC_DEFINE([HAVE_FP_ENABLE],[1],[fp_enable is present])])
@@ -539,9 +543,14 @@ AC_CHECK_FUNC([fp_enable],[have_fp_enable=yes AC_DEFINE([HAVE_FP_ENABLE],[1],[fp
 # build chain.
 . ${srcdir}/configure.host
 AC_MSG_NOTICE([FPU dependent file will be ${fpu_host}.h])
+AC_MSG_NOTICE([Support for IEEE modules: ${ieee_support}])
 FPU_HOST_HEADER=config/${fpu_host}.h
 AC_SUBST(FPU_HOST_HEADER)
 
+# Whether we will build the IEEE modules
+AM_CONDITIONAL(IEEE_SUPPORT,[test x${ieee_support} = xyes])
+AC_SUBST(IEEE_SUPPORT)
+
 # Some targets require additional compiler options for IEEE compatibility.
 IEEE_FLAGS="${ieee_flags}"
 AC_SUBST(IEEE_FLAGS)
diff --git a/libgfortran/configure.host b/libgfortran/configure.host
index 92b6433b968..72da478ac5e 100644
--- a/libgfortran/configure.host
+++ b/libgfortran/configure.host
@@ -19,26 +19,32 @@
 
 # DEFAULTS
 fpu_host='fpu-generic'
+ieee_support='no'
+
+if test "x${have_fp_enable}" = "xyes" && test "x${have_fp_trap}" = "xyes"; then
+  fpu_host='fpu-aix'
+  ieee_support='yes'
+fi
+
+if test "x${have_fpsetmask}" = "xyes"; then
+  fpu_host='fpu-sysv'
+  ieee_support='yes'
+fi
 
 if test "x${have_feenableexcept}" = "xyes"; then
   fpu_host='fpu-glibc'
+  ieee_support='yes'
 fi
 
 # x86 asm should be used instead of glibc, since glibc doesn't support
 # the x86 denormal exception.
 case "${host_cpu}" in
   i?86 | x86_64)
-    fpu_host='fpu-387' ;;
+    fpu_host='fpu-387'
+    ieee_support='yes'
+    ;;
 esac
 
-if test "x${have_fpsetmask}" = "xyes"; then
-  fpu_host='fpu-sysv'
-fi
-
-if test "x${have_fp_enable}" = "xyes" && test "x${have_fp_trap}" = "xyes"; then
-  fpu_host='fpu-aix'
-fi
-
 # Some targets require additional compiler options for NaN/Inf.
 ieee_flags=
 case "${host_cpu}" in
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 80a9a00071a..20f7f289b59 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1195,6 +1195,117 @@ GFORTRAN_1.5 {
     _gfortran_backtrace;
 } GFORTRAN_1.4; 
 
+GFORTRAN_1.6 {
+  global:
+    _gfortran_ieee_copy_sign_4_4_;
+    _gfortran_ieee_copy_sign_4_8_;
+    _gfortran_ieee_copy_sign_8_4_;
+    _gfortran_ieee_copy_sign_8_8_;
+    _gfortran_ieee_is_finite_4_;
+    _gfortran_ieee_is_finite_8_;
+    _gfortran_ieee_is_nan_4_;
+    _gfortran_ieee_is_nan_8_;
+    _gfortran_ieee_is_negative_4_;
+    _gfortran_ieee_is_negative_8_;
+    _gfortran_ieee_is_normal_4_;
+    _gfortran_ieee_is_normal_8_;
+    _gfortran_ieee_logb_4_;
+    _gfortran_ieee_logb_8_;
+    _gfortran_ieee_next_after_4_4_;
+    _gfortran_ieee_next_after_4_8_;
+    _gfortran_ieee_next_after_8_4_;
+    _gfortran_ieee_next_after_8_8_;
+    _gfortran_ieee_procedure_entry;
+    _gfortran_ieee_procedure_exit;
+    _gfortran_ieee_rem_4_4_;
+    _gfortran_ieee_rem_4_8_;
+    _gfortran_ieee_rem_8_4_;
+    _gfortran_ieee_rem_8_8_;
+    _gfortran_ieee_rint_4_;
+    _gfortran_ieee_rint_8_;
+    _gfortran_ieee_scalb_4_;
+    _gfortran_ieee_scalb_8_;
+    _gfortran_ieee_unordered_4_4_;
+    _gfortran_ieee_unordered_4_8_;
+    _gfortran_ieee_unordered_8_4_;
+    _gfortran_ieee_unordered_8_8_;
+    __ieee_arithmetic_MOD_ieee_class_4;
+    __ieee_arithmetic_MOD_ieee_class_8;
+    __ieee_arithmetic_MOD_ieee_class_type_eq;
+    __ieee_arithmetic_MOD_ieee_class_type_ne;
+    __ieee_arithmetic_MOD_ieee_get_rounding_mode;
+    __ieee_arithmetic_MOD_ieee_get_underflow_mode;
+    __ieee_arithmetic_MOD_ieee_round_type_eq;
+    __ieee_arithmetic_MOD_ieee_round_type_ne;
+    __ieee_arithmetic_MOD_ieee_selected_real_kind;
+    __ieee_arithmetic_MOD_ieee_set_rounding_mode;
+    __ieee_arithmetic_MOD_ieee_set_underflow_mode;
+    __ieee_arithmetic_MOD_ieee_support_datatype_4;
+    __ieee_arithmetic_MOD_ieee_support_datatype_8;
+    __ieee_arithmetic_MOD_ieee_support_datatype_10;
+    __ieee_arithmetic_MOD_ieee_support_datatype_16;
+    __ieee_arithmetic_MOD_ieee_support_datatype_noarg;
+    __ieee_arithmetic_MOD_ieee_support_denormal_4;
+    __ieee_arithmetic_MOD_ieee_support_denormal_8;
+    __ieee_arithmetic_MOD_ieee_support_denormal_10;
+    __ieee_arithmetic_MOD_ieee_support_denormal_16;
+    __ieee_arithmetic_MOD_ieee_support_denormal_noarg;
+    __ieee_arithmetic_MOD_ieee_support_divide_4;
+    __ieee_arithmetic_MOD_ieee_support_divide_8;
+    __ieee_arithmetic_MOD_ieee_support_divide_10;
+    __ieee_arithmetic_MOD_ieee_support_divide_16;
+    __ieee_arithmetic_MOD_ieee_support_divide_noarg;
+    __ieee_arithmetic_MOD_ieee_support_inf_4;
+    __ieee_arithmetic_MOD_ieee_support_inf_8;
+    __ieee_arithmetic_MOD_ieee_support_inf_10;
+    __ieee_arithmetic_MOD_ieee_support_inf_16;
+    __ieee_arithmetic_MOD_ieee_support_inf_noarg;
+    __ieee_arithmetic_MOD_ieee_support_io_4;
+    __ieee_arithmetic_MOD_ieee_support_io_8;
+    __ieee_arithmetic_MOD_ieee_support_io_10;
+    __ieee_arithmetic_MOD_ieee_support_io_16;
+    __ieee_arithmetic_MOD_ieee_support_io_noarg;
+    __ieee_arithmetic_MOD_ieee_support_nan_4;
+    __ieee_arithmetic_MOD_ieee_support_nan_8;
+    __ieee_arithmetic_MOD_ieee_support_nan_10;
+    __ieee_arithmetic_MOD_ieee_support_nan_16;
+    __ieee_arithmetic_MOD_ieee_support_nan_noarg;
+    __ieee_arithmetic_MOD_ieee_support_rounding_4;
+    __ieee_arithmetic_MOD_ieee_support_rounding_8;
+    __ieee_arithmetic_MOD_ieee_support_rounding_10;
+    __ieee_arithmetic_MOD_ieee_support_rounding_16;
+    __ieee_arithmetic_MOD_ieee_support_rounding_noarg;
+    __ieee_arithmetic_MOD_ieee_support_sqrt_4;
+    __ieee_arithmetic_MOD_ieee_support_sqrt_8;
+    __ieee_arithmetic_MOD_ieee_support_sqrt_10;
+    __ieee_arithmetic_MOD_ieee_support_sqrt_16;
+    __ieee_arithmetic_MOD_ieee_support_sqrt_noarg;
+    __ieee_arithmetic_MOD_ieee_support_standard_4;
+    __ieee_arithmetic_MOD_ieee_support_standard_8;
+    __ieee_arithmetic_MOD_ieee_support_standard_10;
+    __ieee_arithmetic_MOD_ieee_support_standard_16;
+    __ieee_arithmetic_MOD_ieee_support_standard_noarg;
+    __ieee_arithmetic_MOD_ieee_support_underflow_control_4;
+    __ieee_arithmetic_MOD_ieee_support_underflow_control_8;
+    __ieee_arithmetic_MOD_ieee_support_underflow_control_10;
+    __ieee_arithmetic_MOD_ieee_support_underflow_control_16;
+    __ieee_arithmetic_MOD_ieee_support_underflow_control_noarg;
+    __ieee_arithmetic_MOD_ieee_value_4;
+    __ieee_arithmetic_MOD_ieee_value_8;
+    __ieee_exceptions_MOD_ieee_all;
+    __ieee_exceptions_MOD_ieee_get_flag;
+    __ieee_exceptions_MOD_ieee_get_halting_mode;
+    __ieee_exceptions_MOD_ieee_get_status;
+    __ieee_exceptions_MOD_ieee_set_flag;
+    __ieee_exceptions_MOD_ieee_set_halting_mode;
+    __ieee_exceptions_MOD_ieee_set_status;
+    __ieee_exceptions_MOD_ieee_support_flag_4;
+    __ieee_exceptions_MOD_ieee_support_flag_8;
+    __ieee_exceptions_MOD_ieee_support_flag_noarg;
+    __ieee_exceptions_MOD_ieee_support_halting;
+    __ieee_exceptions_MOD_ieee_usual;
+} GFORTRAN_1.5; 
+
 F2C_1.0 {
   global:
     _gfortran_f2c_specific__abs_c4;
diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90
new file mode 100644
index 00000000000..1dce4f79ee4
--- /dev/null
+++ b/libgfortran/ieee/ieee_arithmetic.F90
@@ -0,0 +1,817 @@
+!    Implementation of the IEEE_ARITHMETIC standard intrinsic module
+!    Copyright (C) 2013 Free Software Foundation, Inc.
+!    Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+! 
+! This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+! 
+! 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.
+! 
+! Under Section 7 of GPL version 3, you are granted additional
+! permissions described in the GCC Runtime Library Exception, version
+! 3.1, as published by the Free Software Foundation.
+! 
+! You should have received a copy of the GNU General Public License and
+! a copy of the GCC Runtime Library Exception along with this program;
+! see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+! <http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+#include "fpu-target.inc"
+
+module IEEE_ARITHMETIC
+
+  use IEEE_EXCEPTIONS
+  implicit none
+  private
+
+  ! Every public symbol from IEEE_EXCEPTIONS must be made public here
+  public :: IEEE_FLAG_TYPE, IEEE_INVALID, IEEE_OVERFLOW, &
+    IEEE_DIVIDE_BY_ZERO, IEEE_UNDERFLOW, IEEE_INEXACT, IEEE_USUAL, &
+    IEEE_ALL, IEEE_STATUS_TYPE, IEEE_GET_FLAG, IEEE_GET_HALTING_MODE, &
+    IEEE_GET_STATUS, IEEE_SET_FLAG, IEEE_SET_HALTING_MODE, &
+    IEEE_SET_STATUS, IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
+
+  ! Derived types and named constants
+
+  type, public :: IEEE_CLASS_TYPE
+    private
+    integer :: hidden
+  end type
+
+  type(IEEE_CLASS_TYPE), parameter, public :: &
+    IEEE_OTHER_VALUE       = IEEE_CLASS_TYPE(0), &
+    IEEE_SIGNALING_NAN     = IEEE_CLASS_TYPE(1), &
+    IEEE_QUIET_NAN         = IEEE_CLASS_TYPE(2), &
+    IEEE_NEGATIVE_INF      = IEEE_CLASS_TYPE(3), &
+    IEEE_NEGATIVE_NORMAL   = IEEE_CLASS_TYPE(4), &
+    IEEE_NEGATIVE_DENORMAL = IEEE_CLASS_TYPE(5), &
+    IEEE_NEGATIVE_ZERO     = IEEE_CLASS_TYPE(6), &
+    IEEE_POSITIVE_ZERO     = IEEE_CLASS_TYPE(7), &
+    IEEE_POSITIVE_DENORMAL = IEEE_CLASS_TYPE(8), &
+    IEEE_POSITIVE_NORMAL   = IEEE_CLASS_TYPE(9), &
+    IEEE_POSITIVE_INF      = IEEE_CLASS_TYPE(10)
+
+  type, public :: IEEE_ROUND_TYPE
+    private
+    integer :: hidden
+  end type
+
+  type(IEEE_ROUND_TYPE), parameter, public :: &
+    IEEE_NEAREST           = IEEE_ROUND_TYPE(GFC_FPE_TONEAREST), &
+    IEEE_TO_ZERO           = IEEE_ROUND_TYPE(GFC_FPE_TOWARDZERO), &
+    IEEE_UP                = IEEE_ROUND_TYPE(GFC_FPE_UPWARD), &
+    IEEE_DOWN              = IEEE_ROUND_TYPE(GFC_FPE_DOWNWARD), &
+    IEEE_OTHER             = IEEE_ROUND_TYPE(0)
+
+
+  ! Equality operators on the derived types
+  interface operator (==)
+    module procedure IEEE_CLASS_TYPE_EQ, IEEE_ROUND_TYPE_EQ
+  end interface
+  public :: operator(==)
+
+  interface operator (/=)
+    module procedure IEEE_CLASS_TYPE_NE, IEEE_ROUND_TYPE_NE
+  end interface
+  public :: operator (/=)
+
+
+  ! IEEE_IS_FINITE
+
+  interface
+    elemental logical function _gfortran_ieee_is_finite_4(X)
+      real(kind=4), intent(in) :: X
+    end function
+    elemental logical function _gfortran_ieee_is_finite_8(X)
+      real(kind=8), intent(in) :: X
+    end function
+  end interface
+
+  interface IEEE_IS_FINITE
+    procedure _gfortran_ieee_is_finite_4, _gfortran_ieee_is_finite_8
+  end interface
+  public :: IEEE_IS_FINITE
+
+  ! IEEE_IS_NAN
+
+  interface
+    elemental logical function _gfortran_ieee_is_nan_4(X)
+      real(kind=4), intent(in) :: X
+    end function
+    elemental logical function _gfortran_ieee_is_nan_8(X)
+      real(kind=8), intent(in) :: X
+    end function
+  end interface
+
+  interface IEEE_IS_NAN
+    procedure _gfortran_ieee_is_nan_4, _gfortran_ieee_is_nan_8
+  end interface
+  public :: IEEE_IS_NAN
+
+  ! IEEE_IS_NEGATIVE
+
+  interface
+    elemental logical function _gfortran_ieee_is_negative_4(X)
+      real(kind=4), intent(in) :: X
+    end function
+    elemental logical function _gfortran_ieee_is_negative_8(X)
+      real(kind=8), intent(in) :: X
+    end function
+  end interface
+
+  interface IEEE_IS_NEGATIVE
+    procedure _gfortran_ieee_is_negative_4, _gfortran_ieee_is_negative_8
+  end interface
+  public :: IEEE_IS_NEGATIVE
+
+  ! IEEE_IS_NORMAL
+
+  interface
+    elemental logical function _gfortran_ieee_is_normal_4(X)
+      real(kind=4), intent(in) :: X
+    end function
+    elemental logical function _gfortran_ieee_is_normal_8(X)
+      real(kind=8), intent(in) :: X
+    end function
+  end interface
+
+  interface IEEE_IS_NORMAL
+    procedure _gfortran_ieee_is_normal_4, _gfortran_ieee_is_normal_8
+  end interface
+  public :: IEEE_IS_NORMAL
+
+  ! IEEE_COPY_SIGN
+
+  interface
+    elemental real(kind=4) function _gfortran_ieee_copy_sign_4_4 (X,Y)
+      real(kind=4), intent(in) :: X
+      real(kind=4), intent(in) :: Y
+    end function
+    elemental real(kind=4) function _gfortran_ieee_copy_sign_4_8 (X,Y)
+      real(kind=4), intent(in) :: X
+      real(kind=8), intent(in) :: Y
+    end function
+    elemental real(kind=8) function _gfortran_ieee_copy_sign_8_4 (X,Y)
+      real(kind=8), intent(in) :: X
+      real(kind=4), intent(in) :: Y
+    end function
+    elemental real(kind=8) function _gfortran_ieee_copy_sign_8_8 (X,Y)
+      real(kind=8), intent(in) :: X
+      real(kind=8), intent(in) :: Y
+    end function
+  end interface
+
+  interface IEEE_COPY_SIGN
+    procedure _gfortran_ieee_copy_sign_4_4, _gfortran_ieee_copy_sign_4_8, &
+              _gfortran_ieee_copy_sign_8_4, _gfortran_ieee_copy_sign_8_8
+  end interface
+  public :: IEEE_COPY_SIGN
+
+  ! IEEE_UNORDERED
+
+  interface
+    elemental logical function _gfortran_ieee_unordered_4_4 (X,Y)
+      real(kind=4), intent(in) :: X
+      real(kind=4), intent(in) :: Y
+    end function
+    elemental logical function _gfortran_ieee_unordered_4_8 (X,Y)
+      real(kind=4), intent(in) :: X
+      real(kind=8), intent(in) :: Y
+    end function
+    elemental logical function _gfortran_ieee_unordered_8_4 (X,Y)
+      real(kind=8), intent(in) :: X
+      real(kind=4), intent(in) :: Y
+    end function
+    elemental logical function _gfortran_ieee_unordered_8_8 (X,Y)
+      real(kind=8), intent(in) :: X
+      real(kind=8), intent(in) :: Y
+    end function
+  end interface
+
+  interface IEEE_UNORDERED
+    procedure _gfortran_ieee_unordered_4_4, _gfortran_ieee_unordered_4_8, &
+              _gfortran_ieee_unordered_8_4, _gfortran_ieee_unordered_8_8
+  end interface
+  public :: IEEE_UNORDERED
+
+  ! IEEE_LOGB
+
+  interface
+    elemental real(kind=4) function _gfortran_ieee_logb_4 (X)
+      real(kind=4), intent(in) :: X
+    end function
+    elemental real(kind=8) function _gfortran_ieee_logb_8 (X)
+      real(kind=8), intent(in) :: X
+    end function
+  end interface
+
+  interface IEEE_LOGB
+    procedure _gfortran_ieee_logb_4, _gfortran_ieee_logb_8
+  end interface
+  public :: IEEE_LOGB
+
+  ! IEEE_NEXT_AFTER
+
+  interface
+    elemental real(kind=4) function _gfortran_ieee_next_after_4_4 (X, Y)
+      real(kind=4), intent(in) :: X
+      real(kind=4), intent(in) :: Y
+    end function
+    elemental real(kind=4) function _gfortran_ieee_next_after_4_8 (X, Y)
+      real(kind=4), intent(in) :: X
+      real(kind=8), intent(in) :: Y
+    end function
+    elemental real(kind=8) function _gfortran_ieee_next_after_8_4 (X, Y)
+      real(kind=8), intent(in) :: X
+      real(kind=4), intent(in) :: Y
+    end function
+    elemental real(kind=8) function _gfortran_ieee_next_after_8_8 (X, Y)
+      real(kind=8), intent(in) :: X
+      real(kind=8), intent(in) :: Y
+    end function
+  end interface
+
+  interface IEEE_NEXT_AFTER
+    procedure _gfortran_ieee_next_after_4_4, _gfortran_ieee_next_after_4_8, &
+              _gfortran_ieee_next_after_8_4, _gfortran_ieee_next_after_8_8
+  end interface
+  public :: IEEE_NEXT_AFTER
+
+  ! IEEE_REM
+
+  interface
+    elemental real(kind=4) function _gfortran_ieee_rem_4_4 (X, Y)
+      real(kind=4), intent(in) :: X
+      real(kind=4), intent(in) :: Y
+    end function
+    elemental real(kind=8) function _gfortran_ieee_rem_4_8 (X, Y)
+      real(kind=4), intent(in) :: X
+      real(kind=8), intent(in) :: Y
+    end function
+    elemental real(kind=8) function _gfortran_ieee_rem_8_4 (X, Y)
+      real(kind=8), intent(in) :: X
+      real(kind=4), intent(in) :: Y
+    end function
+    elemental real(kind=8) function _gfortran_ieee_rem_8_8 (X, Y)
+      real(kind=8), intent(in) :: X
+      real(kind=8), intent(in) :: Y
+    end function
+  end interface
+
+  interface IEEE_REM
+    procedure _gfortran_ieee_rem_4_4, _gfortran_ieee_rem_4_8, &
+              _gfortran_ieee_rem_8_4, _gfortran_ieee_rem_8_8
+  end interface
+  public :: IEEE_REM
+
+  ! IEEE_RINT
+
+  interface
+    elemental real(kind=4) function _gfortran_ieee_rint_4 (X)
+      real(kind=4), intent(in) :: X
+    end function
+    elemental real(kind=8) function _gfortran_ieee_rint_8 (X)
+      real(kind=8), intent(in) :: X
+    end function
+  end interface
+
+  interface IEEE_RINT
+    procedure _gfortran_ieee_rint_4, _gfortran_ieee_rint_8
+  end interface
+  public :: IEEE_RINT
+
+  ! IEEE_SCALB
+
+  interface
+    elemental real(kind=4) function _gfortran_ieee_scalb_4 (X, I)
+      real(kind=4), intent(in) :: X
+      integer, intent(in) :: I
+    end function
+    elemental real(kind=8) function _gfortran_ieee_scalb_8 (X, I)
+      real(kind=8), intent(in) :: X
+      integer, intent(in) :: I
+    end function
+  end interface
+
+  interface IEEE_SCALB
+    procedure _gfortran_ieee_scalb_4, _gfortran_ieee_scalb_8
+  end interface
+  public :: IEEE_SCALB
+
+  ! IEEE_VALUE
+
+  interface IEEE_VALUE
+    module procedure IEEE_VALUE_4, IEEE_VALUE_8
+  end interface
+  public :: IEEE_VALUE
+
+  ! IEEE_CLASS
+
+  interface IEEE_CLASS
+    module procedure IEEE_CLASS_4, IEEE_CLASS_8
+  end interface
+  public :: IEEE_CLASS
+
+  ! Public declarations for contained procedures
+  public :: IEEE_GET_ROUNDING_MODE, IEEE_SET_ROUNDING_MODE
+  public :: IEEE_GET_UNDERFLOW_MODE, IEEE_SET_UNDERFLOW_MODE
+  public :: IEEE_SELECTED_REAL_KIND
+
+  ! IEEE_SUPPORT_ROUNDING
+
+  interface IEEE_SUPPORT_ROUNDING
+    module procedure IEEE_SUPPORT_ROUNDING_4, IEEE_SUPPORT_ROUNDING_8, &
+#ifdef HAVE_GFC_REAL_10
+                     IEEE_SUPPORT_ROUNDING_10, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+                     IEEE_SUPPORT_ROUNDING_16, &
+#endif
+                     IEEE_SUPPORT_ROUNDING_NOARG
+  end interface
+  public :: IEEE_SUPPORT_ROUNDING
+  
+  ! Interface to the FPU-specific function
+  interface
+    pure integer function support_rounding_helper(flag) &
+        bind(c, name="_gfortrani_support_fpu_rounding_mode")
+      integer, intent(in), value :: flag
+    end function
+  end interface
+
+! IEEE_SUPPORT_* generic functions
+
+#if defined(HAVE_GFC_REAL_10) && defined(HAVE_GFC_REAL_16)
+# define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_10, NAME/**/_16, NAME/**/_NOARG
+#elif defined(HAVE_GFC_REAL_10)
+# define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_10, NAME/**/_NOARG
+#elif defined(HAVE_GFC_REAL_16)
+# define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_16, NAME/**/_NOARG
+#else
+# define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_NOARG
+#endif
+
+#define SUPPORTGENERIC(NAME) \
+  interface NAME ; module procedure MACRO1(NAME) ; end interface ; \
+  public :: NAME
+
+SUPPORTGENERIC(IEEE_SUPPORT_DATATYPE)
+SUPPORTGENERIC(IEEE_SUPPORT_DENORMAL)
+SUPPORTGENERIC(IEEE_SUPPORT_DIVIDE)
+SUPPORTGENERIC(IEEE_SUPPORT_INF)
+SUPPORTGENERIC(IEEE_SUPPORT_IO)
+SUPPORTGENERIC(IEEE_SUPPORT_NAN)
+SUPPORTGENERIC(IEEE_SUPPORT_SQRT)
+SUPPORTGENERIC(IEEE_SUPPORT_STANDARD)
+SUPPORTGENERIC(IEEE_SUPPORT_UNDERFLOW_CONTROL)
+
+contains
+
+  ! Equality operators for IEEE_CLASS_TYPE and IEEE_ROUNDING_MODE
+  elemental logical function IEEE_CLASS_TYPE_EQ (X, Y) result(res)
+    implicit none
+    type(IEEE_CLASS_TYPE), intent(in) :: X, Y
+    res = (X%hidden == Y%hidden)
+  end function
+
+  elemental logical function IEEE_CLASS_TYPE_NE (X, Y) result(res)
+    implicit none
+    type(IEEE_CLASS_TYPE), intent(in) :: X, Y
+    res = (X%hidden /= Y%hidden)
+  end function
+
+  elemental logical function IEEE_ROUND_TYPE_EQ (X, Y) result(res)
+    implicit none
+    type(IEEE_ROUND_TYPE), intent(in) :: X, Y
+    res = (X%hidden == Y%hidden)
+  end function
+
+  elemental logical function IEEE_ROUND_TYPE_NE (X, Y) result(res)
+    implicit none
+    type(IEEE_ROUND_TYPE), intent(in) :: X, Y
+    res = (X%hidden /= Y%hidden)
+  end function
+
+  ! IEEE_SELECTED_REAL_KIND
+  integer function IEEE_SELECTED_REAL_KIND (P, R, RADIX) result(res)
+    implicit none
+    integer, intent(in), optional :: P, R, RADIX
+    integer :: p2, r2
+
+    p2 = 0 ; r2 = 0
+    if (present(p)) p2 = p
+    if (present(r)) r2 = r
+
+    ! The only IEEE types we support right now are binary
+    if (present(radix)) then
+      if (radix /= 2) then
+        res = -5
+        return
+      endif
+    endif
+
+    ! Does IEEE float fit?
+    if (precision(0.) >= p2 .and. range(0.) >= r2) then
+      res = kind(0.)
+      return
+    endif
+
+    ! Does IEEE double fit?
+    if (precision(0.d0) >= p2 .and. range(0.d0) >= r2) then
+      res = kind(0.d0)
+      return
+    endif
+
+    if (precision(0.d0) < p2 .and. range(0.d0) < r2) then
+      res = -3
+      return
+    endif
+
+    if (precision(0.d0) < p2) then
+      res = -1
+      return
+    endif
+
+   res = -2
+  end function
+
+
+  ! IEEE_CLASS
+
+  elemental function IEEE_CLASS_4 (X) result(res)
+    implicit none
+    real(kind=4), intent(in) :: X
+    type(IEEE_CLASS_TYPE) :: res
+
+    interface
+      pure integer function _gfortrani_ieee_class_helper_4(val)
+        real(kind=4), intent(in) :: val
+      end function
+    end interface
+
+    res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_4(X))
+  end function
+
+  elemental function IEEE_CLASS_8 (X) result(res)
+    implicit none
+    real(kind=8), intent(in) :: X
+    type(IEEE_CLASS_TYPE) :: res
+
+    interface
+      pure integer function _gfortrani_ieee_class_helper_8(val)
+        real(kind=8), intent(in) :: val
+      end function
+    end interface
+
+    res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_8(X))
+  end function
+
+  ! IEEE_VALUE
+
+  elemental real(kind=4) function IEEE_VALUE_4(X, C) result(res)
+    implicit none
+    real(kind=4), intent(in) :: X
+    type(IEEE_CLASS_TYPE), intent(in) :: C
+
+    select case (C%hidden)
+      case (1)     ! IEEE_SIGNALING_NAN
+        res = -1
+        res = sqrt(res)
+      case (2)     ! IEEE_QUIET_NAN
+        res = -1
+        res = sqrt(res)
+      case (3)     ! IEEE_NEGATIVE_INF
+        res = huge(res)
+        res = (-res) * res
+      case (4)     ! IEEE_NEGATIVE_NORMAL
+        res = -42
+      case (5)     ! IEEE_NEGATIVE_DENORMAL
+        res = -tiny(res)
+        res = res / 2
+      case (6)     ! IEEE_NEGATIVE_ZERO
+        res = 0
+        res = -res
+      case (7)     ! IEEE_POSITIVE_ZERO
+        res = 0
+      case (8)     ! IEEE_POSITIVE_DENORMAL
+        res = tiny(res)
+        res = res / 2
+      case (9)     ! IEEE_POSITIVE_NORMAL
+        res = 42
+      case (10)    ! IEEE_POSITIVE_INF
+        res = huge(res)
+        res = res * res
+      case default ! IEEE_OTHER_VALUE, should not happen
+        res = 0
+     end select
+  end function
+
+  elemental real(kind=8) function IEEE_VALUE_8(X, C) result(res)
+    implicit none
+    real(kind=8), intent(in) :: X
+    type(IEEE_CLASS_TYPE), intent(in) :: C
+
+    select case (C%hidden)
+      case (1)     ! IEEE_SIGNALING_NAN
+        res = -1
+        res = sqrt(res)
+      case (2)     ! IEEE_QUIET_NAN
+        res = -1
+        res = sqrt(res)
+      case (3)     ! IEEE_NEGATIVE_INF
+        res = huge(res)
+        res = (-res) * res
+      case (4)     ! IEEE_NEGATIVE_NORMAL
+        res = -42
+      case (5)     ! IEEE_NEGATIVE_DENORMAL
+        res = -tiny(res)
+        res = res / 2
+      case (6)     ! IEEE_NEGATIVE_ZERO
+        res = 0
+        res = -res
+      case (7)     ! IEEE_POSITIVE_ZERO
+        res = 0
+      case (8)     ! IEEE_POSITIVE_DENORMAL
+        res = tiny(res)
+        res = res / 2
+      case (9)     ! IEEE_POSITIVE_NORMAL
+        res = 42
+      case (10)    ! IEEE_POSITIVE_INF
+        res = huge(res)
+        res = res * res
+      case default ! IEEE_OTHER_VALUE, should not happen
+        res = 0
+     end select
+  end function
+
+
+  ! IEEE_GET_ROUNDING_MODE
+
+  subroutine IEEE_GET_ROUNDING_MODE (ROUND_VALUE)
+    implicit none
+    type(IEEE_ROUND_TYPE), intent(out) :: ROUND_VALUE
+    integer :: i
+
+    interface
+      integer function helper() &
+        bind(c, name="_gfortrani_get_fpu_rounding_mode")
+      end function
+    end interface
+
+    ! FIXME: Use intermediate variable i to avoid triggering PR59023
+    i = helper()
+    ROUND_VALUE = IEEE_ROUND_TYPE(i)
+  end subroutine
+
+
+  ! IEEE_SET_ROUNDING_MODE
+
+  subroutine IEEE_SET_ROUNDING_MODE (ROUND_VALUE)
+    implicit none
+    type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
+
+    interface
+      subroutine helper(val) &
+          bind(c, name="_gfortrani_set_fpu_rounding_mode")
+        integer, value :: val
+      end subroutine
+    end interface
+    
+    call helper(ROUND_VALUE%hidden)
+  end subroutine
+
+
+  ! IEEE_GET_UNDERFLOW_MODE
+
+  subroutine IEEE_GET_UNDERFLOW_MODE (GRADUAL)
+    implicit none
+    logical, intent(out) :: GRADUAL
+    ! We do not support getting/setting underflow mode yet. We still
+    ! provide the procedures to avoid link-time error if a user program
+    ! uses it protected by a call to IEEE_SUPPORT_UNDERFLOW_CONTROL
+    call abort
+  end subroutine
+
+
+  ! IEEE_SET_UNDERFLOW_MODE
+
+  subroutine IEEE_SET_UNDERFLOW_MODE (GRADUAL)
+    implicit none
+    logical, intent(in) :: GRADUAL
+    ! We do not support getting/setting underflow mode yet. We still
+    ! provide the procedures to avoid link-time error if a user program
+    ! uses it protected by a call to IEEE_SUPPORT_UNDERFLOW_CONTROL
+    call abort
+  end subroutine
+
+! IEEE_SUPPORT_ROUNDING
+
+  pure logical function IEEE_SUPPORT_ROUNDING_4 (ROUND_VALUE, X) result(res)
+    implicit none
+    real(kind=4), intent(in) :: X
+    type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
+    res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
+  end function
+
+  pure logical function IEEE_SUPPORT_ROUNDING_8 (ROUND_VALUE, X) result(res)
+    implicit none
+    real(kind=8), intent(in) :: X
+    type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
+    res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
+  end function
+
+#ifdef HAVE_GFC_REAL_10
+  pure logical function IEEE_SUPPORT_ROUNDING_10 (ROUND_VALUE, X) result(res)
+    implicit none
+    real(kind=10), intent(in) :: X
+    type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
+    res = .false.
+  end function
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+  pure logical function IEEE_SUPPORT_ROUNDING_16 (ROUND_VALUE, X) result(res)
+    implicit none
+    real(kind=16), intent(in) :: X
+    type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
+    res = .false.
+  end function
+#endif
+
+  pure logical function IEEE_SUPPORT_ROUNDING_NOARG (ROUND_VALUE) result(res)
+    implicit none
+    type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
+#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
+    res = .false.
+#else
+    res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
+#endif
+  end function
+
+! IEEE_SUPPORT_* functions
+
+#define SUPPORTMACRO(NAME, INTKIND, VALUE) \
+  pure logical function NAME/**/_/**/INTKIND (X) result(res) ; \
+    implicit none                                            ; \
+    real(INTKIND), intent(in) :: X(..)                       ; \
+    res = VALUE                                              ; \
+  end function
+
+#define SUPPORTMACRO_NOARG(NAME, VALUE) \
+  pure logical function NAME/**/_NOARG () result(res) ; \
+    implicit none                                     ; \
+    res = VALUE                                       ; \
+  end function
+
+! IEEE_SUPPORT_DATATYPE
+
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,4,.true.)
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,8,.true.)
+#ifdef HAVE_GFC_REAL_10
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.false.)
+#endif
+#ifdef HAVE_GFC_REAL_16
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.false.)
+#endif
+#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.false.)
+#else
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.true.)
+#endif
+
+! IEEE_SUPPORT_DENORMAL
+
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,4,.true.)
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,8,.true.)
+#ifdef HAVE_GFC_REAL_10
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,10,.false.)
+#endif
+#ifdef HAVE_GFC_REAL_16
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.false.)
+#endif
+#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.false.)
+#else
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.true.)
+#endif
+
+! IEEE_SUPPORT_DIVIDE
+
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,4,.true.)
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,8,.true.)
+#ifdef HAVE_GFC_REAL_10
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,10,.false.)
+#endif
+#ifdef HAVE_GFC_REAL_16
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.false.)
+#endif
+#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.false.)
+#else
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.true.)
+#endif
+
+! IEEE_SUPPORT_INF
+
+SUPPORTMACRO(IEEE_SUPPORT_INF,4,.true.)
+SUPPORTMACRO(IEEE_SUPPORT_INF,8,.true.)
+#ifdef HAVE_GFC_REAL_10
+SUPPORTMACRO(IEEE_SUPPORT_INF,10,.false.)
+#endif
+#ifdef HAVE_GFC_REAL_16
+SUPPORTMACRO(IEEE_SUPPORT_INF,16,.false.)
+#endif
+#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.false.)
+#else
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.true.)
+#endif
+
+! IEEE_SUPPORT_IO
+
+SUPPORTMACRO(IEEE_SUPPORT_IO,4,.true.)
+SUPPORTMACRO(IEEE_SUPPORT_IO,8,.true.)
+#ifdef HAVE_GFC_REAL_10
+SUPPORTMACRO(IEEE_SUPPORT_IO,10,.false.)
+#endif
+#ifdef HAVE_GFC_REAL_16
+SUPPORTMACRO(IEEE_SUPPORT_IO,16,.false.)
+#endif
+#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.false.)
+#else
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.true.)
+#endif
+
+! IEEE_SUPPORT_NAN
+
+SUPPORTMACRO(IEEE_SUPPORT_NAN,4,.true.)
+SUPPORTMACRO(IEEE_SUPPORT_NAN,8,.true.)
+#ifdef HAVE_GFC_REAL_10
+SUPPORTMACRO(IEEE_SUPPORT_NAN,10,.false.)
+#endif
+#ifdef HAVE_GFC_REAL_16
+SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.false.)
+#endif
+#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.false.)
+#else
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.true.)
+#endif
+
+! IEEE_SUPPORT_SQRT
+
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,4,.true.)
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,8,.true.)
+#ifdef HAVE_GFC_REAL_10
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,10,.false.)
+#endif
+#ifdef HAVE_GFC_REAL_16
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.false.)
+#endif
+#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.false.)
+#else
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.true.)
+#endif
+
+! IEEE_SUPPORT_STANDARD
+
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,4,.true.)
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,8,.true.)
+#ifdef HAVE_GFC_REAL_10
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,10,.false.)
+#endif
+#ifdef HAVE_GFC_REAL_16
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.false.)
+#endif
+#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.false.)
+#else
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.true.)
+#endif
+
+! IEEE_SUPPORT_UNDERFLOW_CONTROL
+
+SUPPORTMACRO(IEEE_SUPPORT_UNDERFLOW_CONTROL,4,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_UNDERFLOW_CONTROL,8,.false.)
+#ifdef HAVE_GFC_REAL_10
+SUPPORTMACRO(IEEE_SUPPORT_UNDERFLOW_CONTROL,10,.false.)
+#endif
+#ifdef HAVE_GFC_REAL_16
+SUPPORTMACRO(IEEE_SUPPORT_UNDERFLOW_CONTROL,16,.false.)
+#endif
+SUPPORTMACRO_NOARG(IEEE_SUPPORT_UNDERFLOW_CONTROL,.false.)
+
+
+end module IEEE_ARITHMETIC
diff --git a/libgfortran/ieee/ieee_exceptions.F90 b/libgfortran/ieee/ieee_exceptions.F90
new file mode 100644
index 00000000000..e77bcf0f8dd
--- /dev/null
+++ b/libgfortran/ieee/ieee_exceptions.F90
@@ -0,0 +1,218 @@
+!    Implementation of the IEEE_EXCEPTIONS standard intrinsic module
+!    Copyright (C) 2013 Free Software Foundation, Inc.
+!    Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+! 
+! This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+! 
+! 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.
+! 
+! Under Section 7 of GPL version 3, you are granted additional
+! permissions described in the GCC Runtime Library Exception, version
+! 3.1, as published by the Free Software Foundation.
+! 
+! You should have received a copy of the GNU General Public License and
+! a copy of the GCC Runtime Library Exception along with this program;
+! see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+! <http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+#include "fpu-target.inc"
+
+module IEEE_EXCEPTIONS
+
+  implicit none
+  private
+
+! Derived types and named constants
+
+  type, public :: IEEE_FLAG_TYPE
+    private
+    integer :: hidden
+  end type
+
+  type(IEEE_FLAG_TYPE), parameter, public :: &
+    IEEE_INVALID        = IEEE_FLAG_TYPE(GFC_FPE_INVALID), &
+    IEEE_OVERFLOW       = IEEE_FLAG_TYPE(GFC_FPE_OVERFLOW), &
+    IEEE_DIVIDE_BY_ZERO = IEEE_FLAG_TYPE(GFC_FPE_ZERO), &
+    IEEE_UNDERFLOW      = IEEE_FLAG_TYPE(GFC_FPE_UNDERFLOW), &
+    IEEE_INEXACT        = IEEE_FLAG_TYPE(GFC_FPE_INEXACT)
+
+  type(IEEE_FLAG_TYPE), parameter, public :: &
+    IEEE_USUAL(3) = [ IEEE_OVERFLOW, IEEE_DIVIDE_BY_ZERO, IEEE_INVALID ], &
+    IEEE_ALL(5)   = [ IEEE_USUAL, IEEE_UNDERFLOW, IEEE_INEXACT ]
+
+  type, public :: IEEE_STATUS_TYPE
+    private
+    character(len=GFC_FPE_STATE_BUFFER_SIZE) :: hidden
+  end type
+
+  interface IEEE_SUPPORT_FLAG
+    module procedure IEEE_SUPPORT_FLAG_NOARG, &
+                     IEEE_SUPPORT_FLAG_4, &
+                     IEEE_SUPPORT_FLAG_8
+  end interface IEEE_SUPPORT_FLAG
+
+  public :: IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
+  public :: IEEE_SET_HALTING_MODE, IEEE_GET_HALTING_MODE
+  public :: IEEE_SET_FLAG, IEEE_GET_FLAG
+  public :: IEEE_SET_STATUS, IEEE_GET_STATUS
+
+contains
+
+! Saving and restoring floating-point status
+
+  subroutine IEEE_GET_STATUS (STATUS_VALUE)
+    implicit none
+    type(IEEE_STATUS_TYPE), intent(out) :: STATUS_VALUE
+
+    interface
+      subroutine helper(ptr) &
+          bind(c, name="_gfortrani_get_fpu_state")
+        use, intrinsic :: iso_c_binding, only : c_char
+        character(kind=c_char) :: ptr(*)
+      end subroutine
+    end interface
+
+    call helper(STATUS_VALUE%hidden)
+  end subroutine
+
+  subroutine IEEE_SET_STATUS (STATUS_VALUE)
+    implicit none
+    type(IEEE_STATUS_TYPE), intent(in) :: STATUS_VALUE
+
+    interface
+      subroutine helper(ptr) &
+          bind(c, name="_gfortrani_set_fpu_state")
+        use, intrinsic :: iso_c_binding, only : c_char
+        character(kind=c_char) :: ptr(*)
+      end subroutine
+    end interface
+
+    call helper(STATUS_VALUE%hidden)
+  end subroutine
+
+! Getting and setting flags
+
+  elemental subroutine IEEE_GET_FLAG (FLAG, FLAG_VALUE)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    logical, intent(out) :: FLAG_VALUE
+
+    interface
+      pure integer function helper() &
+        bind(c, name="_gfortrani_get_fpu_except_flags")
+      end function
+    end interface
+
+    FLAG_VALUE = (IAND(helper(), FLAG%hidden) /= 0)
+  end subroutine
+
+  elemental subroutine IEEE_SET_FLAG (FLAG, FLAG_VALUE)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    logical, intent(in) :: FLAG_VALUE
+
+    interface
+      pure subroutine helper(set, clear) &
+          bind(c, name="_gfortrani_set_fpu_except_flags")
+        integer, intent(in), value :: set, clear
+      end subroutine
+    end interface
+
+    if (FLAG_VALUE) then
+      call helper(FLAG%hidden, 0)
+    else
+      call helper(0, FLAG%hidden)
+    end if
+  end subroutine
+
+! Querying and changing the halting mode
+
+  elemental subroutine IEEE_GET_HALTING_MODE (FLAG, HALTING)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    logical, intent(out) :: HALTING
+
+    interface
+      pure integer function helper() &
+          bind(c, name="_gfortrani_get_fpu_trap_exceptions")
+      end function
+    end interface
+
+    HALTING = (IAND(helper(), FLAG%hidden) /= 0)
+  end subroutine
+
+  elemental subroutine IEEE_SET_HALTING_MODE (FLAG, HALTING)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    logical, intent(in) :: HALTING
+
+    interface
+      pure subroutine helper(trap, notrap) &
+          bind(c, name="_gfortrani_set_fpu_trap_exceptions")
+        integer, intent(in), value :: trap, notrap
+      end subroutine
+    end interface
+
+    if (HALTING) then
+      call helper(FLAG%hidden, 0)
+    else
+      call helper(0, FLAG%hidden)
+    end if
+  end subroutine
+
+! Querying support
+
+  pure logical function IEEE_SUPPORT_HALTING (FLAG)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+
+    interface
+      pure integer function helper(flag) &
+          bind(c, name="_gfortrani_support_fpu_trap")
+        integer, intent(in), value :: flag
+      end function
+    end interface
+
+    IEEE_SUPPORT_HALTING = (helper(FLAG%hidden) /= 0)
+  end function
+
+  pure logical function IEEE_SUPPORT_FLAG_NOARG (FLAG)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+
+    interface
+      pure integer function helper(flag) &
+          bind(c, name="_gfortrani_support_fpu_flag")
+        integer, intent(in), value :: flag
+      end function
+    end interface
+
+    IEEE_SUPPORT_FLAG_NOARG = (helper(FLAG%hidden) /= 0)
+  end function
+
+  pure logical function IEEE_SUPPORT_FLAG_4 (FLAG, X) result(res)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    real(kind=4), intent(in) :: X
+    res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
+  end function
+
+  pure logical function IEEE_SUPPORT_FLAG_8 (FLAG, X) result(res)
+    implicit none
+    type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+    real(kind=8), intent(in) :: X
+    res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
+  end function
+
+end module IEEE_EXCEPTIONS
diff --git a/libgfortran/ieee/ieee_features.F90 b/libgfortran/ieee/ieee_features.F90
new file mode 100644
index 00000000000..b3a5c5404f6
--- /dev/null
+++ b/libgfortran/ieee/ieee_features.F90
@@ -0,0 +1,49 @@
+!    Implementation of the IEEE_FEATURES standard intrinsic module
+!    Copyright (C) 2013 Free Software Foundation, Inc.
+!    Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+! 
+! This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+! 
+! 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.
+! 
+! Under Section 7 of GPL version 3, you are granted additional
+! permissions described in the GCC Runtime Library Exception, version
+! 3.1, as published by the Free Software Foundation.
+! 
+! You should have received a copy of the GNU General Public License and
+! a copy of the GCC Runtime Library Exception along with this program;
+! see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+! <http://www.gnu.org/licenses/>.  */
+
+module IEEE_FEATURES
+
+  implicit none
+  private
+
+  type, public :: IEEE_FEATURES_TYPE
+    private
+    integer :: hidden
+  end type
+
+  type(IEEE_FEATURES_TYPE), parameter, public :: &
+    IEEE_DATATYPE       = IEEE_FEATURES_TYPE(0), &
+    IEEE_DENORMAL       = IEEE_FEATURES_TYPE(1), &
+    IEEE_DIVIDE         = IEEE_FEATURES_TYPE(2), &
+    IEEE_HALTING        = IEEE_FEATURES_TYPE(3), &
+    IEEE_INEXACT_FLAG   = IEEE_FEATURES_TYPE(4), &
+    IEEE_INF            = IEEE_FEATURES_TYPE(5), &
+    IEEE_INVALID_FLAG   = IEEE_FEATURES_TYPE(6), &
+    IEEE_NAN            = IEEE_FEATURES_TYPE(7), &
+    IEEE_ROUNDING       = IEEE_FEATURES_TYPE(8), &
+    IEEE_SQRT           = IEEE_FEATURES_TYPE(9), &
+    IEEE_UNDERFLOW_FLAG = IEEE_FEATURES_TYPE(10)
+
+end module IEEE_FEATURES
diff --git a/libgfortran/ieee/ieee_helper.c b/libgfortran/ieee/ieee_helper.c
new file mode 100644
index 00000000000..f628add6b2e
--- /dev/null
+++ b/libgfortran/ieee/ieee_helper.c
@@ -0,0 +1,407 @@
+/* Helper functions in C for IEEE modules
+   Copyright (C) 2013 Free Software Foundation, Inc.
+   Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+
+/* Prototypes.  */
+
+extern int ieee_class_helper_4 (GFC_REAL_4 *);
+internal_proto(ieee_class_helper_4);
+
+extern int ieee_class_helper_8 (GFC_REAL_8 *);
+internal_proto(ieee_class_helper_8);
+
+extern int ieee_is_finite_4_ (GFC_REAL_4 *);
+export_proto(ieee_is_finite_4_);
+
+extern int ieee_is_finite_8_ (GFC_REAL_8 *);
+export_proto(ieee_is_finite_8_);
+
+extern int ieee_is_nan_4_ (GFC_REAL_4 *);
+export_proto(ieee_is_nan_4_);
+
+extern int ieee_is_nan_8_ (GFC_REAL_8 *);
+export_proto(ieee_is_nan_8_);
+
+extern int ieee_is_negative_4_ (GFC_REAL_4 *);
+export_proto(ieee_is_negative_4_);
+
+extern int ieee_is_negative_8_ (GFC_REAL_8 *);
+export_proto(ieee_is_negative_8_);
+
+extern int ieee_is_normal_4_ (GFC_REAL_4 *);
+export_proto(ieee_is_normal_4_);
+
+extern int ieee_is_normal_8_ (GFC_REAL_8 *);
+export_proto(ieee_is_normal_8_);
+
+
+/* Enumeration of the possible floating-point types. These values
+   correspond to the hidden arguments of the IEEE_CLASS_TYPE
+   derived-type of IEEE_ARITHMETIC.  */
+
+enum { IEEE_OTHER_VALUE = 0, IEEE_SIGNALING_NAN, IEEE_QUIET_NAN,
+  IEEE_NEGATIVE_INF, IEEE_NEGATIVE_NORMAL, IEEE_NEGATIVE_DENORMAL,
+  IEEE_NEGATIVE_ZERO, IEEE_POSITIVE_ZERO, IEEE_POSITIVE_DENORMAL,
+  IEEE_POSITIVE_NORMAL, IEEE_POSITIVE_INF };
+
+#define CLASSMACRO(TYPE) \
+  int ieee_class_helper_ ## TYPE (GFC_REAL_ ## TYPE *value) \
+  { \
+    int res = __builtin_fpclassify (IEEE_QUIET_NAN, IEEE_POSITIVE_INF, \
+				    IEEE_POSITIVE_NORMAL, \
+				    IEEE_POSITIVE_DENORMAL, \
+				    IEEE_POSITIVE_ZERO, *value); \
+ \
+    if (__builtin_signbit (*value)) \
+    { \
+      if (res == IEEE_POSITIVE_NORMAL) \
+	return IEEE_NEGATIVE_NORMAL; \
+      else if (res == IEEE_POSITIVE_DENORMAL) \
+	return IEEE_NEGATIVE_DENORMAL; \
+      else if (res == IEEE_POSITIVE_ZERO) \
+	return IEEE_NEGATIVE_ZERO; \
+      else if (res == IEEE_POSITIVE_INF) \
+	return IEEE_NEGATIVE_INF; \
+    } \
+ \
+    if (res == IEEE_QUIET_NAN) \
+    { \
+      /* TODO: Handle signaling NaNs  */ \
+      return res; \
+    } \
+ \
+    return res; \
+  }
+
+CLASSMACRO(4)
+CLASSMACRO(8)
+
+
+/* Testing functions.  */
+
+int ieee_is_finite_4_ (GFC_REAL_4 *val)
+{
+  return __builtin_isfinite(*val) ? 1 : 0;
+}
+
+int ieee_is_finite_8_ (GFC_REAL_8 *val)
+{
+  return __builtin_isfinite(*val) ? 1 : 0;
+}
+
+int ieee_is_nan_4_ (GFC_REAL_4 *val)
+{
+  return __builtin_isnan(*val) ? 1 : 0;
+}
+
+int ieee_is_nan_8_ (GFC_REAL_8 *val)
+{
+  return __builtin_isnan(*val) ? 1 : 0;
+}
+
+int ieee_is_negative_4_ (GFC_REAL_4 *val)
+{
+  return (__builtin_signbit(*val) && !__builtin_isnan(*val)) ? 1 : 0;
+}
+
+int ieee_is_negative_8_ (GFC_REAL_8 *val)
+{
+  return (__builtin_signbit(*val) && !__builtin_isnan(*val)) ? 1 : 0;
+}
+
+int ieee_is_normal_4_ (GFC_REAL_4 *val)
+{
+  return (__builtin_isnormal(*val) || *val == 0) ? 1 : 0;
+}
+
+int ieee_is_normal_8_ (GFC_REAL_8 *val)
+{
+  return (__builtin_isnormal(*val) || *val == 0) ? 1 : 0;
+}
+
+GFC_REAL_4 ieee_copy_sign_4_4_ (GFC_REAL_4 *, GFC_REAL_4 *);
+export_proto(ieee_copy_sign_4_4_);
+GFC_REAL_4 ieee_copy_sign_4_4_ (GFC_REAL_4 *x, GFC_REAL_4 *y)
+{
+  GFC_REAL_4 s = __builtin_signbit(*y) ? -1 : 1;
+  return __builtin_copysign(*x, s);
+}
+
+GFC_REAL_4 ieee_copy_sign_4_8_ (GFC_REAL_4 *, GFC_REAL_8 *);
+export_proto(ieee_copy_sign_4_8_);
+GFC_REAL_4 ieee_copy_sign_4_8_ (GFC_REAL_4 *x, GFC_REAL_8 *y)
+{
+  GFC_REAL_4 s = __builtin_signbit(*y) ? -1 : 1;
+  return __builtin_copysign(*x, s);
+}
+
+GFC_REAL_8 ieee_copy_sign_8_4_ (GFC_REAL_8 *, GFC_REAL_4 *);
+export_proto(ieee_copy_sign_8_4_);
+GFC_REAL_8 ieee_copy_sign_8_4_ (GFC_REAL_8 *x, GFC_REAL_4 *y)
+{
+  GFC_REAL_8 s = __builtin_signbit(*y) ? -1 : 1;
+  return __builtin_copysign(*x, s);
+}
+
+GFC_REAL_8 ieee_copy_sign_8_8_ (GFC_REAL_8 *, GFC_REAL_8 *);
+export_proto(ieee_copy_sign_8_8_);
+GFC_REAL_8 ieee_copy_sign_8_8_ (GFC_REAL_8 *x, GFC_REAL_8 *y)
+{
+  GFC_REAL_8 s = __builtin_signbit(*y) ? -1 : 1;
+  return __builtin_copysign(*x, s);
+}
+
+int ieee_unordered_4_4_ (GFC_REAL_4 *, GFC_REAL_4 *);
+export_proto(ieee_unordered_4_4_);
+int ieee_unordered_4_4_ (GFC_REAL_4 *x, GFC_REAL_4 *y)
+{
+  return __builtin_isunordered(*x, *y);
+}
+
+int ieee_unordered_4_8_ (GFC_REAL_4 *, GFC_REAL_8 *);
+export_proto(ieee_unordered_4_8_);
+int ieee_unordered_4_8_ (GFC_REAL_4 *x, GFC_REAL_8 *y)
+{
+  return __builtin_isunordered(*x, *y);
+}
+
+int ieee_unordered_8_4_ (GFC_REAL_8 *, GFC_REAL_4 *);
+export_proto(ieee_unordered_8_4_);
+int ieee_unordered_8_4_ (GFC_REAL_8 *x, GFC_REAL_4 *y)
+{
+  return __builtin_isunordered(*x, *y);
+}
+
+int ieee_unordered_8_8_ (GFC_REAL_8 *, GFC_REAL_8 *);
+export_proto(ieee_unordered_8_8_);
+int ieee_unordered_8_8_ (GFC_REAL_8 *x, GFC_REAL_8 *y)
+{
+  return __builtin_isunordered(*x, *y);
+}
+
+
+/* Arithmetic functions (LOGB, NEXT_AFTER, REM, RINT, SCALB).  */
+
+GFC_REAL_4 ieee_logb_4_ (GFC_REAL_4 *);
+export_proto(ieee_logb_4_);
+
+GFC_REAL_4 ieee_logb_4_ (GFC_REAL_4 *x)
+{
+  GFC_REAL_4 res;
+  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
+
+  get_fpu_state (buffer);
+  res = __builtin_logb (*x);
+  set_fpu_state (buffer);
+  return res;
+}
+
+GFC_REAL_8 ieee_logb_8_ (GFC_REAL_8 *);
+export_proto(ieee_logb_8_);
+
+GFC_REAL_8 ieee_logb_8_ (GFC_REAL_8 *x)
+{
+  GFC_REAL_8 res;
+  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
+
+  get_fpu_state (buffer);
+  res = __builtin_logb (*x);
+  set_fpu_state (buffer);
+  return res;
+}
+
+GFC_REAL_4 ieee_next_after_4_4_ (GFC_REAL_4 *, GFC_REAL_4 *);
+export_proto(ieee_next_after_4_4_);
+
+GFC_REAL_4 ieee_next_after_4_4_ (GFC_REAL_4 *x, GFC_REAL_4 *y)
+{
+  return __builtin_nextafterf (*x, *y);
+}
+
+GFC_REAL_4 ieee_next_after_4_8_ (GFC_REAL_4 *, GFC_REAL_8 *);
+export_proto(ieee_next_after_4_8_);
+
+GFC_REAL_4 ieee_next_after_4_8_ (GFC_REAL_4 *x, GFC_REAL_8 *y)
+{
+  return __builtin_nextafterf (*x, *y);
+}
+
+GFC_REAL_8 ieee_next_after_8_4_ (GFC_REAL_8 *, GFC_REAL_4 *);
+export_proto(ieee_next_after_8_4_);
+
+GFC_REAL_8 ieee_next_after_8_4_ (GFC_REAL_8 *x, GFC_REAL_4 *y)
+{
+  return __builtin_nextafter (*x, *y);
+}
+
+GFC_REAL_8 ieee_next_after_8_8_ (GFC_REAL_8 *, GFC_REAL_8 *);
+export_proto(ieee_next_after_8_8_);
+
+GFC_REAL_8 ieee_next_after_8_8_ (GFC_REAL_8 *x, GFC_REAL_8 *y)
+{
+  return __builtin_nextafter (*x, *y);
+}
+
+GFC_REAL_4 ieee_rem_4_4_ (GFC_REAL_4 *, GFC_REAL_4 *);
+export_proto(ieee_rem_4_4_);
+
+GFC_REAL_4 ieee_rem_4_4_ (GFC_REAL_4 *x, GFC_REAL_4 *y)
+{
+  GFC_REAL_4 res;
+  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
+
+  get_fpu_state (buffer);
+  res = __builtin_remainderf (*x, *y);
+  set_fpu_state (buffer);
+  return res;
+}
+
+GFC_REAL_8 ieee_rem_4_8_ (GFC_REAL_4 *, GFC_REAL_8 *);
+export_proto(ieee_rem_4_8_);
+
+GFC_REAL_8 ieee_rem_4_8_ (GFC_REAL_4 *x, GFC_REAL_8 *y)
+{
+  GFC_REAL_8 res;
+  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
+
+  get_fpu_state (buffer);
+  res = __builtin_remainder (*x, *y);
+  set_fpu_state (buffer);
+  return res;
+}
+
+GFC_REAL_8 ieee_rem_8_4_ (GFC_REAL_8 *, GFC_REAL_4 *);
+export_proto(ieee_rem_8_4_);
+
+GFC_REAL_8 ieee_rem_8_4_ (GFC_REAL_8 *x, GFC_REAL_4 *y)
+{
+  GFC_REAL_8 res;
+  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
+
+  get_fpu_state (buffer);
+  res = __builtin_remainder (*x, *y);
+  set_fpu_state (buffer);
+  return res;
+}
+
+GFC_REAL_8 ieee_rem_8_8_ (GFC_REAL_8 *, GFC_REAL_8 *);
+export_proto(ieee_rem_8_8_);
+
+GFC_REAL_8 ieee_rem_8_8_ (GFC_REAL_8 *x, GFC_REAL_8 *y)
+{
+  GFC_REAL_8 res;
+  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
+
+  get_fpu_state (buffer);
+  res = __builtin_remainder (*x, *y);
+  set_fpu_state (buffer);
+  return res;
+}
+
+GFC_REAL_4 ieee_rint_4_ (GFC_REAL_4 *);
+export_proto(ieee_rint_4_);
+
+GFC_REAL_4 ieee_rint_4_ (GFC_REAL_4 *x)
+{
+  GFC_REAL_4 res;
+  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
+
+  get_fpu_state (buffer);
+  res = __builtin_rint (*x);
+  set_fpu_state (buffer);
+  return res;
+}
+
+GFC_REAL_8 ieee_rint_8_ (GFC_REAL_8 *);
+export_proto(ieee_rint_8_);
+
+GFC_REAL_8 ieee_rint_8_ (GFC_REAL_8 *x)
+{
+  GFC_REAL_8 res;
+  char buffer[GFC_FPE_STATE_BUFFER_SIZE];
+
+  get_fpu_state (buffer);
+  res = __builtin_rint (*x);
+  set_fpu_state (buffer);
+  return res;
+}
+
+GFC_REAL_4 ieee_scalb_4_ (GFC_REAL_4 *, int *);
+export_proto(ieee_scalb_4_);
+
+GFC_REAL_4 ieee_scalb_4_ (GFC_REAL_4 *x, int *i)
+{
+  return __builtin_scalbnf (*x, *i);
+}
+
+GFC_REAL_8 ieee_scalb_8_ (GFC_REAL_8 *, int *);
+export_proto(ieee_scalb_8_);
+
+GFC_REAL_8 ieee_scalb_8_ (GFC_REAL_8 *x, int *i)
+{
+  return __builtin_scalbn (*x, *i);
+}
+
+
+#define GFC_FPE_ALL (GFC_FPE_INVALID | GFC_FPE_DENORMAL | \
+		     GFC_FPE_ZERO | GFC_FPE_OVERFLOW | \
+		     GFC_FPE_UNDERFLOW | GFC_FPE_INEXACT)
+
+/* Functions to save and restore floating-point state, clear and restore
+   exceptions on procedure entry/exit.  The rules we follow are set
+   in Fortran 2008's 14.3 paragraph 3, note 14.4, 14.4 paragraph 4,
+   14.5 paragraph 2, and 14.6 paragraph 1.  */
+
+void ieee_procedure_entry (void *);
+export_proto(ieee_procedure_entry);
+
+void
+ieee_procedure_entry (void *state)
+{
+  /* Save the floating-point state in the space provided by the caller.  */
+  get_fpu_state (state);
+
+  /* Clear the floating-point exceptions.  */
+  set_fpu_except_flags (0, GFC_FPE_ALL);
+}
+
+
+void ieee_procedure_exit (void *);
+export_proto(ieee_procedure_exit);
+
+void
+ieee_procedure_exit (void *state)
+{
+  /* Get the flags currently signaling.  */
+  int flags = get_fpu_except_flags ();
+
+  /* Restore the floating-point state we had on entry.  */
+  set_fpu_state (state);
+
+  /* And re-raised the flags that were raised since entry.  */
+  set_fpu_except_flags (flags, 0);
+}
+
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index c8c09f6910c..8179ceab739 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -754,15 +754,39 @@ internal_proto(gf_strerror);
 extern void set_fpu (void);
 internal_proto(set_fpu);
 
+extern int get_fpu_trap_exceptions (void);
+internal_proto(get_fpu_trap_exceptions);
+
+extern void set_fpu_trap_exceptions (int, int);
+internal_proto(set_fpu_trap_exceptions);
+
+extern int support_fpu_trap (int);
+internal_proto(support_fpu_trap);
+
 extern int get_fpu_except_flags (void);
 internal_proto(get_fpu_except_flags);
 
-extern void set_fpu_rounding_mode (int round);
+extern void set_fpu_except_flags (int, int);
+internal_proto(set_fpu_except_flags);
+
+extern int support_fpu_flag (int);
+internal_proto(support_fpu_flag);
+
+extern void set_fpu_rounding_mode (int);
 internal_proto(set_fpu_rounding_mode);
 
 extern int get_fpu_rounding_mode (void);
 internal_proto(get_fpu_rounding_mode);
 
+extern int support_fpu_rounding_mode (int);
+internal_proto(support_fpu_rounding_mode);
+
+extern void get_fpu_state (void *);
+internal_proto(get_fpu_state);
+
+extern void set_fpu_state (void *);
+internal_proto(set_fpu_state);
+
 /* memory.c */
 
 extern void *xmalloc (size_t) __attribute__ ((malloc));
author	Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>	2014-06-28 14:17:41 +0000
committer	François-Xavier Coudert <fxcoudert@gcc.gnu.org>	2014-06-28 14:17:41 +0000
commit	8b198102220210ef6a61477d9a45564c206ee6b5 (patch)
tree	e7bff5fef45c93b6d9ac36021ec9edaa569bf861 /libgfortran
parent	a86471635f38376128e6cea8d6856f025a57b4c2 (diff)