[flang] Fold IEEE_SUPPORT_xxx() intrinsic functions

All of the IEEE_SUPPORT_xxx() intrinsic functions must fold to
constant logical values when they have constant arguments; and
since they fold to .TRUE. for currently support architectures,
always fold them.  But also put in the infrastructure whereby a
driver can initialize Evaluate's target information to set some
of them to .FALSE. if that becomes necessary.

Author: klausler

flang/include/flang/Common/Fortran.h

@@ -67,12 +67,14 @@ ENUM_CLASS(
 const char *AsFortran(DefinedIo);
 
 // Floating-point rounding modes; these are packed into a byte to save
-// room in the runtime's format processing context structure.
+// room in the runtime's format processing context structure.  These
+// enumerators are defined with the corresponding values returned from
+// llvm.get.rounding.
 enum class RoundingMode : std::uint8_t {
-  TiesToEven, // ROUND=NEAREST, RN - default IEEE rounding
   ToZero, // ROUND=ZERO, RZ - truncation
-  Down, // ROUND=DOWN, RD
+  TiesToEven, // ROUND=NEAREST, RN - default IEEE rounding
   Up, // ROUND=UP, RU
+  Down, // ROUND=DOWN, RD
   TiesAwayFromZero, // ROUND=COMPATIBLE, RC - ties round away from zero
 };
 

flang/include/flang/Evaluate/common.h

@@ -128,9 +128,9 @@ static constexpr bool Satisfies(RelationalOperator op, Relation relation) {
   return false; // silence g++ warning
 }
 
-ENUM_CLASS(
-    RealFlag, Overflow, DivideByZero, InvalidArgument, Underflow, Inexact)
-
+// These are ordered like the bits in a common fenv.h header file.
+ENUM_CLASS(RealFlag, InvalidArgument, Denorm, DivideByZero, Overflow, Underflow,
+    Inexact)
 using RealFlags = common::EnumSet<RealFlag, RealFlag_enumSize>;
 
 template <typename A> struct ValueWithRealFlags {

flang/include/flang/Evaluate/target.h

@@ -13,6 +13,8 @@
 #define FORTRAN_EVALUATE_TARGET_H_
 
 #include "flang/Common/Fortran.h"
+#include "flang/Common/enum-class.h"
+#include "flang/Common/enum-set.h"
 #include "flang/Evaluate/common.h"
 #include <cstdint>
 
@@ -32,6 +34,11 @@ struct Rounding {
 #endif
 };
 
+ENUM_CLASS(IeeeFeature, Denormal, Divide, Flags, Halting, Inf, Io, NaN,
+    Rounding, Sqrt, Standard, Subnormal, UnderflowControl)
+
+using IeeeFeatures = common::EnumSet<IeeeFeature, 16>;
+
 class TargetCharacteristics {
 public:
   TargetCharacteristics();
@@ -95,6 +102,9 @@ class TargetCharacteristics {
   bool isPPC() const { return isPPC_; }
   void set_isPPC(bool isPPC = false);
 
+  IeeeFeatures &ieeeFeatures() { return ieeeFeatures_; }
+  const IeeeFeatures &ieeeFeatures() const { return ieeeFeatures_; }
+
 private:
   static constexpr int maxKind{32};
   std::uint8_t byteSize_[common::TypeCategory_enumSize][maxKind]{};
@@ -110,6 +120,11 @@ class TargetCharacteristics {
   std::size_t maxAlignment_{8 /*at least*/};
   std::string compilerOptionsString_;
   std::string compilerVersionString_;
+  IeeeFeatures ieeeFeatures_{IeeeFeature::Denormal, IeeeFeature::Divide,
+      IeeeFeature::Flags, IeeeFeature::Halting, IeeeFeature::Inf,
+      IeeeFeature::Io, IeeeFeature::NaN, IeeeFeature::Rounding,
+      IeeeFeature::Sqrt, IeeeFeature::Standard, IeeeFeature::Subnormal,
+      IeeeFeature::UnderflowControl};
 };
 
 } // namespace Fortran::evaluate

flang/include/flang/Evaluate/tools.h

@@ -1320,6 +1320,10 @@ bool IsBuiltinCPtr(const Symbol &);
 bool IsEventType(const DerivedTypeSpec *);
 bool IsLockType(const DerivedTypeSpec *);
 bool IsNotifyType(const DerivedTypeSpec *);
+// Is this derived type IEEE_FLAG_TYPE from module ISO_IEEE_EXCEPTIONS?
+bool IsIeeeFlagType(const DerivedTypeSpec *);
+// Is this derived type IEEE_ROUND_TYPE from module ISO_IEEE_ARITHMETIC?
+bool IsIeeeRoundType(const DerivedTypeSpec *);
 // Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV?
 bool IsTeamType(const DerivedTypeSpec *);
 // Is this derived type TEAM_TYPE, C_PTR, or C_FUNPTR?

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

@@ -275,10 +275,6 @@ struct IntrinsicLibrary {
   mlir::Value genIeeeSignalingCompare(mlir::Type resultType,
                                       llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeSignbit(mlir::Type, llvm::ArrayRef<mlir::Value>);
-  fir::ExtendedValue
-      genIeeeSupportFlagOrHalting(mlir::Type,
-                                  llvm::ArrayRef<fir::ExtendedValue>);
-  mlir::Value genIeeeSupportRounding(mlir::Type, llvm::ArrayRef<mlir::Value>);
   template <mlir::arith::CmpIPredicate pred>
   mlir::Value genIeeeTypeCompare(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeUnordered(mlir::Type, llvm::ArrayRef<mlir::Value>);

flang/lib/Evaluate/fold-logical.cpp

@@ -620,6 +620,24 @@ static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
   return AsExpr(std::move(funcRef));
 }
 
+static std::optional<common::RoundingMode> GetRoundingMode(
+    const std::optional<ActualArgument> &arg) {
+  if (arg) {
+    if (const auto *cst{UnwrapExpr<Constant<SomeDerived>>(*arg)}) {
+      if (auto constr{cst->GetScalarValue()}) {
+        if (StructureConstructorValues & values{constr->values()};
+            values.size() == 1) {
+          const Expr<SomeType> &value{values.begin()->second.value()};
+          if (auto code{ToInt64(value)}) {
+            return static_cast<common::RoundingMode>(*code);
+          }
+        }
+      }
+    }
+  }
+  return std::nullopt;
+}
+
 template <int KIND>
 Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
     FoldingContext &context,
@@ -831,17 +849,50 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
         }
       }
     }
-  } else if (name == "__builtin_ieee_support_datatype" ||
-      name == "__builtin_ieee_support_denormal" ||
-      name == "__builtin_ieee_support_divide" ||
-      name == "__builtin_ieee_support_inf" ||
-      name == "__builtin_ieee_support_io" ||
-      name == "__builtin_ieee_support_nan" ||
-      name == "__builtin_ieee_support_sqrt" ||
-      name == "__builtin_ieee_support_standard" ||
-      name == "__builtin_ieee_support_subnormal" ||
-      name == "__builtin_ieee_support_underflow_control") {
+  } else if (name == "__builtin_ieee_support_datatype") {
     return Expr<T>{true};
+  } else if (name == "__builtin_ieee_support_denormal") {
+    return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
+        IeeeFeature::Denormal)};
+  } else if (name == "__builtin_ieee_support_divide") {
+    return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
+        IeeeFeature::Divide)};
+  } else if (name == "__builtin_ieee_support_flag") {
+    return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
+        IeeeFeature::Flags)};
+  } else if (name == "__builtin_ieee_support_halting") {
+    return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
+        IeeeFeature::Halting)};
+  } else if (name == "__builtin_ieee_support_inf") {
+    return Expr<T>{
+        context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Inf)};
+  } else if (name == "__builtin_ieee_support_io") {
+    return Expr<T>{
+        context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Io)};
+  } else if (name == "__builtin_ieee_support_nan") {
+    return Expr<T>{
+        context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::NaN)};
+  } else if (name == "__builtin_ieee_support_rounding") {
+    bool result{false};
+    if (context.targetCharacteristics().ieeeFeatures().test(
+            IeeeFeature::Rounding)) {
+      if (auto mode{GetRoundingMode(args[0])}) {
+        result = mode != common::RoundingMode::TiesAwayFromZero;
+      }
+    }
+    return Expr<T>{result};
+  } else if (name == "__builtin_ieee_support_sqrt") {
+    return Expr<T>{
+        context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Sqrt)};
+  } else if (name == "__builtin_ieee_support_standard") {
+    return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
+        IeeeFeature::Standard)};
+  } else if (name == "__builtin_ieee_support_subnormal") {
+    return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
+        IeeeFeature::Subnormal)};
+  } else if (name == "__builtin_ieee_support_underflow_control") {
+    return Expr<T>{context.targetCharacteristics().ieeeFeatures().test(
+        IeeeFeature::UnderflowControl)};
   }
   return Expr<T>{std::move(funcRef)};
 }

flang/lib/Evaluate/intrinsics.cpp

@@ -88,6 +88,8 @@ ENUM_CLASS(KindCode, none, defaultIntegerKind,
     sameKind,
     operand, // match any kind, with promotion (non-standard)
     typeless, // BOZ literals are INTEGER with this kind
+    ieeeFlagType, // IEEE_FLAG_TYPE from ISO_FORTRAN_EXCEPTION
+    ieeeRoundType, // IEEE_ROUND_TYPE from ISO_FORTRAN_ARITHMETIC
     teamType, // TEAM_TYPE from module ISO_FORTRAN_ENV (for coarrays)
     kindArg, // this argument is KIND=
     effectiveKind, // for function results: "kindArg" value, possibly defaulted
@@ -121,6 +123,9 @@ static constexpr TypePattern DefaultChar{CharType, KindCode::defaultCharKind};
 static constexpr TypePattern DefaultLogical{
     LogicalType, KindCode::defaultLogicalKind};
 static constexpr TypePattern BOZ{IntType, KindCode::typeless};
+static constexpr TypePattern IeeeFlagType{DerivedType, KindCode::ieeeFlagType};
+static constexpr TypePattern IeeeRoundType{
+    DerivedType, KindCode::ieeeRoundType};
 static constexpr TypePattern TeamType{DerivedType, KindCode::teamType};
 static constexpr TypePattern DoublePrecision{
     RealType, KindCode::doublePrecision};
@@ -940,6 +945,12 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"__builtin_ieee_support_divide",
         {{"x", AnyReal, Rank::elemental, Optionality::optional}},
         DefaultLogical},
+    {"__builtin_ieee_support_flag",
+        {{"flag", IeeeFlagType, Rank::scalar},
+            {"x", AnyReal, Rank::elemental, Optionality::optional}},
+        DefaultLogical},
+    {"__builtin_ieee_support_halting", {{"flag", IeeeFlagType, Rank::scalar}},
+        DefaultLogical},
     {"__builtin_ieee_support_inf",
         {{"x", AnyReal, Rank::elemental, Optionality::optional}},
         DefaultLogical},
@@ -949,6 +960,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"__builtin_ieee_support_nan",
         {{"x", AnyReal, Rank::elemental, Optionality::optional}},
         DefaultLogical},
+    {"__builtin_ieee_support_rounding",
+        {{"round_value", IeeeRoundType, Rank::scalar},
+            {"x", AnyReal, Rank::elemental, Optionality::optional}},
+        DefaultLogical},
     {"__builtin_ieee_support_sqrt",
         {{"x", AnyReal, Rank::elemental, Optionality::optional}},
         DefaultLogical},
@@ -1851,6 +1866,16 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
     case KindCode::typeless:
       argOk = false;
       break;
+    case KindCode::ieeeFlagType:
+      argOk = !type->IsUnlimitedPolymorphic() &&
+          type->category() == TypeCategory::Derived &&
+          semantics::IsIeeeFlagType(&type->GetDerivedTypeSpec());
+      break;
+    case KindCode::ieeeRoundType:
+      argOk = !type->IsUnlimitedPolymorphic() &&
+          type->category() == TypeCategory::Derived &&
+          semantics::IsIeeeRoundType(&type->GetDerivedTypeSpec());
+      break;
     case KindCode::teamType:
       argOk = !type->IsUnlimitedPolymorphic() &&
           type->category() == TypeCategory::Derived &&

flang/lib/Evaluate/tools.cpp

@@ -1754,13 +1754,34 @@ bool IsSequenceOrBindCType(const DerivedTypeSpec *derived) {
           derived->typeSymbol().get<DerivedTypeDetails>().sequence());
 }
 
+static bool IsSameModule(const Scope *x, const Scope *y) {
+  if (x == y) {
+    return true;
+  } else if (x && y) {
+    // Allow for a builtin module to be read from distinct paths
+    const Symbol *xSym{x->symbol()};
+    const Symbol *ySym{y->symbol()};
+    if (xSym && ySym && xSym->name() == ySym->name()) {
+      const auto *xMod{xSym->detailsIf<ModuleDetails>()};
+      const auto *yMod{ySym->detailsIf<ModuleDetails>()};
+      if (xMod && yMod) {
+        auto xHash{xMod->moduleFileHash()};
+        auto yHash{yMod->moduleFileHash()};
+        return xHash && yHash && *xHash == *yHash;
+      }
+    }
+  }
+  return false;
+}
+
 bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name) {
-  if (!derived) {
-    return false;
-  } else {
+  if (derived) {
     const auto &symbol{derived->typeSymbol()};
-    return &symbol.owner() == symbol.owner().context().GetBuiltinsScope() &&
-        symbol.name() == "__builtin_"s + name;
+    const Scope &scope{symbol.owner()};
+    return symbol.name() == "__builtin_"s + name &&
+        IsSameModule(&scope, scope.context().GetBuiltinsScope());
+  } else {
+    return false;
   }
 }
 
@@ -1790,6 +1811,14 @@ bool IsNotifyType(const DerivedTypeSpec *derived) {
   return IsBuiltinDerivedType(derived, "notify_type");
 }
 
+bool IsIeeeFlagType(const DerivedTypeSpec *derived) {
+  return IsBuiltinDerivedType(derived, "ieee_flag_type");
+}
+
+bool IsIeeeRoundType(const DerivedTypeSpec *derived) {
+  return IsBuiltinDerivedType(derived, "ieee_round_type");
+}
+
 bool IsTeamType(const DerivedTypeSpec *derived) {
   return IsBuiltinDerivedType(derived, "team_type");
 }

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -373,12 +373,6 @@ static constexpr IntrinsicHandler handlers[]{
     {"ieee_signaling_ne",
      &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::UNE>},
     {"ieee_signbit", &I::genIeeeSignbit},
-    {"ieee_support_flag",
-     &I::genIeeeSupportFlagOrHalting,
-     {{{"flag", asValue}, {"x", asInquired, handleDynamicOptional}}},
-     /*isElemental=*/false},
-    {"ieee_support_halting", &I::genIeeeSupportFlagOrHalting},
-    {"ieee_support_rounding", &I::genIeeeSupportRounding},
     {"ieee_unordered", &I::genIeeeUnordered},
     {"ieee_value", &I::genIeeeValue},
     {"ieor", &I::genIeor},
@@ -4710,57 +4704,6 @@ mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType,
   return builder.createConvert(loc, resultType, sign);
 }
 
-// IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
-fir::ExtendedValue IntrinsicLibrary::genIeeeSupportFlagOrHalting(
-    mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
-  // Check if a floating point exception or halting mode FLAG is supported.
-  // An IEEE_SUPPORT_FLAG flag is supported either for all type kinds or none.
-  // An optional kind argument X is therefore ignored.
-  // Standard flags are all supported.
-  // The nonstandard DENORM extension is not supported. (At least for now.)
-  assert(args.size() == 1 || args.size() == 2);
-  auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
-  mlir::Value flag = builder.create<fir::LoadOp>(loc, fieldRef);
-  mlir::Value mask = builder.createIntegerConstant( // values are powers of 2
-      loc, fieldTy,
-      _FORTRAN_RUNTIME_IEEE_INVALID | _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO |
-          _FORTRAN_RUNTIME_IEEE_OVERFLOW | _FORTRAN_RUNTIME_IEEE_UNDERFLOW |
-          _FORTRAN_RUNTIME_IEEE_INEXACT);
-  return builder.createConvert(
-      loc, resultType,
-      builder.create<mlir::arith::CmpIOp>(
-          loc, mlir::arith::CmpIPredicate::ne,
-          builder.create<mlir::arith::AndIOp>(loc, flag, mask),
-          builder.createIntegerConstant(loc, fieldTy, 0)));
-}
-
-// IEEE_SUPPORT_ROUNDING
-mlir::Value
-IntrinsicLibrary::genIeeeSupportRounding(mlir::Type resultType,
-                                         llvm::ArrayRef<mlir::Value> args) {
-  // Check if floating point rounding mode ROUND_VALUE is supported.
-  // Rounding is supported either for all type kinds or none.
-  // An optional X kind argument is therefore ignored.
-  // Values are chosen to match the llvm.get.rounding encoding:
-  //  0 - toward zero [supported]
-  //  1 - to nearest, ties to even [supported] - default
-  //  2 - toward positive infinity [supported]
-  //  3 - toward negative infinity [supported]
-  //  4 - to nearest, ties away from zero [not supported]
-  assert(args.size() == 1 || args.size() == 2);
-  auto [fieldRef, fieldTy] = getFieldRef(builder, loc, args[0]);
-  mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef);
-  mlir::Value lbOk = builder.create<mlir::arith::CmpIOp>(
-      loc, mlir::arith::CmpIPredicate::sge, mode,
-      builder.createIntegerConstant(loc, fieldTy,
-                                    _FORTRAN_RUNTIME_IEEE_TO_ZERO));
-  mlir::Value ubOk = builder.create<mlir::arith::CmpIOp>(
-      loc, mlir::arith::CmpIPredicate::sle, mode,
-      builder.createIntegerConstant(loc, fieldTy, _FORTRAN_RUNTIME_IEEE_DOWN));
-  return builder.createConvert(
-      loc, resultType, builder.create<mlir::arith::AndIOp>(loc, lbOk, ubOk));
-}
-
 // IEEE_UNORDERED
 mlir::Value
 IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType,