[flang] Fix SCALE() folding with big scale factors

[klausler]

The folding of the SCALE() intrinsic function is implemented via multiplication by a power of two; this simplifies handling of exceptional cases. But sometimes scaling by a power of two requires an exponent larger or smaller than a floating-point format can represent, and two multiplications are required.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

The folding of the SCALE() intrinsic function is implemented via multiplication by a power of two; this simplifies handling of exceptional cases. But sometimes scaling by a power of two requires an exponent larger or smaller than a floating-point format can represent, and two multiplications are required.

---

Full diff: https://github.com/llvm/llvm-project/pull/85576.diff

2 Files Affected:

• (modified) flang/include/flang/Evaluate/real.h (+21-8)
• (modified) flang/test/Evaluate/fold-scale.f90 (+2-1)

diff --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h
index d0da9634651f36..b7af0ff6b431c8 100644
--- a/flang/include/flang/Evaluate/real.h
+++ b/flang/include/flang/Evaluate/real.h
@@ -221,20 +221,33 @@ class Real : public common::RealDetails<PREC> {
     // Normalize a fraction with just its LSB set and then multiply.
     // (Set the LSB, not the MSB, in case the scale factor needs to
     //  be subnormal.)
-    auto adjust{exponentBias + binaryPrecision - 1};
+    constexpr auto adjust{exponentBias + binaryPrecision - 1};
+    constexpr auto maxCoeffExpo{maxExponent + binaryPrecision - 1};
     auto expo{adjust + by.ToInt64()};
-    Real twoPow;
     RealFlags flags;
     int rMask{1};
     if (IsZero()) {
       expo = exponentBias; // ignore by, don't overflow
-    } else if (by > INT{maxExponent}) {
-      expo = maxExponent + binaryPrecision - 1;
-    } else if (by < INT{-adjust}) { // underflow
-      expo = 0;
-      rMask = 0;
-      flags.set(RealFlag::Underflow);
+    } else if (expo > maxCoeffExpo) {
+      if (Exponent() < exponentBias) {
+        // Must implement with two multiplications
+        return SCALE(INT{exponentBias})
+            .value.SCALE(by.SubtractSigned(INT{exponentBias}).value, rounding);
+      } else { // overflow
+        expo = maxCoeffExpo;
+      }
+    } else if (expo < 0) {
+      if (Exponent() > exponentBias) {
+        // Must implement with two multiplications
+        return SCALE(INT{-exponentBias})
+            .value.SCALE(by.AddSigned(INT{exponentBias}).value, rounding);
+      } else { // underflow to zero
+        expo = 0;
+        rMask = 0;
+        flags.set(RealFlag::Underflow);
+      }
     }
+    Real twoPow;
     flags |=
         twoPow.Normalize(false, static_cast<int>(expo), Fraction::MASKR(rMask));
     ValueWithRealFlags<Real> result{Multiply(twoPow, rounding)};
diff --git a/flang/test/Evaluate/fold-scale.f90 b/flang/test/Evaluate/fold-scale.f90
index a5c5f081668b16..6d767a9f4c9a3c 100644
--- a/flang/test/Evaluate/fold-scale.f90
+++ b/flang/test/Evaluate/fold-scale.f90
@@ -7,5 +7,6 @@ module m
   logical, parameter :: test_4 = sign(1.0, scale(0.0, 0)) == 1.0
   logical, parameter :: test_5 = scale(1.0, -1) == 0.5
   logical, parameter :: test_6 = scale(2.0, -1) == 1.0
+  logical, parameter :: test_7 = scale(huge(0.d0), -1200) == 1.0440487148797638d-53
+  logical, parameter :: test_8 = scale(tiny(0.d0), 1200) == 3.8312388521647221d053
 end module
-