[flang] ieee_denorm

flang-rt/lib/runtime/exceptions.cpp

@@ -76,22 +76,74 @@ uint32_t RTNAME(MapException)(uint32_t excepts) {
   return except_value;
 }
 
+// The following exception processing routines have a libm call component,
+// and where available, an additional component for handling the nonstandard
+// ieee_denorm exception. The denorm component does not subsume the libm
+// component; both are needed.
+
+void RTNAME(feclearexcept)(uint32_t excepts) {
+  feclearexcept(excepts);
+#if defined(_MM_EXCEPT_DENORM)
+  _mm_setcsr(_mm_getcsr() & ~(excepts & _MM_EXCEPT_MASK));
+#endif
+}
+void RTNAME(feraiseexcept)(uint32_t excepts) {
+  feraiseexcept(excepts);
+#if defined(_MM_EXCEPT_DENORM)
+  _mm_setcsr(_mm_getcsr() | (excepts & _MM_EXCEPT_MASK));
+#endif
+}
+uint32_t RTNAME(fetestexcept)(uint32_t excepts) {
+#if defined(_MM_EXCEPT_DENORM)
+  return (_mm_getcsr() & _MM_EXCEPT_MASK & excepts) | fetestexcept(excepts);
+#else
+  return fetestexcept(excepts);
+#endif
+}
+void RTNAME(fedisableexcept)(uint32_t excepts) {
+#ifdef __USE_GNU
+  fedisableexcept(excepts);
+#endif
+#if defined(_MM_EXCEPT_DENORM)
+  _mm_setcsr(_mm_getcsr() | ((excepts & _MM_EXCEPT_MASK) << 7));
+#endif
+}
+void RTNAME(feenableexcept)(uint32_t excepts) {
+#ifdef __USE_GNU
+  feenableexcept(excepts);
+#endif
+#if defined(_MM_EXCEPT_DENORM)
+  _mm_setcsr(_mm_getcsr() & ~((excepts & _MM_EXCEPT_MASK) << 7));
+#endif
+}
+uint32_t RTNAME(fegetexcept)() {
+  uint32_t excepts = 0;
+#ifdef __USE_GNU
+  excepts = fegetexcept();
+#endif
+#if defined(_MM_EXCEPT_DENORM)
+  return (63 - ((_mm_getcsr() >> 7) & _MM_EXCEPT_MASK)) | excepts;
+#else
+  return excepts;
+#endif
+}
+
 // Check if the processor has the ability to control whether to halt or
 // continue execution when a given exception is raised.
 bool RTNAME(SupportHalting)([[maybe_unused]] uint32_t except) {
 #ifdef __USE_GNU
   except = RTNAME(MapException)(except);
-  int currentSet = fegetexcept(), flipSet, ok;
+  int currentSet = RTNAME(fegetexcept)(), flipSet;
   if (currentSet & except) {
-    ok = fedisableexcept(except);
-    flipSet = fegetexcept();
-    ok |= feenableexcept(except);
+    RTNAME(fedisableexcept)(except);
+    flipSet = RTNAME(fegetexcept)();
+    RTNAME(feenableexcept)(except);
   } else {
-    ok = feenableexcept(except);
-    flipSet = fegetexcept();
-    ok |= fedisableexcept(except);
+    RTNAME(feenableexcept)(except);
+    flipSet = RTNAME(fegetexcept)();
+    RTNAME(fedisableexcept)(except);
   }
-  return ok != -1 && currentSet != flipSet;
+  return currentSet != flipSet;
 #else
   return false;
 #endif

flang/include/flang/Evaluate/target.h

@@ -54,6 +54,13 @@ class TargetCharacteristics {
   bool hasSubnormalFlushingControl(bool any = false) const;
   void set_hasSubnormalFlushingControl(int kind, bool yes = true);
 
+  // Check if a given real kind has support for raising a nonstandard
+  // ieee_denorm exception.
+  bool hasSubnormalExceptionSupport(int kind) const;
+  // Check if all real kinds have support for the ieee_denorm exception.
+  bool hasSubnormalExceptionSupport() const;
+  void set_hasSubnormalExceptionSupport(int kind, bool yes = true);
+
   Rounding roundingMode() const { return roundingMode_; }
   void set_roundingMode(Rounding);
 
@@ -134,6 +141,7 @@ class TargetCharacteristics {
   bool haltingSupportIsUnknownAtCompileTime_{false};
   bool areSubnormalsFlushedToZero_{false};
   bool hasSubnormalFlushingControl_[maxKind + 1]{};
+  bool hasSubnormalExceptionSupport_[maxKind + 1]{};
   Rounding roundingMode_{defaultRounding};
   std::size_t procedurePointerByteSize_{8};
   std::size_t procedurePointerAlignment_{8};

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

@@ -26,6 +26,23 @@ namespace fir::runtime {
 mlir::Value genMapExcept(fir::FirOpBuilder &builder, mlir::Location loc,
                          mlir::Value excepts);
 
+void genFeclearexcept(fir::FirOpBuilder &builder, mlir::Location loc,
+                      mlir::Value excepts);
+
+void genFeraiseexcept(fir::FirOpBuilder &builder, mlir::Location loc,
+                      mlir::Value excepts);
+
+mlir::Value genFetestexcept(fir::FirOpBuilder &builder, mlir::Location loc,
+                            mlir::Value excepts);
+
+void genFedisableexcept(fir::FirOpBuilder &builder, mlir::Location loc,
+                        mlir::Value excepts);
+
+void genFeenableexcept(fir::FirOpBuilder &builder, mlir::Location loc,
+                       mlir::Value excepts);
+
+mlir::Value genFegetexcept(fir::FirOpBuilder &builder, mlir::Location loc);
+
 mlir::Value genSupportHalting(fir::FirOpBuilder &builder, mlir::Location loc,
                               mlir::Value excepts);
 

flang/include/flang/Runtime/exceptions.h

@@ -6,7 +6,8 @@
 //
 //===----------------------------------------------------------------------===//
 
-// Map Fortran ieee_arithmetic module exceptions to fenv.h exceptions.
+// Support for floating point exceptions and related floating point environment
+// functionality.
 
 #ifndef FORTRAN_RUNTIME_EXCEPTIONS_H_
 #define FORTRAN_RUNTIME_EXCEPTIONS_H_
@@ -25,6 +26,15 @@ extern "C" {
 // This mapping is done at runtime to support cross compilation.
 std::uint32_t RTNAME(MapException)(std::uint32_t excepts);
 
+// Exception processing functions that call the corresponding libm functions,
+// and also include support for denormal exceptions where available.
+void RTNAME(feclearexcept)(std::uint32_t excepts);
+void RTNAME(feraiseexcept)(std::uint32_t excepts);
+std::uint32_t RTNAME(fetestexcept)(std::uint32_t excepts);
+void RTNAME(fedisableexcept)(std::uint32_t excepts);
+void RTNAME(feenableexcept)(std::uint32_t excepts);
+std::uint32_t RTNAME(fegetexcept)(void);
+
 // Check if the processor has the ability to control whether to halt
 // or continue exeuction when a given exception is raised.
 bool RTNAME(SupportHalting)(uint32_t except);

flang/include/flang/Tools/TargetSetup.h

@@ -29,6 +29,10 @@ namespace Fortran::tools {
     targetCharacteristics.set_hasSubnormalFlushingControl(/*kind=*/3);
     targetCharacteristics.set_hasSubnormalFlushingControl(/*kind=*/4);
     targetCharacteristics.set_hasSubnormalFlushingControl(/*kind=*/8);
+    // ieee_denorm exception support is nonstandard.
+    targetCharacteristics.set_hasSubnormalExceptionSupport(/*kind=*/3);
+    targetCharacteristics.set_hasSubnormalExceptionSupport(/*kind=*/4);
+    targetCharacteristics.set_hasSubnormalExceptionSupport(/*kind=*/8);
   }
 
   if (targetTriple.isARM() || targetTriple.isAArch64()) {

flang/lib/Evaluate/fold-logical.cpp

@@ -875,8 +875,38 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
     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)};
+    if (context.targetCharacteristics().ieeeFeatures().test(
+            IeeeFeature::Flags)) {
+      if (args[0]) {
+        if (const auto *cst{UnwrapExpr<Constant<SomeDerived>>(args[0])}) {
+          if (auto constr{cst->GetScalarValue()}) {
+            if (StructureConstructorValues & values{constr->values()};
+                values.size() == 1) {
+              const Expr<SomeType> &value{values.begin()->second.value()};
+              if (auto flag{ToInt64(value)}) {
+                if (flag != _FORTRAN_RUNTIME_IEEE_DENORM) {
+                  // Check for suppport for standard exceptions.
+                  return Expr<T>{
+                      context.targetCharacteristics().ieeeFeatures().test(
+                          IeeeFeature::Flags)};
+                } else if (args[1]) {
+                  // Check for nonstandard ieee_denorm exception support for
+                  // a given kind.
+                  return Expr<T>{context.targetCharacteristics()
+                          .hasSubnormalExceptionSupport(
+                              args[1]->GetType().value().kind())};
+                } else {
+                  // Check for nonstandard ieee_denorm exception support for
+                  // all kinds.
+                  return Expr<T>{context.targetCharacteristics()
+                          .hasSubnormalExceptionSupport()};
+                }
+              }
+            }
+          }
+        }
+      }
+    }
   } else if (name == "__builtin_ieee_support_halting") {
     if (!context.targetCharacteristics()
             .haltingSupportIsUnknownAtCompileTime()) {

flang/lib/Evaluate/target.cpp

@@ -134,6 +134,30 @@ void TargetCharacteristics::set_hasSubnormalFlushingControl(
   hasSubnormalFlushingControl_[kind] = yes;
 }
 
+// Check if a given real kind has (nonstandard) ieee_denorm exception control.
+bool TargetCharacteristics::hasSubnormalExceptionSupport(int kind) const {
+  CHECK(kind > 0 && kind <= maxKind);
+  CHECK(CanSupportType(TypeCategory::Real, kind));
+  return hasSubnormalExceptionSupport_[kind];
+}
+
+// Check if all real kinds have support for the ieee_denorm exception.
+bool TargetCharacteristics::hasSubnormalExceptionSupport() const {
+  for (int kind{1}; kind <= maxKind; ++kind) {
+    if (CanSupportType(TypeCategory::Real, kind) &&
+        !hasSubnormalExceptionSupport_[kind]) {
+      return false;
+    }
+  }
+  return true;
+}
+
+void TargetCharacteristics::set_hasSubnormalExceptionSupport(
+    int kind, bool yes) {
+  CHECK(kind > 0 && kind <= maxKind);
+  hasSubnormalExceptionSupport_[kind] = yes;
+}
+
 void TargetCharacteristics::set_roundingMode(Rounding rounding) {
   roundingMode_ = rounding;
 }

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -4571,8 +4571,8 @@ void IntrinsicLibrary::genRaiseExcept(int excepts, mlir::Value cond) {
     builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
   }
   mlir::Type i32Ty = builder.getIntegerType(32);
-  genRuntimeCall(
-      "feraiseexcept", i32Ty,
+  fir::runtime::genFeraiseexcept(
+      builder, loc,
       fir::runtime::genMapExcept(
           builder, loc, builder.createIntegerConstant(loc, i32Ty, excepts)));
   if (cond)
@@ -4939,8 +4939,8 @@ void IntrinsicLibrary::genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue> args) {
   mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);
   auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);
   mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
-  mlir::Value excepts = IntrinsicLibrary::genRuntimeCall(
-      "fetestexcept", i32Ty,
+  mlir::Value excepts = fir::runtime::genFetestexcept(
+      builder, loc,
       fir::runtime::genMapExcept(
           builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)));
   mlir::Value logicalResult = builder.create<fir::ConvertOp>(
@@ -4963,8 +4963,7 @@ void IntrinsicLibrary::genIeeeGetHaltingMode(
   mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);
   auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);
   mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
-  mlir::Value haltSet =
-      IntrinsicLibrary::genRuntimeCall("fegetexcept", i32Ty, {});
+  mlir::Value haltSet = fir::runtime::genFegetexcept(builder, loc);
   mlir::Value intResult = builder.create<mlir::arith::AndIOp>(
       loc, haltSet,
       fir::runtime::genMapExcept(
@@ -5712,9 +5711,11 @@ void IntrinsicLibrary::genIeeeSetFlagOrHaltingMode(
       loc, builder.create<fir::ConvertOp>(loc, i1Ty, getBase(args[1])),
       /*withElseRegion=*/true);
   builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
-  genRuntimeCall(isFlag ? "feraiseexcept" : "feenableexcept", i32Ty, except);
+  (isFlag ? fir::runtime::genFeraiseexcept : fir::runtime::genFeenableexcept)(
+      builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, except));
   builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
-  genRuntimeCall(isFlag ? "feclearexcept" : "fedisableexcept", i32Ty, except);
+  (isFlag ? fir::runtime::genFeclearexcept : fir::runtime::genFedisableexcept)(
+      builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, except));
   builder.setInsertionPointAfter(ifOp);
 }
 
@@ -5805,24 +5806,61 @@ mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType,
 fir::ExtendedValue
 IntrinsicLibrary::genIeeeSupportFlag(mlir::Type resultType,
                                      llvm::ArrayRef<fir::ExtendedValue> args) {
-  // Check if a floating point exception flag is supported. A 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.
+  // Check if a floating point exception flag is supported.
   assert(args.size() == 1 || args.size() == 2);
+  mlir::Type i1Ty = builder.getI1Type();
+  mlir::Type i32Ty = builder.getIntegerType(32);
   auto [fieldRef, fieldTy] = getFieldRef(builder, loc, getBase(args[0]));
   mlir::Value flag = builder.create<fir::LoadOp>(loc, fieldRef);
-  mlir::Value mask = builder.createIntegerConstant( // values are powers of 2
+  mlir::Value standardFlagMask = builder.createIntegerConstant(
       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)));
+  mlir::Value isStandardFlag = builder.create<mlir::arith::CmpIOp>(
+      loc, mlir::arith::CmpIPredicate::ne,
+      builder.create<mlir::arith::AndIOp>(loc, flag, standardFlagMask),
+      builder.createIntegerConstant(loc, fieldTy, 0));
+  fir::IfOp ifOp = builder.create<fir::IfOp>(loc, i1Ty, isStandardFlag,
+                                             /*withElseRegion=*/true);
+  // Standard flags are supported.
+  builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+  builder.create<fir::ResultOp>(loc, builder.createBool(loc, true));
+
+  // TargetCharacteristics information for the nonstandard ieee_denorm flag
+  // is not available here. So use a runtime check restricted to possibly
+  // supported kinds.
+  builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
+  bool mayBeSupported = false;
+  if (mlir::Value arg1 = getBase(args[1])) {
+    mlir::Type arg1Ty = arg1.getType();
+    if (fir::ReferenceType refTy = mlir::dyn_cast<fir::ReferenceType>(arg1Ty))
+      arg1Ty = refTy.getEleTy();
+    switch (mlir::dyn_cast<mlir::FloatType>(arg1Ty).getWidth()) {
+    case 16:
+      mayBeSupported = arg1Ty.isBF16(); // kind=3
+      break;
+    case 32: // kind=4
+    case 64: // kind=8
+      mayBeSupported = true;
+      break;
+    }
+  }
+  if (mayBeSupported) {
+    mlir::Value isDenorm = builder.create<mlir::arith::CmpIOp>(
+        loc, mlir::arith::CmpIPredicate::eq, flag,
+        builder.createIntegerConstant(loc, fieldTy,
+                                      _FORTRAN_RUNTIME_IEEE_DENORM));
+    mlir::Value result = builder.create<mlir::arith::AndIOp>(
+        loc, isDenorm,
+        fir::runtime::genSupportHalting(
+            builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, flag)));
+    builder.create<fir::ResultOp>(loc, result);
+  } else {
+    builder.create<fir::ResultOp>(loc, builder.createBool(loc, false));
+  }
+  builder.setInsertionPointAfter(ifOp);
+  return builder.createConvert(loc, resultType, ifOp.getResult(0));
 }
 
 // IEEE_SUPPORT_HALTING
@@ -5838,7 +5876,7 @@ fir::ExtendedValue IntrinsicLibrary::genIeeeSupportHalting(
   return builder.createConvert(
       loc, resultType,
       fir::runtime::genSupportHalting(
-          builder, loc, {builder.create<fir::ConvertOp>(loc, i32Ty, field)}));
+          builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)));
 }
 
 // IEEE_SUPPORT_ROUNDING
@@ -5874,10 +5912,10 @@ fir::ExtendedValue IntrinsicLibrary::genIeeeSupportStandard(
   // if halting control is supported, as that is the only support component
   // that may not be available.
   assert(args.size() <= 1);
-  mlir::Value nearest = builder.createIntegerConstant(
-      loc, builder.getIntegerType(32), _FORTRAN_RUNTIME_IEEE_NEAREST);
+  mlir::Value overflow = builder.createIntegerConstant(
+      loc, builder.getIntegerType(32), _FORTRAN_RUNTIME_IEEE_OVERFLOW);
   return builder.createConvert(
-      loc, resultType, fir::runtime::genSupportHalting(builder, loc, nearest));
+      loc, resultType, fir::runtime::genSupportHalting(builder, loc, overflow));
 }
 
 // IEEE_UNORDERED