diff --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h --- a/flang/include/flang/Evaluate/real.h +++ b/flang/include/flang/Evaluate/real.h @@ -80,6 +80,7 @@ constexpr bool IsInfinite() const { return Exponent() == maxExponent && GetSignificand().IsZero(); } + constexpr bool IsFinite() const { return Exponent() != maxExponent; } constexpr bool IsZero() const { return Exponent() == 0 && GetSignificand().IsZero(); } diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp --- a/flang/lib/Evaluate/fold-logical.cpp +++ b/flang/lib/Evaluate/fold-logical.cpp @@ -89,9 +89,9 @@ [&fptr](const Scalar &i, const Scalar &j) { return Scalar{std::invoke(fptr, i, j)}; })); - } else if (name == "isnan") { + } else if (name == "isnan" || name == "__builtin_ieee_is_nan") { // A warning about an invalid argument is discarded from converting - // the argument of isnan(). + // the argument of isnan() / IEEE_IS_NAN(). auto restorer{context.messages().DiscardMessages()}; using DefaultReal = Type; return FoldElementalIntrinsic(context, std::move(funcRef), diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -772,6 +772,7 @@ {"back", AnyLogical, Rank::elemental, Optionality::optional}, DefaultingKIND}, KINDInt}, + {"__builtin_ieee_is_nan", {{"a", AnyFloating}}, DefaultLogical}, {"__builtin_ieee_selected_real_kind", // alias for selected_real_kind {{"p", AnyInt, Rank::scalar}, {"r", AnyInt, Rank::scalar, Optionality::optional}, diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90 --- a/flang/module/__fortran_builtins.f90 +++ b/flang/module/__fortran_builtins.f90 @@ -35,6 +35,7 @@ procedure(type(__builtin_c_ptr)) :: __builtin_c_loc + intrinsic :: __builtin_ieee_is_nan intrinsic :: __builtin_ieee_selected_real_kind intrinsic :: __builtin_ieee_support_datatype, & __builtin_ieee_support_denormal, __builtin_ieee_support_divide, & diff --git a/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90 --- a/flang/module/ieee_arithmetic.f90 +++ b/flang/module/ieee_arithmetic.f90 @@ -10,6 +10,8 @@ module ieee_arithmetic use __Fortran_builtins, only: & + ieee_is_nan => __builtin_ieee_is_nan, & + ieee_selected_real_kind => __builtin_ieee_selected_real_kind, & ieee_support_datatype => __builtin_ieee_support_datatype, & ieee_support_denormal => __builtin_ieee_support_denormal, & ieee_support_divide => __builtin_ieee_support_divide, & @@ -19,8 +21,9 @@ ieee_support_sqrt => __builtin_ieee_support_sqrt, & ieee_support_standard => __builtin_ieee_support_standard, & ieee_support_subnormal => __builtin_ieee_support_subnormal, & - ieee_support_underflow_control => __builtin_ieee_support_underflow_control, & - ieee_selected_real_kind => __builtin_ieee_selected_real_kind + ieee_support_underflow_control => __builtin_ieee_support_underflow_control + + implicit none type :: ieee_class_type private @@ -65,25 +68,32 @@ module procedure class_ne module procedure round_ne end interface operator(/=) + private :: class_eq, class_ne, round_eq, round_ne ! See Fortran 2018, 17.10 & 17.11 - interface ieee_class - module procedure ieee_class_a2 - module procedure ieee_class_a3 - module procedure ieee_class_a4 - module procedure ieee_class_a8 - module procedure ieee_class_a10 - module procedure ieee_class_a16 - end interface ieee_class - - interface ieee_copy_sign - module procedure ieee_copy_sign_a2 - module procedure ieee_copy_sign_a3 - module procedure ieee_copy_sign_a4 - module procedure ieee_copy_sign_a8 - module procedure ieee_copy_sign_a10 - module procedure ieee_copy_sign_a16 - end interface ieee_copy_sign + 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, & @@ -203,6 +213,72 @@ _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 + +! 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. diff --git a/flang/runtime/numeric.h b/flang/runtime/numeric.h --- a/flang/runtime/numeric.h +++ b/flang/runtime/numeric.h @@ -206,6 +206,12 @@ CppTypeFor RTNAME(Fraction16)( CppTypeFor); +// ISNAN / IEEE_IS_NAN +bool RTNAME(IsNaN4)(CppTypeFor); +bool RTNAME(IsNaN8)(CppTypeFor); +bool RTNAME(IsNaN10)(CppTypeFor); +bool RTNAME(IsNaN16)(CppTypeFor); + // MOD & MODULO CppTypeFor RTNAME(ModInteger1)( CppTypeFor, CppTypeFor); diff --git a/flang/runtime/numeric.cpp b/flang/runtime/numeric.cpp --- a/flang/runtime/numeric.cpp +++ b/flang/runtime/numeric.cpp @@ -508,6 +508,38 @@ } #endif +bool RTNAME(IsFinite4)(CppTypeFor x) { + return std::isfinite(x); +} +bool RTNAME(IsFinite8)(CppTypeFor x) { + return std::isfinite(x); +} +#if LONG_DOUBLE == 80 +bool RTNAME(IsFinite10)(CppTypeFor x) { + return std::isfinite(x); +} +#elif LONG_DOUBLE == 128 +bool RTNAME(IsFinite16)(CppTypeFor x) { + return std::isfinite(x); +} +#endif + +bool RTNAME(IsNaN4)(CppTypeFor x) { + return std::isnan(x); +} +bool RTNAME(IsNaN8)(CppTypeFor x) { + return std::isnan(x); +} +#if LONG_DOUBLE == 80 +bool RTNAME(IsNaN10)(CppTypeFor x) { + return std::isnan(x); +} +#elif LONG_DOUBLE == 128 +bool RTNAME(IsNaN16)(CppTypeFor x) { + return std::isnan(x); +} +#endif + CppTypeFor RTNAME(ModInteger1)( CppTypeFor x, CppTypeFor p) { diff --git a/flang/unittests/RuntimeGTest/Numeric.cpp b/flang/unittests/RuntimeGTest/Numeric.cpp --- a/flang/unittests/RuntimeGTest/Numeric.cpp +++ b/flang/unittests/RuntimeGTest/Numeric.cpp @@ -71,6 +71,12 @@ std::isnan(RTNAME(Fraction8)(std::numeric_limits>::quiet_NaN()))); } +TEST(Numeric, IsNaN) { + EXPECT_FALSE(RTNAME(IsNaN4)(Real<4>{0})); + EXPECT_FALSE(RTNAME(IsNaN8)(std::numeric_limits>::infinity())); + EXPECT_TRUE(RTNAME(IsNaN8)(std::numeric_limits>::quiet_NaN())); +} + TEST(Numeric, Mod) { EXPECT_EQ(RTNAME(ModInteger1)(Int<1>{8}, Int<1>(5)), 3); EXPECT_EQ(RTNAME(ModInteger4)(Int<4>{-8}, Int<4>(5)), -3);