From f4b1209f4bfc0509792606010cca29ae2de35768 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Wed, 29 May 2019 15:38:33 -0700 Subject: [PATCH] [flang] PRECISION, RANGE, RADIX Original-commit: flang-compiler/f18@de0bf5a18f74f2041c85149e52781e8f80d0352b Reviewed-on: https://github.com/flang-compiler/f18/pull/472 Tree-same-pre-rewrite: false --- flang/lib/evaluate/fold.cc | 30 ++++++++++++++++++++++++++++++ flang/lib/evaluate/integer.h | 4 ++++ flang/lib/evaluate/intrinsics.cc | 6 +++++- flang/lib/evaluate/real.h | 21 ++++++++++++++++----- flang/lib/evaluate/type.cc | 7 ++----- flang/test/semantics/modfile26.f90 | 23 +++++++++++++++++++++-- 6 files changed, 78 insertions(+), 13 deletions(-) diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc index 18e04cb..a99583b 100644 --- a/flang/lib/evaluate/fold.cc +++ b/flang/lib/evaluate/fold.cc @@ -508,6 +508,36 @@ Expr> FoldOperation(FoldingContext &context, } return FoldElementalIntrinsic( context, std::move(funcRef), &Scalar::MERGE_BITS); + } else if (name == "precision") { + if (const auto *cx{UnwrapExpr>(args[0])}) { + return Expr{std::visit( + [](const auto &kx) { + return Scalar>::PRECISION; + }, + cx->u)}; + } else if (const auto *cx{UnwrapExpr>(args[0])}) { + return Expr{std::visit( + [](const auto &kx) { + return Scalar::Part>::PRECISION; + }, + cx->u)}; + } + } else if (name == "radix") { + return Expr{2}; + } else if (name == "range") { + if (const auto *cx{UnwrapExpr>(args[0])}) { + return Expr{std::visit( + [](const auto &kx) { + return Scalar>::RANGE; + }, + cx->u)}; + } else if (const auto *cx{UnwrapExpr>(args[0])}) { + return Expr{std::visit( + [](const auto &kx) { + return Scalar::Part>::RANGE; + }, + cx->u)}; + } } else if (name == "rank") { // TODO assumed-rank dummy argument return Expr{args[0].value().Rank()}; diff --git a/flang/lib/evaluate/integer.h b/flang/lib/evaluate/integer.h index e48ace0..d8b9b81 100644 --- a/flang/lib/evaluate/integer.h +++ b/flang/lib/evaluate/integer.h @@ -350,6 +350,10 @@ public: static constexpr Integer BIT_SIZE() { return {bits}; } static constexpr Integer HUGE() { return MASKR(bits - 1); } + static constexpr int Precision{// in the sense of SELECTED_INT_KIND + // This magic value is LOG10(2.)*1E12. + static_cast(((bits - 1) * 301029995664) / 1000000000000)}; + // Returns the number of full decimal digits that can be represented. static constexpr int RANGE() { if (bits < 4) { diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 320ff33..9bb95f2 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -110,6 +110,7 @@ static constexpr TypePattern AnyInt{IntType, KindCode::any}; static constexpr TypePattern AnyReal{RealType, KindCode::any}; static constexpr TypePattern AnyIntOrReal{IntOrRealType, KindCode::any}; static constexpr TypePattern AnyComplex{ComplexType, KindCode::any}; +static constexpr TypePattern AnyFloating{FloatingType, KindCode::any}; static constexpr TypePattern AnyNumeric{NumericType, KindCode::any}; static constexpr TypePattern AnyChar{CharType, KindCode::any}; static constexpr TypePattern AnyLogical{LogicalType, KindCode::any}; @@ -507,7 +508,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"product", {{"array", SameNumeric, Rank::array}, OptionalDIM, OptionalMASK}, SameNumeric, Rank::dimReduced}, + {"precision", {{"x", AnyFloating, Rank::anyOrAssumedRank}}, DefaultInt}, {"present", {{"a", Anything, Rank::anyOrAssumedRank}}, DefaultLogical}, + {"radix", {{"x", AnyFloating, Rank::anyOrAssumedRank}}, DefaultInt}, + {"range", {{"x", AnyFloating, Rank::anyOrAssumedRank}}, DefaultInt}, {"rank", {{"a", Anything, Rank::anyOrAssumedRank}}, DefaultInt}, {"real", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND}, KINDReal}, @@ -617,7 +621,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ // SAME_TYPE, STORAGE_SIZE // TODO: Type inquiry intrinsic functions - these return constants // BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, -// NEW_LINE, PRECISION, RADIX, RANGE, TINY +// NEW_LINE, TINY // TODO: Non-standard intrinsic functions // AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT, // COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, diff --git a/flang/lib/evaluate/real.h b/flang/lib/evaluate/real.h index fd2aabb..283a9d6 100644 --- a/flang/lib/evaluate/real.h +++ b/flang/lib/evaluate/real.h @@ -37,11 +37,11 @@ namespace Fortran::evaluate::value { // the third, if true, indicates that the most significant position of the // fraction is an implicit bit whose value is assumed to be 1 in a finite // normal number. -template class Real { +template class Real { public: using Word = WORD; static constexpr int bits{Word::bits}; - static constexpr int precision{PRECISION}; + static constexpr int precision{PREC}; using Fraction = Integer; // all bits made explicit static constexpr bool implicitMSB{IMPLICIT_MSB}; static constexpr int significandBits{precision - implicitMSB}; @@ -64,9 +64,9 @@ public: return word_ == that.word_; } - // TODO ANINT, CEILING, FLOOR, DIM, MAX, MIN, DPROD, FRACTION - // HUGE, INT/NINT, MAXEXPONENT, MINEXPONENT, NEAREST, OUT_OF_RANGE, - // PRECISION, HUGE, TINY, RRSPACING/SPACING, SCALE, SET_EXPONENT, SIGN + // TODO: ANINT, CEILING, FLOOR, DIM, MAX, MIN, DPROD, FRACTION, + // INT/NINT, MAXEXPONENT, MINEXPONENT, NEAREST, OUT_OF_RANGE, + // HUGE, TINY, RRSPACING/SPACING, SCALE, SET_EXPONENT, SIGN constexpr bool IsNegative() const { return !IsNotANumber() && word_.BTEST(bits - 1); @@ -128,6 +128,17 @@ public: return epsilon; } +private: + // LOG10(2.)*1E12 + static constexpr std::int64_t ScaledLogBaseTenOfTwo{301029995664}; + +public: + static constexpr int PRECISION{static_cast( + (precision - 1) * ScaledLogBaseTenOfTwo / 1000000000000)}; + + static constexpr int RANGE{static_cast( + (exponentBias - 1) * ScaledLogBaseTenOfTwo / 1000000000000)}; + constexpr Real FlushSubnormalToZero() const { if (IsSubnormal()) { return Real{}; diff --git a/flang/lib/evaluate/type.cc b/flang/lib/evaluate/type.cc index db6c6f9..fdb765a 100644 --- a/flang/lib/evaluate/type.cc +++ b/flang/lib/evaluate/type.cc @@ -221,15 +221,13 @@ bool SomeKind::operator==( return PointeeComparison(derivedTypeSpec_, that.derivedTypeSpec_); } -static constexpr double LogBaseTenOfTwo{0.301029995664}; - class SelectedIntKindVisitor { public: explicit SelectedIntKindVisitor(std::int64_t p) : precision_{p} {} using Result = std::optional; using Types = IntegerTypes; template Result Test() const { - if ((Scalar::bits - 1) * LogBaseTenOfTwo > precision_) { + if (Scalar::Precision >= precision_) { return T::kind; } else { return std::nullopt; @@ -255,8 +253,7 @@ public: using Result = std::optional; using Types = RealTypes; template Result Test() const { - if ((Scalar::precision - 1) * LogBaseTenOfTwo > precision_ && - (Scalar::exponentBias - 1) * LogBaseTenOfTwo > range_) { + if (Scalar::PRECISION >= precision_ && Scalar::RANGE >= range_) { return {T::kind}; } else { return std::nullopt; diff --git a/flang/test/semantics/modfile26.f90 b/flang/test/semantics/modfile26.f90 index 9bf5196..23998a5 100644 --- a/flang/test/semantics/modfile26.f90 +++ b/flang/test/semantics/modfile26.f90 @@ -12,7 +12,7 @@ ! See the License for the specific language governing permissions and ! limitations under the License. -! SELECTED_INT_KIND and SELECTED_REAL_KIND +! Intrinsics SELECTED_INT_KIND, SELECTED_REAL_KIND, PRECISION, RANGE, RADIX module m1 ! INTEGER(KIND=1) handles 0 <= P < 3 @@ -25,11 +25,17 @@ module m1 [(selected_int_kind(intpvals(j)),j=1,size(intpvals))] logical, parameter :: ipcheck = & all([1, 1, 2, 2, 4, 4, 8, 8, 16, 16, -1] == intpkinds) + ! REAL(KIND=2) handles 0 <= P < 4 (if available) + ! REAL(KIND=3) handles 0 <= P < 3 (if available) ! REAL(KIND=4) handles 4 <= P < 7 ! REAL(KIND=8) handles 7 <= P < 16 ! REAL(KIND=10) handles 16 <= P < 19 (if available; ifort is KIND=16) - ! REAL(KIND=16) handles 19 <= P < 34 (32 with Power double/double) + ! REAL(KIND=16) handles 19 <= P < 34 (would be 32 with Power double/double) + integer, parameter :: realprecs(:) = & + [precision(0._2), precision(0._3), precision(0._4), precision(0._8), & + precision(0._10), precision(0._16)] + logical, parameter :: rpreccheck = all([3, 2, 6, 15, 18, 33] == realprecs) integer, parameter :: realpvals(:) = [0, 3, 4, 6, 7, 15, 16, 18, 19, 33, 34] integer, parameter :: realpkinds(:) = & [(selected_real_kind(realpvals(j),0),j=1,size(realpvals))] @@ -41,22 +47,35 @@ module m1 ! REAL(KIND=8) handles 38 <= R < 308 ! REAL(KIND=10) handles 308 <= R < 4932 (if available; ifort is KIND=16) ! REAL(KIND=16) handles 4932 <= R < 9864 (except Power double/double) + integer, parameter :: realranges(:) = & + [range(0._2), range(0._3), range(0._4), range(0._8), range(0._10), & + range(0._16)] + logical, parameter :: rrangecheck = & + all([4, 37, 37, 307, 4931, 9863] == realranges) integer, parameter :: realrvals(:) = & [0, 4, 5, 37, 38, 307, 308, 4931, 4932, 9863, 9864] integer, parameter :: realrkinds(:) = & [(selected_real_kind(0,realrvals(j)),j=1,size(realrvals))] logical, parameter :: realrcheck = & all([2, 2, 3, 3, 8, 8, 10, 10, 16, 16, -2] == realrkinds) + logical, parameter :: radixcheck = & + all([radix(0._2), radix(0._3), radix(0._4), radix(0._8), & + radix(0._10), radix(0._16)] == 2) end module m1 !Expect: m1.mod !module m1 !integer(4),parameter::intpvals(1_8:)=[Integer(4)::0_4,2_4,3_4,4_4,5_4,9_4,10_4,18_4,19_4,38_4,39_4] !integer(4),parameter::intpkinds(1_8:)=[Integer(4)::1_4,1_4,2_4,2_4,4_4,4_4,8_4,8_4,16_4,16_4,-1_4] !logical(4),parameter::ipcheck=.true._4 +!integer(4),parameter::realprecs(1_8:)=[Integer(4)::3_4,2_4,6_4,15_4,18_4,33_4] +!logical(4),parameter::rpreccheck=.true._4 !integer(4),parameter::realpvals(1_8:)=[Integer(4)::0_4,3_4,4_4,6_4,7_4,15_4,16_4,18_4,19_4,33_4,34_4] !integer(4),parameter::realpkinds(1_8:)=[Integer(4)::2_4,2_4,4_4,4_4,8_4,8_4,10_4,10_4,16_4,16_4,-1_4] !logical(4),parameter::realpcheck=.true._4 +!integer(4),parameter::realranges(1_8:)=[Integer(4)::4_4,37_4,37_4,307_4,4931_4,9863_4] +!logical(4),parameter::rrangecheck=.true._4 !integer(4),parameter::realrvals(1_8:)=[Integer(4)::0_4,4_4,5_4,37_4,38_4,307_4,308_4,4931_4,4932_4,9863_4,9864_4] !integer(4),parameter::realrkinds(1_8:)=[Integer(4)::2_4,2_4,3_4,3_4,8_4,8_4,10_4,10_4,16_4,16_4,-2_4] !logical(4),parameter::realrcheck=.true._4 +!logical(4),parameter::radixcheck=.true._4 !end -- 2.7.4