[flang-commits] [PATCH] D117150: [flang] Fold SCALE()

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: jeanPerier.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a reviewer: sscalpone.
klausler requested review of this revision.

Fold references to the intrinsic function SCALE().


https://reviews.llvm.org/D117150

Files:
  flang/include/flang/Evaluate/real.h
  flang/lib/Evaluate/fold-real.cpp
  flang/test/Evaluate/errors01.f90
  flang/test/Evaluate/fold-scale.f90


Index: flang/test/Evaluate/fold-scale.f90
===================================================================
--- /dev/null
+++ flang/test/Evaluate/fold-scale.f90
@@ -0,0 +1,10 @@
+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of SCALE()
+module m
+  logical, parameter :: test_1 = scale(1.0, 1) == 2.0
+  logical, parameter :: test_2 = scale(0.0, 1) == 0.0
+  logical, parameter :: test_3 = sign(1.0, scale(-0.0, 1)) == -1.0
+  logical, parameter :: test_4 = sign(1.0, scale(0.0, 0)) == 1.0
+  logical, parameter :: test_5 = scale(1.0, -1) == 0.5
+end module
+
Index: flang/test/Evaluate/errors01.f90
===================================================================
--- flang/test/Evaluate/errors01.f90
+++ flang/test/Evaluate/errors01.f90
@@ -100,4 +100,10 @@
     !CHECK: error: DIM=4 argument to SPREAD must be between 1 and 3
     integer, parameter :: bad3 = spread(matrix, 4, 1)
   end subroutine
+  subroutine warnings
+    real, parameter :: ok1 = scale(0.0, 99999) ! 0.0
+    real, parameter :: ok2 = scale(1.0, -99999) ! 0.0
+    !CHECK: SCALE intrinsic folding overflow
+    real, parameter :: bad1 = scale(1.0, 99999)
+  end subroutine
 end module
Index: flang/lib/Evaluate/fold-real.cpp
===================================================================
--- flang/lib/Evaluate/fold-real.cpp
+++ flang/lib/Evaluate/fold-real.cpp
@@ -130,6 +130,25 @@
     if (auto *expr{args[0].value().UnwrapExpr()}) {
       return ToReal<KIND>(context, std::move(*expr));
     }
+  } else if (name == "scale") {
+    if (const auto *byExpr{UnwrapExpr<Expr<SomeInteger>>(args[1])}) {
+      return std::visit(
+          [&](const auto &byVal) -> Expr<T> {
+            using TBY = ResultType<decltype(byVal)>;
+            return FoldElementalIntrinsic<T, T, TBY>(context,
+                std::move(funcRef),
+                ScalarFunc<T, T, TBY>(
+                    [&](const Scalar<T> &x, const Scalar<TBY> &y) -> Scalar<T> {
+                      ValueWithRealFlags<Scalar<T>> result{x.template SCALE(y)};
+                      if (result.flags.test(RealFlag::Overflow)) {
+                        context.messages().Say(
+                            "SCALE intrinsic folding overflow"_en_US);
+                      }
+                      return result.value;
+                    }));
+          },
+          byExpr->u);
+    }
   } else if (name == "sign") {
     return FoldElementalIntrinsic<T, T, T>(
         context, std::move(funcRef), &Scalar<T>::SIGN);
@@ -143,7 +162,7 @@
     return Expr<T>{Scalar<T>::TINY()};
   }
   // TODO: dim, dot_product, fraction, matmul,
-  // modulo, nearest, norm2, rrspacing, scale,
+  // modulo, nearest, norm2, rrspacing,
   // __builtin_next_after/down/up,
   // set_exponent, spacing, transfer,
   // bessel_jn (transformational) and bessel_yn (transformational)
Index: flang/include/flang/Evaluate/real.h
===================================================================
--- flang/include/flang/Evaluate/real.h
+++ flang/include/flang/Evaluate/real.h
@@ -155,6 +155,26 @@
   static constexpr int MAXEXPONENT{maxExponent - exponentBias};
   static constexpr int MINEXPONENT{2 - exponentBias};
 
+  // SCALE(); also known as IEEE_SCALB and (in IEEE-754 '08) ScaleB.
+  template <typename INT>
+  ValueWithRealFlags<Real> SCALE(
+      const INT &by, Rounding rounding = defaultRounding) const {
+    auto expo{exponentBias + by.ToInt64()};
+    if (IsZero()) {
+      expo = exponentBias; // ignore by, don't overflow
+    } else if (by > INT{maxExponent}) {
+      expo = maxExponent;
+    } else if (by < INT{-exponentBias}) {
+      expo = -1;
+    }
+    Real twoPow;
+    RealFlags flags{
+        twoPow.Normalize(false, static_cast<int>(expo), Fraction::MASKL(1))};
+    ValueWithRealFlags<Real> result{Multiply(twoPow, rounding)};
+    result.flags |= flags;
+    return result;
+  }
+
   constexpr Real FlushSubnormalToZero() const {
     if (IsSubnormal()) {
       return Real{};


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D117150.399444.patch
Type: text/x-patch
Size: 3972 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220112/252279c5/attachment-0001.bin>