[flang] Add software subnormal flusing around host library call for host arch that do not support it

Original-commit: flang-compiler/f18@04555f5359
Tree-same-pre-rewrite: false

flang/lib/evaluate/host.cc

@@ -35,6 +35,7 @@ void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
     return;
   }
 #if __x86_64__
+  HasSubnormalFlushingHardwareControl_ = true;
   if (context.flushSubnormalsToZero()) {
     currentFenv_.__mxcsr |= 0x8000;  // result
     currentFenv_.__mxcsr |= 0x0040;  // operands
@@ -61,9 +62,7 @@ void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
       "TODO: flushing mode for subnormals is not set for this host architecture due to incompatible C library it uses"_en_US);
 #endif
 #else
-  // TODO other architectures
-  context.messages().Say(
-      "TODO: flushing mode for subnormals is not set for this host architecture when folding with host runtime functions"_en_US);
+  // Software flushing will be performed around host library calls if needed.
 #endif
   errno = 0;
   if (fesetenv(&currentFenv_) != 0) {

flang/lib/evaluate/host.h

@@ -39,10 +39,14 @@ class HostFloatingPointEnvironment {
 public:
   void SetUpHostFloatingPointEnvironment(FoldingContext &);
   void CheckAndRestoreFloatingPointEnvironment(FoldingContext &);
+  bool HasSubnormalFlushingHardwareControl() {
+    return HasSubnormalFlushingHardwareControl_;
+  }
 
 private:
   std::fenv_t originalFenv_;
   std::fenv_t currentFenv_;
+  bool HasSubnormalFlushingHardwareControl_{false};
 };
 
 // Type mapping from F18 types to host types

flang/lib/evaluate/intrinsics-library-templates.h

@@ -60,6 +60,26 @@ template<typename TR, typename... ArgInfo>
 using HostFuncPointer = FuncPointer<host::HostType<TR>,
     HostArgType<typename ArgInfo::Type, ArgInfo::pass>...>;
 
+// Software Subnormal Flushing helper.
+template<typename T> struct Flusher {
+  // Only flush floating-points. Forward other scalars untouched.
+  static constexpr inline const Scalar<T> &FlushSubnormals(const Scalar<T> &x) {
+    return x;
+  }
+};
+template<int Kind> struct Flusher<Type<TypeCategory::Real, Kind>> {
+  using T = Type<TypeCategory::Real, Kind>;
+  static constexpr inline Scalar<T> FlushSubnormals(const Scalar<T> &x) {
+    return x.FlushSubnormalToZero();
+  }
+};
+template<int Kind> struct Flusher<Type<TypeCategory::Complex, Kind>> {
+  using T = Type<TypeCategory::Complex, Kind>;
+  static constexpr inline Scalar<T> FlushSubnormals(const Scalar<T> &x) {
+    return x.FlushSubnormalToZero();
+  }
+};
+
 // Callable factory
 template<typename TR, typename... ArgInfo> struct CallableHostWrapper {
   static Scalar<TR> scalarCallable(FoldingContext &context,
@@ -68,10 +88,18 @@ template<typename TR, typename... ArgInfo> struct CallableHostWrapper {
     if constexpr (host::HostTypeExists<TR, typename ArgInfo::Type...>()) {
       host::HostFloatingPointEnvironment hostFPE;
       hostFPE.SetUpHostFloatingPointEnvironment(context);
-      host::HostType<TR> res{
-          func(host::CastFortranToHost<typename ArgInfo::Type>(x)...)};
-      hostFPE.CheckAndRestoreFloatingPointEnvironment(context);
-      return host::CastHostToFortran<TR>(res);
+      host::HostType<TR> res{};
+      if (context.flushSubnormalsToZero() &&
+          !hostFPE.HasSubnormalFlushingHardwareControl()) {
+        res = func(host::CastFortranToHost<typename ArgInfo::Type>(
+            Flusher<typename ArgInfo::Type>::FlushSubnormals(x))...);
+        hostFPE.CheckAndRestoreFloatingPointEnvironment(context);
+        return Flusher<TR>::FlushSubnormals(host::CastHostToFortran<TR>(res));
+      } else {
+        res = func(host::CastFortranToHost<typename ArgInfo::Type>(x)...);
+        hostFPE.CheckAndRestoreFloatingPointEnvironment(context);
+        return host::CastHostToFortran<TR>(res);
+      }
     } else {
       common::die("Internal error: Host does not supports this function type."
                   "This should not have been called for folding");

flang/test/evaluate/folding.cc

@@ -72,7 +72,7 @@ float SubnormalFlusher2(float f) {  // given f/2 is subnormal
   return f / 2.3;  // returns 0 if subnormal
 }
 
-void TestSubnormalFlushing() {
+void TestHostRuntimeSubnormalFlushing() {
   using R4 = Type<TypeCategory::Real, 4>;
   if constexpr (std::is_same_v<host::HostType<R4>, float>) {
     Fortran::parser::CharBlock src;
@@ -119,6 +119,6 @@ void TestSubnormalFlushing() {
 
 int main() {
   RunOnTypes<TestGetScalarConstantValue, AllIntrinsicTypes>::Run();
-  TestSubnormalFlushing();
+  TestHostRuntimeSubnormalFlushing();
   return testing::Complete();
 }