[flang-commits] [flang] [flang] IEEE_GET_UNDERFLOW_MODE, IEEE_SET_UNDERFLOW_MODE (PR #118551)
via flang-commits
flang-commits at lists.llvm.org
Tue Dec 3 14:00:54 PST 2024
https://github.com/vdonaldson created https://github.com/llvm/llvm-project/pull/118551
Implement IEEE_GET_UNDERFLOW_MODE and IEEE_SET_UNDERFLOW_MODE. Update IEEE_SUPPORT_UNDERFLOW_CONTROL to enable support for indvidual REAL kinds.
>From efbc83eff80e2b911adf5e11aec4ff2473386d3b Mon Sep 17 00:00:00 2001
From: V Donaldson <vdonaldson at nvidia.com>
Date: Tue, 3 Dec 2024 13:54:59 -0800
Subject: [PATCH] [flang] IEEE_GET_UNDERFLOW_MODE, IEEE_SET_UNDERFLOW_MODE
Implement IEEE_GET_UNDERFLOW_MODE and IEEE_SET_UNDERFLOW_MODE.
Update IEEE_SUPPORT_UNDERFLOW_CONTROL to enable support for indvidual
REAL kinds.
---
flang/include/flang/Evaluate/target.h | 12 ++++--
flang/include/flang/Lower/PFTBuilder.h | 1 +
.../flang/Optimizer/Builder/IntrinsicCall.h | 7 +---
.../Optimizer/Builder/Runtime/Exceptions.h | 4 ++
flang/include/flang/Runtime/exceptions.h | 4 ++
flang/include/flang/Tools/TargetSetup.h | 5 +++
flang/lib/Evaluate/fold-logical.cpp | 6 ++-
flang/lib/Evaluate/target.cpp | 35 +++++++++++++++--
flang/lib/Lower/Bridge.cpp | 19 +++++++--
flang/lib/Lower/PFTBuilder.cpp | 5 ++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 34 ++++++++++------
.../Optimizer/Builder/Runtime/Exceptions.cpp | 14 +++++++
flang/runtime/exceptions.cpp | 20 ++++++++++
flang/test/Evaluate/fold-ieee.f90 | 2 +-
flang/test/Evaluate/folding18.f90 | 8 ++--
.../test/Lower/Intrinsics/ieee_underflow.f90 | 39 +++++++++++++++++++
16 files changed, 180 insertions(+), 35 deletions(-)
create mode 100644 flang/test/Lower/Intrinsics/ieee_underflow.f90
diff --git a/flang/include/flang/Evaluate/target.h b/flang/include/flang/Evaluate/target.h
index b347c549e012da..8abd72d29d38b5 100644
--- a/flang/include/flang/Evaluate/target.h
+++ b/flang/include/flang/Evaluate/target.h
@@ -52,6 +52,11 @@ class TargetCharacteristics {
}
void set_areSubnormalsFlushedToZero(bool yes = true);
+ // Check if a given real kind, any real kind, or all real kinds have
+ // flushing control.
+ bool hasSubnormalFlushingControl(int kind, bool any = false) const;
+ void set_hasSubnormalFlushingControl(int kind, bool yes = true);
+
Rounding roundingMode() const { return roundingMode_; }
void set_roundingMode(Rounding);
@@ -111,13 +116,14 @@ class TargetCharacteristics {
const IeeeFeatures &ieeeFeatures() const { return ieeeFeatures_; }
private:
- static constexpr int maxKind{32};
- std::uint8_t byteSize_[common::TypeCategory_enumSize][maxKind]{};
- std::uint8_t align_[common::TypeCategory_enumSize][maxKind]{};
+ static constexpr int maxKind{16};
+ std::uint8_t byteSize_[common::TypeCategory_enumSize][maxKind + 1]{};
+ std::uint8_t align_[common::TypeCategory_enumSize][maxKind + 1]{};
bool isBigEndian_{false};
bool isPPC_{false};
bool isOSWindows_{false};
bool areSubnormalsFlushedToZero_{false};
+ bool hasSubnormalFlushingControl_[maxKind + 1]{};
Rounding roundingMode_{defaultRounding};
std::size_t procedurePointerByteSize_{8};
std::size_t procedurePointerAlignment_{8};
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 9b9d9febc190a9..42d6546b77553b 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -723,6 +723,7 @@ struct FunctionLikeUnit : public ProgramUnit {
bool hasIeeeAccess{false};
bool mayModifyHaltingMode{false};
bool mayModifyRoundingMode{false};
+ bool mayModifyUnderflowMode{false};
/// Terminal basic block (if any)
mlir::Block *finalBlock{};
HostAssociations hostAssociations;
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 19c623cc1ec006..e7955c2fc0314d 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -166,11 +166,6 @@ struct IntrinsicLibrary {
getRuntimeCallGenerator(llvm::StringRef name,
mlir::FunctionType soughtFuncType);
- /// Helper to generate TODOs for module procedures that must be intercepted in
- /// lowering and are not yet implemented.
- template <const char *intrinsicName>
- void genModuleProcTODO(llvm::ArrayRef<fir::ExtendedValue>);
-
void genAbort(llvm::ArrayRef<fir::ExtendedValue>);
/// Lowering for the ABS intrinsic. The ABS intrinsic expects one argument in
/// the llvm::ArrayRef. The ABS intrinsic is lowered into MLIR/FIR operation
@@ -278,6 +273,7 @@ struct IntrinsicLibrary {
template <bool isGet>
void genIeeeGetOrSetStatus(llvm::ArrayRef<fir::ExtendedValue>);
void genIeeeGetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
+ void genIeeeGetUnderflowMode(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genIeeeInt(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genIeeeIsNan(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -295,6 +291,7 @@ struct IntrinsicLibrary {
template <bool isFlag>
void genIeeeSetFlagOrHaltingMode(llvm::ArrayRef<fir::ExtendedValue>);
void genIeeeSetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
+ void genIeeeSetUnderflowMode(llvm::ArrayRef<fir::ExtendedValue>);
template <mlir::arith::CmpFPredicate pred>
mlir::Value genIeeeSignalingCompare(mlir::Type resultType,
llvm::ArrayRef<mlir::Value>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
index aa6e33c7440adc..f2f83b46f20fde 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
@@ -26,5 +26,9 @@ namespace fir::runtime {
mlir::Value genMapExcept(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);
+
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
diff --git a/flang/include/flang/Runtime/exceptions.h b/flang/include/flang/Runtime/exceptions.h
index 1ab22da103a50f..bd6c439b150ab9 100644
--- a/flang/include/flang/Runtime/exceptions.h
+++ b/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);
+// Get and set the ieee underflow mode if supported; otherwise nops.
+bool RTNAME(GetUnderflowMode)(void);
+void RTNAME(SetUnderflowMode)(bool flag);
+
} // extern "C"
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_EXCEPTIONS_H_
diff --git a/flang/include/flang/Tools/TargetSetup.h b/flang/include/flang/Tools/TargetSetup.h
index f52b5ddaa8d49a..1889140ddce75e 100644
--- a/flang/include/flang/Tools/TargetSetup.h
+++ b/flang/include/flang/Tools/TargetSetup.h
@@ -29,6 +29,11 @@ namespace Fortran::tools {
targetCharacteristics.DisableType(
Fortran::common::TypeCategory::Real, /*kind=*/10);
}
+ if (targetTriple.getArch() == llvm::Triple::ArchType::x86_64) {
+ targetCharacteristics.set_hasSubnormalFlushingControl(/*kind=*/3);
+ targetCharacteristics.set_hasSubnormalFlushingControl(/*kind=*/4);
+ targetCharacteristics.set_hasSubnormalFlushingControl(/*kind=*/8);
+ }
// Figure out if we can support F128: see
// flang/runtime/Float128Math/math-entries.h
diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp
index f5bbe7e4293359..991e1fd6e26834 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -890,8 +890,10 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
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)};
+ // Setting kind=0 checks subnormal flushing control across all type kinds.
+ int kind{args[0] ? args[0]->GetType().value().kind() : 0};
+ return Expr<T>{
+ context.targetCharacteristics().hasSubnormalFlushingControl(kind)};
}
return Expr<T>{std::move(funcRef)};
}
diff --git a/flang/lib/Evaluate/target.cpp b/flang/lib/Evaluate/target.cpp
index 1e2cf6b0d298d4..0c72da414a5e51 100644
--- a/flang/lib/Evaluate/target.cpp
+++ b/flang/lib/Evaluate/target.cpp
@@ -17,7 +17,7 @@ Rounding TargetCharacteristics::defaultRounding;
TargetCharacteristics::TargetCharacteristics() {
auto enableCategoryKinds{[this](TypeCategory category) {
- for (int kind{0}; kind < maxKind; ++kind) {
+ for (int kind{1}; kind <= maxKind; ++kind) {
if (CanSupportType(category, kind)) {
auto byteSize{static_cast<std::size_t>(kind)};
if (category == TypeCategory::Real ||
@@ -70,14 +70,14 @@ bool TargetCharacteristics::EnableType(common::TypeCategory category,
void TargetCharacteristics::DisableType(
common::TypeCategory category, std::int64_t kind) {
- if (kind >= 0 && kind < maxKind) {
+ if (kind > 0 && kind <= maxKind) {
align_[static_cast<int>(category)][kind] = 0;
}
}
std::size_t TargetCharacteristics::GetByteSize(
common::TypeCategory category, std::int64_t kind) const {
- if (kind >= 0 && kind < maxKind) {
+ if (kind > 0 && kind <= maxKind) {
return byteSize_[static_cast<int>(category)][kind];
} else {
return 0;
@@ -86,7 +86,7 @@ std::size_t TargetCharacteristics::GetByteSize(
std::size_t TargetCharacteristics::GetAlignment(
common::TypeCategory category, std::int64_t kind) const {
- if (kind >= 0 && kind < maxKind) {
+ if (kind > 0 && kind <= maxKind) {
return align_[static_cast<int>(category)][kind];
} else {
return 0;
@@ -108,6 +108,33 @@ void TargetCharacteristics::set_areSubnormalsFlushedToZero(bool yes) {
areSubnormalsFlushedToZero_ = yes;
}
+// Check if the target has subnormal flushing control for:
+// - a given real kind (kind != 0)
+// - any real kind (kind == 0 && any == true)
+// - all real kinds (kind == 0 && any == false)
+bool TargetCharacteristics::hasSubnormalFlushingControl(
+ int kind, bool any) const {
+ CHECK(kind >= 0 && kind <= maxKind);
+ if (kind == 0) {
+ for (int kind{1}; kind <= maxKind; ++kind) {
+ if (CanSupportType(TypeCategory::Real, kind) &&
+ hasSubnormalFlushingControl_[kind] == any) {
+ return any;
+ }
+ }
+ return !any;
+ } else {
+ CHECK(CanSupportType(TypeCategory::Real, kind));
+ return hasSubnormalFlushingControl_[kind];
+ }
+}
+
+void TargetCharacteristics::set_hasSubnormalFlushingControl(
+ int kind, bool yes) {
+ CHECK(kind > 0 && kind <= maxKind);
+ hasSubnormalFlushingControl_[kind] = yes;
+}
+
void TargetCharacteristics::set_roundingMode(Rounding rounding) {
roundingMode_ = rounding;
}
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 77003eff190e26..226c6306132d10 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -39,6 +39,7 @@
#include "flang/Optimizer/Builder/Runtime/Character.h"
#include "flang/Optimizer/Builder/Runtime/Derived.h"
#include "flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h"
+#include "flang/Optimizer/Builder/Runtime/Exceptions.h"
#include "flang/Optimizer/Builder/Runtime/Main.h"
#include "flang/Optimizer/Builder/Runtime/Ragged.h"
#include "flang/Optimizer/Builder/Runtime/Stop.h"
@@ -5181,8 +5182,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
genOpenMPSymbolProperties(*this, var);
}
- /// Where applicable, save the exception state and halting and rounding
- /// modes at function entry and restore them at function exits.
+ /// Where applicable, save the exception state and halting, rounding, and
+ /// underflow modes at function entry, and restore them at function exits.
void manageFPEnvironment(Fortran::lower::pft::FunctionLikeUnit &funit) {
mlir::Location loc = toLocation();
mlir::Location endLoc =
@@ -5224,7 +5225,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
});
}
if (funit.mayModifyRoundingMode) {
- // F18 Clause 17.4.5: In a procedure [...], the processor shall not
+ // F18 Clause 17.4p5: In a procedure [...], the processor shall not
// change the rounding modes on entry, and on return shall ensure that
// the rounding modes are the same as they were on entry.
mlir::func::FuncOp getRounding =
@@ -5237,6 +5238,18 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder->create<fir::CallOp>(endLoc, setRounding, roundingMode);
});
}
+ if ((funit.mayModifyUnderflowMode) &&
+ (bridge.getTargetCharacteristics().hasSubnormalFlushingControl(
+ 0, /*any=*/true))) {
+ // F18 Clause 17.5p2: In a procedure [...], the processor shall not
+ // change the underflow mode on entry, and on return shall ensure that
+ // the underflow mode is the same as it was on entry.
+ mlir::Value underflowMode =
+ fir::runtime::genGetUnderflowMode(*builder, loc);
+ bridge.fctCtx().attachCleanup([=]() {
+ fir::runtime::genSetUnderflowMode(*builder, loc, {underflowMode});
+ });
+ }
}
/// Start translation of a function.
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 793e291a168adf..41bdff4dca4719 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -161,11 +161,14 @@ class PFTBuilder {
return;
if (procName.starts_with("ieee_set_modes_") ||
procName.starts_with("ieee_set_status_"))
- proc->mayModifyHaltingMode = proc->mayModifyRoundingMode = true;
+ proc->mayModifyHaltingMode = proc->mayModifyRoundingMode =
+ proc->mayModifyUnderflowMode = true;
else if (procName.starts_with("ieee_set_halting_mode_"))
proc->mayModifyHaltingMode = true;
else if (procName.starts_with("ieee_set_rounding_mode_"))
proc->mayModifyRoundingMode = true;
+ else if (procName.starts_with("ieee_set_underflow_mode_"))
+ proc->mayModifyUnderflowMode = true;
}
/// Convert an IfStmt into an IfConstruct, retaining the IfStmt as the
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 5dfa53e047f421..2758da48bceca4 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -95,10 +95,6 @@ static bool isStaticallyPresent(const fir::ExtendedValue &exv) {
return !isStaticallyAbsent(exv);
}
-/// IEEE module procedure names not yet implemented for genModuleProcTODO.
-static constexpr char ieee_get_underflow_mode[] = "ieee_get_underflow_mode";
-static constexpr char ieee_set_underflow_mode[] = "ieee_set_underflow_mode";
-
using I = IntrinsicLibrary;
/// Flag to indicate that an intrinsic argument has to be handled as
@@ -328,7 +324,10 @@ static constexpr IntrinsicHandler handlers[]{
{"radix", asValue, handleDynamicOptional}}},
/*isElemental=*/false},
{"ieee_get_status", &I::genIeeeGetOrSetStatus</*isGet=*/true>},
- {"ieee_get_underflow_mode", &I::genModuleProcTODO<ieee_get_underflow_mode>},
+ {"ieee_get_underflow_mode",
+ &I::genIeeeGetUnderflowMode,
+ {{{"gradual", asAddr}}},
+ /*isElemental=*/false},
{"ieee_int", &I::genIeeeInt},
{"ieee_is_finite", &I::genIeeeIsFinite},
{"ieee_is_nan", &I::genIeeeIsNan},
@@ -375,7 +374,7 @@ static constexpr IntrinsicHandler handlers[]{
{"radix", asValue, handleDynamicOptional}}},
/*isElemental=*/false},
{"ieee_set_status", &I::genIeeeGetOrSetStatus</*isGet=*/false>},
- {"ieee_set_underflow_mode", &I::genModuleProcTODO<ieee_set_underflow_mode>},
+ {"ieee_set_underflow_mode", &I::genIeeeSetUnderflowMode},
{"ieee_signaling_eq",
&I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OEQ>},
{"ieee_signaling_ge",
@@ -2295,12 +2294,6 @@ mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
return builder.convertWithSemantics(loc, resultType, args[0]);
}
-template <const char *intrinsicName>
-void IntrinsicLibrary::genModuleProcTODO(
- llvm::ArrayRef<fir::ExtendedValue> args) {
- crashOnMissingIntrinsic(loc, intrinsicName);
-}
-
// ABORT
void IntrinsicLibrary::genAbort(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 0);
@@ -4471,6 +4464,14 @@ void IntrinsicLibrary::genIeeeGetOrSetStatus(
genRuntimeCall(isGet ? "fegetenv" : "fesetenv", i32Ty, addr);
}
+// IEEE_GET_UNDERFLOW_MODE
+void IntrinsicLibrary::genIeeeGetUnderflowMode(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 1);
+ mlir::Value flag = fir::runtime::genGetUnderflowMode(builder, loc);
+ builder.createStoreWithConvert(loc, flag, fir::getBase(args[0]));
+}
+
// IEEE_INT
mlir::Value IntrinsicLibrary::genIeeeInt(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
@@ -5135,6 +5136,15 @@ void IntrinsicLibrary::genIeeeSetRoundingMode(
builder.create<fir::CallOp>(loc, setRound, mode);
}
+// IEEE_SET_UNDERFLOW_MODE
+void IntrinsicLibrary::genIeeeSetUnderflowMode(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 1);
+ mlir::Value gradual = builder.create<fir::ConvertOp>(loc, builder.getI1Type(),
+ getBase(args[0]));
+ fir::runtime::genSetUnderflowMode(builder, loc, {gradual});
+}
+
// IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
// IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
template <mlir::arith::CmpFPredicate pred>
diff --git a/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp b/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp
index 8775b50437af23..85f38424eabdc4 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp
@@ -20,3 +20,17 @@ mlir::Value fir::runtime::genMapExcept(fir::FirOpBuilder &builder,
fir::runtime::getRuntimeFunc<mkRTKey(MapException)>(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{
+ fir::runtime::getRuntimeFunc<mkRTKey(GetUnderflowMode)>(loc, builder)};
+ return builder.create<fir::CallOp>(loc, func).getResult(0);
+}
+
+void fir::runtime::genSetUnderflowMode(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value flag) {
+ mlir::func::FuncOp func{
+ fir::runtime::getRuntimeFunc<mkRTKey(SetUnderflowMode)>(loc, builder)};
+ builder.create<fir::CallOp>(loc, func, flag);
+}
diff --git a/flang/runtime/exceptions.cpp b/flang/runtime/exceptions.cpp
index 8239c556bcea97..993c996c9ce75d 100644
--- a/flang/runtime/exceptions.cpp
+++ b/flang/runtime/exceptions.cpp
@@ -11,6 +11,9 @@
#include "flang/Runtime/exceptions.h"
#include "terminator.h"
#include <cfenv>
+#if __x86_64__
+#include <xmmintrin.h>
+#endif
// When not supported, these macro are undefined in cfenv.h,
// set them to zero in that case.
@@ -78,5 +81,22 @@ 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.
+bool RTNAME(GetUnderflowMode)(void) {
+#if __x86_64__
+ // The MXCSR Flush to Zero flag is the negation of the ieee_get_underflow_mode
+ // GRADUAL argument. It affects real computations of kinds 3, 4, and 8.
+ return _MM_GET_FLUSH_ZERO_MODE() == _MM_FLUSH_ZERO_OFF;
+#else
+ return false;
+#endif
+}
+void RTNAME(SetUnderflowMode)(bool flag) {
+#if __x86_64__
+ // The MXCSR Flush to Zero flag is the negation of the ieee_set_underflow_mode
+ // GRADUAL argument. It affects real computations of kinds 3, 4, and 8.
+ _MM_SET_FLUSH_ZERO_MODE(flag ? _MM_FLUSH_ZERO_OFF : _MM_FLUSH_ZERO_ON);
+#endif
+}
+
} // extern "C"
} // namespace Fortran::runtime
diff --git a/flang/test/Evaluate/fold-ieee.f90 b/flang/test/Evaluate/fold-ieee.f90
index 536db6481e6709..a74630d50933c8 100644
--- a/flang/test/Evaluate/fold-ieee.f90
+++ b/flang/test/Evaluate/fold-ieee.f90
@@ -58,7 +58,7 @@ 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 = ieee_support_underflow_control()
+ 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)
end
diff --git a/flang/test/Evaluate/folding18.f90 b/flang/test/Evaluate/folding18.f90
index 9110689cf5d63d..9e2b0a8f05de8a 100644
--- a/flang/test/Evaluate/folding18.f90
+++ b/flang/test/Evaluate/folding18.f90
@@ -65,11 +65,11 @@ module m
.and. ieee_support_subnormal(1.0_8) &
.and. ieee_support_subnormal(1.0_10) &
.and. ieee_support_subnormal(1.0_16)
- logical, parameter :: test_ieee_support_underflow_control = ieee_support_underflow_control() &
- .and. ieee_support_underflow_control(1.0_2) &
+ logical, parameter :: test_ieee_support_underflow_control = .not. ieee_support_underflow_control() &
+ .and. .not. ieee_support_underflow_control(1.0_2) &
.and. ieee_support_underflow_control(1.0_3) &
.and. ieee_support_underflow_control(1.0_4) &
.and. ieee_support_underflow_control(1.0_8) &
- .and. ieee_support_underflow_control(1.0_10) &
- .and. ieee_support_underflow_control(1.0_16)
+ .and. .not. ieee_support_underflow_control(1.0_10) &
+ .and. .not. ieee_support_underflow_control(1.0_16)
end module
diff --git a/flang/test/Lower/Intrinsics/ieee_underflow.f90 b/flang/test/Lower/Intrinsics/ieee_underflow.f90
new file mode 100644
index 00000000000000..3170583e6e3aeb
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_underflow.f90
@@ -0,0 +1,39 @@
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QPs
+subroutine s
+ ! CHECK: %[[V_0:[0-9]+]] = fir.call @fetestexcept(%c-1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_1:[0-9]+]] = fir.call @feclearexcept(%[[V_0]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_2:[0-9]+]] = fir.call @_FortranAGetUnderflowMode() fastmath<contract> : () -> i1
+ use ieee_arithmetic, only: ieee_get_underflow_mode, ieee_set_underflow_mode
+
+ ! CHECK: %[[V_3:[0-9]+]] = fir.alloca !fir.logical<4> {bindc_name = "r", uniq_name = "_QFsEr"}
+ ! CHECK: %[[V_4:[0-9]+]]:2 = hlfir.declare %[[V_3]] {uniq_name = "_QFsEr"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+ logical r
+
+ ! CHECK: %[[V_5:[0-9]+]] = fir.convert %false{{[_0-9]*}} : (i1) -> i1
+ ! CHECK: %[[V_6:[0-9]+]] = fir.call @_FortranASetUnderflowMode(%[[V_5]]) fastmath<contract> : (i1) -> none
+ call ieee_set_underflow_mode(.false.)
+
+ ! CHECK: %[[V_7:[0-9]+]] = fir.call @_FortranAGetUnderflowMode() fastmath<contract> : () -> i1
+ ! CHECK: %[[V_8:[0-9]+]] = fir.convert %[[V_7]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_8]] to %[[V_4]]#1 : !fir.ref<!fir.logical<4>>
+ call ieee_get_underflow_mode(r)
+! print*, r
+
+ ! CHECK: %[[V_9:[0-9]+]] = fir.convert %true{{[_0-9]*}} : (i1) -> i1
+ ! CHECK: %[[V_10:[0-9]+]] = fir.call @_FortranASetUnderflowMode(%[[V_9]]) fastmath<contract> : (i1) -> none
+ call ieee_set_underflow_mode(.true.)
+
+ ! CHECK: %[[V_11:[0-9]+]] = fir.call @_FortranAGetUnderflowMode() fastmath<contract> : () -> i1
+ ! CHECK: %[[V_12:[0-9]+]] = fir.convert %[[V_11]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_12]] to %[[V_4]]#1 : !fir.ref<!fir.logical<4>>
+ call ieee_get_underflow_mode(r)
+! print*, r
+
+ ! CHECK: %[[V_13:[0-9]+]] = fir.call @_FortranASetUnderflowMode(%[[V_2]]) fastmath<contract> : (i1) -> none
+ ! CHECK: %[[V_14:[0-9]+]] = fir.call @feraiseexcept(%[[V_0]]) fastmath<contract> : (i32) -> i32
+end
+
+ call s
+end
More information about the flang-commits
mailing list