From d3f5ef241ae3841b6f9b70bd138a9252ed3a002e Mon Sep 17 00:00:00 2001 From: Yury Gribov Date: Fri, 21 Jan 2022 17:24:32 +0900 Subject: [PATCH] Add ieee_is_normal/ieee_is_negative to ieee_arithmetic module. --- flang/include/flang/Evaluate/real.h | 3 +++ flang/lib/Evaluate/fold-logical.cpp | 14 +++++++++++ flang/lib/Evaluate/intrinsics.cpp | 2 ++ flang/module/__fortran_builtins.f90 | 3 ++- flang/module/ieee_arithmetic.f90 | 36 +++++++++++++++++++++++++++++ 5 files changed, 57 insertions(+), 1 deletion(-) diff --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h index 77c25c4feae1..01634022d5fd 100644 --- a/flang/include/flang/Evaluate/real.h +++ b/flang/include/flang/Evaluate/real.h @@ -88,6 +88,9 @@ public: constexpr bool IsSubnormal() const { return Exponent() == 0 && !GetSignificand().IsZero(); } + constexpr bool IsNormal() const { + return !(IsInfinite() || IsNotANumber() || IsSubnormal()); + } constexpr Real ABS() const { // non-arithmetic, no flags returned return {word_.IBCLR(bits - 1)}; diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp index 4ba4ce838760..34a7639ba32d 100644 --- a/flang/lib/Evaluate/fold-logical.cpp +++ b/flang/lib/Evaluate/fold-logical.cpp @@ -118,6 +118,20 @@ Expr> FoldIntrinsicFunction( ScalarFunc([](const Scalar &x) { return Scalar{x.IsNotANumber()}; })); + } else if (name == "__builtin_ieee_is_negative") { + auto restorer{context.messages().DiscardMessages()}; + using DefaultReal = Type; + return FoldElementalIntrinsic(context, std::move(funcRef), + ScalarFunc([](const Scalar &x) { + return Scalar{x.IsNegative()}; + })); + } else if (name == "__builtin_ieee_is_normal") { + auto restorer{context.messages().DiscardMessages()}; + using DefaultReal = Type; + return FoldElementalIntrinsic(context, std::move(funcRef), + ScalarFunc([](const Scalar &x) { + return Scalar{x.IsNormal()}; + })); } else if (name == "is_contiguous") { if (args.at(0)) { if (auto *expr{args[0]->UnwrapExpr()}) { diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index ae7e5e9bf788..9dca8b4cc60a 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -793,6 +793,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ DefaultingKIND}, KINDInt}, {"__builtin_ieee_is_nan", {{"a", AnyFloating}}, DefaultLogical}, + {"__builtin_ieee_is_normal", {{"a", AnyFloating}}, DefaultLogical}, + {"__builtin_ieee_is_negative", {{"a", AnyFloating}}, DefaultLogical}, {"__builtin_ieee_next_after", {{"x", SameReal}, {"y", AnyReal}}, SameReal}, {"__builtin_ieee_next_down", {{"x", SameReal}}, SameReal}, {"__builtin_ieee_next_up", {{"x", SameReal}}, SameReal}, diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90 index 5d7a0008ec36..4a4c55e44e05 100644 --- a/flang/module/__fortran_builtins.f90 +++ b/flang/module/__fortran_builtins.f90 @@ -41,7 +41,8 @@ module __Fortran_builtins procedure(type(__builtin_c_ptr)) :: __builtin_c_loc - intrinsic :: __builtin_ieee_is_nan + intrinsic :: __builtin_ieee_is_nan, __builtin_ieee_is_normal, & + __builtin_ieee_is_negative intrinsic :: __builtin_ieee_next_after, __builtin_ieee_next_down, & __builtin_ieee_next_up intrinsic :: scale ! for ieee_scalb diff --git a/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90 index 1d7c32e7e116..45d3cc3f02a1 100644 --- a/flang/module/ieee_arithmetic.f90 +++ b/flang/module/ieee_arithmetic.f90 @@ -11,6 +11,8 @@ module ieee_arithmetic 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_next_after => __builtin_ieee_next_after, & ieee_next_down => __builtin_ieee_next_down, & ieee_next_up => __builtin_ieee_next_up, & @@ -235,6 +237,40 @@ module ieee_arithmetic _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); \