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

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.

2 files changed, 23 insertions, 9 deletions

diff --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h
index d0da963..b7af0ff 100644
--- a/flang/include/flang/Evaluate/real.h
+++ b/flang/include/flang/Evaluate/real.h
@@ -221,20 +221,33 @@ public:
     // 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 a5c5f08..6d767a9 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
-