[flang] Modifications to ieee_support_halting

The F23 standard requires that a call to intrinsic module procedure ieee_support_halting be foldable to a constant at compile time in some contexts. See for example F23 Clause 10.1.11 [Specification expression] list item (13), Clause 1.1.12 [Constant expression] list item (11), and references to specification and constant expressions elsewhere, such as constraints C1012, C853, and C704.

Some Arm processors allow a user to control processor behavior when an arithmetic exception is signaled, and some Arm processors do not have this capability. An Arm executable will run on either type of processor, so it is effectively unknown at compile time whether or not this support will be available at runtime. This in conflict with the standard requirement.

This patch addresses this conflict by implementing ieee_support_halting calls on Arm processors to check if this capability is present at runtime. A call to ieee_support_halting in a constant context, such as in the specification part of a program unit, will generate a compile time "cannot be computed as a constant value" error. The expectation is that such calls are unlikely to appear in production code.

Code generation for other processors will continue to generate a compile time constant result for ieee_support_halting calls.

Author: vdonaldson

flang/docs/Extensions.md

@@ -141,6 +141,18 @@ end
   This interpretation has usability advantages and is what six other
   Fortran compilers do, but is not conforming now that J3 approved an
   "interp" in June 2024 to the contrary.
+* Arm has processors that allow a user to control what happens when an
+  arithmetic exception is signaled, as well as processors that do not
+  have this capability. An Arm executable will run on either type of
+  processor, so it is effectively unknown at compile time whether or
+  not this support will be available at runtime. The standard requires
+  that a call to intrinsic module procedure `IEEE_SUPPORT_HALTING` with
+  a constant argument has a compile time constant result in `constant
+  expression` and `specification expression` contexts. In compilations
+  where this information is not known at compile time, f18 generates code
+  to determine the absence or presence of this capability at runtime.
+  A call to `IEEE_SUPPORT_HALTING` in contexts that the standard requires
+  to be constant will generate a compilation error.
 
 ## Extensions, deletions, and legacy features supported by default
 

flang/include/flang/Evaluate/target.h

@@ -36,6 +36,13 @@ class TargetCharacteristics {
   bool isBigEndian() const { return isBigEndian_; }
   void set_isBigEndian(bool isBig = true);
 
+  bool haltingSupportIsUnknownAtCompileTime() const {
+    return haltingSupportIsUnknownAtCompileTime_;
+  }
+  void set_haltingSupportIsUnknownAtCompileTime(bool yes = true) {
+    haltingSupportIsUnknownAtCompileTime_ = yes;
+  }
+
   bool areSubnormalsFlushedToZero() const {
     return areSubnormalsFlushedToZero_;
   }
@@ -50,6 +57,14 @@ class TargetCharacteristics {
   Rounding roundingMode() const { return roundingMode_; }
   void set_roundingMode(Rounding);
 
+  void set_ieeeFeature(IeeeFeature ieeeFeature, bool yes = true) {
+    if (yes) {
+      ieeeFeatures_.set(ieeeFeature);
+    } else {
+      ieeeFeatures_.reset(ieeeFeature);
+    }
+  }
+
   std::size_t procedurePointerByteSize() const {
     return procedurePointerByteSize_;
   }
@@ -112,6 +127,7 @@ class TargetCharacteristics {
   bool isBigEndian_{false};
   bool isPPC_{false};
   bool isOSWindows_{false};
+  bool haltingSupportIsUnknownAtCompileTime_{false};
   bool areSubnormalsFlushedToZero_{false};
   bool hasSubnormalFlushingControl_[maxKind + 1]{};
   Rounding roundingMode_{defaultRounding};
@@ -123,10 +139,9 @@ class TargetCharacteristics {
   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};
+      IeeeFeature::Flags, IeeeFeature::Inf, IeeeFeature::Io, IeeeFeature::NaN,
+      IeeeFeature::Rounding, IeeeFeature::Sqrt, IeeeFeature::Standard,
+      IeeeFeature::Subnormal, IeeeFeature::UnderflowControl};
 };
 
 } // namespace Fortran::evaluate

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

@@ -296,9 +296,10 @@ 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>);
+  fir::ExtendedValue genIeeeSupportFlag(mlir::Type,
+                                        llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genIeeeSupportHalting(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>);

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

@@ -26,6 +26,9 @@ namespace fir::runtime {
 mlir::Value genMapExcept(fir::FirOpBuilder &builder, mlir::Location loc,
                          mlir::Value excepts);
 
+mlir::Value genSupportHalting(fir::FirOpBuilder &builder, mlir::Location loc,
+                              mlir::Value excepts);
+
 mlir::Value genGetUnderflowMode(fir::FirOpBuilder &builder, mlir::Location loc);
 void genSetUnderflowMode(fir::FirOpBuilder &builder, mlir::Location loc,
                          mlir::Value bit);

flang/include/flang/Runtime/exceptions.h

@@ -24,6 +24,10 @@ extern "C" {
 // This mapping is done at runtime to support cross compilation.
 std::uint32_t RTNAME(MapException)(std::uint32_t excepts);
 
+// 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);
+
 // Get and set the ieee underflow mode if supported; otherwise nops.
 bool RTNAME(GetUnderflowMode)(void);
 void RTNAME(SetUnderflowMode)(bool flag);

flang/include/flang/Tools/TargetSetup.h

@@ -34,6 +34,13 @@ namespace Fortran::tools {
     targetCharacteristics.set_hasSubnormalFlushingControl(/*kind=*/4);
     targetCharacteristics.set_hasSubnormalFlushingControl(/*kind=*/8);
   }
+  if (targetTriple.isARM() || targetTriple.isAArch64()) {
+    targetCharacteristics.set_haltingSupportIsUnknownAtCompileTime();
+    targetCharacteristics.set_ieeeFeature(
+        evaluate::IeeeFeature::Halting, false);
+  } else {
+    targetCharacteristics.set_ieeeFeature(evaluate::IeeeFeature::Halting);
+  }
 
   // Figure out if we can support F128: see
   // flang/runtime/Float128Math/math-entries.h

flang/lib/Evaluate/fold-logical.cpp

@@ -881,8 +881,11 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
     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)};
+    if (!context.targetCharacteristics()
+             .haltingSupportIsUnknownAtCompileTime()) {
+      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)};

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -389,10 +389,10 @@ static constexpr IntrinsicHandler handlers[]{
      &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::UNE>},
     {"ieee_signbit", &I::genIeeeSignbit},
     {"ieee_support_flag",
-     &I::genIeeeSupportFlagOrHalting,
+     &I::genIeeeSupportFlag,
      {{{"flag", asValue}, {"x", asInquired, handleDynamicOptional}}},
      /*isElemental=*/false},
-    {"ieee_support_halting", &I::genIeeeSupportFlagOrHalting},
+    {"ieee_support_halting", &I::genIeeeSupportHalting},
     {"ieee_support_rounding", &I::genIeeeSupportRounding},
     {"ieee_unordered", &I::genIeeeUnordered},
     {"ieee_value", &I::genIeeeValue},
@@ -5259,14 +5259,14 @@ 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.)
+// IEEE_SUPPORT_FLAG
+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.
   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);
@@ -5283,6 +5283,22 @@ fir::ExtendedValue IntrinsicLibrary::genIeeeSupportFlagOrHalting(
           builder.createIntegerConstant(loc, fieldTy, 0)));
 }
 
+// IEEE_SUPPORT_HALTING
+fir::ExtendedValue IntrinsicLibrary::genIeeeSupportHalting(
+    mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
+  // Check if halting is supported for a floating point exception flag.
+  // Standard flags are all supported. The nonstandard DENORM extension is
+  // not supported, at least for now.
+  assert(args.size() == 1);
+  mlir::Type i32Ty = builder.getIntegerType(32);
+  auto [fieldRef, ignore] = getFieldRef(builder, loc, getBase(args[0]));
+  mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
+  return builder.createConvert(
+      loc, resultType,
+      fir::runtime::genSupportHalting(
+          builder, loc, {builder.create<fir::ConvertOp>(loc, i32Ty, field)}));
+}
+
 // IEEE_SUPPORT_ROUNDING
 mlir::Value
 IntrinsicLibrary::genIeeeSupportRounding(mlir::Type resultType,

flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp

@@ -21,6 +21,14 @@ mlir::Value fir::runtime::genMapExcept(fir::FirOpBuilder &builder,
   return builder.create<fir::CallOp>(loc, func, excepts).getResult(0);
 }
 
+mlir::Value fir::runtime::genSupportHalting(fir::FirOpBuilder &builder,
+                                            mlir::Location loc,
+                                            mlir::Value excepts) {
+  mlir::func::FuncOp func{
+      fir::runtime::getRuntimeFunc<mkRTKey(SupportHalting)>(loc, builder)};
+  return builder.create<fir::CallOp>(loc, func, excepts).getResult(0);
+}
+
 mlir::Value fir::runtime::genGetUnderflowMode(fir::FirOpBuilder &builder,
                                               mlir::Location loc) {
   mlir::func::FuncOp func{

flang/runtime/exceptions.cpp

@@ -81,6 +81,23 @@ uint32_t RTNAME(MapException)(uint32_t excepts) {
 // on some systems, e.g. Solaris, so omit object size comparison for now.
 // TODO: consider femode_t object size comparison once its more mature.
 
+// Check if the processor has the ability to control whether to halt or
+// continue execution when a given exception is raised.
+bool RTNAME(SupportHalting)(uint32_t except) {
+  except = RTNAME(MapException)(except);
+  int currentSet = fegetexcept(), flipSet, ok;
+  if (currentSet & except) {
+    ok = fedisableexcept(except);
+    flipSet = fegetexcept();
+    ok |= feenableexcept(except);
+  } else {
+    ok = feenableexcept(except);
+    flipSet = fegetexcept();
+    ok |= fedisableexcept(except);
+  }
+  return ok != -1 && currentSet != flipSet;
+}
+
 bool RTNAME(GetUnderflowMode)(void) {
 #if __x86_64__
   // The MXCSR Flush to Zero flag is the negation of the ieee_get_underflow_mode

flang/test/Evaluate/fold-ieee.f90

@@ -26,11 +26,13 @@ module m
   logical, parameter :: test_fl_ix_all = ieee_support_flag(ieee_inexact)
   logical, parameter :: test_fl_ix_4 = ieee_support_flag(ieee_inexact, 1.)
   logical, parameter :: test_fl_ix_8 = ieee_support_flag(ieee_inexact, 1.d0)
+#if __x86_64__
   logical, parameter :: test_halt_in = ieee_support_halting(ieee_invalid)
   logical, parameter :: test_halt_ov = ieee_support_halting(ieee_overflow)
   logical, parameter :: test_halt_d0 = ieee_support_halting(ieee_divide_by_zero)
   logical, parameter :: test_halt_un = ieee_support_halting(ieee_underflow)
   logical, parameter :: test_halt_ix = ieee_support_halting(ieee_inexact)
+#endif
   logical, parameter :: test_inf_all = ieee_support_inf()
   logical, parameter :: test_inf_4 = ieee_support_inf(1.)
   logical, parameter :: test_inf_8 = ieee_support_inf(1.d0)
@@ -58,7 +60,9 @@ module m
   logical, parameter :: test_sn_all = ieee_support_subnormal()
   logical, parameter :: test_sn_4 = ieee_support_subnormal(1.)
   logical, parameter :: test_sn_8 = ieee_support_subnormal(1.d0)
-! logical, parameter :: test_uc_all = .not. ieee_support_underflow_control()
-! logical, parameter :: test_uc_4 = ieee_support_underflow_control(1.)
-! logical, parameter :: test_uc_8 = ieee_support_underflow_control(1.d0)
+#if __x86_64__
+  logical, parameter :: test_uc_all = .not. ieee_support_underflow_control()
+  logical, parameter :: test_uc_4 = ieee_support_underflow_control(1.)
+  logical, parameter :: test_uc_8 = ieee_support_underflow_control(1.d0)
+#endif
 end

flang/test/Lower/Intrinsics/ieee_flag.f90

@@ -271,7 +271,7 @@
   print*, 'Halting'
 
   ! CHECK:     %[[V_211:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
-  ! CHECK:     %[[V_220:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_211]], %true) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+  ! CHECK:     %[[V_220:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_211]]
   print*, 'support invalid: ', ieee_support_halting(ieee_invalid)
 
   ! CHECK:     %[[V_222:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_builtinsT__builtin_ieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>