[flang] IEEE_NEXT_AFTER, IEEE_NEXT_DOWN, IEEE_NEXT_UP, NEAREST (#100782)

IEEE_ARITHMETIC intrinsic module procedures IEEE_NEXT_AFTER,
IEEE_NEXT_DOWN, and IEEE_NEXT_UP, and intrinsic NEAREST return larger or
smaller values adjacent to their primary REAL argument. The four
procedures vary in how the direction is chosen, in how special cases are
treated, and in what exceptions are generated. Implement the three
IEEE_ARITHMETIC procedures. Update the NEAREST implementation to support
all six REAL kinds 2,3,4,8,10,16, and fix several bugs.

IEEE_NEXT_AFTER(X,Y) returns a NaN when Y is a NaN as that seems to be
the universal choice of other compilers.

Change the front end compile time implementation of these procedures to
return normal (HUGE) values for infinities when applicable, rather than
always returning the input infinity.

Author: vdonaldson

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

@@ -330,6 +330,8 @@ struct IntrinsicLibrary {
   mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
   void genMoveAlloc(llvm::ArrayRef<fir::ExtendedValue>);
   void genMvbits(llvm::ArrayRef<fir::ExtendedValue>);
+  enum class NearestProc { Nearest, NextAfter, NextDown, NextUp };
+  template <NearestProc>
   mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genNorm2(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -422,9 +424,12 @@ struct IntrinsicLibrary {
                                   mlir::Type resultType,
                                   llvm::ArrayRef<fir::ExtendedValue> args);
 
-  /// Generate code to raise \p except if \p cond is absent,
+  /// Generate code to raise \p excepts if \p cond is absent,
   /// or present and true.
-  void genRaiseExcept(int except, mlir::Value cond = {});
+  void genRaiseExcept(int excepts, mlir::Value cond = {});
+
+  /// Generate a quiet NaN of a given floating point type.
+  mlir::Value genQNan(mlir::Type resultType);
 
   /// Define the different FIR generators that can be mapped to intrinsic to
   /// generate the related code.

flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h

@@ -21,10 +21,10 @@ class FirOpBuilder;
 
 namespace fir::runtime {
 
-/// Generate a runtime call to map an ieee_flag_type exception value to a
-/// libm fenv.h value.
-mlir::Value genMapException(fir::FirOpBuilder &builder, mlir::Location loc,
-                            mlir::Value except);
+/// Generate a runtime call to map a set of ieee_flag_type exceptions to a
+/// libm fenv.h excepts value.
+mlir::Value genMapExcept(fir::FirOpBuilder &builder, mlir::Location loc,
+                         mlir::Value excepts);
 
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H

flang/include/flang/Runtime/exceptions.h

@@ -12,7 +12,6 @@
 #define FORTRAN_RUNTIME_EXCEPTIONS_H_
 
 #include "flang/Runtime/entry-names.h"
-#include "flang/Runtime/magic-numbers.h"
 #include <cinttypes>
 
 namespace Fortran::runtime {
@@ -21,11 +20,9 @@ class Descriptor;
 
 extern "C" {
 
-// Map a (single) IEEE_FLAG_TYPE exception value to a libm fenv.h value.
-// This could be extended to handle sets of exceptions, but there is no
-// current use case for that. This mapping is done at runtime to support
-// cross compilation.
-std::int32_t RTNAME(MapException)(std::int32_t except);
+// Map a set of IEEE_FLAG_TYPE exception values to a libm fenv.h excepts value.
+// This mapping is done at runtime to support cross compilation.
+std::uint32_t RTNAME(MapException)(std::uint32_t excepts);
 
 } // extern "C"
 } // namespace Fortran::runtime

flang/include/flang/Runtime/magic-numbers.h

@@ -100,6 +100,10 @@ The denorm value is a nonstandard extension.
 #define _FORTRAN_RUNTIME_IEEE_OVERFLOW 8
 #define _FORTRAN_RUNTIME_IEEE_UNDERFLOW 16
 #define _FORTRAN_RUNTIME_IEEE_INEXACT 32
+#define _FORTRAN_RUNTIME_IEEE_ALL \
+  _FORTRAN_RUNTIME_IEEE_INVALID | _FORTRAN_RUNTIME_IEEE_DENORM | \
+      _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO | _FORTRAN_RUNTIME_IEEE_OVERFLOW | \
+      _FORTRAN_RUNTIME_IEEE_UNDERFLOW | _FORTRAN_RUNTIME_IEEE_INEXACT
 
 #if 0
 ieee_round_type values

flang/lib/Evaluate/real.cpp

@@ -330,12 +330,12 @@ ValueWithRealFlags<Real<W, P>> Real<W, P>::SQRT(Rounding rounding) const {
 template <typename W, int P>
 ValueWithRealFlags<Real<W, P>> Real<W, P>::NEAREST(bool upward) const {
   ValueWithRealFlags<Real> result;
+  bool isNegative{IsNegative()};
   if (IsFinite()) {
     Fraction fraction{GetFraction()};
     int expo{Exponent()};
     Fraction one{1};
     Fraction nearest;
-    bool isNegative{IsNegative()};
     if (upward != isNegative) { // upward in magnitude
       auto next{fraction.AddUnsigned(one)};
       if (next.carry) {
@@ -359,6 +359,8 @@ ValueWithRealFlags<Real<W, P>> Real<W, P>::NEAREST(bool upward) const {
       }
     }
     result.flags = result.value.Normalize(isNegative, expo, nearest);
+  } else if (IsInfinite() && upward == isNegative) {
+    result.value = isNegative ? HUGE().Negate() : HUGE(); // largest mag finite
   } else {
     result.flags.set(RealFlag::InvalidArgument);
     result.value = *this;