summaryrefslogtreecommitdiff
path: root/libgfortran
diff options
context:
space:
mode:
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>2015-08-04 07:27:19 +0000
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>2015-08-04 07:27:19 +0000
commitc53bd1d9c1745c0e68de604ab46a29c382796751 (patch)
tree54d33530ee51771415c90c43ce2de54eb7cc9fef /libgfortran
parent207b8288310903e584235dd61bea2ff9b17a3548 (diff)
downloadgcc-c53bd1d9c1745c0e68de604ab46a29c382796751.tar.gz
PR fortran/64022
* simplify.c (gfc_simplify_ieee_selected_real_kind): Extend IEEE support to all real kinds. * ieee/ieee_exceptions.F90: Support all real kinds. * ieee/ieee_arithmetic.F90: Likewise. * ieee/ieee_helper.c (ieee_class_helper_10, ieee_class_helper_16): New functions * gfortran.map (GFORTRAN_1.7): Add entries. * gfortran.dg/ieee/ieee_7.f90: Adjust test. * gfortran.dg/ieee/large_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@226548 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/ChangeLog9
-rw-r--r--libgfortran/gfortran.map10
-rw-r--r--libgfortran/ieee/ieee_arithmetic.F90760
-rw-r--r--libgfortran/ieee/ieee_exceptions.F9030
-rw-r--r--libgfortran/ieee/ieee_helper.c18
5 files changed, 646 insertions, 181 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 29efe0ad486..e74bff61dac 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2015-08-04 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/64022
+ * ieee/ieee_exceptions.F90: Support all real kinds.
+ * ieee/ieee_arithmetic.F90: Likewise.
+ * ieee/ieee_helper.c (ieee_class_helper_10,
+ ieee_class_helper_16): New functions
+ * gfortran.map (GFORTRAN_1.7): Add entries.
+
2015-07-29 Uros Bizjak <ubizjak@gmail.com>
PR libgfortran/66650
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index cfbfb160a52..73cdde78571 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1276,6 +1276,16 @@ GFORTRAN_1.6 {
__ieee_exceptions_MOD_ieee_usual;
} GFORTRAN_1.5;
+GFORTRAN_1.7 {
+ global:
+ __ieee_arithmetic_MOD_ieee_class_10;
+ __ieee_arithmetic_MOD_ieee_class_16;
+ __ieee_arithmetic_MOD_ieee_value_10;
+ __ieee_arithmetic_MOD_ieee_value_16;
+ __ieee_exceptions_MOD_ieee_support_flag_10;
+ __ieee_exceptions_MOD_ieee_support_flag_16;
+} GFORTRAN_1.6;
+
F2C_1.0 {
global:
_gfortran_f2c_specific__abs_c4;
diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90
index f81a4f89e13..89456cf1550 100644
--- a/libgfortran/ieee/ieee_arithmetic.F90
+++ b/libgfortran/ieee/ieee_arithmetic.F90
@@ -95,10 +95,27 @@ module IEEE_ARITHMETIC
elemental logical function _gfortran_ieee_is_finite_8(X)
real(kind=8), intent(in) :: X
end function
+#ifdef HAVE_GFC_REAL_10
+ elemental logical function _gfortran_ieee_is_finite_10(X)
+ real(kind=10), intent(in) :: X
+ end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+ elemental logical function _gfortran_ieee_is_finite_16(X)
+ real(kind=16), intent(in) :: X
+ end function
+#endif
end interface
interface IEEE_IS_FINITE
- procedure _gfortran_ieee_is_finite_4, _gfortran_ieee_is_finite_8
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_is_finite_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_is_finite_10, &
+#endif
+ _gfortran_ieee_is_finite_8, _gfortran_ieee_is_finite_4
end interface
public :: IEEE_IS_FINITE
@@ -111,10 +128,27 @@ module IEEE_ARITHMETIC
elemental logical function _gfortran_ieee_is_nan_8(X)
real(kind=8), intent(in) :: X
end function
+#ifdef HAVE_GFC_REAL_10
+ elemental logical function _gfortran_ieee_is_nan_10(X)
+ real(kind=10), intent(in) :: X
+ end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+ elemental logical function _gfortran_ieee_is_nan_16(X)
+ real(kind=16), intent(in) :: X
+ end function
+#endif
end interface
interface IEEE_IS_NAN
- procedure _gfortran_ieee_is_nan_4, _gfortran_ieee_is_nan_8
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_is_nan_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_is_nan_10, &
+#endif
+ _gfortran_ieee_is_nan_8, _gfortran_ieee_is_nan_4
end interface
public :: IEEE_IS_NAN
@@ -127,10 +161,27 @@ module IEEE_ARITHMETIC
elemental logical function _gfortran_ieee_is_negative_8(X)
real(kind=8), intent(in) :: X
end function
+#ifdef HAVE_GFC_REAL_10
+ elemental logical function _gfortran_ieee_is_negative_10(X)
+ real(kind=10), intent(in) :: X
+ end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+ elemental logical function _gfortran_ieee_is_negative_16(X)
+ real(kind=16), intent(in) :: X
+ end function
+#endif
end interface
interface IEEE_IS_NEGATIVE
- procedure _gfortran_ieee_is_negative_4, _gfortran_ieee_is_negative_8
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_is_negative_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_is_negative_10, &
+#endif
+ _gfortran_ieee_is_negative_8, _gfortran_ieee_is_negative_4
end interface
public :: IEEE_IS_NEGATIVE
@@ -143,64 +194,189 @@ module IEEE_ARITHMETIC
elemental logical function _gfortran_ieee_is_normal_8(X)
real(kind=8), intent(in) :: X
end function
+#ifdef HAVE_GFC_REAL_10
+ elemental logical function _gfortran_ieee_is_normal_10(X)
+ real(kind=10), intent(in) :: X
+ end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+ elemental logical function _gfortran_ieee_is_normal_16(X)
+ real(kind=16), intent(in) :: X
+ end function
+#endif
end interface
interface IEEE_IS_NORMAL
- procedure _gfortran_ieee_is_normal_4, _gfortran_ieee_is_normal_8
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_is_normal_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_is_normal_10, &
+#endif
+ _gfortran_ieee_is_normal_8, _gfortran_ieee_is_normal_4
end interface
public :: IEEE_IS_NORMAL
! IEEE_COPY_SIGN
+#define COPYSIGN_MACRO(A,B) \
+ elemental real(kind = A) function \
+ _gfortran_ieee_copy_sign_/**/A/**/_/**/B (X,Y) ; \
+ real(kind = A), intent(in) :: X ; \
+ real(kind = B), intent(in) :: Y ; \
+ end function
+
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
+COPYSIGN_MACRO(4,4)
+COPYSIGN_MACRO(4,8)
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(4,16)
+#endif
+COPYSIGN_MACRO(8,4)
+COPYSIGN_MACRO(8,8)
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(10,4)
+COPYSIGN_MACRO(10,8)
+COPYSIGN_MACRO(10,10)
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+COPYSIGN_MACRO(16,4)
+COPYSIGN_MACRO(16,8)
+#ifdef HAVE_GFC_REAL_10
+COPYSIGN_MACRO(16,10)
+#endif
+COPYSIGN_MACRO(16,16)
+#endif
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
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_copy_sign_16_16, &
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_copy_sign_16_10, &
+#endif
+ _gfortran_ieee_copy_sign_16_8, &
+ _gfortran_ieee_copy_sign_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_copy_sign_10_16, &
+#endif
+ _gfortran_ieee_copy_sign_10_10, &
+ _gfortran_ieee_copy_sign_10_8, &
+ _gfortran_ieee_copy_sign_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_copy_sign_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_copy_sign_8_10, &
+#endif
+ _gfortran_ieee_copy_sign_8_8, &
+ _gfortran_ieee_copy_sign_8_4, &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_copy_sign_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_copy_sign_4_10, &
+#endif
+ _gfortran_ieee_copy_sign_4_8, &
+ _gfortran_ieee_copy_sign_4_4
end interface
public :: IEEE_COPY_SIGN
! IEEE_UNORDERED
+#define UNORDERED_MACRO(A,B) \
+ elemental logical function \
+ _gfortran_ieee_unordered_/**/A/**/_/**/B (X,Y) ; \
+ real(kind = A), intent(in) :: X ; \
+ real(kind = B), intent(in) :: Y ; \
+ end function
+
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
+UNORDERED_MACRO(4,4)
+UNORDERED_MACRO(4,8)
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(4,16)
+#endif
+UNORDERED_MACRO(8,4)
+UNORDERED_MACRO(8,8)
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(10,4)
+UNORDERED_MACRO(10,8)
+UNORDERED_MACRO(10,10)
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+UNORDERED_MACRO(16,4)
+UNORDERED_MACRO(16,8)
+#ifdef HAVE_GFC_REAL_10
+UNORDERED_MACRO(16,10)
+#endif
+UNORDERED_MACRO(16,16)
+#endif
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
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_unordered_16_16, &
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_unordered_16_10, &
+#endif
+ _gfortran_ieee_unordered_16_8, &
+ _gfortran_ieee_unordered_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_unordered_10_16, &
+#endif
+ _gfortran_ieee_unordered_10_10, &
+ _gfortran_ieee_unordered_10_8, &
+ _gfortran_ieee_unordered_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_unordered_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_unordered_8_10, &
+#endif
+ _gfortran_ieee_unordered_8_8, &
+ _gfortran_ieee_unordered_8_4, &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_unordered_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_unordered_4_10, &
+#endif
+ _gfortran_ieee_unordered_4_8, &
+ _gfortran_ieee_unordered_4_4
end interface
public :: IEEE_UNORDERED
@@ -213,64 +389,190 @@ module IEEE_ARITHMETIC
elemental real(kind=8) function _gfortran_ieee_logb_8 (X)
real(kind=8), intent(in) :: X
end function
+#ifdef HAVE_GFC_REAL_10
+ elemental real(kind=10) function _gfortran_ieee_logb_10 (X)
+ real(kind=10), intent(in) :: X
+ end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+ elemental real(kind=16) function _gfortran_ieee_logb_16 (X)
+ real(kind=16), intent(in) :: X
+ end function
+#endif
end interface
interface IEEE_LOGB
- procedure _gfortran_ieee_logb_4, _gfortran_ieee_logb_8
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_logb_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_logb_10, &
+#endif
+ _gfortran_ieee_logb_8, &
+ _gfortran_ieee_logb_4
end interface
public :: IEEE_LOGB
! IEEE_NEXT_AFTER
+#define NEXT_AFTER_MACRO(A,B) \
+ elemental real(kind = A) function \
+ _gfortran_ieee_next_after_/**/A/**/_/**/B (X,Y) ; \
+ real(kind = A), intent(in) :: X ; \
+ real(kind = B), intent(in) :: Y ; \
+ end function
+
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
+NEXT_AFTER_MACRO(4,4)
+NEXT_AFTER_MACRO(4,8)
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(4,16)
+#endif
+NEXT_AFTER_MACRO(8,4)
+NEXT_AFTER_MACRO(8,8)
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(10,4)
+NEXT_AFTER_MACRO(10,8)
+NEXT_AFTER_MACRO(10,10)
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+NEXT_AFTER_MACRO(16,4)
+NEXT_AFTER_MACRO(16,8)
+#ifdef HAVE_GFC_REAL_10
+NEXT_AFTER_MACRO(16,10)
+#endif
+NEXT_AFTER_MACRO(16,16)
+#endif
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
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_next_after_16_16, &
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_next_after_16_10, &
+#endif
+ _gfortran_ieee_next_after_16_8, &
+ _gfortran_ieee_next_after_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_next_after_10_16, &
+#endif
+ _gfortran_ieee_next_after_10_10, &
+ _gfortran_ieee_next_after_10_8, &
+ _gfortran_ieee_next_after_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_next_after_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_next_after_8_10, &
+#endif
+ _gfortran_ieee_next_after_8_8, &
+ _gfortran_ieee_next_after_8_4, &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_next_after_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_next_after_4_10, &
+#endif
+ _gfortran_ieee_next_after_4_8, &
+ _gfortran_ieee_next_after_4_4
end interface
public :: IEEE_NEXT_AFTER
! IEEE_REM
+#define REM_MACRO(RES,A,B) \
+ elemental real(kind = RES) function \
+ _gfortran_ieee_rem_/**/A/**/_/**/B (X,Y) ; \
+ real(kind = A), intent(in) :: X ; \
+ real(kind = B), intent(in) :: Y ; \
+ end function
+
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
+REM_MACRO(4,4,4)
+REM_MACRO(8,4,8)
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(10,4,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,4,16)
+#endif
+REM_MACRO(8,8,4)
+REM_MACRO(8,8,8)
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(10,8,10)
+#endif
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,8,16)
+#endif
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(10,10,4)
+REM_MACRO(10,10,8)
+REM_MACRO(10,10,10)
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,10,16)
+#endif
+#endif
+#ifdef HAVE_GFC_REAL_16
+REM_MACRO(16,16,4)
+REM_MACRO(16,16,8)
+#ifdef HAVE_GFC_REAL_10
+REM_MACRO(16,16,10)
+#endif
+REM_MACRO(16,16,16)
+#endif
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
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_rem_16_16, &
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_rem_16_10, &
+#endif
+ _gfortran_ieee_rem_16_8, &
+ _gfortran_ieee_rem_16_4, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_rem_10_16, &
+#endif
+ _gfortran_ieee_rem_10_10, &
+ _gfortran_ieee_rem_10_8, &
+ _gfortran_ieee_rem_10_4, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_rem_8_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_rem_8_10, &
+#endif
+ _gfortran_ieee_rem_8_8, &
+ _gfortran_ieee_rem_8_4, &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_rem_4_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_rem_4_10, &
+#endif
+ _gfortran_ieee_rem_4_8, &
+ _gfortran_ieee_rem_4_4
end interface
public :: IEEE_REM
@@ -283,10 +585,27 @@ module IEEE_ARITHMETIC
elemental real(kind=8) function _gfortran_ieee_rint_8 (X)
real(kind=8), intent(in) :: X
end function
+#ifdef HAVE_GFC_REAL_10
+ elemental real(kind=10) function _gfortran_ieee_rint_10 (X)
+ real(kind=10), intent(in) :: X
+ end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+ elemental real(kind=16) function _gfortran_ieee_rint_16 (X)
+ real(kind=16), intent(in) :: X
+ end function
+#endif
end interface
interface IEEE_RINT
- procedure _gfortran_ieee_rint_4, _gfortran_ieee_rint_8
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_rint_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_rint_10, &
+#endif
+ _gfortran_ieee_rint_8, _gfortran_ieee_rint_4
end interface
public :: IEEE_RINT
@@ -301,24 +620,57 @@ module IEEE_ARITHMETIC
real(kind=8), intent(in) :: X
integer, intent(in) :: I
end function
+#ifdef HAVE_GFC_REAL_10
+ elemental real(kind=10) function _gfortran_ieee_scalb_10 (X, I)
+ real(kind=10), intent(in) :: X
+ integer, intent(in) :: I
+ end function
+#endif
+#ifdef HAVE_GFC_REAL_16
+ elemental real(kind=16) function _gfortran_ieee_scalb_16 (X, I)
+ real(kind=16), intent(in) :: X
+ integer, intent(in) :: I
+ end function
+#endif
end interface
interface IEEE_SCALB
- procedure _gfortran_ieee_scalb_4, _gfortran_ieee_scalb_8
+ procedure &
+#ifdef HAVE_GFC_REAL_16
+ _gfortran_ieee_scalb_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ _gfortran_ieee_scalb_10, &
+#endif
+ _gfortran_ieee_scalb_8, _gfortran_ieee_scalb_4
end interface
public :: IEEE_SCALB
! IEEE_VALUE
interface IEEE_VALUE
- module procedure IEEE_VALUE_4, IEEE_VALUE_8
+ module procedure &
+#ifdef HAVE_GFC_REAL_16
+ IEEE_VALUE_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ IEEE_VALUE_10, &
+#endif
+ IEEE_VALUE_8, IEEE_VALUE_4
end interface
public :: IEEE_VALUE
! IEEE_CLASS
interface IEEE_CLASS
- module procedure IEEE_CLASS_4, IEEE_CLASS_8
+ module procedure &
+#ifdef HAVE_GFC_REAL_16
+ IEEE_CLASS_16, &
+#endif
+#ifdef HAVE_GFC_REAL_10
+ IEEE_CLASS_10, &
+#endif
+ IEEE_CLASS_8, IEEE_CLASS_4
end interface
public :: IEEE_CLASS
@@ -424,47 +776,19 @@ contains
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
+
+ ! Currently, if IEEE is supported and this module is built, it means
+ ! all our floating-point types conform to IEEE. Hence, we simply call
+ ! SELECTED_REAL_KIND.
+
+ res = SELECTED_REAL_KIND (P, R, RADIX)
+
end function
@@ -498,6 +822,39 @@ contains
res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_8(X))
end function
+#ifdef HAVE_GFC_REAL_10
+ elemental function IEEE_CLASS_10 (X) result(res)
+ implicit none
+ real(kind=10), intent(in) :: X
+ type(IEEE_CLASS_TYPE) :: res
+
+ interface
+ pure integer function _gfortrani_ieee_class_helper_10(val)
+ real(kind=10), intent(in) :: val
+ end function
+ end interface
+
+ res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_10(X))
+ end function
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+ elemental function IEEE_CLASS_16 (X) result(res)
+ implicit none
+ real(kind=16), intent(in) :: X
+ type(IEEE_CLASS_TYPE) :: res
+
+ interface
+ pure integer function _gfortrani_ieee_class_helper_16(val)
+ real(kind=16), intent(in) :: val
+ end function
+ end interface
+
+ res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_16(X))
+ end function
+#endif
+
+
! IEEE_VALUE
elemental real(kind=4) function IEEE_VALUE_4(X, C) result(res)
@@ -576,6 +933,86 @@ contains
end select
end function
+#ifdef HAVE_GFC_REAL_10
+ elemental real(kind=10) function IEEE_VALUE_10(X, C) result(res)
+ implicit none
+ real(kind=10), 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
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+ elemental real(kind=16) function IEEE_VALUE_16(X, C) result(res)
+ implicit none
+ real(kind=16), 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
+#endif
+
! IEEE_GET_ROUNDING_MODE
@@ -663,7 +1100,7 @@ contains
implicit none
real(kind=10), intent(in) :: X
type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
- res = .false.
+ res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
end function
#endif
@@ -672,18 +1109,14 @@ contains
implicit none
real(kind=16), intent(in) :: X
type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
- res = .false.
+ res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
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_UNDERFLOW_CONTROL
@@ -704,7 +1137,7 @@ contains
pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_10 (X) result(res)
implicit none
real(kind=10), intent(in) :: X
- res = .false.
+ res = (support_underflow_control_helper(10) /= 0)
end function
#endif
@@ -712,18 +1145,21 @@ contains
pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_16 (X) result(res)
implicit none
real(kind=16), intent(in) :: X
- res = .false.
+ res = (support_underflow_control_helper(16) /= 0)
end function
#endif
pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG () result(res)
implicit none
-#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
- res = .false.
-#else
res = (support_underflow_control_helper(4) /= 0 &
- .and. support_underflow_control_helper(8) /= 0)
+ .and. support_underflow_control_helper(8) /= 0 &
+#ifdef HAVE_GFC_REAL_10
+ .and. support_underflow_control_helper(10) /= 0 &
+#endif
+#ifdef HAVE_GFC_REAL_16
+ .and. support_underflow_control_helper(16) /= 0 &
#endif
+ )
end function
! IEEE_SUPPORT_* functions
@@ -746,127 +1182,95 @@ contains
SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,4,.true.)
SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,8,.true.)
#ifdef HAVE_GFC_REAL_10
-SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.true.)
#endif
#ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.true.)
#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.)
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,10,.true.)
#endif
#ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.true.)
#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.)
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,10,.true.)
#endif
#ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.true.)
#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.)
+SUPPORTMACRO(IEEE_SUPPORT_INF,10,.true.)
#endif
#ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_INF,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_INF,16,.true.)
#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.)
+SUPPORTMACRO(IEEE_SUPPORT_IO,10,.true.)
#endif
#ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_IO,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_IO,16,.true.)
#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.)
+SUPPORTMACRO(IEEE_SUPPORT_NAN,10,.true.)
#endif
#ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.true.)
#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.)
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,10,.true.)
#endif
#ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.true.)
#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.)
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,10,.true.)
#endif
#ifdef HAVE_GFC_REAL_16
-SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.false.)
+SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.true.)
#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
end module IEEE_ARITHMETIC
diff --git a/libgfortran/ieee/ieee_exceptions.F90 b/libgfortran/ieee/ieee_exceptions.F90
index 4283906eb26..662c42f03e0 100644
--- a/libgfortran/ieee/ieee_exceptions.F90
+++ b/libgfortran/ieee/ieee_exceptions.F90
@@ -57,9 +57,15 @@ module IEEE_EXCEPTIONS
end type
interface IEEE_SUPPORT_FLAG
- module procedure IEEE_SUPPORT_FLAG_NOARG, &
- IEEE_SUPPORT_FLAG_4, &
- IEEE_SUPPORT_FLAG_8
+ module procedure IEEE_SUPPORT_FLAG_4, &
+ IEEE_SUPPORT_FLAG_8, &
+#ifdef HAVE_GFC_REAL_10
+ IEEE_SUPPORT_FLAG_10, &
+#endif
+#ifdef HAVE_GFC_REAL_16
+ IEEE_SUPPORT_FLAG_16, &
+#endif
+ IEEE_SUPPORT_FLAG_NOARG
end interface IEEE_SUPPORT_FLAG
public :: IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
@@ -215,4 +221,22 @@ contains
res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
end function
+#ifdef HAVE_GFC_REAL_10
+ pure logical function IEEE_SUPPORT_FLAG_10 (FLAG, X) result(res)
+ implicit none
+ type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+ real(kind=10), intent(in) :: X
+ res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
+ end function
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+ pure logical function IEEE_SUPPORT_FLAG_16 (FLAG, X) result(res)
+ implicit none
+ type(IEEE_FLAG_TYPE), intent(in) :: FLAG
+ real(kind=16), intent(in) :: X
+ res = IEEE_SUPPORT_FLAG_NOARG(FLAG)
+ end function
+#endif
+
end module IEEE_EXCEPTIONS
diff --git a/libgfortran/ieee/ieee_helper.c b/libgfortran/ieee/ieee_helper.c
index c8ed77b15f3..f3362d42ef3 100644
--- a/libgfortran/ieee/ieee_helper.c
+++ b/libgfortran/ieee/ieee_helper.c
@@ -33,6 +33,16 @@ internal_proto(ieee_class_helper_4);
extern int ieee_class_helper_8 (GFC_REAL_8 *);
internal_proto(ieee_class_helper_8);
+#ifdef HAVE_GFC_REAL_10
+extern int ieee_class_helper_10 (GFC_REAL_10 *);
+internal_proto(ieee_class_helper_10);
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+extern int ieee_class_helper_16 (GFC_REAL_16 *);
+internal_proto(ieee_class_helper_16);
+#endif
+
/* Enumeration of the possible floating-point types. These values
correspond to the hidden arguments of the IEEE_CLASS_TYPE
derived-type of IEEE_ARITHMETIC. */
@@ -74,6 +84,14 @@ enum { IEEE_OTHER_VALUE = 0, IEEE_SIGNALING_NAN, IEEE_QUIET_NAN,
CLASSMACRO(4)
CLASSMACRO(8)
+#ifdef HAVE_GFC_REAL_10
+CLASSMACRO(10)
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+CLASSMACRO(16)
+#endif
+
#define GFC_FPE_ALL (GFC_FPE_INVALID | GFC_FPE_DENORMAL | \
GFC_FPE_ZERO | GFC_FPE_OVERFLOW | \