[llvm-branch-commits] [flang] acff94a - Update intrinsic module source files
V Donaldson via llvm-branch-commits
llvm-branch-commits at lists.llvm.org
Wed May 25 16:09:52 PDT 2022
Author: V Donaldson
Date: 2022-05-25T15:32:02-07:00
New Revision: acff94a87a3b531e4613b4b886d96219c9415882
URL: https://github.com/llvm/llvm-project/commit/acff94a87a3b531e4613b4b886d96219c9415882
DIFF: https://github.com/llvm/llvm-project/commit/acff94a87a3b531e4613b4b886d96219c9415882.diff
LOG: Update intrinsic module source files
The f18 standard defines several intrinsic modules containing definitions
and declarations for various constants, types, and procedures. This PR adds
declarations for missing procedures in these modules.
Added:
Modified:
flang/module/__fortran_builtins.f90
flang/module/__fortran_ieee_exceptions.f90
flang/module/ieee_arithmetic.f90
flang/module/iso_fortran_env.f90
Removed:
################################################################################
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index 4a4c55e44e056..4ce4901c4505d 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -41,8 +41,8 @@
procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
- intrinsic :: __builtin_ieee_is_nan, __builtin_ieee_is_normal, &
- __builtin_ieee_is_negative
+ intrinsic :: __builtin_ieee_is_nan, __builtin_ieee_is_negative, &
+ __builtin_ieee_is_normal
intrinsic :: __builtin_ieee_next_after, __builtin_ieee_next_down, &
__builtin_ieee_next_up
intrinsic :: scale ! for ieee_scalb
diff --git a/flang/module/__fortran_ieee_exceptions.f90 b/flang/module/__fortran_ieee_exceptions.f90
index bd8782e4db5a6..7232bbf53cd61 100644
--- a/flang/module/__fortran_ieee_exceptions.f90
+++ b/flang/module/__fortran_ieee_exceptions.f90
@@ -40,90 +40,110 @@
private
end type ieee_status_type
- private :: ieee_support_flag_2, ieee_support_flag_3, &
- ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, &
- ieee_support_flag_16
- interface ieee_support_flag
- module procedure :: ieee_support_flag, &
- ieee_support_flag_2, ieee_support_flag_3, &
- ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, &
- ieee_support_flag_16
+! Define specifics with 1 LOGICAL or REAL argument for generic G.
+#define SPECIFICS_L(G) \
+ G(1) G(2) G(4) G(8)
+#define SPECIFICS_R(G) \
+ G(2) G(3) G(4) G(8) G(10) G(16)
+
+! Set PRIVATE accessibility for specifics with 1 LOGICAL or REAL argument for
+! generic G.
+#define PRIVATE_L(G) private :: \
+ G##_l1, G##_l2, G##_l4, G##_l8
+#define PRIVATE_R(G) private :: \
+ G##_a2, G##_a3, G##_a4, G##_a8, G##_a10, G##_a16
+
+ interface
+ elemental subroutine ieee_get_flag(flag, flag_value)
+ import ieee_flag_type
+ type(ieee_flag_type), intent(in) :: flag
+ logical, intent(out) :: flag_value
+ end subroutine ieee_get_flag
+ end interface
+
+ interface
+ elemental subroutine ieee_get_halting_mode(flag, halting)
+ import ieee_flag_type
+ type(ieee_flag_type), intent(in) :: flag
+ logical, intent(out) :: halting
+ end subroutine ieee_get_halting_mode
+ end interface
+
+ interface
+ subroutine ieee_get_modes(modes)
+ import ieee_modes_type
+ type(ieee_modes_type), intent(out) :: modes
+ end subroutine ieee_get_modes
+ end interface
+
+ interface
+ subroutine ieee_get_status(status)
+ import ieee_status_type
+ type(ieee_status_type), intent(out) :: status
+ end subroutine ieee_get_status
+ end interface
+
+#define IEEE_SET_FLAG_L(FVKIND) \
+ pure subroutine ieee_set_flag_l##FVKIND(flag,flag_value); \
+ import ieee_flag_type; \
+ type(ieee_flag_type), intent(in) :: flag(..); \
+ logical(FVKIND), intent(in) :: flag_value(..); \
+ end subroutine ieee_set_flag_l##FVKIND;
+ interface ieee_set_flag
+ SPECIFICS_L(IEEE_SET_FLAG_L)
+ end interface ieee_set_flag
+ private :: ieee_set_flag_1
+ PRIVATE_L(IEEE_SET_FLAG)
+#undef IEEE_SET_FLAG_L
+
+#define IEEE_SET_HALTING_MODE_L(HKIND) \
+ pure subroutine ieee_set_halting_mode_l##HKIND(flag,halting); \
+ import ieee_flag_type; \
+ type(ieee_flag_type), intent(in) :: flag(..); \
+ logical(HKIND), intent(in) :: halting(..); \
+ end subroutine ieee_set_halting_mode_l##HKIND;
+ interface ieee_set_halting_mode
+ SPECIFICS_L(IEEE_SET_HALTING_MODE_L)
+ end interface ieee_set_halting_mode
+ private :: ieee_set_halting_mode_1
+ PRIVATE_L(IEEE_SET_HALTING_MODE)
+#undef IEEE_SET_HALTING_MODE_L
+
+ interface
+ subroutine ieee_set_modes(modes)
+ import ieee_modes_type
+ type(ieee_modes_type), intent(in) :: modes
+ end subroutine ieee_set_modes
+ end interface
+
+ interface
+ subroutine ieee_set_status(status)
+ import ieee_status_type
+ type(ieee_status_type), intent(in) :: status
+ end subroutine ieee_set_status
end interface
- contains
- elemental subroutine ieee_get_flag(flag, flag_value)
- type(ieee_flag_type), intent(in) :: flag
- logical, intent(out) :: flag_value
- end subroutine ieee_get_flag
-
- elemental subroutine ieee_get_halting_mode(flag, halting)
- type(ieee_flag_type), intent(in) :: flag
- logical, intent(out) :: halting
- end subroutine ieee_get_halting_mode
-
- subroutine ieee_get_modes(modes)
- type(ieee_modes_type), intent(out) :: modes
- end subroutine ieee_get_modes
-
- subroutine ieee_get_status(status)
- type(ieee_status_type), intent(out) :: status
- end subroutine ieee_get_status
-
- pure subroutine ieee_set_flag(flag, flag_value)
- type(ieee_flag_type), intent(in) :: flag
- logical, intent(in) :: flag_value
- end subroutine ieee_set_flag
-
- pure subroutine ieee_set_halting_mode(flag, halting)
- type(ieee_flag_type), intent(in) :: flag
- logical, intent(in) :: halting
- end subroutine ieee_set_halting_mode
-
- subroutine ieee_set_modes(modes)
- type(ieee_modes_type), intent(in) :: modes
- end subroutine ieee_set_modes
-
- subroutine ieee_set_status(status)
- type(ieee_status_type), intent(in) :: status
- end subroutine ieee_set_status
-
- pure logical function ieee_support_flag(flag)
- type(ieee_flag_type), intent(in) :: flag
- ieee_support_flag = .true.
- end function
- pure logical function ieee_support_flag_2(flag, x)
- type(ieee_flag_type), intent(in) :: flag
- real(kind=2), intent(in) :: x(..)
- ieee_support_flag_2 = .true.
- end function
- pure logical function ieee_support_flag_3(flag, x)
- type(ieee_flag_type), intent(in) :: flag
- real(kind=3), intent(in) :: x(..)
- ieee_support_flag_3 = .true.
- end function
- pure logical function ieee_support_flag_4(flag, x)
- type(ieee_flag_type), intent(in) :: flag
- real(kind=4), intent(in) :: x(..)
- ieee_support_flag_4 = .true.
- end function
- pure logical function ieee_support_flag_8(flag, x)
- type(ieee_flag_type), intent(in) :: flag
- real(kind=8), intent(in) :: x(..)
- ieee_support_flag_8 = .true.
- end function
- pure logical function ieee_support_flag_10(flag, x)
- type(ieee_flag_type), intent(in) :: flag
- real(kind=10), intent(in) :: x(..)
- ieee_support_flag_10 = .true.
- end function
- pure logical function ieee_support_flag_16(flag, x)
- type(ieee_flag_type), intent(in) :: flag
- real(kind=16), intent(in) :: x(..)
- ieee_support_flag_16 = .true.
- end function
-
- pure logical function ieee_support_halting(flag)
- type(ieee_flag_type), intent(in) :: flag
- end function ieee_support_halting
+#define IEEE_SUPPORT_FLAG_R(XKIND) \
+ logical function ieee_support_flag_a##XKIND(flag, x); \
+ import ieee_flag_type; \
+ type(ieee_flag_type), intent(in) :: flag; \
+ real(XKIND), intent(in) :: x(..); \
+ end function ieee_support_flag_a##XKIND;
+ interface ieee_support_flag
+ logical function ieee_support_flag(flag)
+ import ieee_flag_type
+ type(ieee_flag_type), intent(in) :: flag
+ end function ieee_support_flag
+ SPECIFICS_R(IEEE_SUPPORT_FLAG_R)
+ end interface ieee_support_flag
+ PRIVATE_R(IEEE_SUPPORT_FLAG)
+#undef IEEE_SUPPORT_FLAG_R
+
+ interface
+ pure logical function ieee_support_halting(flag)
+ import ieee_flag_type
+ type(ieee_flag_type), intent(in) :: flag
+ end function ieee_support_halting
+ end interface
end module __Fortran_ieee_exceptions
diff --git a/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90
index 5fe57f782a815..b2ac217aa86ae 100644
--- a/flang/module/ieee_arithmetic.f90
+++ b/flang/module/ieee_arithmetic.f90
@@ -6,13 +6,18 @@
!
!===------------------------------------------------------------------------===!
-! See Fortran 2018, clause 17.2
+! Fortran 2018 Clause 17
+
module ieee_arithmetic
+ ! 17.1: "The module IEEE_ARITHMETIC behaves as if it contained a
+ ! USE statement for IEEE_EXCEPTIONS; everything that is public in
+ ! IEEE_EXCEPTIONS is public in IEEE_ARITHMETIC."
+ use __Fortran_ieee_exceptions
use __Fortran_builtins, only: &
ieee_is_nan => __builtin_ieee_is_nan, &
- ieee_is_normal => __builtin_ieee_is_normal, &
ieee_is_negative => __builtin_ieee_is_negative, &
+ ieee_is_normal => __builtin_ieee_is_normal, &
ieee_next_after => __builtin_ieee_next_after, &
ieee_next_down => __builtin_ieee_next_down, &
ieee_next_up => __builtin_ieee_next_up, &
@@ -29,11 +34,6 @@ module ieee_arithmetic
ieee_support_subnormal => __builtin_ieee_support_subnormal, &
ieee_support_underflow_control => __builtin_ieee_support_underflow_control
- ! 17.1: "The module IEEE_ARITHMETIC behaves as if it contained a USE statement
- ! for IEEE_EXCEPTIONS; everything that is public in IEEE_EXCEPTIONS is public
- ! in IEEE_ARITHMETIC."
- use __Fortran_ieee_exceptions
-
implicit none
type :: ieee_class_type
@@ -72,291 +72,478 @@ module ieee_arithmetic
ieee_other = ieee_round_type(6)
interface operator(==)
- module procedure class_eq
- module procedure round_eq
+ elemental logical function ieee_class_eq(x, y)
+ import ieee_class_type
+ type(ieee_class_type), intent(in) :: x, y
+ end function ieee_class_eq
+ elemental logical function ieee_round_eq(x, y)
+ import ieee_round_type
+ type(ieee_round_type), intent(in) :: x, y
+ end function ieee_round_eq
end interface operator(==)
interface operator(/=)
- module procedure class_ne
- module procedure round_ne
+ elemental logical function ieee_class_ne(x, y)
+ import ieee_class_type
+ type(ieee_class_type), intent(in) :: x, y
+ end function ieee_class_ne
+ elemental logical function ieee_round_ne(x, y)
+ import ieee_round_type
+ type(ieee_round_type), intent(in) :: x, y
+ end function ieee_round_ne
end interface operator(/=)
- private :: class_eq, class_ne, round_eq, round_ne
-
- ! See Fortran 2018, 17.10 & 17.11
- generic :: ieee_class => ieee_class_a2, ieee_class_a3, ieee_class_a4, ieee_class_a8, ieee_class_a10, ieee_class_a16
- private :: ieee_class_a2, ieee_class_a3, ieee_class_a4, ieee_class_a8, ieee_class_a10, ieee_class_a16
-
- generic :: ieee_copy_sign => ieee_copy_sign_a2, ieee_copy_sign_a3, ieee_copy_sign_a4, ieee_copy_sign_a8, ieee_copy_sign_a10, ieee_copy_sign_a16
- private :: ieee_copy_sign_a2, ieee_copy_sign_a3, ieee_copy_sign_a4, ieee_copy_sign_a8, ieee_copy_sign_a10, ieee_copy_sign_a16
-
- generic :: ieee_is_finite => ieee_is_finite_a2, ieee_is_finite_a3, ieee_is_finite_a4, ieee_is_finite_a8, ieee_is_finite_a10, ieee_is_finite_a16
- private :: ieee_is_finite_a2, ieee_is_finite_a3, ieee_is_finite_a4, ieee_is_finite_a8, ieee_is_finite_a10, ieee_is_finite_a16
-
- generic :: ieee_rem => &
- ieee_rem_a2_a2, ieee_rem_a2_a3, ieee_rem_a2_a4, ieee_rem_a2_a8, ieee_rem_a2_a10, ieee_rem_a2_a16, &
- ieee_rem_a3_a2, ieee_rem_a3_a3, ieee_rem_a3_a4, ieee_rem_a3_a8, ieee_rem_a3_a10, ieee_rem_a3_a16, &
- ieee_rem_a4_a2, ieee_rem_a4_a3, ieee_rem_a4_a4, ieee_rem_a4_a8, ieee_rem_a4_a10, ieee_rem_a4_a16, &
- ieee_rem_a8_a2, ieee_rem_a8_a3, ieee_rem_a8_a4, ieee_rem_a8_a8, ieee_rem_a8_a10, ieee_rem_a8_a16, &
- ieee_rem_a10_a2, ieee_rem_a10_a3, ieee_rem_a10_a4, ieee_rem_a10_a8, ieee_rem_a10_a10, ieee_rem_a10_a16, &
- ieee_rem_a16_a2, ieee_rem_a16_a3, ieee_rem_a16_a4, ieee_rem_a16_a8, ieee_rem_a16_a10, ieee_rem_a16_a16
- private :: &
- ieee_rem_a2_a2, ieee_rem_a2_a3, ieee_rem_a2_a4, ieee_rem_a2_a8, ieee_rem_a2_a10, ieee_rem_a2_a16, &
- ieee_rem_a3_a2, ieee_rem_a3_a3, ieee_rem_a3_a4, ieee_rem_a3_a8, ieee_rem_a3_a10, ieee_rem_a3_a16, &
- ieee_rem_a4_a2, ieee_rem_a4_a3, ieee_rem_a4_a4, ieee_rem_a4_a8, ieee_rem_a4_a10, ieee_rem_a4_a16, &
- ieee_rem_a8_a2, ieee_rem_a8_a3, ieee_rem_a8_a4, ieee_rem_a8_a8, ieee_rem_a8_a10, ieee_rem_a8_a16, &
- ieee_rem_a10_a2, ieee_rem_a10_a3, ieee_rem_a10_a4, ieee_rem_a10_a8, ieee_rem_a10_a10, ieee_rem_a10_a16, &
- ieee_rem_a16_a2, ieee_rem_a16_a3, ieee_rem_a16_a4, ieee_rem_a16_a8, ieee_rem_a16_a10, ieee_rem_a16_a16
-
- generic :: ieee_support_rounding => ieee_support_rounding_, &
- ieee_support_rounding_2, ieee_support_rounding_3, &
- ieee_support_rounding_4, ieee_support_rounding_8, &
- ieee_support_rounding_10, ieee_support_rounding_16
- private :: ieee_support_rounding_, &
- ieee_support_rounding_2, ieee_support_rounding_3, &
- ieee_support_rounding_4, ieee_support_rounding_8, &
- ieee_support_rounding_10, ieee_support_rounding_16
-
- ! TODO: more interfaces (_fma, &c.)
-
- private :: classify
-
- contains
-
- elemental logical function class_eq(x,y)
- type(ieee_class_type), intent(in) :: x, y
- class_eq = x%which == y%which
- end function class_eq
-
- elemental logical function class_ne(x,y)
- type(ieee_class_type), intent(in) :: x, y
- class_ne = x%which /= y%which
- end function class_ne
-
- elemental logical function round_eq(x,y)
- type(ieee_round_type), intent(in) :: x, y
- round_eq = x%mode == y%mode
- end function round_eq
-
- elemental logical function round_ne(x,y)
- type(ieee_round_type), intent(in) :: x, y
- round_ne = x%mode /= y%mode
- end function round_ne
-
- elemental type(ieee_class_type) function classify( &
- expo,maxExpo,negative,significandNZ,quietBit)
- integer, intent(in) :: expo, maxExpo
- logical, intent(in) :: negative, significandNZ, quietBit
- if (expo == 0) then
- if (significandNZ) then
- if (negative) then
- classify = ieee_negative_denormal
- else
- classify = ieee_positive_denormal
- end if
- else
- if (negative) then
- classify = ieee_negative_zero
- else
- classify = ieee_positive_zero
- end if
- end if
- else if (expo == maxExpo) then
- if (significandNZ) then
- if (quietBit) then
- classify = ieee_quiet_nan
- else
- classify = ieee_signaling_nan
- end if
- else
- if (negative) then
- classify = ieee_negative_inf
- else
- classify = ieee_positive_inf
- end if
- end if
- else
- if (negative) then
- classify = ieee_negative_normal
- else
- classify = ieee_positive_normal
- end if
- end if
- end function classify
-
-#define _CLASSIFY(RKIND,IKIND,TOTALBITS,PREC,IMPLICIT) \
- type(ieee_class_type) elemental function ieee_class_a##RKIND(x); \
- real(kind=RKIND), intent(in) :: x; \
- integer(kind=IKIND) :: raw; \
- integer, parameter :: significand = PREC - IMPLICIT; \
- integer, parameter :: exponentBits = TOTALBITS - 1 - significand; \
- integer, parameter :: maxExpo = shiftl(1, exponentBits) - 1; \
- integer :: exponent, sign; \
- logical :: negative, nzSignificand, quiet; \
- raw = transfer(x, raw); \
- exponent = ibits(raw, significand, exponentBits); \
- negative = btest(raw, TOTALBITS - 1); \
- nzSignificand = ibits(raw, 0, significand) /= 0; \
- quiet = btest(raw, significand - 1); \
- ieee_class_a##RKIND = classify(exponent, maxExpo, negative, nzSignificand, quiet); \
- end function ieee_class_a##RKIND
- _CLASSIFY(2,2,16,11,1)
- _CLASSIFY(3,2,16,8,1)
- _CLASSIFY(4,4,32,24,1)
- _CLASSIFY(8,8,64,53,1)
- _CLASSIFY(10,16,80,64,0)
- _CLASSIFY(16,16,128,112,1)
-#undef _CLASSIFY
-
- ! TODO: This might need to be an actual Operation instead
-#define _COPYSIGN(RKIND,IKIND,BITS) \
- real(kind=RKIND) elemental function ieee_copy_sign_a##RKIND(x,y); \
- real(kind=RKIND), intent(in) :: x, y; \
- integer(kind=IKIND) :: xbits, ybits; \
- xbits = transfer(x, xbits); \
- ybits = transfer(y, ybits); \
- xbits = ior(ibclr(xbits, BITS-1), iand(ybits, shiftl(1_##IKIND, BITS-1))); \
- ieee_copy_sign_a##RKIND = transfer(xbits, x); \
- end function ieee_copy_sign_a##RKIND
- _COPYSIGN(2,2,16)
- _COPYSIGN(3,2,16)
- _COPYSIGN(4,4,32)
- _COPYSIGN(8,8,64)
- _COPYSIGN(10,16,80)
- _COPYSIGN(16,16,128)
-#undef _COPYSIGN
-
-#define _IS_FINITE(KIND) \
- elemental function ieee_is_finite_a##KIND(x) result(res); \
- real(kind=KIND), intent(in) :: x; \
- logical :: res; \
- type(ieee_class_type) :: classification; \
- classification = ieee_class(x); \
- res = classification == ieee_negative_zero .or. classification == ieee_positive_zero \
- .or. classification == ieee_negative_denormal .or. classification == ieee_positive_denormal \
- .or. classification == ieee_negative_normal .or. classification == ieee_positive_normal; \
- end function
- _IS_FINITE(2)
- _IS_FINITE(3)
- _IS_FINITE(4)
- _IS_FINITE(8)
- _IS_FINITE(10)
- _IS_FINITE(16)
-#undef _IS_FINITE
-
-#define _IS_NEGATIVE(KIND) \
- elemental function ieee_is_negative_a##KIND(x) result(res); \
- real(kind=KIND), intent(in) :: x; \
- logical :: res; \
- type(ieee_class_type) :: classification; \
- classification = ieee_class(x); \
- res = classification == ieee_negative_zero .or. classification == ieee_negative_denormal \
- .or. classification == ieee_negative_normal .or. classification == ieee_negative_inf; \
- end function
- _IS_NEGATIVE(2)
- _IS_NEGATIVE(3)
- _IS_NEGATIVE(4)
- _IS_NEGATIVE(8)
- _IS_NEGATIVE(10)
- _IS_NEGATIVE(16)
-#undef _IS_NEGATIVE
-
-#define _IS_NORMAL(KIND) \
- elemental function ieee_is_normal_a##KIND(x) result(res); \
- real(kind=KIND), intent(in) :: x; \
- logical :: res; \
- type(ieee_class_type) :: classification; \
- classification = ieee_class(x); \
- res = classification == ieee_negative_normal .or. classification == ieee_positive_normal \
- .or. classification == ieee_negative_zero .or. classification == ieee_positive_zero; \
- end function
- _IS_NORMAL(2)
- _IS_NORMAL(3)
- _IS_NORMAL(4)
- _IS_NORMAL(8)
- _IS_NORMAL(10)
- _IS_NORMAL(16)
-#undef _IS_NORMAL
-
-! TODO: handle edge cases from 17.11.31
-#define _REM(XKIND,YKIND) \
- elemental function ieee_rem_a##XKIND##_a##YKIND(x, y) result(res); \
- real(kind=XKIND), intent(in) :: x; \
- real(kind=YKIND), intent(in) :: y; \
- integer, parameter :: rkind = max(XKIND, YKIND); \
- real(kind=rkind) :: res, tmp; \
- tmp = anint(real(x, kind=rkind) / y); \
- res = x - y * tmp; \
- end function
- _REM(2,2)
- _REM(2,3)
- _REM(2,4)
- _REM(2,8)
- _REM(2,10)
- _REM(2,16)
- _REM(3,2)
- _REM(3,3)
- _REM(3,4)
- _REM(3,8)
- _REM(3,10)
- _REM(3,16)
- _REM(4,2)
- _REM(4,3)
- _REM(4,4)
- _REM(4,8)
- _REM(4,10)
- _REM(4,16)
- _REM(8,2)
- _REM(8,3)
- _REM(8,4)
- _REM(8,8)
- _REM(8,10)
- _REM(8,16)
- _REM(10,2)
- _REM(10,3)
- _REM(10,4)
- _REM(10,8)
- _REM(10,10)
- _REM(10,16)
- _REM(16,2)
- _REM(16,3)
- _REM(16,4)
- _REM(16,8)
- _REM(16,10)
- _REM(16,16)
-#undef _REM
-
- pure logical function ieee_support_rounding_(round_type)
- type(ieee_round_type), intent(in) :: round_type
- ieee_support_rounding_ = .true.
- end function
- pure logical function ieee_support_rounding_2(round_type,x)
- type(ieee_round_type), intent(in) :: round_type
- real(kind=2), intent(in) :: x
- ieee_support_rounding_2 = .true.
- end function
- pure logical function ieee_support_rounding_3(round_type,x)
- type(ieee_round_type), intent(in) :: round_type
- real(kind=3), intent(in) :: x
- ieee_support_rounding_3 = .true.
- end function
- pure logical function ieee_support_rounding_4(round_type,x)
- type(ieee_round_type), intent(in) :: round_type
- real(kind=4), intent(in) :: x
- ieee_support_rounding_4 = .true.
- end function
- pure logical function ieee_support_rounding_8(round_type,x)
- type(ieee_round_type), intent(in) :: round_type
- real(kind=8), intent(in) :: x
- ieee_support_rounding_8 = .true.
- end function
- pure logical function ieee_support_rounding_10(round_type,x)
- type(ieee_round_type), intent(in) :: round_type
- real(kind=10), intent(in) :: x
- ieee_support_rounding_10 = .true.
- end function
- pure logical function ieee_support_rounding_16(round_type,x)
- type(ieee_round_type), intent(in) :: round_type
- real(kind=16), intent(in) :: x
- ieee_support_rounding_16 = .true.
- end function
+ private :: ieee_class_eq, ieee_round_eq, ieee_class_ne, ieee_round_ne
+
+! Define specifics with 1 or 2 INTEGER, LOGICAL, or REAL arguments for
+! generic G.
+#define SPECIFICS_I(G) \
+ G(1) G(2) G(4) G(8) G(16)
+#define SPECIFICS_L(G) \
+ G(1) G(2) G(4) G(8)
+#define SPECIFICS_R(G) \
+ G(2) G(3) G(4) G(8) G(10) G(16)
+#define SPECIFICS_II(G) \
+ G(1,1) G(1,2) G(1,4) G(1,8) G(1,16) \
+ G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
+ G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
+ G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
+ G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
+#define SPECIFICS_RI(G) \
+ G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
+ G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \
+ G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
+ G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
+ G(10,1) G(10,2) G(10,4) G(10,8) G(10,16) \
+ G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
+#define SPECIFICS_RR(G) \
+ G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) G(2,16) \
+ G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) G(3,16) \
+ G(4,2) G(4,3) G(4,4) G(4,8) G(4,10) G(4,16) \
+ G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) G(8,16) \
+ G(10,2) G(10,3) G(10,4) G(10,8) G(10,10) G(10,16) \
+ G(16,2) G(16,3) G(16,4) G(16,8) G(16,10) G(16,16)
+
+! Set PRIVATE accessibility for specifics with 1 or 2 INTEGER, LOGICAL, or REAL
+! arguments for generic G.
+#define PRIVATE_I(G) private :: \
+ G##_i1, G##_i2, G##_i4, G##_i8, G##_i16
+#define PRIVATE_L(G) private :: \
+ G##_l1, G##_l2, G##_l4, G##_l8
+#define PRIVATE_R(G) private :: \
+ G##_a2, G##_a3, G##_a4, G##_a8, G##_a10, G##_a16
+#define PRIVATE_II(G) private :: \
+ G##_i1_i1, G##_i1_i2, G##_i1_i4, G##_i1_i8, G##_i1_i16, \
+ G##_i2_i1, G##_i2_i2, G##_i2_i4, G##_i2_i8, G##_i2_i16, \
+ G##_i4_i1, G##_i4_i2, G##_i4_i4, G##_i4_i8, G##_i4_i16, \
+ G##_i8_i1, G##_i8_i2, G##_i8_i4, G##_i8_i8, G##_i8_i16, \
+ G##_i16_i1, G##_i16_i2, G##_i16_i4, G##_i16_i8, G##_i16_i16
+#define PRIVATE_RI(G) private :: \
+ G##_a2_i1, G##_a2_i2, G##_a2_i4, G##_a2_i8, G##_a2_i16, \
+ G##_a3_i1, G##_a3_i2, G##_a3_i4, G##_a3_i8, G##_a3_i16, \
+ G##_a4_i1, G##_a4_i2, G##_a4_i4, G##_a4_i8, G##_a4_i16, \
+ G##_a8_i1, G##_a8_i2, G##_a8_i4, G##_a8_i8, G##_a8_i16, \
+ G##_a10_i1, G##_a10_i2, G##_a10_i4, G##_a10_i8, G##_a10_i16, \
+ G##_a16_i1, G##_a16_i2, G##_a16_i4, G##_a16_i8, G##_a16_i16
+#define PRIVATE_RR(G) private :: \
+ G##_a2_a2, G##_a2_a3, G##_a2_a4, G##_a2_a8, G##_a2_a10, G##_a2_a16, \
+ G##_a3_a2, G##_a3_a3, G##_a3_a4, G##_a3_a8, G##_a3_a10, G##_a3_a16, \
+ G##_a4_a2, G##_a4_a3, G##_a4_a4, G##_a4_a8, G##_a4_a10, G##_a4_a16, \
+ G##_a8_a2, G##_a8_a3, G##_a8_a4, G##_a8_a8, G##_a8_a10, G##_a8_a16, \
+ G##_a10_a2, G##_a10_a3, G##_a10_a4, G##_a10_a8, G##_a10_a10, G##_a10_a16, \
+ G##_a16_a2, G##_a16_a3, G##_a16_a4, G##_a16_a8, G##_a16_a10, G##_a16_a16
+
+#define IEEE_CLASS_R(XKIND) \
+ elemental type(ieee_class_type) function ieee_class_a##XKIND(x); \
+ import ieee_class_type; \
+ real(XKIND), intent(in) :: x; \
+ end function ieee_class_a##XKIND;
+ interface ieee_class
+ SPECIFICS_R(IEEE_CLASS_R)
+ end interface ieee_class
+ PRIVATE_R(IEEE_CLASS)
+#undef IEEE_CLASS_R
+
+#define IEEE_COPY_SIGN_RR(XKIND, YKIND) \
+ elemental real(XKIND) function ieee_copy_sign_a##XKIND##_a##YKIND(x, y); \
+ real(XKIND), intent(in) :: x; \
+ real(YKIND), intent(in) :: y; \
+ end function ieee_copy_sign_a##XKIND##_a##YKIND;
+ interface ieee_copy_sign
+ SPECIFICS_RR(IEEE_COPY_SIGN_RR)
+ end interface ieee_copy_sign
+ PRIVATE_RR(IEEE_COPY_SIGN)
+#undef IEEE_COPY_SIGN_RR
+
+#define IEEE_FMA_R(AKIND) \
+ elemental real(AKIND) function ieee_fma_a##AKIND(a, b, c); \
+ real(AKIND), intent(in) :: a, b, c; \
+ end function ieee_fma_a##AKIND;
+ interface ieee_fma
+ SPECIFICS_R(IEEE_FMA_R)
+ end interface ieee_fma
+ PRIVATE_R(IEEE_FMA)
+#undef IEEE_FMA_R
+
+#define IEEE_GET_ROUNDING_MODE_I(RKIND) \
+ subroutine ieee_get_rounding_mode_i##RKIND(round_value, radix); \
+ import ieee_round_type; \
+ type(ieee_round_type), intent(out) :: round_value; \
+ integer(RKIND), intent(in) :: radix; \
+ end subroutine ieee_get_rounding_mode_i##RKIND;
+ interface ieee_get_rounding_mode
+ subroutine ieee_get_rounding_mode(round_value)
+ import ieee_round_type
+ type(ieee_round_type), intent(out) :: round_value
+ end subroutine ieee_get_rounding_mode
+ SPECIFICS_I(IEEE_GET_ROUNDING_MODE_I)
+ end interface ieee_get_rounding_mode
+ PRIVATE_I(IEEE_GET_ROUNDING_MODE)
+#undef IEEE_GET_ROUNDING_MODE_I
+
+#define IEEE_GET_UNDERFLOW_MODE_L(GKIND) \
+ subroutine ieee_get_underflow_mode_l##GKIND(gradual); \
+ logical(GKIND), intent(out) :: gradual; \
+ end subroutine ieee_get_underflow_mode_l##GKIND;
+ interface ieee_get_underflow_mode
+ SPECIFICS_L(IEEE_GET_UNDERFLOW_MODE_L)
+ end interface ieee_get_underflow_mode
+ PRIVATE_L(IEEE_GET_UNDERFLOW_MODE)
+#undef IEEE_GET_UNDERFLOW_MODE_L
+
+! When kind argument is present, kind(result) is value(kind), not kind(kind).
+! That is not known here, so return integer(16).
+#define IEEE_INT_R(AKIND) \
+ elemental integer function ieee_int_a##AKIND(a, round); \
+ import ieee_round_type; \
+ real(AKIND), intent(in) :: a; \
+ type(ieee_round_type), intent(in) :: round; \
+ end function ieee_int_a##AKIND;
+#define IEEE_INT_RI(AKIND, KKIND) \
+ elemental integer(16) function ieee_int_a##AKIND##_i##KKIND(a, round, kind); \
+ import ieee_round_type; \
+ real(AKIND), intent(in) :: a; \
+ type(ieee_round_type), intent(in) :: round; \
+ integer(KKIND), intent(in) :: kind; \
+ end function ieee_int_a##AKIND##_i##KKIND;
+ interface ieee_int
+ SPECIFICS_R(IEEE_INT_R)
+ SPECIFICS_RI(IEEE_INT_RI)
+ end interface ieee_int
+ PRIVATE_R(IEEE_INT)
+ PRIVATE_RI(IEEE_INT)
+#undef IEEE_INT_R
+#undef IEEE_INT_RI
+
+#define IEEE_IS_FINITE_R(XKIND) \
+ elemental logical function ieee_is_finite_a##XKIND(x); \
+ real(XKIND), intent(in) :: x; \
+ end function ieee_is_finite_a##XKIND;
+ interface ieee_is_finite
+ SPECIFICS_R(IEEE_IS_FINITE_R)
+ end interface ieee_is_finite
+ PRIVATE_R(IEEE_IS_FINITE)
+#undef IEEE_IS_FINITE_R
+
+#define IEEE_LOGB_R(XKIND) \
+ elemental real(XKIND) function ieee_logb_a##XKIND(x); \
+ real(XKIND), intent(in) :: x; \
+ end function ieee_logb_a##XKIND;
+ interface ieee_logb
+ SPECIFICS_R(IEEE_LOGB_R)
+ end interface ieee_logb
+ PRIVATE_R(IEEE_LOGB)
+#undef IEEE_LOGB_R
+
+#define IEEE_MAX_NUM_R(XKIND) \
+ elemental real(XKIND) function ieee_max_num_a##XKIND(x, y); \
+ real(XKIND), intent(in) :: x, y; \
+ end function ieee_max_num_a##XKIND;
+ interface ieee_max_num
+ SPECIFICS_R(IEEE_MAX_NUM_R)
+ end interface ieee_max_num
+ PRIVATE_R(IEEE_MAX_NUM)
+#undef IEEE_MAX_NUM_R
+
+#define IEEE_MAX_NUM_MAG_R(XKIND) \
+ elemental real(XKIND) function ieee_max_num_mag_a##XKIND(x, y); \
+ real(XKIND), intent(in) :: x, y; \
+ end function ieee_max_num_mag_a##XKIND;
+ interface ieee_max_num_mag
+ SPECIFICS_R(IEEE_MAX_NUM_MAG_R)
+ end interface ieee_max_num_mag
+ PRIVATE_R(IEEE_MAX_NUM_MAG)
+#undef IEEE_MAX_NUM_MAG_R
+
+#define IEEE_MIN_NUM_R(XKIND) \
+ elemental real(XKIND) function ieee_min_num_a##XKIND(x, y); \
+ real(XKIND), intent(in) :: x, y; \
+ end function ieee_min_num_a##XKIND;
+ interface ieee_min_num
+ SPECIFICS_R(IEEE_MIN_NUM_R)
+ end interface ieee_min_num
+ PRIVATE_R(IEEE_MIN_NUM)
+#undef IEEE_MIN_NUM_R
+
+#define IEEE_MIN_NUM_MAG_R(XKIND) \
+ elemental real(XKIND) function ieee_min_num_mag_a##XKIND(x, y); \
+ real(XKIND), intent(in) :: x, y; \
+ end function ieee_min_num_mag_a##XKIND;
+ interface ieee_min_num_mag
+ SPECIFICS_R(IEEE_MIN_NUM_MAG_R)
+ end interface ieee_min_num_mag
+ PRIVATE_R(IEEE_MIN_NUM_MAG)
+#undef IEEE_MIN_NUM_MAG_R
+
+#define IEEE_QUIET_EQ_R(AKIND) \
+ elemental logical function ieee_quiet_eq_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_quiet_eq_a##AKIND;
+ interface ieee_quiet_eq
+ SPECIFICS_R(IEEE_QUIET_EQ_R)
+ end interface ieee_quiet_eq
+ PRIVATE_R(IEEE_QUIET_EQ)
+#undef IEEE_QUIET_EQ_R
+
+#define IEEE_QUIET_GE_R(AKIND) \
+ elemental logical function ieee_quiet_ge_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_quiet_ge_a##AKIND;
+ interface ieee_quiet_ge
+ SPECIFICS_R(IEEE_QUIET_GE_R)
+ end interface ieee_quiet_ge
+ PRIVATE_R(IEEE_QUIET_GE)
+#undef IEEE_QUIET_GE_R
+
+#define IEEE_QUIET_GT_R(AKIND) \
+ elemental logical function ieee_quiet_gt_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_quiet_gt_a##AKIND;
+ interface ieee_quiet_gt
+ SPECIFICS_R(IEEE_QUIET_GT_R)
+ end interface ieee_quiet_gt
+ PRIVATE_R(IEEE_QUIET_GT)
+#undef IEEE_QUIET_GT_R
+
+#define IEEE_QUIET_LE_R(AKIND) \
+ elemental logical function ieee_quiet_le_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_quiet_le_a##AKIND;
+ interface ieee_quiet_le
+ SPECIFICS_R(IEEE_QUIET_LE_R)
+ end interface ieee_quiet_le
+ PRIVATE_R(IEEE_QUIET_LE)
+#undef IEEE_QUIET_LE_R
+
+#define IEEE_QUIET_LT_R(AKIND) \
+ elemental logical function ieee_quiet_lt_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_quiet_lt_a##AKIND;
+ interface ieee_quiet_lt
+ SPECIFICS_R(IEEE_QUIET_LT_R)
+ end interface ieee_quiet_lt
+ PRIVATE_R(IEEE_QUIET_LT)
+#undef IEEE_QUIET_LT_R
+
+#define IEEE_QUIET_NE_R(AKIND) \
+ elemental logical function ieee_quiet_ne_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_quiet_ne_a##AKIND;
+ interface ieee_quiet_ne
+ SPECIFICS_R(IEEE_QUIET_NE_R)
+ end interface ieee_quiet_ne
+ PRIVATE_R(IEEE_QUIET_NE)
+#undef IEEE_QUIET_NE_R
+
+! When kind argument is present, kind(result) is value(kind), not kind(kind).
+! That is not known here, so return real(16).
+#define IEEE_REAL_I(AKIND) \
+ elemental real function ieee_real_i##AKIND(a); \
+ integer(AKIND), intent(in) :: a; \
+ end function ieee_real_i##AKIND;
+#define IEEE_REAL_R(AKIND) \
+ elemental real function ieee_real_a##AKIND(a); \
+ real(AKIND), intent(in) :: a; \
+ end function ieee_real_a##AKIND;
+#define IEEE_REAL_II(AKIND, KKIND) \
+ elemental real(16) function ieee_real_i##AKIND##_i##KKIND(a, kind); \
+ integer(AKIND), intent(in) :: a; \
+ integer(KKIND), intent(in) :: kind; \
+ end function ieee_real_i##AKIND##_i##KKIND;
+#define IEEE_REAL_RI(AKIND, KKIND) \
+ elemental real(16) function ieee_real_a##AKIND##_i##KKIND(a, kind); \
+ real(AKIND), intent(in) :: a; \
+ integer(KKIND), intent(in) :: kind; \
+ end function ieee_real_a##AKIND##_i##KKIND;
+ interface ieee_real
+ SPECIFICS_I(IEEE_REAL_I)
+ SPECIFICS_R(IEEE_REAL_R)
+ SPECIFICS_II(IEEE_REAL_II)
+ SPECIFICS_RI(IEEE_REAL_RI)
+ end interface ieee_real
+ PRIVATE_I(IEEE_REAL)
+ PRIVATE_R(IEEE_REAL)
+ PRIVATE_II(IEEE_REAL)
+ PRIVATE_RI(IEEE_REAL)
+#undef IEEE_REAL_I
+#undef IEEE_REAL_R
+#undef IEEE_REAL_II
+#undef IEEE_REAL_RI
+
+#define IEEE_REM_RR(XKIND, YKIND) \
+ elemental real(XKIND) function ieee_rem_a##XKIND##_a##YKIND(x, y); \
+ real(XKIND), intent(in) :: x; \
+ real(YKIND), intent(in) :: y; \
+ end function ieee_rem_a##XKIND##_a##YKIND;
+ interface ieee_rem
+ SPECIFICS_RR(IEEE_REM_RR)
+ end interface ieee_rem
+ PRIVATE_RR(IEEE_REM)
+#undef IEEE_REM_RR
+
+#define IEEE_RINT_R(XKIND) \
+ elemental real(XKIND) function ieee_rint_a##XKIND(x, round); \
+ import ieee_round_type; \
+ real(XKIND), intent(in) :: x; \
+ type(ieee_round_type), optional, intent(in) :: round; \
+ end function ieee_rint_a##XKIND;
+ interface ieee_rint
+ SPECIFICS_R(IEEE_RINT_R)
+ end interface ieee_rint
+ PRIVATE_R(IEEE_RINT)
+#undef IEEE_RINT_R
+
+#define IEEE_SET_ROUNDING_MODE_I(RKIND) \
+ subroutine ieee_set_rounding_mode_i##RKIND(round_value, radix); \
+ import ieee_round_type; \
+ type(ieee_round_type), intent(in) :: round_value; \
+ integer(RKIND), intent(in) :: radix; \
+ end subroutine ieee_set_rounding_mode_i##RKIND;
+ interface ieee_set_rounding_mode
+ subroutine ieee_set_rounding_mode(round_value)
+ import ieee_round_type
+ type(ieee_round_type), intent(in) :: round_value
+ end subroutine ieee_set_rounding_mode
+ SPECIFICS_I(IEEE_SET_ROUNDING_MODE_I)
+ end interface ieee_set_rounding_mode
+ PRIVATE_I(IEEE_SET_ROUNDING_MODE)
+#undef IEEE_SET_ROUNDING_MODE_I
+
+#define IEEE_SET_UNDERFLOW_MODE_L(GKIND) \
+ subroutine ieee_set_underflow_mode_l##GKIND(gradual); \
+ logical(GKIND), intent(in) :: gradual; \
+ end subroutine ieee_set_underflow_mode_l##GKIND;
+ interface ieee_set_underflow_mode
+ SPECIFICS_L(IEEE_SET_UNDERFLOW_MODE_L)
+ end interface ieee_set_underflow_mode
+ PRIVATE_L(IEEE_SET_UNDERFLOW_MODE)
+#undef IEEE_SET_UNDERFLOW_MODE_L
+
+#define IEEE_SIGNALING_EQ_R(AKIND) \
+ elemental logical function ieee_signaling_eq_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_signaling_eq_a##AKIND;
+ interface ieee_signaling_eq
+ SPECIFICS_R(IEEE_SIGNALING_EQ_R)
+ end interface ieee_signaling_eq
+ PRIVATE_R(IEEE_SIGNALING_EQ)
+#undef IEEE_SIGNALING_EQ_R
+
+#define IEEE_SIGNALING_GE_R(AKIND) \
+ elemental logical function ieee_signaling_ge_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_signaling_ge_a##AKIND;
+ interface ieee_signaling_ge
+ SPECIFICS_R(IEEE_SIGNALING_GE_R)
+ end interface ieee_signaling_ge
+ PRIVATE_R(IEEE_SIGNALING_GE)
+#undef IEEE_SIGNALING_GE_R
+
+#define IEEE_SIGNALING_GT_R(AKIND) \
+ elemental logical function ieee_signaling_gt_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_signaling_gt_a##AKIND;
+ interface ieee_signaling_gt
+ SPECIFICS_R(IEEE_SIGNALING_GT_R)
+ end interface ieee_signaling_gt
+ PRIVATE_R(IEEE_SIGNALING_GT)
+#undef IEEE_SIGNALING_GT_R
+
+#define IEEE_SIGNALING_LE_R(AKIND) \
+ elemental logical function ieee_signaling_le_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_signaling_le_a##AKIND;
+ interface ieee_signaling_le
+ SPECIFICS_R(IEEE_SIGNALING_LE_R)
+ end interface ieee_signaling_le
+ PRIVATE_R(IEEE_SIGNALING_LE)
+#undef IEEE_SIGNALING_LE_R
+
+#define IEEE_SIGNALING_LT_R(AKIND) \
+ elemental logical function ieee_signaling_lt_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_signaling_lt_a##AKIND;
+ interface ieee_signaling_lt
+ SPECIFICS_R(IEEE_SIGNALING_LT_R)
+ end interface ieee_signaling_lt
+ PRIVATE_R(IEEE_SIGNALING_LT)
+#undef IEEE_SIGNALING_LT_R
+
+#define IEEE_SIGNALING_NE_R(AKIND) \
+ elemental logical function ieee_signaling_ne_a##AKIND(a, b); \
+ real(AKIND), intent(in) :: a, b; \
+ end function ieee_signaling_ne_a##AKIND;
+ interface ieee_signaling_ne
+ SPECIFICS_R(IEEE_SIGNALING_NE_R)
+ end interface ieee_signaling_ne
+ PRIVATE_R(IEEE_SIGNALING_NE)
+#undef IEEE_SIGNALING_NE_R
+
+#define IEEE_SIGNBIT_R(XKIND) \
+ elemental logical function ieee_signbit_a##XKIND(x); \
+ real(XKIND), intent(in) :: x; \
+ end function ieee_signbit_a##XKIND;
+ interface ieee_signbit
+ SPECIFICS_R(IEEE_SIGNBIT_R)
+ end interface ieee_signbit
+ PRIVATE_R(IEEE_SIGNBIT)
+#undef IEEE_SIGNBIT_R
+
+#define IEEE_SUPPORT_ROUNDING_R(XKIND) \
+ pure logical function ieee_support_rounding_a##XKIND(round_value, x); \
+ import ieee_round_type; \
+ type(ieee_round_type), intent(in) :: round_value; \
+ real(XKIND), intent(in) :: x(..); \
+ end function ieee_support_rounding_a##XKIND;
+ interface ieee_support_rounding
+ logical function ieee_support_rounding(round_value)
+ import ieee_round_type
+ type(ieee_round_type), intent(in) :: round_value
+ end function ieee_support_rounding
+ SPECIFICS_R(IEEE_SUPPORT_ROUNDING_R)
+ end interface ieee_support_rounding
+ PRIVATE_R(IEEE_SUPPORT_ROUNDING)
+#undef IEEE_SUPPORT_ROUNDING_R
+
+#define IEEE_UNORDERED_RR(XKIND, YKIND) \
+ elemental logical function ieee_unordered_a##XKIND##_a##YKIND(x, y); \
+ real(XKIND), intent(in) :: x; \
+ real(YKIND), intent(in) :: y; \
+ end function ieee_unordered_a##XKIND##_a##YKIND;
+ interface ieee_unordered
+ SPECIFICS_RR(IEEE_UNORDERED_RR)
+ end interface ieee_unordered
+ PRIVATE_RR(IEEE_UNORDERED)
+#undef IEEE_UNORDERED_RR
+
+#define IEEE_VALUE_R(XKIND) \
+ elemental real(XKIND) function ieee_value_a##XKIND(x, class); \
+ import ieee_class_type; \
+ real(XKIND), intent(in) :: x; \
+ type(ieee_class_type), intent(in) :: class; \
+ end function ieee_value_a##XKIND;
+ interface ieee_value
+ SPECIFICS_R(IEEE_VALUE_R)
+ end interface ieee_value
+ PRIVATE_R(IEEE_VALUE)
+#undef IEEE_VALUE_R
end module ieee_arithmetic
diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90
index e85d2e2a7a36c..abf7098aca5b2 100644
--- a/flang/module/iso_fortran_env.f90
+++ b/flang/module/iso_fortran_env.f90
@@ -144,13 +144,14 @@ module iso_fortran_env
integer, parameter :: stat_unlocked = FORTRAN_RUNTIME_STAT_UNLOCKED
integer, parameter :: stat_unlocked_failed_image = FORTRAN_RUNTIME_STAT_UNLOCKED_FAILED_IMAGE
- contains
+ interface compiler_options
+ character(len=80) function compiler_options()
+ end function compiler_options
+ end interface compiler_options
- character(len=80) function compiler_options()
- compiler_options = 'COMPILER_OPTIONS() not yet implemented'
- end function compiler_options
+ interface compiler_version
+ character(len=80) function compiler_version()
+ end function compiler_version
+ end interface compiler_version
- character(len=80) function compiler_version()
- compiler_version = 'f18 in development'
- end function compiler_version
end module iso_fortran_env
More information about the llvm-branch-commits
mailing list