[flang] Modifications to ieee_support_halting

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,27 @@ 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)([[maybe_unused]] uint32_t except) {
+#ifdef _WIN32
+  return false;
+#else
+  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;
+#endif
+}
+
 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}>>